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