stgit.el: Add support for showing git-svn information
[stgit] / contrib / stgit.el
CommitLineData
3a59f3db
KH
1;; stgit.el: An emacs mode for StGit
2;;
3;; Copyright (C) 2007 David Kågedal <davidk@lysator.liu.se>
4;;
5;; To install: put this file on the load-path and place the following
6;; in your .emacs file:
7;;
8;; (require 'stgit)
9;;
10;; To start: `M-x stgit'
11
4f7efe0c
GH
12(when (< emacs-major-version 22)
13 (error "Emacs older than 22 is not supported by stgit.el"))
14
0f076fe6 15(require 'git nil t)
50d88c67 16(require 'cl)
a4a01630 17(require 'comint)
98230edd 18(require 'ewoc)
5038381d 19(require 'easymenu)
0b9ea6b8 20(require 'format-spec)
0f076fe6 21
4ba91e80
DK
22(defun stgit-set-default (symbol value)
23 "Set default value of SYMBOL to VALUE using `set-default' and
24reload all StGit buffers."
25 (set-default symbol value)
26 (dolist (buf (buffer-list))
27 (with-current-buffer buf
28 (when (eq major-mode 'stgit-mode)
29 (stgit-reload)))))
30
31(defgroup stgit nil
32 "A user interface for the StGit patch maintenance tool."
33 :group 'tools
34 :link '(function-link stgit)
35 :link '(url-link "http://www.procode.org/stgit/"))
36
37(defcustom stgit-abbreviate-copies-and-renames t
38 "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\"
39instead of \"dir/old/file -> dir/new/file\"."
40 :type 'boolean
41 :group 'stgit
42 :set 'stgit-set-default)
43
44(defcustom stgit-default-show-worktree t
45 "Set to non-nil to by default show the working tree in a new stgit buffer.
46
bc11fb08
GH
47Use \\<stgit-mode-map>\\[stgit-toggle-worktree] to toggle this \
48setting in an already-started StGit buffer."
4ba91e80
DK
49 :type 'boolean
50 :group 'stgit
51 :link '(variable-link stgit-show-worktree))
52
bc11fb08
GH
53(defcustom stgit-default-show-unknown nil
54 "Set to non-nil to by default show unknown files a new stgit buffer.
55
56Use \\<stgit-mode-map>\\[stgit-toggle-unknown] to toggle this \
57setting in an already-started StGit buffer."
58 :type 'boolean
59 :group 'stgit
60 :link '(variable-link stgit-show-unknown))
61
62(defcustom stgit-default-show-ignored nil
63 "Set to non-nil to by default show ignored files a new stgit buffer.
64
65Use \\<stgit-mode-map>\\[stgit-toggle-ignored] to toggle this \
66setting in an already-started StGit buffer."
67 :type 'boolean
68 :group 'stgit
69 :link '(variable-link stgit-show-ignored))
70
137b315b
GH
71(defcustom stgit-default-show-svn t
72 "Set to non-nil to by default show subversion information in a
73new stgit buffer.
74
75Use \\<stgit-mode-map>\\[stgit-toggle-svn] to toggle this \
76setting in an already-started StGit buffer."
77 :type 'boolean
78 :group 'stgit
79 :link '(variable-link stgit-show-worktree))
80
4ba91e80
DK
81(defcustom stgit-find-copies-harder nil
82 "Try harder to find copied files when listing patches.
83
84When not nil, runs git diff-tree with the --find-copies-harder
85flag, which reduces performance."
86 :type 'boolean
87 :group 'stgit
88 :set 'stgit-set-default)
89
90(defcustom stgit-show-worktree-mode 'center
91 "This variable controls where the \"Index\" and \"Work tree\"
92will be shown on in the buffer.
93
94It can be set to 'top (above all patches), 'center (show between
95applied and unapplied patches), and 'bottom (below all patches)."
96 :type '(radio (const :tag "above all patches (top)" top)
97 (const :tag "between applied and unapplied patches (center)"
98 center)
99 (const :tag "below all patches (bottom)" bottom))
100 :group 'stgit
101 :link '(variable-link stgit-show-worktree)
102 :set 'stgit-set-default)
103
0b9ea6b8
DK
104(defcustom stgit-patch-line-format "%s%m%-30n %e%d"
105 "The format string used to format patch lines.
106The format string is passed to `format-spec' and the following
107format characters are recognized:
108
109 %s - A '+', '-', '>' or space, depending on whether the patch is
110 applied, unapplied, top, or something else.
111
112 %m - An asterisk if the patch is marked, and a space otherwise.
113
114 %n - The patch name.
115
116 %e - The string \"(empty) \" if the patch is empty.
117
a0045b87
DK
118 %d - The short patch description.
119
120 %D - The short patch description, or the patch name.
121
122When `stgit-show-patch-names' is non-nil, the `stgit-noname-patch-line-format'
123variable is used instead."
124 :type 'string
125 :group 'stgit
126 :set 'stgit-set-default)
127
128(defcustom stgit-noname-patch-line-format "%s%m%e%D"
129 "The alternate format string used to format patch lines.
130It has the same semantics as `stgit-patch-line-format', and the
f3dbdbc0
GH
131display can be toggled between the two formats using \
132\\<stgit-mode-map>\\[stgit-toggle-patch-names].
a0045b87
DK
133
134The alternate form is used when the patch name is hidden."
0b9ea6b8
DK
135 :type 'string
136 :group 'stgit
137 :set 'stgit-set-default)
138
bf7e391c
GH
139(defcustom stgit-default-show-committed nil
140 "Set to nil to inhibit showing of historical git commits by default.
141
142Use \\<stgit-mode-map>\\[stgit-toggle-committed] \
143to toggle this setting and to control how many commits are
144shown."
145 :type 'boolean
146 :group 'stgit
147 :link '(variable-link stgit-show-committed))
148
149(defcustom stgit-default-committed-count 5
150 "The number of historical commits to show when `stgit-show-committed'
151is enabled."
152 :type 'number
153 :link '(variable-link stgit-committed-count))
154
a0045b87
DK
155(defcustom stgit-default-show-patch-names t
156 "If non-nil, default to showing patch names in a new stgit buffer.
157
f3dbdbc0
GH
158Use \\<stgit-mode-map>\\[stgit-toggle-patch-names] \
159to toggle the this setting in an already-started StGit buffer."
a0045b87
DK
160 :type 'boolean
161 :group 'stgit
162 :link '(variable-link stgit-show-patch-names))
163
43ee50b6
DK
164(defcustom stgit-file-line-format " %-11s %-2m %n %c"
165 "The format string used to format file lines.
166The format string is passed to `format-spec' and the following
167format characters are recognized:
168
169 %s - A string describing the status of the file.
170
171 %m - Mode change information
172
173 %n - The file name.
174
175 %c - A description of file changes."
176 :type 'string
177 :group 'stgit
178 :set 'stgit-set-default)
179
4ba91e80
DK
180(defface stgit-branch-name-face
181 '((t :inherit bold))
182 "The face used for the StGit branch name"
183 :group 'stgit)
184
185(defface stgit-top-patch-face
186 '((((background dark)) (:weight bold :foreground "yellow"))
187 (((background light)) (:weight bold :foreground "purple"))
188 (t (:weight bold)))
189 "The face used for the top patch names"
190 :group 'stgit)
191
192(defface stgit-applied-patch-face
193 '((((background dark)) (:foreground "light yellow"))
194 (((background light)) (:foreground "purple"))
195 (t ()))
196 "The face used for applied patch names"
197 :group 'stgit)
198
199(defface stgit-unapplied-patch-face
200 '((((background dark)) (:foreground "gray80"))
201 (((background light)) (:foreground "orchid"))
202 (t ()))
203 "The face used for unapplied patch names"
204 :group 'stgit)
205
bf7e391c
GH
206(defface stgit-committed-patch-face
207 '((((background dark)) (:foreground "gray50"))
208 (((background light)) (:foreground "gray50"))
209 (t ()))
210 "The face used for already committed patch names"
211 :group 'stgit)
212
4ba91e80
DK
213(defface stgit-description-face
214 '((((background dark)) (:foreground "tan"))
215 (((background light)) (:foreground "dark red")))
216 "The face used for StGit descriptions"
217 :group 'stgit)
218
219(defface stgit-index-work-tree-title-face
220 '((((supports :slant italic)) :slant italic)
221 (t :inherit bold))
222 "StGit mode face used for the \"Index\" and \"Work tree\" titles"
223 :group 'stgit)
224
225(defface stgit-unmerged-file-face
226 '((((class color) (background light)) (:foreground "red" :bold t))
227 (((class color) (background dark)) (:foreground "red" :bold t)))
228 "StGit mode face used for unmerged file status"
229 :group 'stgit)
230
231(defface stgit-unknown-file-face
232 '((((class color) (background light)) (:foreground "goldenrod" :bold t))
233 (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
234 "StGit mode face used for unknown file status"
235 :group 'stgit)
236
237(defface stgit-ignored-file-face
238 '((((class color) (background light)) (:foreground "grey60"))
239 (((class color) (background dark)) (:foreground "grey40")))
240 "StGit mode face used for ignored files")
241
242(defface stgit-file-permission-face
243 '((((class color) (background light)) (:foreground "green" :bold t))
244 (((class color) (background dark)) (:foreground "green" :bold t)))
245 "StGit mode face used for permission changes."
246 :group 'stgit)
247
248(defface stgit-modified-file-face
249 '((((class color) (background light)) (:foreground "purple"))
250 (((class color) (background dark)) (:foreground "salmon")))
251 "StGit mode face used for modified file status"
252 :group 'stgit)
253
56d81fe5 254(defun stgit (dir)
fdf5e327
GH
255 "Manage StGit patches for the tree in DIR.
256
257See `stgit-mode' for commands available."
56d81fe5 258 (interactive "DDirectory: \n")
52144ce5 259 (switch-to-stgit-buffer (git-get-top-dir dir))
1f0bf00f 260 (stgit-reload))
56d81fe5 261
9d04c657
GH
262(defun stgit-assert-mode ()
263 "Signal an error if not in an StGit buffer."
264 (assert (derived-mode-p 'stgit-mode) nil "Not an StGit buffer"))
265
074a4fb0
GH
266(unless (fboundp 'git-get-top-dir)
267 (defun git-get-top-dir (dir)
268 "Retrieve the top-level directory of a git tree."
269 (let ((cdup (with-output-to-string
270 (with-current-buffer standard-output
271 (cd dir)
272 (unless (eq 0 (call-process "git" nil t nil
273 "rev-parse" "--show-cdup"))
df283a8b 274 (error "Cannot find top-level git tree for %s" dir))))))
074a4fb0
GH
275 (expand-file-name (concat (file-name-as-directory dir)
276 (car (split-string cdup "\n")))))))
277
278(defun stgit-refresh-git-status (&optional dir)
279 "If it exists, refresh the `git-status' buffer belonging to
280directory DIR or `default-directory'"
281 (when (and (fboundp 'git-find-status-buffer)
282 (fboundp 'git-refresh-status))
283 (let* ((top-dir (git-get-top-dir (or dir default-directory)))
284 (git-status-buffer (and top-dir (git-find-status-buffer top-dir))))
285 (when git-status-buffer
286 (with-current-buffer git-status-buffer
287 (git-refresh-status))))))
52144ce5 288
b894e680
DK
289(defun stgit-find-buffer (dir)
290 "Return the buffer displaying StGit patches for DIR, or nil if none."
56d81fe5
DK
291 (setq dir (file-name-as-directory dir))
292 (let ((buffers (buffer-list)))
293 (while (and buffers
294 (not (with-current-buffer (car buffers)
295 (and (eq major-mode 'stgit-mode)
296 (string= default-directory dir)))))
297 (setq buffers (cdr buffers)))
b894e680
DK
298 (and buffers (car buffers))))
299
300(defun switch-to-stgit-buffer (dir)
301 "Switch to a (possibly new) buffer displaying StGit patches for DIR."
302 (setq dir (file-name-as-directory dir))
303 (let ((buffer (stgit-find-buffer dir)))
304 (switch-to-buffer (or buffer
305 (create-stgit-buffer dir)))))
306
413f9909
GH
307(defstruct (stgit-patch
308 (:conc-name stgit-patch->))
3164eec6 309 status name desc empty files-ewoc)
56d81fe5 310
0b9ea6b8 311(defun stgit-patch-display-name (patch)
413f9909 312 (let ((name (stgit-patch->name patch)))
0b9ea6b8
DK
313 (case name
314 (:index "Index")
315 (:work "Work Tree")
316 (t (symbol-name name)))))
317
da30db2a
GH
318(defun stgit-insert-without-trailing-whitespace (text)
319 "Insert TEXT in buffer using `insert', without trailing whitespace.
320A newline is appended."
321 (unless (string-match "\\(.*?\\) *$" text)
322 (error))
323 (insert (match-string 1 text) ?\n))
324
6fdc3546
GH
325(defun stgit-line-format ()
326 "Return the current line format; one of
327`stgit-patch-line-format' and `stgit-noname-patch-line-format'"
328 (if stgit-show-patch-names
329 stgit-patch-line-format
330 stgit-noname-patch-line-format))
331
98230edd 332(defun stgit-patch-pp (patch)
413f9909 333 (let* ((status (stgit-patch->status patch))
9153ce3a 334 (start (point))
413f9909 335 (name (stgit-patch->name patch))
0b9ea6b8 336 (face (cdr (assq status stgit-patch-status-face-alist)))
6fdc3546 337 (fmt (stgit-line-format))
0b9ea6b8
DK
338 (spec (format-spec-make
339 ?s (case status
340 ('applied "+")
341 ('top ">")
342 ('unapplied "-")
343 (t " "))
344 ?m (if (memq name stgit-marked-patches)
345 "*" " ")
346 ?n (propertize (stgit-patch-display-name patch)
347 'face face
348 'syntax-table (string-to-syntax "w"))
413f9909
GH
349 ?e (if (stgit-patch->empty patch) "(empty) " "")
350 ?d (propertize (or (stgit-patch->desc patch) "")
a0045b87 351 'face 'stgit-description-face)
48047215
GH
352 ?D (propertize (let ((desc (stgit-patch->desc patch)))
353 (if (zerop (length desc))
354 (stgit-patch-display-name patch)
355 desc))
da30db2a
GH
356 'face face)))
357 (text (format-spec fmt spec)))
0b9ea6b8 358
da30db2a 359 (stgit-insert-without-trailing-whitespace text)
f9b82d36 360 (put-text-property start (point) 'entry-type 'patch)
98230edd 361 (when (memq name stgit-expanded-patches)
0de6881a 362 (stgit-insert-patch-files patch))
98230edd
DK
363 (put-text-property start (point) 'patch-data patch)))
364
56d81fe5
DK
365(defun create-stgit-buffer (dir)
366 "Create a buffer for showing StGit patches.
367Argument DIR is the repository path."
368 (let ((buf (create-file-buffer (concat dir "*stgit*")))
369 (inhibit-read-only t))
370 (with-current-buffer buf
371 (setq default-directory dir)
372 (stgit-mode)
98230edd 373 (set (make-local-variable 'stgit-ewoc)
4f7ff561 374 (ewoc-create #'stgit-patch-pp "Branch:\n\n" "--\n" t))
56d81fe5
DK
375 (setq buffer-read-only t))
376 buf))
377
072e96c5
GH
378(def-edebug-spec stgit-capture-output
379 (form body))
56d81fe5 380(defmacro stgit-capture-output (name &rest body)
e558a4ab
GH
381 "Capture StGit output and, if there was any output, show it in a window
382at the end.
383Returns nil if there was no output."
94baef5a
DK
384 (declare (debug ([&or stringp null] body))
385 (indent 1))
34afb86c
DK
386 `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
387 (stgit-dir default-directory)
388 (inhibit-read-only t))
56d81fe5 389 (with-current-buffer output-buf
277b52af 390 (buffer-disable-undo)
34afb86c
DK
391 (erase-buffer)
392 (setq default-directory stgit-dir)
393 (setq buffer-read-only t))
56d81fe5
DK
394 (let ((standard-output output-buf))
395 ,@body)
34afb86c
DK
396 (with-current-buffer output-buf
397 (set-buffer-modified-p nil)
398 (setq buffer-read-only t)
399 (if (< (point-min) (point-max))
400 (display-buffer output-buf t)))))
56d81fe5 401
d51722b7
GH
402(defun stgit-make-run-args (args)
403 "Return a copy of ARGS with its elements converted to strings."
404 (mapcar (lambda (x)
405 ;; don't use (format "%s" ...) to limit type errors
406 (cond ((stringp x) x)
407 ((integerp x) (number-to-string x))
408 ((symbolp x) (symbol-name x))
409 (t
410 (error "Bad element in stgit-make-run-args args: %S" x))))
411 args))
412
9aecd505 413(defun stgit-run-silent (&rest args)
d51722b7 414 (setq args (stgit-make-run-args args))
56d81fe5
DK
415 (apply 'call-process "stg" nil standard-output nil args))
416
9aecd505 417(defun stgit-run (&rest args)
d51722b7 418 (setq args (stgit-make-run-args args))
9aecd505
DK
419 (let ((msgcmd (mapconcat #'identity args " ")))
420 (message "Running stg %s..." msgcmd)
421 (apply 'call-process "stg" nil standard-output nil args)
422 (message "Running stg %s...done" msgcmd)))
423
378a003d 424(defun stgit-run-git (&rest args)
d51722b7 425 (setq args (stgit-make-run-args args))
378a003d
GH
426 (let ((msgcmd (mapconcat #'identity args " ")))
427 (message "Running git %s..." msgcmd)
428 (apply 'call-process "git" nil standard-output nil args)
429 (message "Running git %s...done" msgcmd)))
430
1f60181a 431(defun stgit-run-git-silent (&rest args)
d51722b7 432 (setq args (stgit-make-run-args args))
1f60181a
GH
433 (apply 'call-process "git" nil standard-output nil args))
434
b894e680
DK
435(defun stgit-index-empty-p ()
436 "Returns non-nil if the index contains no changes from HEAD."
437 (zerop (stgit-run-git-silent "diff-index" "--cached" "--quiet" "HEAD")))
438
1629f59f
GH
439(defun stgit-work-tree-empty-p ()
440 "Returns non-nil if the work tree contains no changes from index."
441 (zerop (stgit-run-git-silent "diff-files" "--quiet")))
442
e44674e3
GH
443(defvar stgit-did-advise nil
444 "Set to non-nil if appropriate (non-stgit) git functions have
445been advised to update the stgit status when necessary.")
446
3e528fb0
GH
447(defconst stgit-allowed-branch-name-re
448 ;; Disallow control characters, space, del, and "/:@^{}~" in
449 ;; "/"-separated parts; parts may not start with a period (.)
450 "^[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\
451\\(/[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\\)*$"
452 "Regular expression that (new) branch names must match.")
453
210a2a52
DK
454(defun stgit-refresh-index ()
455 (when stgit-index-node
456 (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node))))
457
458(defun stgit-refresh-worktree ()
459 (when stgit-worktree-node
460 (ewoc-invalidate (car stgit-worktree-node) (cdr stgit-worktree-node))))
461
8f702de4
GH
462(defun stgit-run-series-insert-index (ewoc)
463 (setq index-node (cons ewoc (ewoc-enter-last ewoc
464 (make-stgit-patch
465 :status 'index
466 :name :index
467 :desc nil
468 :empty nil)))
469 worktree-node (cons ewoc (ewoc-enter-last ewoc
470 (make-stgit-patch
471 :status 'work
472 :name :work
473 :desc nil
474 :empty nil)))))
475
137b315b
GH
476(defun stgit-svn-find-rev (sha1 hash)
477 "Return the subversion revision corresponding to SHA1 as
478reported by git svn.
479
480Cached data is stored in HASH, which must have been created
481using (make-hash-table :test 'equal)."
482 (let ((result (gethash sha1 hash t)))
483 (when (eq result t)
484 (let ((svn-rev (with-output-to-string
485 (stgit-run-git-silent "svn" "find-rev"
486 "--" sha1))))
487 (setq result (when (string-match "\\`[0-9]+" svn-rev)
488 (string-to-number (match-string 0 svn-rev))))
489 (puthash sha1 result hash)))
490 result))
491
98230edd 492(defun stgit-run-series (ewoc)
8f702de4
GH
493 (setq stgit-index-node nil
494 stgit-worktree-node nil)
bf7e391c
GH
495 (let (all-patchsyms)
496 (when stgit-show-committed
137b315b
GH
497 (let* ((show-svn stgit-show-svn)
498 (svn-hash stgit-svn-find-rev-hash)
499 (base (stgit-id "{base}"))
bf7e391c
GH
500 (range (format "%s~%d..%s" base stgit-committed-count base)))
501 (with-temp-buffer
502 (let* ((standard-output (current-buffer))
503 (fmt (stgit-line-format))
504 (commit-abbrev (when (string-match "%-\\([0-9]+\\)n" fmt)
137b315b
GH
505 (string-to-number (match-string 1 fmt))))
506 (exit-status (stgit-run-git-silent "--no-pager" "log"
507 "--reverse"
508 "--pretty=oneline"
509 range)))
bf7e391c
GH
510 (goto-char (point-min))
511 (if (not (zerop exit-status))
512 (message "Failed to run git log")
513 (while (not (eobp))
514 (unless (looking-at
515 "\\([0-9a-f]+\\)\\(\\.\\.\\.\\)? \\(.*\\)")
516 (error "Syntax error in output from git log"))
517 (let* ((state 'committed)
137b315b 518 (name (match-string 1))
bf7e391c
GH
519 (desc (match-string 3))
520 (empty nil))
137b315b
GH
521
522 (when show-svn
523 (let ((svn-rev (stgit-svn-find-rev name svn-hash)))
524 (when svn-rev
525 (setq desc (format "(r%s) %s" svn-rev desc)))))
526
527 (and commit-abbrev
528 (< commit-abbrev (length name))
529 (setq name (substring name 0 commit-abbrev)))
530
531 (setq name (intern name))
532
bf7e391c
GH
533 (setq all-patchsyms (cons name all-patchsyms))
534 (ewoc-enter-last ewoc
535 (make-stgit-patch
536 :status state
537 :name name
538 :desc desc
539 :empty empty)))
540 (forward-line 1)))))))
541 (let ((inserted-index (not stgit-show-worktree))
542 index-node
543 worktree-node)
544 (with-temp-buffer
545 (let* ((standard-output (current-buffer))
546 (exit-status (stgit-run-silent "series"
547 "--description" "--empty")))
548 (goto-char (point-min))
549 (if (not (zerop exit-status))
550 (cond ((looking-at "stg series: \\(.*\\)")
551 (setq inserted-index t)
552 (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
553 (substitute-command-keys
554 "-- not initialized; run \\[stgit-init]")))
555 ((looking-at ".*")
556 (error "Error running stg: %s"
557 (match-string 0))))
558 (while (not (eobp))
559 (unless (looking-at
560 "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
561 (error "Syntax error in output from stg series"))
562 (let* ((state-str (match-string 2))
563 (state (cond ((string= state-str ">") 'top)
564 ((string= state-str "+") 'applied)
565 ((string= state-str "-") 'unapplied)))
566 (name (intern (match-string 4)))
567 (desc (match-string 5))
568 (empty (string= (match-string 1) "0")))
569 (unless inserted-index
570 (when (or (eq stgit-show-worktree-mode 'top)
571 (and (eq stgit-show-worktree-mode 'center)
572 (eq state 'unapplied)))
573 (setq inserted-index t)
574 (stgit-run-series-insert-index ewoc)))
575 (setq all-patchsyms (cons name all-patchsyms))
576 (ewoc-enter-last ewoc
577 (make-stgit-patch
578 :status state
579 :name name
580 :desc desc
581 :empty empty)))
582 (forward-line 1)))))
8f702de4 583 (unless inserted-index
bf7e391c
GH
584 (stgit-run-series-insert-index ewoc))
585 (setq stgit-index-node index-node
586 stgit-worktree-node worktree-node
587 stgit-marked-patches (intersection stgit-marked-patches
588 all-patchsyms)))))
98230edd 589
3e528fb0
GH
590(defun stgit-current-branch ()
591 "Return the name of the current branch."
592 (substring (with-output-to-string
593 (stgit-run-silent "branch"))
594 0 -1))
595
1f0bf00f 596(defun stgit-reload ()
a53347d9 597 "Update the contents of the StGit buffer."
56d81fe5 598 (interactive)
9d04c657 599 (stgit-assert-mode)
56d81fe5
DK
600 (let ((inhibit-read-only t)
601 (curline (line-number-at-pos))
a9089e68
GH
602 (curpatch (stgit-patch-name-at-point))
603 (curfile (stgit-patched-file-at-point)))
98230edd
DK
604 (ewoc-filter stgit-ewoc #'(lambda (x) nil))
605 (ewoc-set-hf stgit-ewoc
606 (concat "Branch: "
3e528fb0
GH
607 (propertize (stgit-current-branch)
608 'face 'stgit-branch-name-face)
4f7ff561 609 "\n\n")
ce3b6130
DK
610 (if stgit-show-worktree
611 "--"
612 (propertize
613 (substitute-command-keys "--\n\"\\[stgit-toggle-worktree]\"\
614 shows the working tree\n")
6a73154a 615 'face 'stgit-description-face)))
98230edd 616 (stgit-run-series stgit-ewoc)
2570f6e5
GH
617 (unless (and curpatch
618 (stgit-goto-patch curpatch
619 (and curfile (stgit-file->file curfile))))
79473ca5
GH
620 (goto-char (point-min))
621 (forward-line (1- curline))
622 (move-to-column (stgit-goal-column))))
074a4fb0 623 (stgit-refresh-git-status))
56d81fe5 624
1f60181a
GH
625(defconst stgit-file-status-code-strings
626 (mapcar (lambda (arg)
627 (cons (car arg)
a6d9a852
GH
628 (propertize (cadr arg) 'face (car (cddr arg)))))
629 '((add "Added" stgit-modified-file-face)
630 (copy "Copied" stgit-modified-file-face)
631 (delete "Deleted" stgit-modified-file-face)
632 (modify "Modified" stgit-modified-file-face)
633 (rename "Renamed" stgit-modified-file-face)
634 (mode-change "Mode change" stgit-modified-file-face)
635 (unmerged "Unmerged" stgit-unmerged-file-face)
d9473917
GH
636 (unknown "Unknown" stgit-unknown-file-face)
637 (ignore "Ignored" stgit-ignored-file-face)))
1f60181a
GH
638 "Alist of code symbols to description strings")
639
000f337c
GH
640(defconst stgit-patch-status-face-alist
641 '((applied . stgit-applied-patch-face)
642 (top . stgit-top-patch-face)
643 (unapplied . stgit-unapplied-patch-face)
bf7e391c 644 (committed . stgit-committed-patch-face)
9153ce3a
GH
645 (index . stgit-index-work-tree-title-face)
646 (work . stgit-index-work-tree-title-face))
000f337c
GH
647 "Alist of face to use for a given patch status")
648
3164eec6
DK
649(defun stgit-file-status-code-as-string (file)
650 "Return stgit status code for FILE as a string"
413f9909 651 (let* ((code (assq (stgit-file->status file)
3164eec6 652 stgit-file-status-code-strings))
413f9909 653 (score (stgit-file->cr-score file)))
3164eec6 654 (when code
43ee50b6
DK
655 (if (and score (/= score 100))
656 (format "%s %s" (cdr code)
657 (propertize (format "%d%%" score)
658 'face 'stgit-description-face))
659 (cdr code)))))
1f60181a 660
a6d9a852 661(defun stgit-file-status-code (str &optional score)
1f60181a
GH
662 "Return stgit status code from git status string"
663 (let ((code (assoc str '(("A" . add)
664 ("C" . copy)
665 ("D" . delete)
d9473917 666 ("I" . ignore)
1f60181a
GH
667 ("M" . modify)
668 ("R" . rename)
669 ("T" . mode-change)
670 ("U" . unmerged)
671 ("X" . unknown)))))
a6d9a852
GH
672 (setq code (if code (cdr code) 'unknown))
673 (when (stringp score)
674 (if (> (length score) 0)
675 (setq score (string-to-number score))
676 (setq score nil)))
677 (if score (cons code score) code)))
678
679(defconst stgit-file-type-strings
680 '((#o100 . "file")
681 (#o120 . "symlink")
682 (#o160 . "subproject"))
683 "Alist of names of file types")
684
685(defun stgit-file-type-string (type)
47271f41
GH
686 "Return string describing file type TYPE (the high bits of file permission).
687Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
a6d9a852
GH
688 (let ((type-str (assoc type stgit-file-type-strings)))
689 (or (and type-str (cdr type-str))
690 (format "unknown type %o" type))))
691
692(defun stgit-file-type-change-string (old-perm new-perm)
47271f41
GH
693 "Return string describing file type change from OLD-PERM to NEW-PERM.
694Cf. `stgit-file-type-string'."
a6d9a852
GH
695 (let ((old-type (lsh old-perm -9))
696 (new-type (lsh new-perm -9)))
697 (cond ((= old-type new-type) "")
698 ((zerop new-type) "")
699 ((zerop old-type)
700 (if (= new-type #o100)
701 ""
43ee50b6
DK
702 (format "(%s)" (stgit-file-type-string new-type))))
703 (t (format "(%s -> %s)"
a6d9a852
GH
704 (stgit-file-type-string old-type)
705 (stgit-file-type-string new-type))))))
706
707(defun stgit-file-mode-change-string (old-perm new-perm)
47271f41
GH
708 "Return string describing file mode change from OLD-PERM to NEW-PERM.
709Cf. `stgit-file-type-change-string'."
a6d9a852
GH
710 (setq old-perm (logand old-perm #o777)
711 new-perm (logand new-perm #o777))
712 (if (or (= old-perm new-perm)
713 (zerop old-perm)
714 (zerop new-perm))
715 ""
716 (let* ((modified (logxor old-perm new-perm))
717 (not-x-modified (logand (logxor old-perm new-perm) #o666)))
718 (cond ((zerop modified) "")
719 ((and (zerop not-x-modified)
720 (or (and (eq #o111 (logand old-perm #o111))
721 (propertize "-x" 'face 'stgit-file-permission-face))
722 (and (eq #o111 (logand new-perm #o111))
723 (propertize "+x" 'face
724 'stgit-file-permission-face)))))
725 (t (concat (propertize (format "%o" old-perm)
726 'face 'stgit-file-permission-face)
727 (propertize " -> "
728 'face 'stgit-description-face)
729 (propertize (format "%o" new-perm)
730 'face 'stgit-file-permission-face)))))))
1f60181a 731
413f9909
GH
732(defstruct (stgit-file
733 (:conc-name stgit-file->))
0de6881a
DK
734 old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
735
ca027a87 736(defun stgit-describe-copy-or-rename (file)
6a73154a
GH
737 (let ((arrow (concat " " (propertize "->" 'face 'stgit-description-face) " "))
738 from to common-head common-tail)
ca027a87
GH
739
740 (when stgit-abbreviate-copies-and-renames
413f9909
GH
741 (setq from (split-string (stgit-file->cr-from file) "/")
742 to (split-string (stgit-file->cr-to file) "/"))
ca027a87
GH
743
744 (while (and from to (cdr from) (cdr to)
745 (string-equal (car from) (car to)))
746 (setq common-head (cons (car from) common-head)
747 from (cdr from)
748 to (cdr to)))
749 (setq common-head (nreverse common-head)
750 from (nreverse from)
751 to (nreverse to))
752 (while (and from to (cdr from) (cdr to)
753 (string-equal (car from) (car to)))
754 (setq common-tail (cons (car from) common-tail)
755 from (cdr from)
756 to (cdr to)))
757 (setq from (nreverse from)
758 to (nreverse to)))
759
760 (if (or common-head common-tail)
761 (concat (if common-head
762 (mapconcat #'identity common-head "/")
763 "")
764 (if common-head "/" "")
765 (propertize "{" 'face 'stgit-description-face)
766 (mapconcat #'identity from "/")
767 arrow
768 (mapconcat #'identity to "/")
769 (propertize "}" 'face 'stgit-description-face)
770 (if common-tail "/" "")
771 (if common-tail
772 (mapconcat #'identity common-tail "/")
773 ""))
413f9909 774 (concat (stgit-file->cr-from file) arrow (stgit-file->cr-to file)))))
ca027a87 775
3164eec6 776(defun stgit-file-pp (file)
43ee50b6
DK
777 (let ((start (point))
778 (spec (format-spec-make
779 ?s (stgit-file-status-code-as-string file)
780 ?m (stgit-file-mode-change-string
413f9909
GH
781 (stgit-file->old-perm file)
782 (stgit-file->new-perm file))
783 ?n (if (stgit-file->copy-or-rename file)
43ee50b6 784 (stgit-describe-copy-or-rename file)
413f9909 785 (stgit-file->file file))
43ee50b6 786 ?c (propertize (stgit-file-type-change-string
413f9909
GH
787 (stgit-file->old-perm file)
788 (stgit-file->new-perm file))
43ee50b6 789 'face 'stgit-description-face))))
da30db2a
GH
790 (stgit-insert-without-trailing-whitespace
791 (format-spec stgit-file-line-format spec))
0de6881a 792 (add-text-properties start (point)
3164eec6
DK
793 (list 'entry-type 'file
794 'file-data file))))
0de6881a 795
7567401c
GH
796(defun stgit-find-copies-harder-diff-arg ()
797 "Return the flag to use with `git-diff' depending on the
b6df231c
GH
798`stgit-find-copies-harder' flag."
799 (if stgit-find-copies-harder "--find-copies-harder" "-C"))
7567401c 800
d9473917
GH
801(defun stgit-insert-ls-files (args file-flag)
802 (let ((start (point)))
803 (apply 'stgit-run-git
804 (append '("ls-files" "--exclude-standard" "-z") args))
805 (goto-char start)
806 (while (looking-at "\\([^\0]*\\)\0")
807 (let ((name-len (- (match-end 0) (match-beginning 0))))
808 (insert ":0 0 0000000000000000000000000000000000000000 0000000000000000000000000000000000000000 " file-flag "\0")
809 (forward-char name-len)))))
810
7f972e9b
GH
811(defun stgit-process-files (callback)
812 (goto-char (point-min))
813 (when (looking-at "[0-9A-Fa-f]\\{40\\}\0")
814 (goto-char (match-end 0)))
815 (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
816 (let ((old-perm (string-to-number (match-string 1) 8))
817 (new-perm (string-to-number (match-string 2) 8)))
818 (goto-char (match-end 0))
819 (let ((file
820 (cond ((looking-at
821 "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
822 (let* ((patch-status (stgit-patch->status patch))
823 (file-subexp (if (eq patch-status 'unapplied)
824 3
825 4))
826 (file (match-string file-subexp)))
827 (make-stgit-file
828 :old-perm old-perm
829 :new-perm new-perm
830 :copy-or-rename t
831 :cr-score (string-to-number (match-string 2))
832 :cr-from (match-string 3)
833 :cr-to (match-string 4)
834 :status (stgit-file-status-code
835 (match-string 1))
836 :file file)))
837 ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
838 (make-stgit-file
839 :old-perm old-perm
840 :new-perm new-perm
841 :copy-or-rename nil
842 :cr-score nil
843 :cr-from nil
844 :cr-to nil
845 :status (stgit-file-status-code
846 (match-string 1))
847 :file (match-string 2))))))
848 (goto-char (match-end 0))
849 (funcall callback file)))))
850
851
0de6881a 852(defun stgit-insert-patch-files (patch)
88134ff7
GH
853 "Expand (show modification of) the patch PATCH after the line
854at point."
d2efc9d5
GH
855 (let* ((patchsym (stgit-patch->name patch))
856 (end (point-marker))
857 (args (list "-z" (stgit-find-copies-harder-diff-arg)))
858 (ewoc (ewoc-create #'stgit-file-pp nil nil t))
859 (show-ignored stgit-show-ignored)
860 (show-unknown stgit-show-unknown))
0434bec1 861 (set-marker-insertion-type end t)
413f9909 862 (setf (stgit-patch->files-ewoc patch) ewoc)
0de6881a 863 (with-temp-buffer
ea305902
GH
864 (let ((standard-output (current-buffer)))
865 (apply 'stgit-run-git
866 (cond ((eq patchsym :work)
0b71b4dc
GH
867 (let (standard-output)
868 (stgit-run-git "update-index" "--refresh"))
ea305902
GH
869 `("diff-files" "-0" ,@args))
870 ((eq patchsym :index)
871 `("diff-index" ,@args "--cached" "HEAD"))
872 (t
873 `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
874
875 (when (and (eq patchsym :work))
d2efc9d5 876 (when show-ignored
ea305902 877 (stgit-insert-ls-files '("--ignored" "--others") "I"))
d2efc9d5 878 (when show-unknown
7f972e9b
GH
879 (stgit-insert-ls-files '("--directory" "--no-empty-directory"
880 "--others")
881 "X"))
ea305902
GH
882 (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
883 (point-min) (point-max)))
884
7f972e9b 885 (stgit-process-files (lambda (file) (ewoc-enter-last ewoc file)))
ea305902
GH
886
887 (unless (ewoc-nth ewoc 0)
888 (ewoc-set-hf ewoc ""
889 (concat " "
890 (propertize "<no files>"
891 'face 'stgit-description-face)
892 "\n")))))
0434bec1 893 (goto-char end)))
07f464e0 894
030f0535
GH
895(defun stgit-find-file (&optional other-window)
896 (let* ((file (or (stgit-patched-file-at-point)
897 (error "No file at point")))
413f9909 898 (filename (expand-file-name (stgit-file->file file))))
0de6881a
DK
899 (unless (file-exists-p filename)
900 (error "File does not exist"))
030f0535
GH
901 (funcall (if other-window 'find-file-other-window 'find-file)
902 filename)
413f9909 903 (when (eq (stgit-file->status file) 'unmerged)
030f0535 904 (smerge-mode 1))))
acc5652f 905
afbf766b 906(defun stgit-expand (&optional patches collapse)
fd64ee57 907 "Show the contents of marked patches, or the patch at point.
afbf766b
GH
908
909See also `stgit-collapse'.
910
911Non-interactively, operate on PATCHES, and collapse instead of
912expand if COLLAPSE is not nil."
beac0f14 913 (interactive (list (stgit-patches-marked-or-at-point t)))
9d04c657 914 (stgit-assert-mode)
afbf766b
GH
915 (let ((patches-diff (funcall (if collapse #'intersection #'set-difference)
916 patches stgit-expanded-patches)))
917 (setq stgit-expanded-patches
918 (if collapse
919 (set-difference stgit-expanded-patches patches-diff)
920 (append stgit-expanded-patches patches-diff)))
921 (ewoc-map #'(lambda (patch)
413f9909 922 (memq (stgit-patch->name patch) patches-diff))
afbf766b
GH
923 stgit-ewoc))
924 (move-to-column (stgit-goal-column)))
925
926(defun stgit-collapse (&optional patches)
fd64ee57 927 "Hide the contents of marked patches, or the patch at point.
afbf766b
GH
928
929See also `stgit-expand'."
beac0f14 930 (interactive (list (stgit-patches-marked-or-at-point t)))
9d04c657 931 (stgit-assert-mode)
afbf766b
GH
932 (stgit-expand patches t))
933
50d88c67 934(defun stgit-select-patch ()
98230edd 935 (let ((patchname (stgit-patch-name-at-point)))
afbf766b
GH
936 (stgit-expand (list patchname)
937 (memq patchname stgit-expanded-patches))))
acc5652f 938
7f972e9b
GH
939(defun stgit-expand-directory (file)
940 (let* ((patch (stgit-patch-at-point))
941 (ewoc (stgit-patch->files-ewoc patch))
942 (node (ewoc-locate ewoc))
943 (filename (stgit-file->file file))
944 (start (make-marker))
945 (end (make-marker)))
946
947 (save-excursion
948 (forward-line 1)
949 (set-marker start (point))
950 (set-marker end (point))
951 (set-marker-insertion-type end t))
952
953 (assert (string-match "/$" filename))
954 ;; remove trailing "/"
955 (setf (stgit-file->file file) (substring filename 0 -1))
956 (ewoc-invalidate ewoc node)
957
958 (with-temp-buffer
959 (let ((standard-output (current-buffer)))
960 (stgit-insert-ls-files (list "--directory" "--others"
961 "--no-empty-directory" "--"
962 filename)
963 "X")
964 (stgit-process-files (lambda (f)
965 (setq node (ewoc-enter-after ewoc node f))))))
966
62548eec
GH
967 (move-to-column (stgit-goal-column))
968
7f972e9b
GH
969 (let ((inhibit-read-only t))
970 (put-text-property start end 'patch-data patch))))
971
972(defun stgit-select-file ()
973 (let* ((file (or (stgit-patched-file-at-point)
974 (error "No file at point")))
975 (filename (stgit-file->file file)))
976 (if (string-match "/$" filename)
977 (stgit-expand-directory file)
978 (stgit-find-file))))
979
378a003d 980(defun stgit-select ()
da01a29b
GH
981 "With point on a patch, toggle showing files in the patch.
982
983With point on a file, open the associated file. Opens the target
984file for (applied) copies and renames."
378a003d 985 (interactive)
9d04c657 986 (stgit-assert-mode)
50d88c67
DK
987 (case (get-text-property (point) 'entry-type)
988 ('patch
989 (stgit-select-patch))
990 ('file
7f972e9b 991 (stgit-select-file))
50d88c67
DK
992 (t
993 (error "No patch or file on line"))))
378a003d
GH
994
995(defun stgit-find-file-other-window ()
996 "Open file at point in other window"
997 (interactive)
9d04c657 998 (stgit-assert-mode)
030f0535 999 (stgit-find-file t))
378a003d 1000
d9b954c7
GH
1001(defun stgit-find-file-merge ()
1002 "Open file at point and merge it using `smerge-ediff'."
1003 (interactive)
9d04c657 1004 (stgit-assert-mode)
d9b954c7
GH
1005 (stgit-find-file t)
1006 (smerge-ediff))
1007
83327d53 1008(defun stgit-quit ()
a53347d9 1009 "Hide the stgit buffer."
83327d53 1010 (interactive)
9d04c657 1011 (stgit-assert-mode)
83327d53
GH
1012 (bury-buffer))
1013
0f076fe6 1014(defun stgit-git-status ()
a53347d9 1015 "Show status using `git-status'."
0f076fe6 1016 (interactive)
9d04c657 1017 (stgit-assert-mode)
0f076fe6 1018 (unless (fboundp 'git-status)
df283a8b 1019 (error "The stgit-git-status command requires git-status"))
0f076fe6
GH
1020 (let ((dir default-directory))
1021 (save-selected-window
1022 (pop-to-buffer nil)
1023 (git-status dir))))
1024
58f72f16
GH
1025(defun stgit-goal-column ()
1026 "Return goal column for the current line"
50d88c67
DK
1027 (case (get-text-property (point) 'entry-type)
1028 ('patch 2)
1029 ('file 4)
1030 (t 0)))
58f72f16
GH
1031
1032(defun stgit-next-line (&optional arg)
378a003d 1033 "Move cursor vertically down ARG lines"
58f72f16 1034 (interactive "p")
9d04c657 1035 (stgit-assert-mode)
58f72f16
GH
1036 (next-line arg)
1037 (move-to-column (stgit-goal-column)))
378a003d 1038
58f72f16 1039(defun stgit-previous-line (&optional arg)
378a003d 1040 "Move cursor vertically up ARG lines"
58f72f16 1041 (interactive "p")
9d04c657 1042 (stgit-assert-mode)
58f72f16
GH
1043 (previous-line arg)
1044 (move-to-column (stgit-goal-column)))
378a003d
GH
1045
1046(defun stgit-next-patch (&optional arg)
98230edd 1047 "Move cursor down ARG patches."
378a003d 1048 (interactive "p")
9d04c657 1049 (stgit-assert-mode)
98230edd
DK
1050 (ewoc-goto-next stgit-ewoc (or arg 1))
1051 (move-to-column goal-column))
378a003d
GH
1052
1053(defun stgit-previous-patch (&optional arg)
98230edd 1054 "Move cursor up ARG patches."
378a003d 1055 (interactive "p")
9d04c657 1056 (stgit-assert-mode)
98230edd
DK
1057 (ewoc-goto-prev stgit-ewoc (or arg 1))
1058 (move-to-column goal-column))
378a003d 1059
56d81fe5
DK
1060(defvar stgit-mode-hook nil
1061 "Run after `stgit-mode' is setup.")
1062
1063(defvar stgit-mode-map nil
1064 "Keymap for StGit major mode.")
1065
1066(unless stgit-mode-map
5038381d
GH
1067 (let ((diff-map (make-sparse-keymap))
1068 (toggle-map (make-sparse-keymap)))
d9b954c7
GH
1069 (mapc (lambda (arg) (define-key diff-map (car arg) (cdr arg)))
1070 '(("b" . stgit-diff-base)
1071 ("c" . stgit-diff-combined)
1072 ("m" . stgit-find-file-merge)
1073 ("o" . stgit-diff-ours)
e02b46e5 1074 ("r" . stgit-diff-range)
d9b954c7 1075 ("t" . stgit-diff-theirs)))
ce3b6130 1076 (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
a0045b87
DK
1077 '(("n" . stgit-toggle-patch-names)
1078 ("t" . stgit-toggle-worktree)
bf7e391c 1079 ("h" . stgit-toggle-committed)
d9473917 1080 ("i" . stgit-toggle-ignored)
137b315b
GH
1081 ("u" . stgit-toggle-unknown)
1082 ("s" . stgit-toggle-svn)))
ce3b6130
DK
1083 (setq stgit-mode-map (make-keymap))
1084 (suppress-keymap stgit-mode-map)
1085 (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
d11e0621
GH
1086 `((" " . stgit-mark-down)
1087 ("m" . stgit-mark-down)
ce3b6130
DK
1088 ("\d" . stgit-unmark-up)
1089 ("u" . stgit-unmark-down)
1090 ("?" . stgit-help)
1091 ("h" . stgit-help)
1092 ("\C-p" . stgit-previous-line)
1093 ("\C-n" . stgit-next-line)
1094 ([up] . stgit-previous-line)
1095 ([down] . stgit-next-line)
1096 ("p" . stgit-previous-patch)
1097 ("n" . stgit-next-patch)
1098 ("\M-{" . stgit-previous-patch)
1099 ("\M-}" . stgit-next-patch)
1100 ("s" . stgit-git-status)
408fa7cb 1101 ("g" . stgit-reload-or-repair)
ce3b6130
DK
1102 ("r" . stgit-refresh)
1103 ("\C-c\C-r" . stgit-rename)
1104 ("e" . stgit-edit)
1105 ("M" . stgit-move-patches)
1106 ("S" . stgit-squash)
1107 ("N" . stgit-new)
2acb7116 1108 ("c" . stgit-new-and-refresh)
e9fdd4ea
GH
1109 ("\C-c\C-c" . stgit-commit)
1110 ("\C-c\C-u" . stgit-uncommit)
1629f59f 1111 ("U" . stgit-revert)
51783171 1112 ("R" . stgit-resolve-file)
ce3b6130 1113 ("\r" . stgit-select)
afbf766b
GH
1114 ("+" . stgit-expand)
1115 ("-" . stgit-collapse)
ce3b6130 1116 ("o" . stgit-find-file-other-window)
dde3ab4d 1117 ("i" . stgit-toggle-index)
ce3b6130
DK
1118 (">" . stgit-push-next)
1119 ("<" . stgit-pop-next)
1120 ("P" . stgit-push-or-pop)
1121 ("G" . stgit-goto)
d9b954c7 1122 ("=" . stgit-diff)
ce3b6130 1123 ("D" . stgit-delete)
b8463f1d 1124 ([?\C-/] . stgit-undo)
ce3b6130 1125 ("\C-_" . stgit-undo)
b8463f1d
GH
1126 ([?\C-c ?\C-/] . stgit-redo)
1127 ("\C-c\C-_" . stgit-redo)
ce3b6130 1128 ("B" . stgit-branch)
380a021f 1129 ("\C-c\C-b" . stgit-rebase)
ce3b6130 1130 ("t" . ,toggle-map)
d9b954c7 1131 ("d" . ,diff-map)
e8faa44b
DK
1132 ("q" . stgit-quit)
1133 ("!" . stgit-execute))))
5038381d
GH
1134
1135 (let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point)))
413f9909 1136 (and file (eq (stgit-file->status file)
5038381d
GH
1137 'unmerged))))
1138 (patch-collapsed-p '(lambda (p) (not (memq p stgit-expanded-patches)))))
1139 (easy-menu-define stgit-menu stgit-mode-map
1140 "StGit Menu"
1141 `("StGit"
1142 ["Reload" stgit-reload-or-repair
1143 :help "Reload StGit status from disk"]
1144 ["Repair" stgit-repair
1145 :keys "\\[universal-argument] \\[stgit-reload-or-repair]"
1146 :help "Repair StGit metadata"]
1147 "-"
1148 ["Undo" stgit-undo t]
1149 ["Redo" stgit-redo t]
1150 "-"
1151 ["Git status" stgit-git-status :active (fboundp 'git-status)]
1152 "-"
1153 ["New patch" stgit-new-and-refresh
1154 :help "Create a new patch from changes in index or work tree"
1155 :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))]
1156 ["New empty patch" stgit-new
1157 :help "Create a new, empty patch"]
1158 ["(Un)mark patch" stgit-toggle-mark
1159 :label (if (memq (stgit-patch-name-at-point nil t)
1160 stgit-marked-patches)
1161 "Unmark patch" "Mark patch")
1162 :active (stgit-patch-name-at-point nil t)]
1163 ["Expand/collapse patch"
1164 (let ((patches (stgit-patches-marked-or-at-point)))
1165 (if (member-if ,patch-collapsed-p patches)
1166 (stgit-expand patches)
1167 (stgit-collapse patches)))
1168 :label (if (member-if ,patch-collapsed-p
1169 (stgit-patches-marked-or-at-point))
1170 "Expand patches"
1171 "Collapse patches")
1172 :active (stgit-patches-marked-or-at-point)]
1173 ["Edit patch" stgit-edit
1174 :help "Edit patch comment"
1175 :active (stgit-patch-name-at-point nil t)]
1176 ["Rename patch" stgit-rename :active (stgit-patch-name-at-point nil t)]
1177 ["Push/pop patch" stgit-push-or-pop
7c11b754
GH
1178 :label (if (subsetp (stgit-patches-marked-or-at-point nil t)
1179 (stgit-applied-patchsyms t))
1180 "Pop patches" "Push patches")]
beac0f14
GH
1181 ["Delete patches" stgit-delete
1182 :active (stgit-patches-marked-or-at-point nil t)]
5038381d
GH
1183 "-"
1184 ["Move patches" stgit-move-patches
1185 :active stgit-marked-patches
fd64ee57 1186 :help "Move marked patch(es) to point"]
5038381d
GH
1187 ["Squash patches" stgit-squash
1188 :active (> (length stgit-marked-patches) 1)
fd64ee57 1189 :help "Merge marked patches into one"]
5038381d
GH
1190 "-"
1191 ["Refresh top patch" stgit-refresh
1192 :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))
1193 :help "Refresh the top patch with changes in index or work tree"]
1194 ["Refresh this patch" (stgit-refresh t)
1195 :keys "\\[universal-argument] \\[stgit-refresh]"
fd64ee57 1196 :help "Refresh marked patch with changes in index or work tree"
5038381d
GH
1197 :active (and (not (and (stgit-index-empty-p)
1198 (stgit-work-tree-empty-p)))
1199 (stgit-patch-name-at-point nil t))]
1200 "-"
1201 ["Find file" stgit-select
1202 :active (eq (get-text-property (point) 'entry-type) 'file)]
1203 ["Open file" stgit-find-file-other-window
1204 :active (eq (get-text-property (point) 'entry-type) 'file)]
1205 ["Toggle file index" stgit-toggle-index
1206 :active (and (eq (get-text-property (point) 'entry-type) 'file)
1207 (memq (stgit-patch-name-at-point) '(:work :index)))
1208 :label (if (eq (stgit-patch-name-at-point) :work)
1209 "Move change to index"
1210 "Move change to work tree")]
1211 "-"
1212 ["Show diff" stgit-diff
1213 :active (get-text-property (point) 'entry-type)]
e02b46e5
KW
1214 ["Show diff for range of applied patches" stgit-diff-range
1215 :active (= (length stgit-marked-patches) 1)]
5038381d
GH
1216 ("Merge"
1217 :active (stgit-git-index-unmerged-p)
1218 ["Combined diff" stgit-diff-combined
1219 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1220 ["Diff against base" stgit-diff-base
1221 :help "Show diff against the common base"
1222 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1223 ["Diff against ours" stgit-diff-ours
1224 :help "Show diff against our branch"
1225 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1226 ["Diff against theirs" stgit-diff-theirs
1227 :help "Show diff against their branch"
1228 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1229 "-"
1230 ["Interactive merge" stgit-find-file-merge
1231 :help "Interactively merge the file"
1232 :active ,at-unmerged-file]
1233 ["Resolve file" stgit-resolve-file
1234 :help "Mark file conflict as resolved"
1235 :active ,at-unmerged-file]
1236 )
1237 "-"
1238 ["Show index & work tree" stgit-toggle-worktree :style toggle
1239 :selected stgit-show-worktree]
1240 ["Show unknown files" stgit-toggle-unknown :style toggle
1241 :selected stgit-show-unknown :active stgit-show-worktree]
1242 ["Show ignored files" stgit-toggle-ignored :style toggle
1243 :selected stgit-show-ignored :active stgit-show-worktree]
a0045b87
DK
1244 ["Show patch names" stgit-toggle-patch-names :style toggle
1245 :selected stgit-show-patch-names]
bf7e391c
GH
1246 ["Show recent commits" stgit-toggle-committed :style toggle
1247 :selected stgit-show-committed]
137b315b
GH
1248 ["Show subversion info" stgit-toggle-svn :style toggle
1249 :selected stgit-show-svn]
5038381d
GH
1250 "-"
1251 ["Switch branches" stgit-branch t
3e528fb0 1252 :help "Switch to or create another branch"]
5038381d
GH
1253 ["Rebase branch" stgit-rebase t
1254 :help "Rebase the current branch"]
1255 ))))
1256
1257;; disable tool bar editing buttons
1258(put 'stgit-mode 'mode-class 'special)
56d81fe5
DK
1259
1260(defun stgit-mode ()
1261 "Major mode for interacting with StGit.
fdf5e327
GH
1262
1263Start StGit using \\[stgit].
1264
1265Basic commands:
1266\\<stgit-mode-map>\
1267\\[stgit-help] Show this help text
1268\\[stgit-quit] Hide the StGit buffer
1269\\[describe-bindings] Show all key bindings
1270
1271\\[stgit-reload-or-repair] Reload the StGit buffer
1272\\[universal-argument] \\[stgit-reload-or-repair] Repair StGit metadata
1273
1274\\[stgit-undo] Undo most recent StGit operation
1275\\[stgit-redo] Undo recent undo
1276
1277\\[stgit-git-status] Run `git-status' (if available)
1278
e8faa44b
DK
1279\\[stgit-execute] Run an stg shell command
1280
fdf5e327
GH
1281Movement commands:
1282\\[stgit-previous-line] Move to previous line
1283\\[stgit-next-line] Move to next line
1284\\[stgit-previous-patch] Move to previous patch
1285\\[stgit-next-patch] Move to next patch
1286
d11e0621 1287\\[stgit-mark-down] Mark patch and move down
fdf5e327
GH
1288\\[stgit-unmark-up] Unmark patch and move up
1289\\[stgit-unmark-down] Unmark patch and move down
1290
1291Commands for patches:
1292\\[stgit-select] Toggle showing changed files in patch
1293\\[stgit-refresh] Refresh patch with changes in index or work tree
1294\\[stgit-diff] Show the patch log and diff
1295
fd64ee57
GH
1296\\[stgit-expand] Show changes in marked patches
1297\\[stgit-collapse] Hide changes in marked patches
afbf766b 1298
2acb7116 1299\\[stgit-new-and-refresh] Create a new patch from index or work tree
c20b20a5
GH
1300\\[stgit-new] Create a new, empty patch
1301
fdf5e327
GH
1302\\[stgit-rename] Rename patch
1303\\[stgit-edit] Edit patch description
1304\\[stgit-delete] Delete patch(es)
1305
1629f59f 1306\\[stgit-revert] Revert all changes in index or work tree
dde3ab4d 1307\\[stgit-toggle-index] Toggle all changes between index and work tree
1629f59f 1308
fdf5e327
GH
1309\\[stgit-push-next] Push next patch onto stack
1310\\[stgit-pop-next] Pop current patch from stack
c20b20a5
GH
1311\\[stgit-push-or-pop] Push or pop marked patches
1312\\[stgit-goto] Make patch at point current by popping or pushing
fdf5e327
GH
1313
1314\\[stgit-squash] Squash (meld together) patches
c20b20a5 1315\\[stgit-move-patches] Move marked patches to point
fdf5e327
GH
1316
1317\\[stgit-commit] Commit patch(es)
1318\\[stgit-uncommit] Uncommit patch(es)
1319
1320Commands for files:
1321\\[stgit-select] Open the file in this window
1322\\[stgit-find-file-other-window] Open the file in another window
1323\\[stgit-diff] Show the file's diff
1324
dde3ab4d 1325\\[stgit-toggle-index] Toggle change between index and work tree
1629f59f 1326\\[stgit-revert] Revert changes to file
fdf5e327
GH
1327
1328Display commands:
a0045b87 1329\\[stgit-toggle-patch-names] Toggle showing patch names
fdf5e327
GH
1330\\[stgit-toggle-worktree] Toggle showing index and work tree
1331\\[stgit-toggle-unknown] Toggle showing unknown files
1332\\[stgit-toggle-ignored] Toggle showing ignored files
bf7e391c 1333\\[stgit-toggle-committed] Toggle showing recent commits
137b315b 1334\\[stgit-toggle-svn] Toggle showing subversion information
fdf5e327
GH
1335
1336Commands for diffs:
1337\\[stgit-diff] Show diff of patch or file
e02b46e5 1338\\[stgit-diff-range] Show diff for range of patches
fdf5e327
GH
1339\\[stgit-diff-base] Show diff against the merge base
1340\\[stgit-diff-ours] Show diff against our branch
1341\\[stgit-diff-theirs] Show diff against their branch
1342
1343 With one prefix argument (e.g., \\[universal-argument] \\[stgit-diff]), \
1344ignore space changes.
1345 With two prefix arguments (e.g., \\[universal-argument] \
1346\\[universal-argument] \\[stgit-diff]), ignore all space changes.
1347
1348Commands for merge conflicts:
1349\\[stgit-find-file-merge] Resolve conflicts using `smerge-ediff'
1350\\[stgit-resolve-file] Mark unmerged file as resolved
1351
1352Commands for branches:
3e528fb0 1353\\[stgit-branch] Switch to or create another branch
380a021f 1354\\[stgit-rebase] Rebase the current branch
fdf5e327
GH
1355
1356Customization variables:
1357`stgit-abbreviate-copies-and-renames'
bc11fb08 1358`stgit-default-show-ignored'
a0045b87 1359`stgit-default-show-patch-names'
bc11fb08 1360`stgit-default-show-unknown'
fdf5e327 1361`stgit-default-show-worktree'
bf7e391c 1362`stgit-default-show-committed'
137b315b 1363`stgit-default-show-svn'
bf7e391c 1364`stgit-default-committed-count'
fdf5e327
GH
1365`stgit-find-copies-harder'
1366`stgit-show-worktree-mode'
1367
1368See also \\[customize-group] for the \"stgit\" group."
56d81fe5
DK
1369 (kill-all-local-variables)
1370 (buffer-disable-undo)
1371 (setq mode-name "StGit"
1372 major-mode 'stgit-mode
1373 goal-column 2)
1374 (use-local-map stgit-mode-map)
a0689e11
GH
1375 (mapc (lambda (x) (set (make-local-variable (car x)) (cdr x)))
1376 `((list-buffers-directory . ,default-directory)
1377 (parse-sexp-lookup-properties . t)
1378 (stgit-expanded-patches . (:work :index))
1379 (stgit-index-node . nil)
1380 (stgit-worktree-node . nil)
1381 (stgit-marked-patches . nil)
137b315b 1382 (stgit-svn-find-rev-hash . ,(make-hash-table :test 'equal))
bf7e391c
GH
1383 (stgit-committed-count . ,stgit-default-committed-count)
1384 (stgit-show-committed . ,stgit-default-show-committed)
a0689e11
GH
1385 (stgit-show-ignored . ,stgit-default-show-ignored)
1386 (stgit-show-patch-names . ,stgit-default-show-patch-names)
137b315b 1387 (stgit-show-svn . ,stgit-default-show-svn)
a0689e11
GH
1388 (stgit-show-unknown . ,stgit-default-show-unknown)
1389 (stgit-show-worktree . ,stgit-default-show-worktree)))
2870f8b8 1390 (set-variable 'truncate-lines 't)
e44674e3
GH
1391 (add-hook 'after-save-hook 'stgit-update-stgit-for-buffer)
1392 (unless stgit-did-advise
1393 (stgit-advise)
1394 (setq stgit-did-advise t))
56d81fe5
DK
1395 (run-hooks 'stgit-mode-hook))
1396
e44674e3
GH
1397(defun stgit-advise-funlist (funlist)
1398 "Add advice to the functions in FUNLIST so we can refresh the
1399stgit buffers as the git status of files change."
1400 (mapc (lambda (sym)
1401 (when (fboundp sym)
1402 (eval `(defadvice ,sym (after stgit-update-stgit-for-buffer)
1403 (stgit-update-stgit-for-buffer t)))
1404 (ad-activate sym)))
1405 funlist))
1406
1407(defun stgit-advise ()
1408 "Add advice to appropriate (non-stgit) git functions so we can
1409refresh the stgit buffers as the git status of files change."
1410 (mapc (lambda (arg)
1411 (let ((feature (car arg))
1412 (funlist (cdr arg)))
1413 (if (featurep feature)
1414 (stgit-advise-funlist funlist)
1415 (add-to-list 'after-load-alist
1416 `(,feature (stgit-advise-funlist
1417 (quote ,funlist)))))))
e9a9f3fa 1418 ;; lists of (<feature> <function> <function> ...) to be advised
e44674e3 1419 '((vc-git vc-git-rename-file vc-git-revert vc-git-register)
e9a9f3fa
GH
1420 (git git-add-file git-checkout git-revert-file git-remove-file)
1421 (dired dired-delete-file))))
e44674e3 1422
455c9f7e
GH
1423(defvar stgit-pending-refresh-buffers nil
1424 "Alist of (cons `buffer' `refresh-index') of buffers that need
1425to be refreshed. `refresh-index' is non-nil if both work tree
1426and index need to be refreshed.")
1427
1428(defun stgit-run-pending-refreshs ()
1429 "Run all pending stgit buffer updates as posted by `stgit-post-refresh'."
1430 (let ((buffers stgit-pending-refresh-buffers)
1431 (stgit-inhibit-messages t))
1432 (setq stgit-pending-refresh-buffers nil)
1433 (while buffers
1434 (let* ((elem (car buffers))
1435 (buffer (car elem))
1436 (refresh-index (cdr elem)))
1437 (when (buffer-name buffer)
1438 (with-current-buffer buffer
1439 (stgit-refresh-worktree)
1440 (when refresh-index (stgit-refresh-index)))))
1441 (setq buffers (cdr buffers)))))
1442
1443(defun stgit-post-refresh (buffer refresh-index)
1444 "Update worktree status in BUFFER when Emacs becomes idle. If
1445REFRESH-INDEX is non-nil, also update the index."
1446 (unless stgit-pending-refresh-buffers
1447 (run-with-idle-timer 0.1 nil 'stgit-run-pending-refreshs))
1448 (let ((elem (assq buffer stgit-pending-refresh-buffers)))
1449 (if elem
1450 ;; if buffer is already present, set its refresh-index flag if
1451 ;; necessary
1452 (when refresh-index
1453 (setcdr elem t))
1454 ;; new entry
1455 (setq stgit-pending-refresh-buffers
1456 (cons (cons buffer refresh-index)
1457 stgit-pending-refresh-buffers)))))
1458
e44674e3 1459(defun stgit-update-stgit-for-buffer (&optional refresh-index)
455c9f7e
GH
1460 "When Emacs becomes idle, refresh worktree status in any
1461`stgit-mode' buffer that shows the status of the current buffer.
e44674e3 1462
455c9f7e 1463If REFRESH-INDEX is non-nil, also update the index."
e9a9f3fa 1464 (let* ((dir (cond ((derived-mode-p 'stgit-status-mode 'dired-mode)
e44674e3
GH
1465 default-directory)
1466 (buffer-file-name
1467 (file-name-directory
1468 (expand-file-name buffer-file-name)))))
1469 (gitdir (and dir (condition-case nil (git-get-top-dir dir)
1470 (error nil))))
b894e680
DK
1471 (buffer (and gitdir (stgit-find-buffer gitdir))))
1472 (when buffer
455c9f7e 1473 (stgit-post-refresh buffer refresh-index))))
b894e680 1474
d51722b7
GH
1475(defun stgit-add-mark (patchsym)
1476 "Mark the patch PATCHSYM."
8036afdd 1477 (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
6df83d42 1478
d51722b7
GH
1479(defun stgit-remove-mark (patchsym)
1480 "Unmark the patch PATCHSYM."
8036afdd 1481 (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))
6df83d42 1482
e6b1fdae 1483(defun stgit-clear-marks ()
47271f41 1484 "Unmark all patches."
e6b1fdae
DK
1485 (setq stgit-marked-patches '()))
1486
735cb7ec 1487(defun stgit-patch-at-point (&optional cause-error)
2c862b07
DK
1488 (get-text-property (point) 'patch-data))
1489
bf7e391c 1490(defun stgit-patch-name-at-point (&optional cause-error types)
d51722b7 1491 "Return the patch name on the current line as a symbol.
64ada6f5 1492If CAUSE-ERROR is not nil, signal an error if none found.
bf7e391c
GH
1493
1494TYPES controls which types of commits and patches can be returned.
1495If it is t, only allow stgit patches; if 'allow-committed, also
1496allow historical commits; if nil, also allow work tree and index."
2c862b07 1497 (let ((patch (stgit-patch-at-point)))
64ada6f5 1498 (and patch
bf7e391c
GH
1499 (memq (stgit-patch->status patch)
1500 (case types
1501 ((nil) nil)
1502 ((allow-committed) '(work index))
1503 ((t) '(work index committed))
1504 (t (error "Bad value"))))
64ada6f5 1505 (setq patch nil))
2c862b07 1506 (cond (patch
413f9909 1507 (stgit-patch->name patch))
2c862b07
DK
1508 (cause-error
1509 (error "No patch on this line")))))
378a003d 1510
3164eec6
DK
1511(defun stgit-patched-file-at-point ()
1512 (get-text-property (point) 'file-data))
56d81fe5 1513
bf7e391c 1514(defun stgit-patches-marked-or-at-point (&optional cause-error types)
beac0f14
GH
1515 "Return the symbols of the marked patches, or the patch on the current line.
1516If CAUSE-ERRROR is not nil, signal an error if none found.
bf7e391c
GH
1517
1518TYPES controls which types of commits and patches can be returned.
1519If it is t, only allow stgit patches; if 'allow-committed, also
1520allow historical commits; if nil, also allow work tree and index."
7755d7f1 1521 (if stgit-marked-patches
d51722b7 1522 stgit-marked-patches
bf7e391c 1523 (let ((patch (stgit-patch-name-at-point nil types)))
beac0f14
GH
1524 (cond (patch (list patch))
1525 (cause-error (error "No patches marked or at this line"))
1526 (t nil)))))
7755d7f1 1527
a9089e68 1528(defun stgit-goto-patch (patchsym &optional file)
2570f6e5
GH
1529 "Move point to the line containing patch PATCHSYM and return non-nil.
1530If that patch cannot be found, do nothing and return nil.
a9089e68
GH
1531
1532If the patch was found and FILE is not nil, instead move to that
1533file's line. If FILE cannot be found, stay on the line of
1534PATCHSYM."
f9b82d36 1535 (let ((node (ewoc-nth stgit-ewoc 0)))
413f9909 1536 (while (and node (not (eq (stgit-patch->name (ewoc-data node))
f9b82d36
DK
1537 patchsym)))
1538 (setq node (ewoc-next stgit-ewoc node)))
a9089e68 1539 (when (and node file)
413f9909 1540 (let* ((file-ewoc (stgit-patch->files-ewoc (ewoc-data node)))
a9089e68 1541 (file-node (ewoc-nth file-ewoc 0)))
ea696de9
GH
1542 (while (and file-node
1543 (not (equal (stgit-file->file (ewoc-data file-node))
1544 file)))
a9089e68
GH
1545 (setq file-node (ewoc-next file-ewoc file-node)))
1546 (when file-node
1547 (ewoc-goto-node file-ewoc file-node)
1548 (move-to-column (stgit-goal-column))
1549 (setq node nil))))
f9b82d36
DK
1550 (when node
1551 (ewoc-goto-node stgit-ewoc node)
d51722b7 1552 (move-to-column goal-column))))
56d81fe5 1553
1c2426dc 1554(defun stgit-init ()
a53347d9 1555 "Run stg init."
1c2426dc 1556 (interactive)
9d04c657 1557 (stgit-assert-mode)
1c2426dc 1558 (stgit-capture-output nil
b0424080 1559 (stgit-run "init"))
1f0bf00f 1560 (stgit-reload))
1c2426dc 1561
d11e0621
GH
1562(defun stgit-toggle-mark ()
1563 "Toggle mark on the patch under point."
1564 (interactive)
1565 (stgit-assert-mode)
1566 (if (memq (stgit-patch-name-at-point t t) stgit-marked-patches)
1567 (stgit-unmark)
1568 (stgit-mark)))
1569
6df83d42 1570(defun stgit-mark ()
a53347d9 1571 "Mark the patch under point."
6df83d42 1572 (interactive)
9d04c657 1573 (stgit-assert-mode)
8036afdd 1574 (let* ((node (ewoc-locate stgit-ewoc))
bf7e391c
GH
1575 (patch (ewoc-data node)))
1576 (case (stgit-patch->status patch)
1577 (work (error "Cannot mark the work tree"))
1578 (index (error "Cannot mark the index"))
1579 (committed (error "Cannot mark a committed patch")))
413f9909 1580 (stgit-add-mark (stgit-patch->name patch))
d11e0621
GH
1581 (let ((column (current-column)))
1582 (ewoc-invalidate stgit-ewoc node)
1583 (move-to-column column))))
1584
1585(defun stgit-mark-down ()
1586 "Mark the patch under point and move to the next patch."
1587 (interactive)
1588 (stgit-mark)
378a003d 1589 (stgit-next-patch))
6df83d42 1590
d11e0621
GH
1591(defun stgit-unmark ()
1592 "Remove mark from the patch on the current line."
6df83d42 1593 (interactive)
9d04c657 1594 (stgit-assert-mode)
8036afdd
DK
1595 (let* ((node (ewoc-locate stgit-ewoc))
1596 (patch (ewoc-data node)))
413f9909 1597 (stgit-remove-mark (stgit-patch->name patch))
d11e0621
GH
1598 (let ((column (current-column)))
1599 (ewoc-invalidate stgit-ewoc node)
1600 (move-to-column column))))
1601
1602(defun stgit-unmark-up ()
1603 "Remove mark from the patch on the previous line."
1604 (interactive)
1605 (stgit-assert-mode)
1606 (stgit-previous-patch)
1607 (stgit-unmark))
9b151b27
GH
1608
1609(defun stgit-unmark-down ()
a53347d9 1610 "Remove mark from the patch on the current line."
9b151b27 1611 (interactive)
9d04c657 1612 (stgit-assert-mode)
d11e0621 1613 (stgit-unmark)
1288eda2 1614 (stgit-next-patch))
6df83d42 1615
56d81fe5 1616(defun stgit-rename (name)
018fa1ac 1617 "Rename the patch under point to NAME."
64ada6f5
GH
1618 (interactive (list
1619 (read-string "Patch name: "
1620 (symbol-name (stgit-patch-name-at-point t t)))))
9d04c657 1621 (stgit-assert-mode)
64ada6f5 1622 (let ((old-patchsym (stgit-patch-name-at-point t t)))
56d81fe5 1623 (stgit-capture-output nil
69db9714 1624 (stgit-run "rename" "--" old-patchsym name))
d51722b7
GH
1625 (let ((name-sym (intern name)))
1626 (when (memq old-patchsym stgit-expanded-patches)
378a003d 1627 (setq stgit-expanded-patches
6a73154a 1628 (cons name-sym (delq old-patchsym stgit-expanded-patches))))
d51722b7 1629 (when (memq old-patchsym stgit-marked-patches)
378a003d 1630 (setq stgit-marked-patches
6a73154a 1631 (cons name-sym (delq old-patchsym stgit-marked-patches))))
d51722b7
GH
1632 (stgit-reload)
1633 (stgit-goto-patch name-sym))))
56d81fe5 1634
408fa7cb
GH
1635(defun stgit-reload-or-repair (repair)
1636 "Update the contents of the StGit buffer (`stgit-reload').
1637
1638With a prefix argument, repair the StGit metadata if the branch
1639was modified with git commands (`stgit-repair')."
1640 (interactive "P")
9d04c657 1641 (stgit-assert-mode)
408fa7cb
GH
1642 (if repair
1643 (stgit-repair)
1644 (stgit-reload)))
1645
26201d96 1646(defun stgit-repair ()
a53347d9 1647 "Run stg repair."
26201d96 1648 (interactive)
9d04c657 1649 (stgit-assert-mode)
26201d96 1650 (stgit-capture-output nil
b0424080 1651 (stgit-run "repair"))
1f0bf00f 1652 (stgit-reload))
26201d96 1653
3e528fb0
GH
1654(defun stgit-available-branches (&optional all)
1655 "Returns a list of the names of the available stg branches as strings.
1656
1657If ALL is not nil, also return non-stgit branches."
adeef6bc
GH
1658 (let ((output (with-output-to-string
1659 (stgit-run "branch" "--list")))
3e528fb0
GH
1660 (pattern (format "^>?\\s-+%c\\s-+\\(\\S-+\\)"
1661 (if all ?. ?s)))
adeef6bc
GH
1662 (start 0)
1663 result)
3e528fb0 1664 (while (string-match pattern output start)
adeef6bc
GH
1665 (setq result (cons (match-string 1 output) result))
1666 (setq start (match-end 0)))
1667 result))
1668
1669(defun stgit-branch (branch)
3e528fb0 1670 "Switch to or create branch BRANCH."
adeef6bc
GH
1671 (interactive (list (completing-read "Switch to branch: "
1672 (stgit-available-branches))))
9d04c657 1673 (stgit-assert-mode)
3e528fb0
GH
1674 (when (cond ((equal branch (stgit-current-branch))
1675 (error "Branch is already current"))
1676 ((member branch (stgit-available-branches t))
1677 (stgit-capture-output nil (stgit-run "branch" "--" branch))
1678 t)
1679 ((not (string-match stgit-allowed-branch-name-re branch))
1680 (error "Invalid branch name"))
1681 ((yes-or-no-p (format "Create branch \"%s\"? " branch))
84e1850a
GH
1682 (let ((branch-point (completing-read
1683 "Branch from (default current branch): "
1684 (stgit-available-branches))))
1685 (stgit-capture-output nil
1686 (apply 'stgit-run
1687 `("branch" "--create" "--"
1688 ,branch
1689 ,@(unless (zerop (length branch-point))
1690 (list branch-point)))))
1691 t)))
3e528fb0 1692 (stgit-reload)))
adeef6bc 1693
380a021f
GH
1694(defun stgit-available-refs (&optional omit-stgit)
1695 "Returns a list of the available git refs.
1696If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"."
1697 (let* ((output (with-output-to-string
1698 (stgit-run-git-silent "for-each-ref" "--format=%(refname)"
1699 "refs/tags" "refs/heads"
1700 "refs/remotes")))
1701 (result (split-string output "\n" t)))
1702 (mapcar (lambda (s)
1703 (if (string-match "^refs/\\(heads\\|tags\\|remotes\\)/" s)
1704 (substring s (match-end 0))
1705 s))
1706 (if omit-stgit
1707 (delete-if (lambda (s)
1708 (string-match "^refs/heads/.*\\.stgit$" s))
1709 result)
1710 result))))
1711
d6e17ce0
GH
1712(defun stgit-parent-branch ()
1713 "Return the parent branch of the current stg branch as per
1714git-config setting branch.<branch>.stgit.parentbranch."
1715 (let ((output (with-output-to-string
1716 (stgit-run-git-silent "config"
1717 (format "branch.%s.stgit.parentbranch"
1718 (stgit-current-branch))))))
1719 (when (string-match ".*" output)
1720 (match-string 0 output))))
1721
380a021f 1722(defun stgit-rebase (new-base)
d6e17ce0
GH
1723 "Rebase the current branch to NEW-BASE.
1724
1725Interactively, first ask which branch to rebase to. Defaults to
1726what git-config branch.<branch>.stgit.parentbranch is set to."
380a021f 1727 (interactive (list (completing-read "Rebase to: "
d6e17ce0
GH
1728 (stgit-available-refs t)
1729 nil nil
1730 (stgit-parent-branch))))
9d04c657 1731 (stgit-assert-mode)
69db9714 1732 (stgit-capture-output nil (stgit-run "rebase" "--" new-base))
380a021f
GH
1733 (stgit-reload))
1734
41c1c59c
GH
1735(defun stgit-commit (count)
1736 "Run stg commit on COUNT commits.
e552cb5f
GH
1737Interactively, the prefix argument is used as COUNT.
1738A negative COUNT will uncommit instead."
41c1c59c 1739 (interactive "p")
9d04c657 1740 (stgit-assert-mode)
e552cb5f
GH
1741 (if (< count 0)
1742 (stgit-uncommit (- count))
1743 (stgit-capture-output nil (stgit-run "commit" "-n" count))
1744 (stgit-reload)))
1745
1746(defun stgit-uncommit (count)
1747 "Run stg uncommit on COUNT commits.
1748Interactively, the prefix argument is used as COUNT.
1749A negative COUNT will commit instead."
1750 (interactive "p")
9d04c657 1751 (stgit-assert-mode)
e552cb5f
GH
1752 (if (< count 0)
1753 (stgit-commit (- count))
1754 (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
1755 (stgit-reload)))
c4aad9a7 1756
556345d3
GH
1757(defun stgit-neighbour-file ()
1758 "Return the file name of the next file after point, or the
1759previous file if point is at the last file within a patch."
1760 (let ((old-point (point))
1761 neighbour-file)
1762 (and (zerop (forward-line 1))
1763 (let ((f (stgit-patched-file-at-point)))
413f9909 1764 (and f (setq neighbour-file (stgit-file->file f)))))
556345d3
GH
1765 (goto-char old-point)
1766 (unless neighbour-file
1767 (and (zerop (forward-line -1))
1768 (let ((f (stgit-patched-file-at-point)))
413f9909 1769 (and f (setq neighbour-file (stgit-file->file f)))))
556345d3
GH
1770 (goto-char old-point))
1771 neighbour-file))
1772
3959a095
GH
1773(defun stgit-revert-file ()
1774 "Revert the file at point, which must be in the index or the
1775working tree."
1776 (interactive)
9d04c657 1777 (stgit-assert-mode)
3959a095
GH
1778 (let* ((patched-file (or (stgit-patched-file-at-point)
1779 (error "No file on the current line")))
1780 (patch-name (stgit-patch-name-at-point))
413f9909
GH
1781 (file-status (stgit-file->status patched-file))
1782 (rm-file (cond ((stgit-file->copy-or-rename patched-file)
1783 (stgit-file->cr-to patched-file))
3959a095 1784 ((eq file-status 'add)
413f9909 1785 (stgit-file->file patched-file))))
3959a095 1786 (co-file (cond ((eq file-status 'rename)
413f9909 1787 (stgit-file->cr-from patched-file))
3959a095 1788 ((not (memq file-status '(copy add)))
413f9909 1789 (stgit-file->file patched-file))))
556345d3 1790 (next-file (stgit-neighbour-file)))
3959a095
GH
1791
1792 (unless (memq patch-name '(:work :index))
1793 (error "No index or working tree file on this line"))
1794
d9473917
GH
1795 (when (eq file-status 'ignore)
1796 (error "Cannot revert ignored files"))
1797
1798 (when (eq file-status 'unknown)
1799 (error "Cannot revert unknown files"))
1800
3959a095
GH
1801 (let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
1802 (when (yes-or-no-p (format "Revert %d file%s? "
1803 nfiles
1804 (if (= nfiles 1) "" "s")))
1805 (stgit-capture-output nil
1806 (when rm-file
1807 (stgit-run-git "rm" "-f" "-q" "--" rm-file))
1808 (when co-file
1809 (stgit-run-git "checkout" "HEAD" co-file)))
556345d3
GH
1810 (stgit-reload)
1811 (stgit-goto-patch patch-name next-file)))))
1629f59f
GH
1812
1813(defun stgit-revert ()
1814 "Revert the change at point, which must be the index, the work
1815tree, or a single change in either."
1816 (interactive)
9d04c657 1817 (stgit-assert-mode)
1629f59f
GH
1818 (let ((patched-file (stgit-patched-file-at-point)))
1819 (if patched-file
1820 (stgit-revert-file)
1821 (let* ((patch-name (or (stgit-patch-name-at-point)
1822 (error "No patch or file at point")))
1823 (patch-desc (case patch-name
1824 (:index "index")
1825 (:work "work tree")
1826 (t (error (substitute-command-keys
1827 "Use \\[stgit-delete] to delete a patch"))))))
1828 (when (if (eq patch-name :work)
1829 (stgit-work-tree-empty-p)
1830 (stgit-index-empty-p))
1831 (error (format "There are no changes in the %s to revert"
1832 patch-desc)))
1833 (and (eq patch-name :index)
1834 (not (stgit-work-tree-empty-p))
1835 (error "Cannot revert index as work tree contains unstaged changes"))
1836
1837 (when (yes-or-no-p (format "Revert all changes in the %s? "
1838 patch-desc))
1839 (if (eq patch-name :index)
1840 (stgit-run-git-silent "reset" "--hard" "-q")
1841 (stgit-run-git-silent "checkout" "--" "."))
1842 (stgit-refresh-index)
1843 (stgit-refresh-worktree)
1844 (stgit-goto-patch patch-name))))))
3959a095 1845
51783171
GH
1846(defun stgit-resolve-file ()
1847 "Resolve conflict in the file at point."
1848 (interactive)
9d04c657 1849 (stgit-assert-mode)
51783171
GH
1850 (let* ((patched-file (stgit-patched-file-at-point))
1851 (patch (stgit-patch-at-point))
413f9909
GH
1852 (patch-name (and patch (stgit-patch->name patch)))
1853 (status (and patched-file (stgit-file->status patched-file))))
51783171
GH
1854
1855 (unless (memq patch-name '(:work :index))
1856 (error "No index or working tree file on this line"))
1857
1858 (unless (eq status 'unmerged)
1859 (error "No conflict to resolve at the current line"))
1860
1861 (stgit-capture-output nil
413f9909 1862 (stgit-move-change-to-index (stgit-file->file patched-file)))
51783171
GH
1863
1864 (stgit-reload)))
1865
d47ee133
GH
1866(defun stgit-push-or-pop-patches (do-push npatches)
1867 "Push (if DO-PUSH is not nil) or pop (if DO-PUSH is nil)
1868NPATCHES patches, or all patches if NPATCHES is t."
1869 (stgit-assert-mode)
1870 (stgit-capture-output nil
1871 (apply 'stgit-run
1872 (if do-push "push" "pop")
1873 (if (eq npatches t)
1874 '("--all")
1875 (list "-n" npatches))))
1876 (stgit-reload)
1877 (stgit-refresh-git-status))
1878
0b661144
DK
1879(defun stgit-push-next (npatches)
1880 "Push the first unapplied patch.
1881With numeric prefix argument, push that many patches."
1882 (interactive "p")
d47ee133 1883 (stgit-push-or-pop-patches t npatches))
56d81fe5 1884
0b661144
DK
1885(defun stgit-pop-next (npatches)
1886 "Pop the topmost applied patch.
d47ee133
GH
1887With numeric prefix argument, pop that many patches.
1888
1889If NPATCHES is t, pop all patches."
0b661144 1890 (interactive "p")
d47ee133 1891 (stgit-push-or-pop-patches nil npatches))
56d81fe5 1892
7c11b754
GH
1893(defun stgit-applied-patches (&optional only-patches)
1894 "Return a list of the applied patches.
1895
1896If ONLY-PATCHES is not nil, exclude index and work tree."
1897 (let ((states (if only-patches
1898 '(applied top)
1899 '(applied top index work)))
1900 result)
9aa61946
GH
1901 (ewoc-map (lambda (patch)
1902 (when (memq (stgit-patch->status patch) states)
1903 (setq result (cons patch result)))
1904 nil)
7c11b754
GH
1905 stgit-ewoc)
1906 result))
1907
1908(defun stgit-applied-patchsyms (&optional only-patches)
1909 "Return a list of the symbols of the applied patches.
1910
1911If ONLY-PATCHES is not nil, exclude index and work tree."
413f9909 1912 (mapcar #'stgit-patch->name (stgit-applied-patches only-patches)))
f9182fca
KH
1913
1914(defun stgit-push-or-pop ()
7c11b754 1915 "Push or pop the marked patches."
f9182fca 1916 (interactive)
9d04c657 1917 (stgit-assert-mode)
7c11b754
GH
1918 (let* ((patchsyms (stgit-patches-marked-or-at-point t t))
1919 (applied-syms (stgit-applied-patchsyms t))
1920 (unapplied (set-difference patchsyms applied-syms)))
f9182fca 1921 (stgit-capture-output nil
7c11b754
GH
1922 (apply 'stgit-run
1923 (if unapplied "push" "pop")
1924 "--"
1925 (stgit-sort-patches (if unapplied unapplied patchsyms)))))
1926 (stgit-reload))
f9182fca 1927
d47ee133 1928(defun stgit-goto-target ()
bf7e391c 1929 "Return the goto target at point: a patchsym, :top,
d47ee133 1930or :bottom."
bf7e391c
GH
1931 (let ((patch (stgit-patch-at-point)))
1932 (cond (patch
1933 (case (stgit-patch->status patch)
1934 ((work index) nil)
1935 ((committed) :bottom)
1936 (t (stgit-patch->name patch))))
d47ee133
GH
1937 ((not (next-single-property-change (point) 'patch-data))
1938 :top)
1939 ((not (previous-single-property-change (point) 'patch-data))
1940 :bottom))))
1941
c7adf5ef 1942(defun stgit-goto ()
48d0a850
GH
1943 "Go to the patch on the current line.
1944
d47ee133
GH
1945Push or pop patches to make this patch topmost. Push or pop all
1946patches if used on a line after or before all patches."
c7adf5ef 1947 (interactive)
9d04c657 1948 (stgit-assert-mode)
d47ee133
GH
1949 (let ((patchsym (stgit-goto-target)))
1950 (unless patchsym
1951 (error "No patch to go to on this line"))
1952 (case patchsym
1953 (:top (stgit-push-or-pop-patches t t))
1954 (:bottom (stgit-push-or-pop-patches nil t))
1955 (t (stgit-capture-output nil
69db9714 1956 (stgit-run "goto" "--" patchsym))
d47ee133 1957 (stgit-reload)))))
c7adf5ef 1958
d51722b7 1959(defun stgit-id (patchsym)
50d88c67
DK
1960 "Return the git commit id for PATCHSYM.
1961If PATCHSYM is a keyword, returns PATCHSYM unmodified."
1962 (if (keywordp patchsym)
1963 patchsym
1964 (let ((result (with-output-to-string
69db9714 1965 (stgit-run-silent "id" "--" patchsym))))
50d88c67
DK
1966 (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
1967 (error "Cannot find commit id for %s" patchsym))
1968 (match-string 1 result))))
378a003d 1969
015a6dfa
KW
1970(defun stgit-whitespace-diff-arg (arg)
1971 (when (numberp arg)
1972 (cond ((> arg 4) "--ignore-all-space")
1973 ((> arg 1) "--ignore-space-change"))))
1974
1aece5c0 1975(defun stgit-show-patch (unmerged-stage ignore-whitespace)
d9b954c7
GH
1976 "Show the patch on the current line.
1977
1978UNMERGED-STAGE is the argument to `git-diff' that that selects
1979which stage to diff against in the case of unmerged files."
015a6dfa 1980 (let ((space-arg (stgit-whitespace-diff-arg ignore-whitespace))
1aece5c0
GH
1981 (patch-name (stgit-patch-name-at-point t)))
1982 (stgit-capture-output "*StGit patch*"
1983 (case (get-text-property (point) 'entry-type)
1984 ('file
1985 (let* ((patched-file (stgit-patched-file-at-point))
1986 (patch-id (let ((id (stgit-id patch-name)))
1987 (if (and (eq id :index)
413f9909 1988 (eq (stgit-file->status patched-file)
1aece5c0
GH
1989 'unmerged))
1990 :work
1991 id)))
1992 (args (append (and space-arg (list space-arg))
413f9909 1993 (and (stgit-file->cr-from patched-file)
1aece5c0
GH
1994 (list (stgit-find-copies-harder-diff-arg)))
1995 (cond ((eq patch-id :index)
1996 '("--cached"))
1997 ((eq patch-id :work)
1998 (list unmerged-stage))
1999 (t
2000 (list (concat patch-id "^") patch-id)))
2001 '("--")
413f9909
GH
2002 (if (stgit-file->copy-or-rename patched-file)
2003 (list (stgit-file->cr-from patched-file)
2004 (stgit-file->cr-to patched-file))
2005 (list (stgit-file->file patched-file))))))
1aece5c0
GH
2006 (apply 'stgit-run-git "diff" args)))
2007 ('patch
2008 (let* ((patch-id (stgit-id patch-name)))
2009 (if (or (eq patch-id :index) (eq patch-id :work))
2010 (apply 'stgit-run-git "diff"
2011 (stgit-find-copies-harder-diff-arg)
2012 (append (and space-arg (list space-arg))
2013 (if (eq patch-id :index)
2014 '("--cached")
2015 (list unmerged-stage))))
2016 (let ((args (append '("show" "-O" "--patch-with-stat" "-O" "-M")
2017 (and space-arg (list "-O" space-arg))
69db9714 2018 '("--")
1aece5c0
GH
2019 (list (stgit-patch-name-at-point)))))
2020 (apply 'stgit-run args)))))
6a73154a
GH
2021 (t
2022 (error "No patch or file at point")))
1aece5c0
GH
2023 (with-current-buffer standard-output
2024 (goto-char (point-min))
2025 (diff-mode)))))
2026
2027(defmacro stgit-define-diff (name diff-arg &optional unmerged-action)
2028 `(defun ,name (&optional ignore-whitespace)
2029 ,(format "Show the patch on the current line.
2030
2031%sWith a prefix argument, ignore whitespace. With a prefix argument
2032greater than four (e.g., \\[universal-argument] \
2033\\[universal-argument] \\[%s]), ignore all whitespace."
2034 (if unmerged-action
2035 (format "For unmerged files, %s.\n\n" unmerged-action)
2036 "")
2037 name)
2038 (interactive "p")
9d04c657 2039 (stgit-assert-mode)
1aece5c0
GH
2040 (stgit-show-patch ,diff-arg ignore-whitespace)))
2041
2042(stgit-define-diff stgit-diff
2043 "--ours" nil)
2044(stgit-define-diff stgit-diff-ours
2045 "--ours"
2046 "diff against our branch")
2047(stgit-define-diff stgit-diff-theirs
2048 "--theirs"
2049 "diff against their branch")
2050(stgit-define-diff stgit-diff-base
2051 "--base"
2052 "diff against the merge base")
2053(stgit-define-diff stgit-diff-combined
2054 "--cc"
2055 "show a combined diff")
d9b954c7 2056
e02b46e5
KW
2057(defun stgit-diff-range (&optional ignore-whitespace)
2058 "Show diff for the range of patches between point and the marked patch.
2059
2060With a prefix argument, ignore whitespace. With a prefix argument
2061greater than four (e.g., \\[universal-argument] \
2062\\[universal-argument] \\[stgit-diff-range]), ignore all whitespace."
2063 (interactive "p")
2064 (stgit-assert-mode)
2065 (unless (= (length stgit-marked-patches) 1)
2066 (error "Need exactly one patch marked"))
bf7e391c
GH
2067 (let* ((patches (stgit-sort-patches
2068 (cons (stgit-patch-name-at-point t 'allow-committed)
2069 stgit-marked-patches)
2070 t))
e02b46e5
KW
2071 (first-patch (car patches))
2072 (second-patch (if (cdr patches) (cadr patches) first-patch))
2073 (whitespace-arg (stgit-whitespace-diff-arg ignore-whitespace))
2074 (applied (stgit-applied-patchsyms t)))
2075 (unless (and (memq first-patch applied) (memq second-patch applied))
2076 (error "Can only show diff range for applied patches"))
2077 (stgit-capture-output (format "*StGit diff %s..%s*"
2078 first-patch second-patch)
2079 (apply 'stgit-run-git (append '("diff" "--patch-with-stat")
2080 (and whitespace-arg (list whitespace-arg))
2081 (list (format "%s^" (stgit-id first-patch))
2082 (stgit-id second-patch))))
2083 (with-current-buffer standard-output
2084 (goto-char (point-min))
2085 (diff-mode)))))
2086
f87c2e22
GH
2087(defun stgit-move-change-to-index (file &optional force)
2088 "Copies the work tree state of FILE to index, using git add or git rm.
2089
2090If FORCE is not nil, use --force."
306b37a6
GH
2091 (let ((op (if (or (file-exists-p file) (file-symlink-p file))
2092 '("add") '("rm" "-q"))))
37cb5766 2093 (stgit-capture-output "*git output*"
f87c2e22
GH
2094 (apply 'stgit-run-git (append op (and force '("--force"))
2095 '("--") (list file))))))
37cb5766 2096
fd9fe574 2097(defun stgit-remove-change-from-index (file)
37cb5766
DK
2098 "Unstages the change in FILE from the index"
2099 (stgit-capture-output "*git output*"
2100 (stgit-run-git "reset" "-q" "--" file)))
2101
dde3ab4d
GH
2102(defun stgit-git-index-unmerged-p ()
2103 (let (result)
2104 (with-output-to-string
2105 (setq result (not (zerop (stgit-run-git-silent "diff-index" "--cached"
2106 "--diff-filter=U"
2107 "--quiet" "HEAD")))))
2108 result))
2109
37cb5766 2110(defun stgit-file-toggle-index ()
a9089e68
GH
2111 "Move modified file in or out of the index.
2112
2113Leaves the point where it is, but moves the mark to where the
2114file ended up. You can then jump to the file with \
2115\\[exchange-point-and-mark]."
37cb5766 2116 (interactive)
9d04c657 2117 (stgit-assert-mode)
612f999a
GH
2118 (let* ((patched-file (or (stgit-patched-file-at-point)
2119 (error "No file on the current line")))
413f9909 2120 (patched-status (stgit-file->status patched-file)))
612f999a 2121 (when (eq patched-status 'unmerged)
51783171 2122 (error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index")))
a9089e68 2123 (let* ((patch (stgit-patch-at-point))
413f9909 2124 (patch-name (stgit-patch->name patch))
612f999a 2125 (mark-file (if (eq patched-status 'rename)
413f9909
GH
2126 (stgit-file->cr-to patched-file)
2127 (stgit-file->file patched-file)))
612f999a 2128 (point-file (if (eq patched-status 'rename)
413f9909 2129 (stgit-file->cr-from patched-file)
6a73154a 2130 (stgit-neighbour-file))))
a9089e68 2131
37cb5766 2132 (cond ((eq patch-name :work)
413f9909 2133 (stgit-move-change-to-index (stgit-file->file patched-file)
f87c2e22 2134 (eq patched-status 'ignore)))
37cb5766 2135 ((eq patch-name :index)
413f9909 2136 (stgit-remove-change-from-index (stgit-file->file patched-file)))
37cb5766 2137 (t
612f999a 2138 (error "Can only move files between working tree and index")))
a9089e68
GH
2139 (stgit-refresh-worktree)
2140 (stgit-refresh-index)
612f999a 2141 (stgit-goto-patch (if (eq patch-name :index) :work :index) mark-file)
a9089e68 2142 (push-mark nil t t)
612f999a 2143 (stgit-goto-patch patch-name point-file))))
37cb5766 2144
dde3ab4d
GH
2145(defun stgit-toggle-index ()
2146 "Move change in or out of the index.
2147
2148Works on index and work tree, as well as files in either.
2149
2150Leaves the point where it is, but moves the mark to where the
2151file ended up. You can then jump to the file with \
2152\\[exchange-point-and-mark]."
2153 (interactive)
9d04c657 2154 (stgit-assert-mode)
dde3ab4d
GH
2155 (if (stgit-patched-file-at-point)
2156 (stgit-file-toggle-index)
2157 (let ((patch-name (stgit-patch-name-at-point)))
2158 (unless (memq patch-name '(:index :work))
2159 (error "Can only move changes between working tree and index"))
2160 (when (stgit-git-index-unmerged-p)
2161 (error "Resolve unmerged changes with \\[stgit-resolve-file] first"))
2162 (if (if (eq patch-name :index)
2163 (stgit-index-empty-p)
2164 (stgit-work-tree-empty-p))
2165 (message "No changes to be moved")
2166 (stgit-capture-output nil
2167 (if (eq patch-name :work)
2168 (stgit-run-git "add" "--update")
2169 (stgit-run-git "reset" "--mixed" "-q")))
2170 (stgit-refresh-worktree)
2171 (stgit-refresh-index))
2172 (stgit-goto-patch (if (eq patch-name :index) :work :index)))))
2173
0bca35c8 2174(defun stgit-edit ()
a53347d9 2175 "Edit the patch on the current line."
0bca35c8 2176 (interactive)
9d04c657 2177 (stgit-assert-mode)
64ada6f5 2178 (let ((patchsym (stgit-patch-name-at-point t t))
0780be79 2179 (edit-buf (get-buffer-create "*StGit edit*"))
0bca35c8
DK
2180 (dir default-directory))
2181 (log-edit 'stgit-confirm-edit t nil edit-buf)
d51722b7 2182 (set (make-local-variable 'stgit-edit-patchsym) patchsym)
0bca35c8
DK
2183 (setq default-directory dir)
2184 (let ((standard-output edit-buf))
655a3977 2185 (save-excursion
69db9714 2186 (stgit-run-silent "edit" "--save-template=-" "--" patchsym)))))
0bca35c8
DK
2187
2188(defun stgit-confirm-edit ()
2189 (interactive)
2190 (let ((file (make-temp-file "stgit-edit-")))
2191 (write-region (point-min) (point-max) file)
2192 (stgit-capture-output nil
69db9714 2193 (stgit-run "edit" "-f" file "--" stgit-edit-patchsym))
0bca35c8 2194 (with-current-buffer log-edit-parent-buffer
1f0bf00f 2195 (stgit-reload))))
0bca35c8 2196
2acb7116 2197(defun stgit-new (add-sign &optional refresh)
aa04f831
GH
2198 "Create a new patch.
2199With a prefix argument, include a \"Signed-off-by:\" line at the
2200end of the patch."
2201 (interactive "P")
9d04c657 2202 (stgit-assert-mode)
c5d45b92
GH
2203 (let ((edit-buf (get-buffer-create "*StGit edit*"))
2204 (dir default-directory))
2205 (log-edit 'stgit-confirm-new t nil edit-buf)
aa04f831 2206 (setq default-directory dir)
2acb7116 2207 (set (make-local-variable 'stgit-refresh-after-new) refresh)
aa04f831
GH
2208 (when add-sign
2209 (save-excursion
2210 (let ((standard-output (current-buffer)))
2211 (stgit-run-silent "new" "--sign" "--save-template=-"))))))
64c097a0
DK
2212
2213(defun stgit-confirm-new ()
2214 (interactive)
2acb7116
DK
2215 (let ((file (make-temp-file "stgit-edit-"))
2216 (refresh stgit-refresh-after-new))
64c097a0
DK
2217 (write-region (point-min) (point-max) file)
2218 (stgit-capture-output nil
27b0f9e4 2219 (stgit-run "new" "-f" file))
64c097a0 2220 (with-current-buffer log-edit-parent-buffer
2acb7116
DK
2221 (if refresh
2222 (stgit-refresh)
2223 (stgit-reload)))))
2224
2225(defun stgit-new-and-refresh (add-sign)
2226 "Create a new patch and refresh it with the current changes.
2227
2228With a prefix argument, include a \"Signed-off-by:\" line at the
2229end of the patch.
2230
2231This works just like running `stgit-new' followed by `stgit-refresh'."
2232 (interactive "P")
9d04c657 2233 (stgit-assert-mode)
2acb7116 2234 (stgit-new add-sign t))
64c097a0
DK
2235
2236(defun stgit-create-patch-name (description)
2237 "Create a patch name from a long description"
2238 (let ((patch ""))
2239 (while (> (length description) 0)
2240 (cond ((string-match "\\`[a-zA-Z_-]+" description)
8439f657
GH
2241 (setq patch (downcase (concat patch
2242 (match-string 0 description))))
64c097a0
DK
2243 (setq description (substring description (match-end 0))))
2244 ((string-match "\\` +" description)
2245 (setq patch (concat patch "-"))
2246 (setq description (substring description (match-end 0))))
2247 ((string-match "\\`[^a-zA-Z_-]+" description)
2248 (setq description (substring description (match-end 0))))))
2249 (cond ((= (length patch) 0)
2250 "patch")
2251 ((> (length patch) 20)
2252 (substring patch 0 20))
2253 (t patch))))
0bca35c8 2254
9008e45b 2255(defun stgit-delete (patchsyms &optional spill-p)
d51722b7 2256 "Delete the patches in PATCHSYMS.
9008e45b
GH
2257Interactively, delete the marked patches, or the patch at point.
2258
2259With a prefix argument, or SPILL-P, spill the patch contents to
2260the work tree and index."
beac0f14 2261 (interactive (list (stgit-patches-marked-or-at-point t t)
9008e45b 2262 current-prefix-arg))
9d04c657 2263 (stgit-assert-mode)
e7231e4f
GH
2264 (unless patchsyms
2265 (error "No patches to delete"))
64ada6f5
GH
2266 (when (memq :index patchsyms)
2267 (error "Cannot delete the index"))
2268 (when (memq :work patchsyms)
2269 (error "Cannot delete the work tree"))
2270
d51722b7 2271 (let ((npatches (length patchsyms)))
9008e45b 2272 (when (yes-or-no-p (format "Really delete %d patch%s%s? "
e7231e4f 2273 npatches
9008e45b
GH
2274 (if (= 1 npatches) "" "es")
2275 (if spill-p
2276 " (spilling contents to index)"
2277 "")))
69db9714
GH
2278 (let ((args (append (when spill-p '("--spill"))
2279 '("--")
2280 patchsyms)))
9008e45b
GH
2281 (stgit-capture-output nil
2282 (apply 'stgit-run "delete" args))
2283 (stgit-reload)))))
d51722b7 2284
7cc45294
GH
2285(defun stgit-move-patches-target ()
2286 "Return the patchsym indicating a target patch for
2287`stgit-move-patches'.
2288
2547179e
GH
2289This is either the first unmarked patch at or after point, or one
2290of :top and :bottom if the point is after or before the applied
2291patches."
2292
2293 (save-excursion
2294 (let (result)
2295 (while (not result)
2296 (let ((patchsym (stgit-patch-name-at-point)))
2297 (cond ((memq patchsym '(:work :index)) (setq result :top))
2298 (patchsym (if (memq patchsym stgit-marked-patches)
2299 (stgit-next-patch)
2300 (setq result patchsym)))
2301 ((re-search-backward "^>" nil t) (setq result :top))
2302 (t (setq result :bottom)))))
2303 result)))
7cc45294 2304
c1412832 2305(defun stgit-sort-patches (patchsyms &optional allow-duplicates)
95369f6c
GH
2306 "Returns the list of patches in PATCHSYMS sorted according to
2307their position in the patch series, bottommost first.
2308
c1412832
KW
2309PATCHSYMS must not contain duplicate entries, unless
2310ALLOW-DUPLICATES is not nil."
95369f6c
GH
2311 (let (sorted-patchsyms
2312 (series (with-output-to-string
2313 (with-current-buffer standard-output
2314 (stgit-run-silent "series" "--noprefix"))))
2315 start)
2316 (while (string-match "^\\(.+\\)" series start)
2317 (let ((patchsym (intern (match-string 1 series))))
2318 (when (memq patchsym patchsyms)
2319 (setq sorted-patchsyms (cons patchsym sorted-patchsyms))))
2320 (setq start (match-end 0)))
2321 (setq sorted-patchsyms (nreverse sorted-patchsyms))
2322
c1412832
KW
2323 (unless allow-duplicates
2324 (unless (= (length patchsyms) (length sorted-patchsyms))
2325 (error "Internal error")))
95369f6c
GH
2326
2327 sorted-patchsyms))
2328
7cc45294
GH
2329(defun stgit-move-patches (patchsyms target-patch)
2330 "Move the patches in PATCHSYMS to below TARGET-PATCH.
2331If TARGET-PATCH is :bottom or :top, move the patches to the
2332bottom or top of the stack, respectively.
2333
2334Interactively, move the marked patches to where the point is."
2335 (interactive (list stgit-marked-patches
2336 (stgit-move-patches-target)))
9d04c657 2337 (stgit-assert-mode)
7cc45294
GH
2338 (unless patchsyms
2339 (error "Need at least one patch to move"))
2340
2341 (unless target-patch
2342 (error "Point not at a patch"))
2343
2547179e
GH
2344 ;; need to have patchsyms sorted by position in the stack
2345 (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
2346 (stgit-capture-output nil
2347 (if (eq target-patch :top)
69db9714 2348 (apply 'stgit-run "float" "--" sorted-patchsyms)
2547179e
GH
2349 (apply 'stgit-run
2350 "sink"
2351 (append (unless (eq target-patch :bottom)
2352 (list "--to" target-patch))
2353 '("--")
2354 sorted-patchsyms)))))
7cc45294
GH
2355 (stgit-reload))
2356
594aa463
KH
2357(defun stgit-squash (patchsyms)
2358 "Squash the patches in PATCHSYMS.
693d179b
GH
2359Interactively, squash the marked patches.
2360
2361Unless there are any conflicts, the patches will be merged into
2362one patch, which will occupy the same spot in the series as the
2363deepest patch had before the squash."
d51722b7 2364 (interactive (list stgit-marked-patches))
9d04c657 2365 (stgit-assert-mode)
d51722b7 2366 (when (< (length patchsyms) 2)
594aa463 2367 (error "Need at least two patches to squash"))
32d7545d
GH
2368 (let ((stgit-buffer (current-buffer))
2369 (edit-buf (get-buffer-create "*StGit edit*"))
693d179b
GH
2370 (dir default-directory)
2371 (sorted-patchsyms (stgit-sort-patches patchsyms)))
594aa463 2372 (log-edit 'stgit-confirm-squash t nil edit-buf)
693d179b 2373 (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms)
ea0def18 2374 (setq default-directory dir)
32d7545d 2375 (let ((result (let ((standard-output edit-buf))
655a3977
GH
2376 (save-excursion
2377 (apply 'stgit-run-silent "squash"
69db9714 2378 "--save-template=-" "--" sorted-patchsyms)))))
32d7545d
GH
2379
2380 ;; stg squash may have reordered the patches or caused conflicts
2381 (with-current-buffer stgit-buffer
2382 (stgit-reload))
2383
2384 (unless (eq 0 result)
2385 (fundamental-mode)
2386 (rename-buffer "*StGit error*")
2387 (resize-temp-buffer-window)
2388 (switch-to-buffer-other-window stgit-buffer)
2389 (error "stg squash failed")))))
ea0def18 2390
594aa463 2391(defun stgit-confirm-squash ()
ea0def18
DK
2392 (interactive)
2393 (let ((file (make-temp-file "stgit-edit-")))
2394 (write-region (point-min) (point-max) file)
2395 (stgit-capture-output nil
69db9714 2396 (apply 'stgit-run "squash" "-f" file "--" stgit-patchsyms))
ea0def18 2397 (with-current-buffer log-edit-parent-buffer
e6b1fdae
DK
2398 (stgit-clear-marks)
2399 ;; Go to first marked patch and stay there
2400 (goto-char (point-min))
2401 (re-search-forward (concat "^[>+-]\\*") nil t)
2402 (move-to-column goal-column)
2403 (let ((pos (point)))
1f0bf00f 2404 (stgit-reload)
e6b1fdae 2405 (goto-char pos)))))
ea0def18 2406
0663524d
KH
2407(defun stgit-help ()
2408 "Display help for the StGit mode."
2409 (interactive)
2410 (describe-function 'stgit-mode))
3a59f3db 2411
e8faa44b
DK
2412(defun stgit-execute-process-sentinel (process sentinel)
2413 (let (old-sentinel stgit-buf)
2414 (with-current-buffer (process-buffer process)
2415 (setq old-sentinel old-process-sentinel
2416 stgit-buf stgit-buffer))
2417 (and (memq (process-status process) '(exit signal))
2418 (buffer-live-p stgit-buf)
2419 (with-current-buffer stgit-buf
2420 (stgit-reload)))
2421 (funcall old-sentinel process sentinel)))
2422
a4a01630
GH
2423(defun stgit-execute-process-filter (process output)
2424 (with-current-buffer (process-buffer process)
2425 (let* ((old-point (point))
2426 (pmark (process-mark process))
2427 (insert-at (marker-position pmark))
2428 (at-pmark (= insert-at old-point)))
2429 (goto-char insert-at)
2430 (insert-before-markers output)
2431 (comint-carriage-motion insert-at (point))
2432 (set-marker pmark (point))
2433 (unless at-pmark
2434 (goto-char old-point)))))
2435
e8faa44b
DK
2436(defun stgit-execute ()
2437 "Prompt for an stg command to execute in a shell.
2438
2439The names of any marked patches or the patch at point are
2440inserted in the command to be executed.
2441
2442If the command ends in an ampersand, run it asynchronously.
2443
2444When the command has finished, reload the stgit buffer."
2445 (interactive)
2446 (stgit-assert-mode)
bf7e391c 2447 (let* ((patches (stgit-patches-marked-or-at-point nil 'allow-committed))
e8faa44b
DK
2448 (patch-names (mapcar 'symbol-name patches))
2449 (hyphens (find-if (lambda (s) (string-match "^-" s)) patch-names))
2450 (defaultcmd (if patches
2451 (concat "stg "
2452 (and hyphens "-- ")
2453 (mapconcat 'identity patch-names " "))
2454 "stg "))
2455 (cmd (read-from-minibuffer "Shell command: " (cons defaultcmd 5)
2456 nil nil 'shell-command-history))
2457 (async (string-match "&[ \t]*\\'" cmd))
2458 (buffer (get-buffer-create
2459 (if async
2460 "*Async Shell Command*"
2461 "*Shell Command Output*"))))
2462 ;; cannot use minibuffer as stgit-reload would overwrite it; if we
2463 ;; show the buffer, shell-command will not use the minibuffer
2464 (display-buffer buffer)
2465 (shell-command cmd)
2466 (if async
2467 (let ((old-buffer (current-buffer)))
2468 (with-current-buffer buffer
2469 (let ((process (get-buffer-process buffer)))
2470 (set (make-local-variable 'old-process-sentinel)
2471 (process-sentinel process))
2472 (set (make-local-variable 'stgit-buffer)
2473 old-buffer)
a4a01630 2474 (set-process-filter process 'stgit-execute-process-filter)
e8faa44b 2475 (set-process-sentinel process 'stgit-execute-process-sentinel))))
a4a01630
GH
2476 (with-current-buffer buffer
2477 (comint-carriage-motion (point-min) (point-max)))
e8faa44b
DK
2478 (shrink-window-if-larger-than-buffer (get-buffer-window buffer))
2479 (stgit-reload))))
2480
6c2d4962
GH
2481(defun stgit-undo-or-redo (redo hard)
2482 "Run stg undo or, if REDO is non-nil, stg redo.
2483
2484If HARD is non-nil, use the --hard flag."
2485 (stgit-assert-mode)
2486 (let ((cmd (if redo "redo" "undo")))
2487 (stgit-capture-output nil
2488 (if arg
2489 (when (or (and (stgit-index-empty-p)
2490 (stgit-work-tree-empty-p))
2491 (y-or-n-p (format "Hard %s may overwrite index/work tree changes. Continue? "
2492 cmd)))
2493 (stgit-run cmd "--hard"))
2494 (stgit-run cmd))))
2495 (stgit-reload))
2496
83e51dbf
DK
2497(defun stgit-undo (&optional arg)
2498 "Run stg undo.
b8463f1d
GH
2499With prefix argument, run it with the --hard flag.
2500
2501See also `stgit-redo'."
83e51dbf 2502 (interactive "P")
6c2d4962 2503 (stgit-undo-or-redo nil arg))
83e51dbf 2504
b8463f1d
GH
2505(defun stgit-redo (&optional arg)
2506 "Run stg redo.
2507With prefix argument, run it with the --hard flag.
2508
2509See also `stgit-undo'."
2510 (interactive "P")
6c2d4962 2511 (stgit-undo-or-redo t arg))
b8463f1d 2512
4d73c4d8
DK
2513(defun stgit-refresh (&optional arg)
2514 "Run stg refresh.
36a4eacd
GH
2515If the index contains any changes, only refresh from index.
2516
a53347d9 2517With prefix argument, refresh the marked patch or the patch under point."
4d73c4d8 2518 (interactive "P")
9d04c657 2519 (stgit-assert-mode)
4d73c4d8 2520 (let ((patchargs (if arg
b51a910f 2521 (let ((patches (stgit-patches-marked-or-at-point t t)))
beac0f14
GH
2522 (when (> (length patches) 1)
2523 (error "Too many patches marked"))
2524 (cons "-p" patches))
b0424080 2525 nil)))
36a4eacd
GH
2526 (unless (stgit-index-empty-p)
2527 (setq patchargs (cons "--index" patchargs)))
4d73c4d8 2528 (stgit-capture-output nil
074a4fb0
GH
2529 (apply 'stgit-run "refresh" patchargs))
2530 (stgit-refresh-git-status))
4d73c4d8
DK
2531 (stgit-reload))
2532
ce3b6130 2533(defvar stgit-show-worktree nil
8f702de4 2534 "If nil, inhibit showing work tree and index in the stgit buffer.
ce3b6130 2535
8f702de4 2536See also `stgit-show-worktree-mode'.")
ce3b6130 2537
d9473917
GH
2538(defvar stgit-show-ignored nil
2539 "If nil, inhibit showing files ignored by git.")
2540
2541(defvar stgit-show-unknown nil
2542 "If nil, inhibit showing files not registered with git.")
2543
a0045b87
DK
2544(defvar stgit-show-patch-names t
2545 "If nil, inhibit showing patch names.")
2546
bf7e391c
GH
2547(defvar stgit-show-committed nil
2548 "If nil, inhibit showing recent commits.")
2549
137b315b
GH
2550(defvar stgit-show-svn nil
2551 "If nil, inhibit showing git svn information.")
2552
bf7e391c
GH
2553(defvar stgit-committed-count nil
2554 "The number of recent commits to show.")
2555
8a619f55
GH
2556(defmacro stgit-define-toggle-view (sym help)
2557 (declare (indent 1))
2558 (let* ((name (symbol-name sym))
2559 (fun (intern (concat "stgit-toggle-" name)))
2560 (flag (intern (concat "stgit-show-" name))))
2561 ;; make help-follow find the correct function
2562 `(put (quote ,fun) 'definition-name 'stgit-define-toggle-view)
2563 `(defun ,fun (&optional arg)
2564 ,help
2565 (interactive "P")
2566 (stgit-assert-mode)
2567 (setq ,flag (if arg
2568 (> (prefix-numeric-value arg) 0)
2569 (not ,flag)))
2570 (stgit-reload))))
2571
2572(stgit-define-toggle-view worktree
ce3b6130 2573 "Toggle the visibility of the work tree.
2d7bcbd9 2574With ARG, show the work tree if ARG is positive.
ce3b6130 2575
8f702de4
GH
2576Its initial setting is controlled by `stgit-default-show-worktree'.
2577
2578`stgit-show-worktree-mode' controls where on screen the index and
8a619f55 2579work tree will show up.")
ce3b6130 2580
8a619f55 2581(stgit-define-toggle-view ignored
d9473917
GH
2582 "Toggle the visibility of files ignored by git in the work
2583tree. With ARG, show these files if ARG is positive.
2584
bc11fb08
GH
2585Its initial setting is controlled by `stgit-default-show-ignored'.
2586
8a619f55 2587Use \\[stgit-toggle-worktree] to show the work tree.")
d9473917 2588
8a619f55 2589(stgit-define-toggle-view unknown
d9473917
GH
2590 "Toggle the visibility of files not registered with git in the
2591work tree. With ARG, show these files if ARG is positive.
2592
bc11fb08
GH
2593Its initial setting is controlled by `stgit-default-show-unknown'.
2594
8a619f55 2595Use \\[stgit-toggle-worktree] to show the work tree.")
d9473917 2596
8a619f55 2597(stgit-define-toggle-view patch-names
a0045b87
DK
2598 "Toggle the visibility of patch names. With ARG, show patch names
2599if ARG is positive.
2600
8a619f55 2601The initial setting is controlled by `stgit-default-show-patch-names'.")
a0045b87 2602
137b315b
GH
2603(stgit-define-toggle-view svn
2604 "Toggle showing subversion information from git svn. With ARG,
2605show svn information if ARG is positive.
2606
2607The initial setting is controlled by `stgit-default-show-svn'.")
2608
bf7e391c
GH
2609(defun stgit-toggle-committed (&optional arg)
2610 "Toggle the visibility of historical git commits.
2611With ARG, set the number of commits to show to ARG, and disable
2612them if ARG is zero.
2613
2614The initial setting is controlled by `stgit-default-show-committed'."
2615 (interactive "P")
2616 (stgit-assert-mode)
2617 (if (null arg)
2618 (setq stgit-show-committed (not stgit-show-committed))
2619 (let ((n (prefix-numeric-value arg)))
2620 (setq stgit-show-committed (> n 0))
2621 (setq stgit-committed-count n)))
2622 (stgit-reload))
2623
3a59f3db 2624(provide 'stgit)