stgit.el: Use comint-carriage-motion in output from "!"
[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
847 (let ((inhibit-read-only t))
848 (put-text-property start end 'patch-data patch))))
849
850(defun stgit-select-file ()
851 (let* ((file (or (stgit-patched-file-at-point)
852 (error "No file at point")))
853 (filename (stgit-file->file file)))
854 (if (string-match "/$" filename)
855 (stgit-expand-directory file)
856 (stgit-find-file))))
857
378a003d 858(defun stgit-select ()
da01a29b
GH
859 "With point on a patch, toggle showing files in the patch.
860
861With point on a file, open the associated file. Opens the target
862file for (applied) copies and renames."
378a003d 863 (interactive)
9d04c657 864 (stgit-assert-mode)
50d88c67
DK
865 (case (get-text-property (point) 'entry-type)
866 ('patch
867 (stgit-select-patch))
868 ('file
7f972e9b 869 (stgit-select-file))
50d88c67
DK
870 (t
871 (error "No patch or file on line"))))
378a003d
GH
872
873(defun stgit-find-file-other-window ()
874 "Open file at point in other window"
875 (interactive)
9d04c657 876 (stgit-assert-mode)
030f0535 877 (stgit-find-file t))
378a003d 878
d9b954c7
GH
879(defun stgit-find-file-merge ()
880 "Open file at point and merge it using `smerge-ediff'."
881 (interactive)
9d04c657 882 (stgit-assert-mode)
d9b954c7
GH
883 (stgit-find-file t)
884 (smerge-ediff))
885
83327d53 886(defun stgit-quit ()
a53347d9 887 "Hide the stgit buffer."
83327d53 888 (interactive)
9d04c657 889 (stgit-assert-mode)
83327d53
GH
890 (bury-buffer))
891
0f076fe6 892(defun stgit-git-status ()
a53347d9 893 "Show status using `git-status'."
0f076fe6 894 (interactive)
9d04c657 895 (stgit-assert-mode)
0f076fe6 896 (unless (fboundp 'git-status)
df283a8b 897 (error "The stgit-git-status command requires git-status"))
0f076fe6
GH
898 (let ((dir default-directory))
899 (save-selected-window
900 (pop-to-buffer nil)
901 (git-status dir))))
902
58f72f16
GH
903(defun stgit-goal-column ()
904 "Return goal column for the current line"
50d88c67
DK
905 (case (get-text-property (point) 'entry-type)
906 ('patch 2)
907 ('file 4)
908 (t 0)))
58f72f16
GH
909
910(defun stgit-next-line (&optional arg)
378a003d 911 "Move cursor vertically down ARG lines"
58f72f16 912 (interactive "p")
9d04c657 913 (stgit-assert-mode)
58f72f16
GH
914 (next-line arg)
915 (move-to-column (stgit-goal-column)))
378a003d 916
58f72f16 917(defun stgit-previous-line (&optional arg)
378a003d 918 "Move cursor vertically up ARG lines"
58f72f16 919 (interactive "p")
9d04c657 920 (stgit-assert-mode)
58f72f16
GH
921 (previous-line arg)
922 (move-to-column (stgit-goal-column)))
378a003d
GH
923
924(defun stgit-next-patch (&optional arg)
98230edd 925 "Move cursor down ARG patches."
378a003d 926 (interactive "p")
9d04c657 927 (stgit-assert-mode)
98230edd
DK
928 (ewoc-goto-next stgit-ewoc (or arg 1))
929 (move-to-column goal-column))
378a003d
GH
930
931(defun stgit-previous-patch (&optional arg)
98230edd 932 "Move cursor up ARG patches."
378a003d 933 (interactive "p")
9d04c657 934 (stgit-assert-mode)
98230edd
DK
935 (ewoc-goto-prev stgit-ewoc (or arg 1))
936 (move-to-column goal-column))
378a003d 937
56d81fe5
DK
938(defvar stgit-mode-hook nil
939 "Run after `stgit-mode' is setup.")
940
941(defvar stgit-mode-map nil
942 "Keymap for StGit major mode.")
943
944(unless stgit-mode-map
5038381d
GH
945 (let ((diff-map (make-sparse-keymap))
946 (toggle-map (make-sparse-keymap)))
d9b954c7
GH
947 (mapc (lambda (arg) (define-key diff-map (car arg) (cdr arg)))
948 '(("b" . stgit-diff-base)
949 ("c" . stgit-diff-combined)
950 ("m" . stgit-find-file-merge)
951 ("o" . stgit-diff-ours)
e02b46e5 952 ("r" . stgit-diff-range)
d9b954c7 953 ("t" . stgit-diff-theirs)))
ce3b6130 954 (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
a0045b87
DK
955 '(("n" . stgit-toggle-patch-names)
956 ("t" . stgit-toggle-worktree)
d9473917
GH
957 ("i" . stgit-toggle-ignored)
958 ("u" . stgit-toggle-unknown)))
ce3b6130
DK
959 (setq stgit-mode-map (make-keymap))
960 (suppress-keymap stgit-mode-map)
961 (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
d11e0621
GH
962 `((" " . stgit-mark-down)
963 ("m" . stgit-mark-down)
ce3b6130
DK
964 ("\d" . stgit-unmark-up)
965 ("u" . stgit-unmark-down)
966 ("?" . stgit-help)
967 ("h" . stgit-help)
968 ("\C-p" . stgit-previous-line)
969 ("\C-n" . stgit-next-line)
970 ([up] . stgit-previous-line)
971 ([down] . stgit-next-line)
972 ("p" . stgit-previous-patch)
973 ("n" . stgit-next-patch)
974 ("\M-{" . stgit-previous-patch)
975 ("\M-}" . stgit-next-patch)
976 ("s" . stgit-git-status)
408fa7cb 977 ("g" . stgit-reload-or-repair)
ce3b6130
DK
978 ("r" . stgit-refresh)
979 ("\C-c\C-r" . stgit-rename)
980 ("e" . stgit-edit)
981 ("M" . stgit-move-patches)
982 ("S" . stgit-squash)
983 ("N" . stgit-new)
2acb7116 984 ("c" . stgit-new-and-refresh)
e9fdd4ea
GH
985 ("\C-c\C-c" . stgit-commit)
986 ("\C-c\C-u" . stgit-uncommit)
1629f59f 987 ("U" . stgit-revert)
51783171 988 ("R" . stgit-resolve-file)
ce3b6130 989 ("\r" . stgit-select)
afbf766b
GH
990 ("+" . stgit-expand)
991 ("-" . stgit-collapse)
ce3b6130 992 ("o" . stgit-find-file-other-window)
dde3ab4d 993 ("i" . stgit-toggle-index)
ce3b6130
DK
994 (">" . stgit-push-next)
995 ("<" . stgit-pop-next)
996 ("P" . stgit-push-or-pop)
997 ("G" . stgit-goto)
d9b954c7 998 ("=" . stgit-diff)
ce3b6130 999 ("D" . stgit-delete)
b8463f1d 1000 ([?\C-/] . stgit-undo)
ce3b6130 1001 ("\C-_" . stgit-undo)
b8463f1d
GH
1002 ([?\C-c ?\C-/] . stgit-redo)
1003 ("\C-c\C-_" . stgit-redo)
ce3b6130 1004 ("B" . stgit-branch)
380a021f 1005 ("\C-c\C-b" . stgit-rebase)
ce3b6130 1006 ("t" . ,toggle-map)
d9b954c7 1007 ("d" . ,diff-map)
e8faa44b
DK
1008 ("q" . stgit-quit)
1009 ("!" . stgit-execute))))
5038381d
GH
1010
1011 (let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point)))
413f9909 1012 (and file (eq (stgit-file->status file)
5038381d
GH
1013 'unmerged))))
1014 (patch-collapsed-p '(lambda (p) (not (memq p stgit-expanded-patches)))))
1015 (easy-menu-define stgit-menu stgit-mode-map
1016 "StGit Menu"
1017 `("StGit"
1018 ["Reload" stgit-reload-or-repair
1019 :help "Reload StGit status from disk"]
1020 ["Repair" stgit-repair
1021 :keys "\\[universal-argument] \\[stgit-reload-or-repair]"
1022 :help "Repair StGit metadata"]
1023 "-"
1024 ["Undo" stgit-undo t]
1025 ["Redo" stgit-redo t]
1026 "-"
1027 ["Git status" stgit-git-status :active (fboundp 'git-status)]
1028 "-"
1029 ["New patch" stgit-new-and-refresh
1030 :help "Create a new patch from changes in index or work tree"
1031 :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))]
1032 ["New empty patch" stgit-new
1033 :help "Create a new, empty patch"]
1034 ["(Un)mark patch" stgit-toggle-mark
1035 :label (if (memq (stgit-patch-name-at-point nil t)
1036 stgit-marked-patches)
1037 "Unmark patch" "Mark patch")
1038 :active (stgit-patch-name-at-point nil t)]
1039 ["Expand/collapse patch"
1040 (let ((patches (stgit-patches-marked-or-at-point)))
1041 (if (member-if ,patch-collapsed-p patches)
1042 (stgit-expand patches)
1043 (stgit-collapse patches)))
1044 :label (if (member-if ,patch-collapsed-p
1045 (stgit-patches-marked-or-at-point))
1046 "Expand patches"
1047 "Collapse patches")
1048 :active (stgit-patches-marked-or-at-point)]
1049 ["Edit patch" stgit-edit
1050 :help "Edit patch comment"
1051 :active (stgit-patch-name-at-point nil t)]
1052 ["Rename patch" stgit-rename :active (stgit-patch-name-at-point nil t)]
1053 ["Push/pop patch" stgit-push-or-pop
7c11b754
GH
1054 :label (if (subsetp (stgit-patches-marked-or-at-point nil t)
1055 (stgit-applied-patchsyms t))
1056 "Pop patches" "Push patches")]
beac0f14
GH
1057 ["Delete patches" stgit-delete
1058 :active (stgit-patches-marked-or-at-point nil t)]
5038381d
GH
1059 "-"
1060 ["Move patches" stgit-move-patches
1061 :active stgit-marked-patches
fd64ee57 1062 :help "Move marked patch(es) to point"]
5038381d
GH
1063 ["Squash patches" stgit-squash
1064 :active (> (length stgit-marked-patches) 1)
fd64ee57 1065 :help "Merge marked patches into one"]
5038381d
GH
1066 "-"
1067 ["Refresh top patch" stgit-refresh
1068 :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))
1069 :help "Refresh the top patch with changes in index or work tree"]
1070 ["Refresh this patch" (stgit-refresh t)
1071 :keys "\\[universal-argument] \\[stgit-refresh]"
fd64ee57 1072 :help "Refresh marked patch with changes in index or work tree"
5038381d
GH
1073 :active (and (not (and (stgit-index-empty-p)
1074 (stgit-work-tree-empty-p)))
1075 (stgit-patch-name-at-point nil t))]
1076 "-"
1077 ["Find file" stgit-select
1078 :active (eq (get-text-property (point) 'entry-type) 'file)]
1079 ["Open file" stgit-find-file-other-window
1080 :active (eq (get-text-property (point) 'entry-type) 'file)]
1081 ["Toggle file index" stgit-toggle-index
1082 :active (and (eq (get-text-property (point) 'entry-type) 'file)
1083 (memq (stgit-patch-name-at-point) '(:work :index)))
1084 :label (if (eq (stgit-patch-name-at-point) :work)
1085 "Move change to index"
1086 "Move change to work tree")]
1087 "-"
1088 ["Show diff" stgit-diff
1089 :active (get-text-property (point) 'entry-type)]
e02b46e5
KW
1090 ["Show diff for range of applied patches" stgit-diff-range
1091 :active (= (length stgit-marked-patches) 1)]
5038381d
GH
1092 ("Merge"
1093 :active (stgit-git-index-unmerged-p)
1094 ["Combined diff" stgit-diff-combined
1095 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1096 ["Diff against base" stgit-diff-base
1097 :help "Show diff against the common base"
1098 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1099 ["Diff against ours" stgit-diff-ours
1100 :help "Show diff against our branch"
1101 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1102 ["Diff against theirs" stgit-diff-theirs
1103 :help "Show diff against their branch"
1104 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1105 "-"
1106 ["Interactive merge" stgit-find-file-merge
1107 :help "Interactively merge the file"
1108 :active ,at-unmerged-file]
1109 ["Resolve file" stgit-resolve-file
1110 :help "Mark file conflict as resolved"
1111 :active ,at-unmerged-file]
1112 )
1113 "-"
1114 ["Show index & work tree" stgit-toggle-worktree :style toggle
1115 :selected stgit-show-worktree]
1116 ["Show unknown files" stgit-toggle-unknown :style toggle
1117 :selected stgit-show-unknown :active stgit-show-worktree]
1118 ["Show ignored files" stgit-toggle-ignored :style toggle
1119 :selected stgit-show-ignored :active stgit-show-worktree]
a0045b87
DK
1120 ["Show patch names" stgit-toggle-patch-names :style toggle
1121 :selected stgit-show-patch-names]
5038381d
GH
1122 "-"
1123 ["Switch branches" stgit-branch t
3e528fb0 1124 :help "Switch to or create another branch"]
5038381d
GH
1125 ["Rebase branch" stgit-rebase t
1126 :help "Rebase the current branch"]
1127 ))))
1128
1129;; disable tool bar editing buttons
1130(put 'stgit-mode 'mode-class 'special)
56d81fe5
DK
1131
1132(defun stgit-mode ()
1133 "Major mode for interacting with StGit.
fdf5e327
GH
1134
1135Start StGit using \\[stgit].
1136
1137Basic commands:
1138\\<stgit-mode-map>\
1139\\[stgit-help] Show this help text
1140\\[stgit-quit] Hide the StGit buffer
1141\\[describe-bindings] Show all key bindings
1142
1143\\[stgit-reload-or-repair] Reload the StGit buffer
1144\\[universal-argument] \\[stgit-reload-or-repair] Repair StGit metadata
1145
1146\\[stgit-undo] Undo most recent StGit operation
1147\\[stgit-redo] Undo recent undo
1148
1149\\[stgit-git-status] Run `git-status' (if available)
1150
e8faa44b
DK
1151\\[stgit-execute] Run an stg shell command
1152
fdf5e327
GH
1153Movement commands:
1154\\[stgit-previous-line] Move to previous line
1155\\[stgit-next-line] Move to next line
1156\\[stgit-previous-patch] Move to previous patch
1157\\[stgit-next-patch] Move to next patch
1158
d11e0621 1159\\[stgit-mark-down] Mark patch and move down
fdf5e327
GH
1160\\[stgit-unmark-up] Unmark patch and move up
1161\\[stgit-unmark-down] Unmark patch and move down
1162
1163Commands for patches:
1164\\[stgit-select] Toggle showing changed files in patch
1165\\[stgit-refresh] Refresh patch with changes in index or work tree
1166\\[stgit-diff] Show the patch log and diff
1167
fd64ee57
GH
1168\\[stgit-expand] Show changes in marked patches
1169\\[stgit-collapse] Hide changes in marked patches
afbf766b 1170
2acb7116 1171\\[stgit-new-and-refresh] Create a new patch from index or work tree
c20b20a5
GH
1172\\[stgit-new] Create a new, empty patch
1173
fdf5e327
GH
1174\\[stgit-rename] Rename patch
1175\\[stgit-edit] Edit patch description
1176\\[stgit-delete] Delete patch(es)
1177
1629f59f 1178\\[stgit-revert] Revert all changes in index or work tree
dde3ab4d 1179\\[stgit-toggle-index] Toggle all changes between index and work tree
1629f59f 1180
fdf5e327
GH
1181\\[stgit-push-next] Push next patch onto stack
1182\\[stgit-pop-next] Pop current patch from stack
c20b20a5
GH
1183\\[stgit-push-or-pop] Push or pop marked patches
1184\\[stgit-goto] Make patch at point current by popping or pushing
fdf5e327
GH
1185
1186\\[stgit-squash] Squash (meld together) patches
c20b20a5 1187\\[stgit-move-patches] Move marked patches to point
fdf5e327
GH
1188
1189\\[stgit-commit] Commit patch(es)
1190\\[stgit-uncommit] Uncommit patch(es)
1191
1192Commands for files:
1193\\[stgit-select] Open the file in this window
1194\\[stgit-find-file-other-window] Open the file in another window
1195\\[stgit-diff] Show the file's diff
1196
dde3ab4d 1197\\[stgit-toggle-index] Toggle change between index and work tree
1629f59f 1198\\[stgit-revert] Revert changes to file
fdf5e327
GH
1199
1200Display commands:
a0045b87 1201\\[stgit-toggle-patch-names] Toggle showing patch names
fdf5e327
GH
1202\\[stgit-toggle-worktree] Toggle showing index and work tree
1203\\[stgit-toggle-unknown] Toggle showing unknown files
1204\\[stgit-toggle-ignored] Toggle showing ignored files
1205
1206Commands for diffs:
1207\\[stgit-diff] Show diff of patch or file
e02b46e5 1208\\[stgit-diff-range] Show diff for range of patches
fdf5e327
GH
1209\\[stgit-diff-base] Show diff against the merge base
1210\\[stgit-diff-ours] Show diff against our branch
1211\\[stgit-diff-theirs] Show diff against their branch
1212
1213 With one prefix argument (e.g., \\[universal-argument] \\[stgit-diff]), \
1214ignore space changes.
1215 With two prefix arguments (e.g., \\[universal-argument] \
1216\\[universal-argument] \\[stgit-diff]), ignore all space changes.
1217
1218Commands for merge conflicts:
1219\\[stgit-find-file-merge] Resolve conflicts using `smerge-ediff'
1220\\[stgit-resolve-file] Mark unmerged file as resolved
1221
1222Commands for branches:
3e528fb0 1223\\[stgit-branch] Switch to or create another branch
380a021f 1224\\[stgit-rebase] Rebase the current branch
fdf5e327
GH
1225
1226Customization variables:
1227`stgit-abbreviate-copies-and-renames'
a0045b87 1228`stgit-default-show-patch-names'
fdf5e327
GH
1229`stgit-default-show-worktree'
1230`stgit-find-copies-harder'
1231`stgit-show-worktree-mode'
1232
1233See also \\[customize-group] for the \"stgit\" group."
56d81fe5
DK
1234 (kill-all-local-variables)
1235 (buffer-disable-undo)
1236 (setq mode-name "StGit"
1237 major-mode 'stgit-mode
1238 goal-column 2)
1239 (use-local-map stgit-mode-map)
1240 (set (make-local-variable 'list-buffers-directory) default-directory)
6df83d42 1241 (set (make-local-variable 'stgit-marked-patches) nil)
6467d976 1242 (set (make-local-variable 'stgit-expanded-patches) (list :work :index))
a0045b87
DK
1243 (set (make-local-variable 'stgit-show-patch-names)
1244 stgit-default-show-patch-names)
ce3b6130 1245 (set (make-local-variable 'stgit-show-worktree) stgit-default-show-worktree)
2ecb05c8
GH
1246 (set (make-local-variable 'stgit-index-node) nil)
1247 (set (make-local-variable 'stgit-worktree-node) nil)
224ef1ec 1248 (set (make-local-variable 'parse-sexp-lookup-properties) t)
2870f8b8 1249 (set-variable 'truncate-lines 't)
e44674e3
GH
1250 (add-hook 'after-save-hook 'stgit-update-stgit-for-buffer)
1251 (unless stgit-did-advise
1252 (stgit-advise)
1253 (setq stgit-did-advise t))
56d81fe5
DK
1254 (run-hooks 'stgit-mode-hook))
1255
e44674e3
GH
1256(defun stgit-advise-funlist (funlist)
1257 "Add advice to the functions in FUNLIST so we can refresh the
1258stgit buffers as the git status of files change."
1259 (mapc (lambda (sym)
1260 (when (fboundp sym)
1261 (eval `(defadvice ,sym (after stgit-update-stgit-for-buffer)
1262 (stgit-update-stgit-for-buffer t)))
1263 (ad-activate sym)))
1264 funlist))
1265
1266(defun stgit-advise ()
1267 "Add advice to appropriate (non-stgit) git functions so we can
1268refresh the stgit buffers as the git status of files change."
1269 (mapc (lambda (arg)
1270 (let ((feature (car arg))
1271 (funlist (cdr arg)))
1272 (if (featurep feature)
1273 (stgit-advise-funlist funlist)
1274 (add-to-list 'after-load-alist
1275 `(,feature (stgit-advise-funlist
1276 (quote ,funlist)))))))
1277 '((vc-git vc-git-rename-file vc-git-revert vc-git-register)
1278 (git git-add-file git-checkout git-revert-file git-remove-file))))
1279
1280(defun stgit-update-stgit-for-buffer (&optional refresh-index)
1281 "Refresh worktree status in any `stgit-mode' buffer that shows
1282the status of the current buffer.
1283
1284If REFRESH-INDEX is not-nil, also update the index."
1285 (let* ((dir (cond ((eq major-mode 'git-status-mode)
1286 default-directory)
1287 (buffer-file-name
1288 (file-name-directory
1289 (expand-file-name buffer-file-name)))))
1290 (gitdir (and dir (condition-case nil (git-get-top-dir dir)
1291 (error nil))))
b894e680
DK
1292 (buffer (and gitdir (stgit-find-buffer gitdir))))
1293 (when buffer
1294 (with-current-buffer buffer
e44674e3
GH
1295 (stgit-refresh-worktree)
1296 (when refresh-index (stgit-refresh-index))))))
b894e680 1297
d51722b7
GH
1298(defun stgit-add-mark (patchsym)
1299 "Mark the patch PATCHSYM."
8036afdd 1300 (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
6df83d42 1301
d51722b7
GH
1302(defun stgit-remove-mark (patchsym)
1303 "Unmark the patch PATCHSYM."
8036afdd 1304 (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))
6df83d42 1305
e6b1fdae 1306(defun stgit-clear-marks ()
47271f41 1307 "Unmark all patches."
e6b1fdae
DK
1308 (setq stgit-marked-patches '()))
1309
735cb7ec 1310(defun stgit-patch-at-point (&optional cause-error)
2c862b07
DK
1311 (get-text-property (point) 'patch-data))
1312
64ada6f5 1313(defun stgit-patch-name-at-point (&optional cause-error only-patches)
d51722b7 1314 "Return the patch name on the current line as a symbol.
64ada6f5
GH
1315If CAUSE-ERROR is not nil, signal an error if none found.
1316If ONLY-PATCHES is not nil, only allow real patches, and not
1317index or work tree."
2c862b07 1318 (let ((patch (stgit-patch-at-point)))
64ada6f5
GH
1319 (and patch
1320 only-patches
413f9909 1321 (memq (stgit-patch->status patch) '(work index))
64ada6f5 1322 (setq patch nil))
2c862b07 1323 (cond (patch
413f9909 1324 (stgit-patch->name patch))
2c862b07
DK
1325 (cause-error
1326 (error "No patch on this line")))))
378a003d 1327
3164eec6
DK
1328(defun stgit-patched-file-at-point ()
1329 (get-text-property (point) 'file-data))
56d81fe5 1330
beac0f14
GH
1331(defun stgit-patches-marked-or-at-point (&optional cause-error only-patches)
1332 "Return the symbols of the marked patches, or the patch on the current line.
1333If CAUSE-ERRROR is not nil, signal an error if none found.
1334If ONLY-PATCHES is not nil, do not include index or work tree."
7755d7f1 1335 (if stgit-marked-patches
d51722b7 1336 stgit-marked-patches
beac0f14
GH
1337 (let ((patch (stgit-patch-name-at-point nil only-patches)))
1338 (cond (patch (list patch))
1339 (cause-error (error "No patches marked or at this line"))
1340 (t nil)))))
7755d7f1 1341
a9089e68 1342(defun stgit-goto-patch (patchsym &optional file)
d51722b7 1343 "Move point to the line containing patch PATCHSYM.
a9089e68
GH
1344If that patch cannot be found, do nothing.
1345
1346If the patch was found and FILE is not nil, instead move to that
1347file's line. If FILE cannot be found, stay on the line of
1348PATCHSYM."
f9b82d36 1349 (let ((node (ewoc-nth stgit-ewoc 0)))
413f9909 1350 (while (and node (not (eq (stgit-patch->name (ewoc-data node))
f9b82d36
DK
1351 patchsym)))
1352 (setq node (ewoc-next stgit-ewoc node)))
a9089e68 1353 (when (and node file)
413f9909 1354 (let* ((file-ewoc (stgit-patch->files-ewoc (ewoc-data node)))
a9089e68 1355 (file-node (ewoc-nth file-ewoc 0)))
ea696de9
GH
1356 (while (and file-node
1357 (not (equal (stgit-file->file (ewoc-data file-node))
1358 file)))
a9089e68
GH
1359 (setq file-node (ewoc-next file-ewoc file-node)))
1360 (when file-node
1361 (ewoc-goto-node file-ewoc file-node)
1362 (move-to-column (stgit-goal-column))
1363 (setq node nil))))
f9b82d36
DK
1364 (when node
1365 (ewoc-goto-node stgit-ewoc node)
d51722b7 1366 (move-to-column goal-column))))
56d81fe5 1367
1c2426dc 1368(defun stgit-init ()
a53347d9 1369 "Run stg init."
1c2426dc 1370 (interactive)
9d04c657 1371 (stgit-assert-mode)
1c2426dc 1372 (stgit-capture-output nil
b0424080 1373 (stgit-run "init"))
1f0bf00f 1374 (stgit-reload))
1c2426dc 1375
d11e0621
GH
1376(defun stgit-toggle-mark ()
1377 "Toggle mark on the patch under point."
1378 (interactive)
1379 (stgit-assert-mode)
1380 (if (memq (stgit-patch-name-at-point t t) stgit-marked-patches)
1381 (stgit-unmark)
1382 (stgit-mark)))
1383
6df83d42 1384(defun stgit-mark ()
a53347d9 1385 "Mark the patch under point."
6df83d42 1386 (interactive)
9d04c657 1387 (stgit-assert-mode)
8036afdd 1388 (let* ((node (ewoc-locate stgit-ewoc))
64ada6f5 1389 (patch (ewoc-data node))
413f9909 1390 (name (stgit-patch->name patch)))
64ada6f5
GH
1391 (when (eq name :work)
1392 (error "Cannot mark the work tree"))
1393 (when (eq name :index)
1394 (error "Cannot mark the index"))
413f9909 1395 (stgit-add-mark (stgit-patch->name patch))
d11e0621
GH
1396 (let ((column (current-column)))
1397 (ewoc-invalidate stgit-ewoc node)
1398 (move-to-column column))))
1399
1400(defun stgit-mark-down ()
1401 "Mark the patch under point and move to the next patch."
1402 (interactive)
1403 (stgit-mark)
378a003d 1404 (stgit-next-patch))
6df83d42 1405
d11e0621
GH
1406(defun stgit-unmark ()
1407 "Remove mark from the patch on the current line."
6df83d42 1408 (interactive)
9d04c657 1409 (stgit-assert-mode)
8036afdd
DK
1410 (let* ((node (ewoc-locate stgit-ewoc))
1411 (patch (ewoc-data node)))
413f9909 1412 (stgit-remove-mark (stgit-patch->name patch))
d11e0621
GH
1413 (let ((column (current-column)))
1414 (ewoc-invalidate stgit-ewoc node)
1415 (move-to-column column))))
1416
1417(defun stgit-unmark-up ()
1418 "Remove mark from the patch on the previous line."
1419 (interactive)
1420 (stgit-assert-mode)
1421 (stgit-previous-patch)
1422 (stgit-unmark))
9b151b27
GH
1423
1424(defun stgit-unmark-down ()
a53347d9 1425 "Remove mark from the patch on the current line."
9b151b27 1426 (interactive)
9d04c657 1427 (stgit-assert-mode)
d11e0621 1428 (stgit-unmark)
1288eda2 1429 (stgit-next-patch))
6df83d42 1430
56d81fe5 1431(defun stgit-rename (name)
018fa1ac 1432 "Rename the patch under point to NAME."
64ada6f5
GH
1433 (interactive (list
1434 (read-string "Patch name: "
1435 (symbol-name (stgit-patch-name-at-point t t)))))
9d04c657 1436 (stgit-assert-mode)
64ada6f5 1437 (let ((old-patchsym (stgit-patch-name-at-point t t)))
56d81fe5 1438 (stgit-capture-output nil
69db9714 1439 (stgit-run "rename" "--" old-patchsym name))
d51722b7
GH
1440 (let ((name-sym (intern name)))
1441 (when (memq old-patchsym stgit-expanded-patches)
378a003d 1442 (setq stgit-expanded-patches
6a73154a 1443 (cons name-sym (delq old-patchsym stgit-expanded-patches))))
d51722b7 1444 (when (memq old-patchsym stgit-marked-patches)
378a003d 1445 (setq stgit-marked-patches
6a73154a 1446 (cons name-sym (delq old-patchsym stgit-marked-patches))))
d51722b7
GH
1447 (stgit-reload)
1448 (stgit-goto-patch name-sym))))
56d81fe5 1449
408fa7cb
GH
1450(defun stgit-reload-or-repair (repair)
1451 "Update the contents of the StGit buffer (`stgit-reload').
1452
1453With a prefix argument, repair the StGit metadata if the branch
1454was modified with git commands (`stgit-repair')."
1455 (interactive "P")
9d04c657 1456 (stgit-assert-mode)
408fa7cb
GH
1457 (if repair
1458 (stgit-repair)
1459 (stgit-reload)))
1460
26201d96 1461(defun stgit-repair ()
a53347d9 1462 "Run stg repair."
26201d96 1463 (interactive)
9d04c657 1464 (stgit-assert-mode)
26201d96 1465 (stgit-capture-output nil
b0424080 1466 (stgit-run "repair"))
1f0bf00f 1467 (stgit-reload))
26201d96 1468
3e528fb0
GH
1469(defun stgit-available-branches (&optional all)
1470 "Returns a list of the names of the available stg branches as strings.
1471
1472If ALL is not nil, also return non-stgit branches."
adeef6bc
GH
1473 (let ((output (with-output-to-string
1474 (stgit-run "branch" "--list")))
3e528fb0
GH
1475 (pattern (format "^>?\\s-+%c\\s-+\\(\\S-+\\)"
1476 (if all ?. ?s)))
adeef6bc
GH
1477 (start 0)
1478 result)
3e528fb0 1479 (while (string-match pattern output start)
adeef6bc
GH
1480 (setq result (cons (match-string 1 output) result))
1481 (setq start (match-end 0)))
1482 result))
1483
1484(defun stgit-branch (branch)
3e528fb0 1485 "Switch to or create branch BRANCH."
adeef6bc
GH
1486 (interactive (list (completing-read "Switch to branch: "
1487 (stgit-available-branches))))
9d04c657 1488 (stgit-assert-mode)
3e528fb0
GH
1489 (when (cond ((equal branch (stgit-current-branch))
1490 (error "Branch is already current"))
1491 ((member branch (stgit-available-branches t))
1492 (stgit-capture-output nil (stgit-run "branch" "--" branch))
1493 t)
1494 ((not (string-match stgit-allowed-branch-name-re branch))
1495 (error "Invalid branch name"))
1496 ((yes-or-no-p (format "Create branch \"%s\"? " branch))
1497 (stgit-capture-output nil (stgit-run "branch" "--create" "--"
1498 branch))
1499 t))
1500 (stgit-reload)))
adeef6bc 1501
380a021f
GH
1502(defun stgit-available-refs (&optional omit-stgit)
1503 "Returns a list of the available git refs.
1504If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"."
1505 (let* ((output (with-output-to-string
1506 (stgit-run-git-silent "for-each-ref" "--format=%(refname)"
1507 "refs/tags" "refs/heads"
1508 "refs/remotes")))
1509 (result (split-string output "\n" t)))
1510 (mapcar (lambda (s)
1511 (if (string-match "^refs/\\(heads\\|tags\\|remotes\\)/" s)
1512 (substring s (match-end 0))
1513 s))
1514 (if omit-stgit
1515 (delete-if (lambda (s)
1516 (string-match "^refs/heads/.*\\.stgit$" s))
1517 result)
1518 result))))
1519
d6e17ce0
GH
1520(defun stgit-parent-branch ()
1521 "Return the parent branch of the current stg branch as per
1522git-config setting branch.<branch>.stgit.parentbranch."
1523 (let ((output (with-output-to-string
1524 (stgit-run-git-silent "config"
1525 (format "branch.%s.stgit.parentbranch"
1526 (stgit-current-branch))))))
1527 (when (string-match ".*" output)
1528 (match-string 0 output))))
1529
380a021f 1530(defun stgit-rebase (new-base)
d6e17ce0
GH
1531 "Rebase the current branch to NEW-BASE.
1532
1533Interactively, first ask which branch to rebase to. Defaults to
1534what git-config branch.<branch>.stgit.parentbranch is set to."
380a021f 1535 (interactive (list (completing-read "Rebase to: "
d6e17ce0
GH
1536 (stgit-available-refs t)
1537 nil nil
1538 (stgit-parent-branch))))
9d04c657 1539 (stgit-assert-mode)
69db9714 1540 (stgit-capture-output nil (stgit-run "rebase" "--" new-base))
380a021f
GH
1541 (stgit-reload))
1542
41c1c59c
GH
1543(defun stgit-commit (count)
1544 "Run stg commit on COUNT commits.
e552cb5f
GH
1545Interactively, the prefix argument is used as COUNT.
1546A negative COUNT will uncommit instead."
41c1c59c 1547 (interactive "p")
9d04c657 1548 (stgit-assert-mode)
e552cb5f
GH
1549 (if (< count 0)
1550 (stgit-uncommit (- count))
1551 (stgit-capture-output nil (stgit-run "commit" "-n" count))
1552 (stgit-reload)))
1553
1554(defun stgit-uncommit (count)
1555 "Run stg uncommit on COUNT commits.
1556Interactively, the prefix argument is used as COUNT.
1557A negative COUNT will commit instead."
1558 (interactive "p")
9d04c657 1559 (stgit-assert-mode)
e552cb5f
GH
1560 (if (< count 0)
1561 (stgit-commit (- count))
1562 (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
1563 (stgit-reload)))
c4aad9a7 1564
556345d3
GH
1565(defun stgit-neighbour-file ()
1566 "Return the file name of the next file after point, or the
1567previous file if point is at the last file within a patch."
1568 (let ((old-point (point))
1569 neighbour-file)
1570 (and (zerop (forward-line 1))
1571 (let ((f (stgit-patched-file-at-point)))
413f9909 1572 (and f (setq neighbour-file (stgit-file->file f)))))
556345d3
GH
1573 (goto-char old-point)
1574 (unless neighbour-file
1575 (and (zerop (forward-line -1))
1576 (let ((f (stgit-patched-file-at-point)))
413f9909 1577 (and f (setq neighbour-file (stgit-file->file f)))))
556345d3
GH
1578 (goto-char old-point))
1579 neighbour-file))
1580
3959a095
GH
1581(defun stgit-revert-file ()
1582 "Revert the file at point, which must be in the index or the
1583working tree."
1584 (interactive)
9d04c657 1585 (stgit-assert-mode)
3959a095
GH
1586 (let* ((patched-file (or (stgit-patched-file-at-point)
1587 (error "No file on the current line")))
1588 (patch-name (stgit-patch-name-at-point))
413f9909
GH
1589 (file-status (stgit-file->status patched-file))
1590 (rm-file (cond ((stgit-file->copy-or-rename patched-file)
1591 (stgit-file->cr-to patched-file))
3959a095 1592 ((eq file-status 'add)
413f9909 1593 (stgit-file->file patched-file))))
3959a095 1594 (co-file (cond ((eq file-status 'rename)
413f9909 1595 (stgit-file->cr-from patched-file))
3959a095 1596 ((not (memq file-status '(copy add)))
413f9909 1597 (stgit-file->file patched-file))))
556345d3 1598 (next-file (stgit-neighbour-file)))
3959a095
GH
1599
1600 (unless (memq patch-name '(:work :index))
1601 (error "No index or working tree file on this line"))
1602
d9473917
GH
1603 (when (eq file-status 'ignore)
1604 (error "Cannot revert ignored files"))
1605
1606 (when (eq file-status 'unknown)
1607 (error "Cannot revert unknown files"))
1608
3959a095
GH
1609 (let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
1610 (when (yes-or-no-p (format "Revert %d file%s? "
1611 nfiles
1612 (if (= nfiles 1) "" "s")))
1613 (stgit-capture-output nil
1614 (when rm-file
1615 (stgit-run-git "rm" "-f" "-q" "--" rm-file))
1616 (when co-file
1617 (stgit-run-git "checkout" "HEAD" co-file)))
556345d3
GH
1618 (stgit-reload)
1619 (stgit-goto-patch patch-name next-file)))))
1629f59f
GH
1620
1621(defun stgit-revert ()
1622 "Revert the change at point, which must be the index, the work
1623tree, or a single change in either."
1624 (interactive)
9d04c657 1625 (stgit-assert-mode)
1629f59f
GH
1626 (let ((patched-file (stgit-patched-file-at-point)))
1627 (if patched-file
1628 (stgit-revert-file)
1629 (let* ((patch-name (or (stgit-patch-name-at-point)
1630 (error "No patch or file at point")))
1631 (patch-desc (case patch-name
1632 (:index "index")
1633 (:work "work tree")
1634 (t (error (substitute-command-keys
1635 "Use \\[stgit-delete] to delete a patch"))))))
1636 (when (if (eq patch-name :work)
1637 (stgit-work-tree-empty-p)
1638 (stgit-index-empty-p))
1639 (error (format "There are no changes in the %s to revert"
1640 patch-desc)))
1641 (and (eq patch-name :index)
1642 (not (stgit-work-tree-empty-p))
1643 (error "Cannot revert index as work tree contains unstaged changes"))
1644
1645 (when (yes-or-no-p (format "Revert all changes in the %s? "
1646 patch-desc))
1647 (if (eq patch-name :index)
1648 (stgit-run-git-silent "reset" "--hard" "-q")
1649 (stgit-run-git-silent "checkout" "--" "."))
1650 (stgit-refresh-index)
1651 (stgit-refresh-worktree)
1652 (stgit-goto-patch patch-name))))))
3959a095 1653
51783171
GH
1654(defun stgit-resolve-file ()
1655 "Resolve conflict in the file at point."
1656 (interactive)
9d04c657 1657 (stgit-assert-mode)
51783171
GH
1658 (let* ((patched-file (stgit-patched-file-at-point))
1659 (patch (stgit-patch-at-point))
413f9909
GH
1660 (patch-name (and patch (stgit-patch->name patch)))
1661 (status (and patched-file (stgit-file->status patched-file))))
51783171
GH
1662
1663 (unless (memq patch-name '(:work :index))
1664 (error "No index or working tree file on this line"))
1665
1666 (unless (eq status 'unmerged)
1667 (error "No conflict to resolve at the current line"))
1668
1669 (stgit-capture-output nil
413f9909 1670 (stgit-move-change-to-index (stgit-file->file patched-file)))
51783171
GH
1671
1672 (stgit-reload)))
1673
d47ee133
GH
1674(defun stgit-push-or-pop-patches (do-push npatches)
1675 "Push (if DO-PUSH is not nil) or pop (if DO-PUSH is nil)
1676NPATCHES patches, or all patches if NPATCHES is t."
1677 (stgit-assert-mode)
1678 (stgit-capture-output nil
1679 (apply 'stgit-run
1680 (if do-push "push" "pop")
1681 (if (eq npatches t)
1682 '("--all")
1683 (list "-n" npatches))))
1684 (stgit-reload)
1685 (stgit-refresh-git-status))
1686
0b661144
DK
1687(defun stgit-push-next (npatches)
1688 "Push the first unapplied patch.
1689With numeric prefix argument, push that many patches."
1690 (interactive "p")
d47ee133 1691 (stgit-push-or-pop-patches t npatches))
56d81fe5 1692
0b661144
DK
1693(defun stgit-pop-next (npatches)
1694 "Pop the topmost applied patch.
d47ee133
GH
1695With numeric prefix argument, pop that many patches.
1696
1697If NPATCHES is t, pop all patches."
0b661144 1698 (interactive "p")
d47ee133 1699 (stgit-push-or-pop-patches nil npatches))
56d81fe5 1700
7c11b754
GH
1701(defun stgit-applied-patches (&optional only-patches)
1702 "Return a list of the applied patches.
1703
1704If ONLY-PATCHES is not nil, exclude index and work tree."
1705 (let ((states (if only-patches
1706 '(applied top)
1707 '(applied top index work)))
1708 result)
9aa61946
GH
1709 (ewoc-map (lambda (patch)
1710 (when (memq (stgit-patch->status patch) states)
1711 (setq result (cons patch result)))
1712 nil)
7c11b754
GH
1713 stgit-ewoc)
1714 result))
1715
1716(defun stgit-applied-patchsyms (&optional only-patches)
1717 "Return a list of the symbols of the applied patches.
1718
1719If ONLY-PATCHES is not nil, exclude index and work tree."
413f9909 1720 (mapcar #'stgit-patch->name (stgit-applied-patches only-patches)))
f9182fca
KH
1721
1722(defun stgit-push-or-pop ()
7c11b754 1723 "Push or pop the marked patches."
f9182fca 1724 (interactive)
9d04c657 1725 (stgit-assert-mode)
7c11b754
GH
1726 (let* ((patchsyms (stgit-patches-marked-or-at-point t t))
1727 (applied-syms (stgit-applied-patchsyms t))
1728 (unapplied (set-difference patchsyms applied-syms)))
f9182fca 1729 (stgit-capture-output nil
7c11b754
GH
1730 (apply 'stgit-run
1731 (if unapplied "push" "pop")
1732 "--"
1733 (stgit-sort-patches (if unapplied unapplied patchsyms)))))
1734 (stgit-reload))
f9182fca 1735
d47ee133
GH
1736(defun stgit-goto-target ()
1737 "Return the goto target a point; either a patchsym, :top,
1738or :bottom."
1739 (let ((patchsym (stgit-patch-name-at-point)))
1740 (cond ((memq patchsym '(:work :index)) nil)
1741 (patchsym)
1742 ((not (next-single-property-change (point) 'patch-data))
1743 :top)
1744 ((not (previous-single-property-change (point) 'patch-data))
1745 :bottom))))
1746
c7adf5ef 1747(defun stgit-goto ()
48d0a850
GH
1748 "Go to the patch on the current line.
1749
d47ee133
GH
1750Push or pop patches to make this patch topmost. Push or pop all
1751patches if used on a line after or before all patches."
c7adf5ef 1752 (interactive)
9d04c657 1753 (stgit-assert-mode)
d47ee133
GH
1754 (let ((patchsym (stgit-goto-target)))
1755 (unless patchsym
1756 (error "No patch to go to on this line"))
1757 (case patchsym
1758 (:top (stgit-push-or-pop-patches t t))
1759 (:bottom (stgit-push-or-pop-patches nil t))
1760 (t (stgit-capture-output nil
69db9714 1761 (stgit-run "goto" "--" patchsym))
d47ee133 1762 (stgit-reload)))))
c7adf5ef 1763
d51722b7 1764(defun stgit-id (patchsym)
50d88c67
DK
1765 "Return the git commit id for PATCHSYM.
1766If PATCHSYM is a keyword, returns PATCHSYM unmodified."
1767 (if (keywordp patchsym)
1768 patchsym
1769 (let ((result (with-output-to-string
69db9714 1770 (stgit-run-silent "id" "--" patchsym))))
50d88c67
DK
1771 (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
1772 (error "Cannot find commit id for %s" patchsym))
1773 (match-string 1 result))))
378a003d 1774
015a6dfa
KW
1775(defun stgit-whitespace-diff-arg (arg)
1776 (when (numberp arg)
1777 (cond ((> arg 4) "--ignore-all-space")
1778 ((> arg 1) "--ignore-space-change"))))
1779
1aece5c0 1780(defun stgit-show-patch (unmerged-stage ignore-whitespace)
d9b954c7
GH
1781 "Show the patch on the current line.
1782
1783UNMERGED-STAGE is the argument to `git-diff' that that selects
1784which stage to diff against in the case of unmerged files."
015a6dfa 1785 (let ((space-arg (stgit-whitespace-diff-arg ignore-whitespace))
1aece5c0
GH
1786 (patch-name (stgit-patch-name-at-point t)))
1787 (stgit-capture-output "*StGit patch*"
1788 (case (get-text-property (point) 'entry-type)
1789 ('file
1790 (let* ((patched-file (stgit-patched-file-at-point))
1791 (patch-id (let ((id (stgit-id patch-name)))
1792 (if (and (eq id :index)
413f9909 1793 (eq (stgit-file->status patched-file)
1aece5c0
GH
1794 'unmerged))
1795 :work
1796 id)))
1797 (args (append (and space-arg (list space-arg))
413f9909 1798 (and (stgit-file->cr-from patched-file)
1aece5c0
GH
1799 (list (stgit-find-copies-harder-diff-arg)))
1800 (cond ((eq patch-id :index)
1801 '("--cached"))
1802 ((eq patch-id :work)
1803 (list unmerged-stage))
1804 (t
1805 (list (concat patch-id "^") patch-id)))
1806 '("--")
413f9909
GH
1807 (if (stgit-file->copy-or-rename patched-file)
1808 (list (stgit-file->cr-from patched-file)
1809 (stgit-file->cr-to patched-file))
1810 (list (stgit-file->file patched-file))))))
1aece5c0
GH
1811 (apply 'stgit-run-git "diff" args)))
1812 ('patch
1813 (let* ((patch-id (stgit-id patch-name)))
1814 (if (or (eq patch-id :index) (eq patch-id :work))
1815 (apply 'stgit-run-git "diff"
1816 (stgit-find-copies-harder-diff-arg)
1817 (append (and space-arg (list space-arg))
1818 (if (eq patch-id :index)
1819 '("--cached")
1820 (list unmerged-stage))))
1821 (let ((args (append '("show" "-O" "--patch-with-stat" "-O" "-M")
1822 (and space-arg (list "-O" space-arg))
69db9714 1823 '("--")
1aece5c0
GH
1824 (list (stgit-patch-name-at-point)))))
1825 (apply 'stgit-run args)))))
6a73154a
GH
1826 (t
1827 (error "No patch or file at point")))
1aece5c0
GH
1828 (with-current-buffer standard-output
1829 (goto-char (point-min))
1830 (diff-mode)))))
1831
1832(defmacro stgit-define-diff (name diff-arg &optional unmerged-action)
1833 `(defun ,name (&optional ignore-whitespace)
1834 ,(format "Show the patch on the current line.
1835
1836%sWith a prefix argument, ignore whitespace. With a prefix argument
1837greater than four (e.g., \\[universal-argument] \
1838\\[universal-argument] \\[%s]), ignore all whitespace."
1839 (if unmerged-action
1840 (format "For unmerged files, %s.\n\n" unmerged-action)
1841 "")
1842 name)
1843 (interactive "p")
9d04c657 1844 (stgit-assert-mode)
1aece5c0
GH
1845 (stgit-show-patch ,diff-arg ignore-whitespace)))
1846
1847(stgit-define-diff stgit-diff
1848 "--ours" nil)
1849(stgit-define-diff stgit-diff-ours
1850 "--ours"
1851 "diff against our branch")
1852(stgit-define-diff stgit-diff-theirs
1853 "--theirs"
1854 "diff against their branch")
1855(stgit-define-diff stgit-diff-base
1856 "--base"
1857 "diff against the merge base")
1858(stgit-define-diff stgit-diff-combined
1859 "--cc"
1860 "show a combined diff")
d9b954c7 1861
e02b46e5
KW
1862(defun stgit-diff-range (&optional ignore-whitespace)
1863 "Show diff for the range of patches between point and the marked patch.
1864
1865With a prefix argument, ignore whitespace. With a prefix argument
1866greater than four (e.g., \\[universal-argument] \
1867\\[universal-argument] \\[stgit-diff-range]), ignore all whitespace."
1868 (interactive "p")
1869 (stgit-assert-mode)
1870 (unless (= (length stgit-marked-patches) 1)
1871 (error "Need exactly one patch marked"))
1872 (let* ((patches (stgit-sort-patches (cons (stgit-patch-name-at-point t t)
1873 stgit-marked-patches)
1874 t))
1875 (first-patch (car patches))
1876 (second-patch (if (cdr patches) (cadr patches) first-patch))
1877 (whitespace-arg (stgit-whitespace-diff-arg ignore-whitespace))
1878 (applied (stgit-applied-patchsyms t)))
1879 (unless (and (memq first-patch applied) (memq second-patch applied))
1880 (error "Can only show diff range for applied patches"))
1881 (stgit-capture-output (format "*StGit diff %s..%s*"
1882 first-patch second-patch)
1883 (apply 'stgit-run-git (append '("diff" "--patch-with-stat")
1884 (and whitespace-arg (list whitespace-arg))
1885 (list (format "%s^" (stgit-id first-patch))
1886 (stgit-id second-patch))))
1887 (with-current-buffer standard-output
1888 (goto-char (point-min))
1889 (diff-mode)))))
1890
f87c2e22
GH
1891(defun stgit-move-change-to-index (file &optional force)
1892 "Copies the work tree state of FILE to index, using git add or git rm.
1893
1894If FORCE is not nil, use --force."
306b37a6
GH
1895 (let ((op (if (or (file-exists-p file) (file-symlink-p file))
1896 '("add") '("rm" "-q"))))
37cb5766 1897 (stgit-capture-output "*git output*"
f87c2e22
GH
1898 (apply 'stgit-run-git (append op (and force '("--force"))
1899 '("--") (list file))))))
37cb5766 1900
fd9fe574 1901(defun stgit-remove-change-from-index (file)
37cb5766
DK
1902 "Unstages the change in FILE from the index"
1903 (stgit-capture-output "*git output*"
1904 (stgit-run-git "reset" "-q" "--" file)))
1905
dde3ab4d
GH
1906(defun stgit-git-index-unmerged-p ()
1907 (let (result)
1908 (with-output-to-string
1909 (setq result (not (zerop (stgit-run-git-silent "diff-index" "--cached"
1910 "--diff-filter=U"
1911 "--quiet" "HEAD")))))
1912 result))
1913
37cb5766 1914(defun stgit-file-toggle-index ()
a9089e68
GH
1915 "Move modified file in or out of the index.
1916
1917Leaves the point where it is, but moves the mark to where the
1918file ended up. You can then jump to the file with \
1919\\[exchange-point-and-mark]."
37cb5766 1920 (interactive)
9d04c657 1921 (stgit-assert-mode)
612f999a
GH
1922 (let* ((patched-file (or (stgit-patched-file-at-point)
1923 (error "No file on the current line")))
413f9909 1924 (patched-status (stgit-file->status patched-file)))
612f999a 1925 (when (eq patched-status 'unmerged)
51783171 1926 (error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index")))
a9089e68 1927 (let* ((patch (stgit-patch-at-point))
413f9909 1928 (patch-name (stgit-patch->name patch))
612f999a 1929 (mark-file (if (eq patched-status 'rename)
413f9909
GH
1930 (stgit-file->cr-to patched-file)
1931 (stgit-file->file patched-file)))
612f999a 1932 (point-file (if (eq patched-status 'rename)
413f9909 1933 (stgit-file->cr-from patched-file)
6a73154a 1934 (stgit-neighbour-file))))
a9089e68 1935
37cb5766 1936 (cond ((eq patch-name :work)
413f9909 1937 (stgit-move-change-to-index (stgit-file->file patched-file)
f87c2e22 1938 (eq patched-status 'ignore)))
37cb5766 1939 ((eq patch-name :index)
413f9909 1940 (stgit-remove-change-from-index (stgit-file->file patched-file)))
37cb5766 1941 (t
612f999a 1942 (error "Can only move files between working tree and index")))
a9089e68
GH
1943 (stgit-refresh-worktree)
1944 (stgit-refresh-index)
612f999a 1945 (stgit-goto-patch (if (eq patch-name :index) :work :index) mark-file)
a9089e68 1946 (push-mark nil t t)
612f999a 1947 (stgit-goto-patch patch-name point-file))))
37cb5766 1948
dde3ab4d
GH
1949(defun stgit-toggle-index ()
1950 "Move change in or out of the index.
1951
1952Works on index and work tree, as well as files in either.
1953
1954Leaves the point where it is, but moves the mark to where the
1955file ended up. You can then jump to the file with \
1956\\[exchange-point-and-mark]."
1957 (interactive)
9d04c657 1958 (stgit-assert-mode)
dde3ab4d
GH
1959 (if (stgit-patched-file-at-point)
1960 (stgit-file-toggle-index)
1961 (let ((patch-name (stgit-patch-name-at-point)))
1962 (unless (memq patch-name '(:index :work))
1963 (error "Can only move changes between working tree and index"))
1964 (when (stgit-git-index-unmerged-p)
1965 (error "Resolve unmerged changes with \\[stgit-resolve-file] first"))
1966 (if (if (eq patch-name :index)
1967 (stgit-index-empty-p)
1968 (stgit-work-tree-empty-p))
1969 (message "No changes to be moved")
1970 (stgit-capture-output nil
1971 (if (eq patch-name :work)
1972 (stgit-run-git "add" "--update")
1973 (stgit-run-git "reset" "--mixed" "-q")))
1974 (stgit-refresh-worktree)
1975 (stgit-refresh-index))
1976 (stgit-goto-patch (if (eq patch-name :index) :work :index)))))
1977
0bca35c8 1978(defun stgit-edit ()
a53347d9 1979 "Edit the patch on the current line."
0bca35c8 1980 (interactive)
9d04c657 1981 (stgit-assert-mode)
64ada6f5 1982 (let ((patchsym (stgit-patch-name-at-point t t))
0780be79 1983 (edit-buf (get-buffer-create "*StGit edit*"))
0bca35c8
DK
1984 (dir default-directory))
1985 (log-edit 'stgit-confirm-edit t nil edit-buf)
d51722b7 1986 (set (make-local-variable 'stgit-edit-patchsym) patchsym)
0bca35c8
DK
1987 (setq default-directory dir)
1988 (let ((standard-output edit-buf))
655a3977 1989 (save-excursion
69db9714 1990 (stgit-run-silent "edit" "--save-template=-" "--" patchsym)))))
0bca35c8
DK
1991
1992(defun stgit-confirm-edit ()
1993 (interactive)
1994 (let ((file (make-temp-file "stgit-edit-")))
1995 (write-region (point-min) (point-max) file)
1996 (stgit-capture-output nil
69db9714 1997 (stgit-run "edit" "-f" file "--" stgit-edit-patchsym))
0bca35c8 1998 (with-current-buffer log-edit-parent-buffer
1f0bf00f 1999 (stgit-reload))))
0bca35c8 2000
2acb7116 2001(defun stgit-new (add-sign &optional refresh)
aa04f831
GH
2002 "Create a new patch.
2003With a prefix argument, include a \"Signed-off-by:\" line at the
2004end of the patch."
2005 (interactive "P")
9d04c657 2006 (stgit-assert-mode)
c5d45b92
GH
2007 (let ((edit-buf (get-buffer-create "*StGit edit*"))
2008 (dir default-directory))
2009 (log-edit 'stgit-confirm-new t nil edit-buf)
aa04f831 2010 (setq default-directory dir)
2acb7116 2011 (set (make-local-variable 'stgit-refresh-after-new) refresh)
aa04f831
GH
2012 (when add-sign
2013 (save-excursion
2014 (let ((standard-output (current-buffer)))
2015 (stgit-run-silent "new" "--sign" "--save-template=-"))))))
64c097a0
DK
2016
2017(defun stgit-confirm-new ()
2018 (interactive)
2acb7116
DK
2019 (let ((file (make-temp-file "stgit-edit-"))
2020 (refresh stgit-refresh-after-new))
64c097a0
DK
2021 (write-region (point-min) (point-max) file)
2022 (stgit-capture-output nil
27b0f9e4 2023 (stgit-run "new" "-f" file))
64c097a0 2024 (with-current-buffer log-edit-parent-buffer
2acb7116
DK
2025 (if refresh
2026 (stgit-refresh)
2027 (stgit-reload)))))
2028
2029(defun stgit-new-and-refresh (add-sign)
2030 "Create a new patch and refresh it with the current changes.
2031
2032With a prefix argument, include a \"Signed-off-by:\" line at the
2033end of the patch.
2034
2035This works just like running `stgit-new' followed by `stgit-refresh'."
2036 (interactive "P")
9d04c657 2037 (stgit-assert-mode)
2acb7116 2038 (stgit-new add-sign t))
64c097a0
DK
2039
2040(defun stgit-create-patch-name (description)
2041 "Create a patch name from a long description"
2042 (let ((patch ""))
2043 (while (> (length description) 0)
2044 (cond ((string-match "\\`[a-zA-Z_-]+" description)
8439f657
GH
2045 (setq patch (downcase (concat patch
2046 (match-string 0 description))))
64c097a0
DK
2047 (setq description (substring description (match-end 0))))
2048 ((string-match "\\` +" description)
2049 (setq patch (concat patch "-"))
2050 (setq description (substring description (match-end 0))))
2051 ((string-match "\\`[^a-zA-Z_-]+" description)
2052 (setq description (substring description (match-end 0))))))
2053 (cond ((= (length patch) 0)
2054 "patch")
2055 ((> (length patch) 20)
2056 (substring patch 0 20))
2057 (t patch))))
0bca35c8 2058
9008e45b 2059(defun stgit-delete (patchsyms &optional spill-p)
d51722b7 2060 "Delete the patches in PATCHSYMS.
9008e45b
GH
2061Interactively, delete the marked patches, or the patch at point.
2062
2063With a prefix argument, or SPILL-P, spill the patch contents to
2064the work tree and index."
beac0f14 2065 (interactive (list (stgit-patches-marked-or-at-point t t)
9008e45b 2066 current-prefix-arg))
9d04c657 2067 (stgit-assert-mode)
e7231e4f
GH
2068 (unless patchsyms
2069 (error "No patches to delete"))
64ada6f5
GH
2070 (when (memq :index patchsyms)
2071 (error "Cannot delete the index"))
2072 (when (memq :work patchsyms)
2073 (error "Cannot delete the work tree"))
2074
d51722b7 2075 (let ((npatches (length patchsyms)))
9008e45b 2076 (when (yes-or-no-p (format "Really delete %d patch%s%s? "
e7231e4f 2077 npatches
9008e45b
GH
2078 (if (= 1 npatches) "" "es")
2079 (if spill-p
2080 " (spilling contents to index)"
2081 "")))
69db9714
GH
2082 (let ((args (append (when spill-p '("--spill"))
2083 '("--")
2084 patchsyms)))
9008e45b
GH
2085 (stgit-capture-output nil
2086 (apply 'stgit-run "delete" args))
2087 (stgit-reload)))))
d51722b7 2088
7cc45294
GH
2089(defun stgit-move-patches-target ()
2090 "Return the patchsym indicating a target patch for
2091`stgit-move-patches'.
2092
2547179e
GH
2093This is either the first unmarked patch at or after point, or one
2094of :top and :bottom if the point is after or before the applied
2095patches."
2096
2097 (save-excursion
2098 (let (result)
2099 (while (not result)
2100 (let ((patchsym (stgit-patch-name-at-point)))
2101 (cond ((memq patchsym '(:work :index)) (setq result :top))
2102 (patchsym (if (memq patchsym stgit-marked-patches)
2103 (stgit-next-patch)
2104 (setq result patchsym)))
2105 ((re-search-backward "^>" nil t) (setq result :top))
2106 (t (setq result :bottom)))))
2107 result)))
7cc45294 2108
c1412832 2109(defun stgit-sort-patches (patchsyms &optional allow-duplicates)
95369f6c
GH
2110 "Returns the list of patches in PATCHSYMS sorted according to
2111their position in the patch series, bottommost first.
2112
c1412832
KW
2113PATCHSYMS must not contain duplicate entries, unless
2114ALLOW-DUPLICATES is not nil."
95369f6c
GH
2115 (let (sorted-patchsyms
2116 (series (with-output-to-string
2117 (with-current-buffer standard-output
2118 (stgit-run-silent "series" "--noprefix"))))
2119 start)
2120 (while (string-match "^\\(.+\\)" series start)
2121 (let ((patchsym (intern (match-string 1 series))))
2122 (when (memq patchsym patchsyms)
2123 (setq sorted-patchsyms (cons patchsym sorted-patchsyms))))
2124 (setq start (match-end 0)))
2125 (setq sorted-patchsyms (nreverse sorted-patchsyms))
2126
c1412832
KW
2127 (unless allow-duplicates
2128 (unless (= (length patchsyms) (length sorted-patchsyms))
2129 (error "Internal error")))
95369f6c
GH
2130
2131 sorted-patchsyms))
2132
7cc45294
GH
2133(defun stgit-move-patches (patchsyms target-patch)
2134 "Move the patches in PATCHSYMS to below TARGET-PATCH.
2135If TARGET-PATCH is :bottom or :top, move the patches to the
2136bottom or top of the stack, respectively.
2137
2138Interactively, move the marked patches to where the point is."
2139 (interactive (list stgit-marked-patches
2140 (stgit-move-patches-target)))
9d04c657 2141 (stgit-assert-mode)
7cc45294
GH
2142 (unless patchsyms
2143 (error "Need at least one patch to move"))
2144
2145 (unless target-patch
2146 (error "Point not at a patch"))
2147
2547179e
GH
2148 ;; need to have patchsyms sorted by position in the stack
2149 (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
2150 (stgit-capture-output nil
2151 (if (eq target-patch :top)
69db9714 2152 (apply 'stgit-run "float" "--" sorted-patchsyms)
2547179e
GH
2153 (apply 'stgit-run
2154 "sink"
2155 (append (unless (eq target-patch :bottom)
2156 (list "--to" target-patch))
2157 '("--")
2158 sorted-patchsyms)))))
7cc45294
GH
2159 (stgit-reload))
2160
594aa463
KH
2161(defun stgit-squash (patchsyms)
2162 "Squash the patches in PATCHSYMS.
693d179b
GH
2163Interactively, squash the marked patches.
2164
2165Unless there are any conflicts, the patches will be merged into
2166one patch, which will occupy the same spot in the series as the
2167deepest patch had before the squash."
d51722b7 2168 (interactive (list stgit-marked-patches))
9d04c657 2169 (stgit-assert-mode)
d51722b7 2170 (when (< (length patchsyms) 2)
594aa463 2171 (error "Need at least two patches to squash"))
32d7545d
GH
2172 (let ((stgit-buffer (current-buffer))
2173 (edit-buf (get-buffer-create "*StGit edit*"))
693d179b
GH
2174 (dir default-directory)
2175 (sorted-patchsyms (stgit-sort-patches patchsyms)))
594aa463 2176 (log-edit 'stgit-confirm-squash t nil edit-buf)
693d179b 2177 (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms)
ea0def18 2178 (setq default-directory dir)
32d7545d 2179 (let ((result (let ((standard-output edit-buf))
655a3977
GH
2180 (save-excursion
2181 (apply 'stgit-run-silent "squash"
69db9714 2182 "--save-template=-" "--" sorted-patchsyms)))))
32d7545d
GH
2183
2184 ;; stg squash may have reordered the patches or caused conflicts
2185 (with-current-buffer stgit-buffer
2186 (stgit-reload))
2187
2188 (unless (eq 0 result)
2189 (fundamental-mode)
2190 (rename-buffer "*StGit error*")
2191 (resize-temp-buffer-window)
2192 (switch-to-buffer-other-window stgit-buffer)
2193 (error "stg squash failed")))))
ea0def18 2194
594aa463 2195(defun stgit-confirm-squash ()
ea0def18
DK
2196 (interactive)
2197 (let ((file (make-temp-file "stgit-edit-")))
2198 (write-region (point-min) (point-max) file)
2199 (stgit-capture-output nil
69db9714 2200 (apply 'stgit-run "squash" "-f" file "--" stgit-patchsyms))
ea0def18 2201 (with-current-buffer log-edit-parent-buffer
e6b1fdae
DK
2202 (stgit-clear-marks)
2203 ;; Go to first marked patch and stay there
2204 (goto-char (point-min))
2205 (re-search-forward (concat "^[>+-]\\*") nil t)
2206 (move-to-column goal-column)
2207 (let ((pos (point)))
1f0bf00f 2208 (stgit-reload)
e6b1fdae 2209 (goto-char pos)))))
ea0def18 2210
0663524d
KH
2211(defun stgit-help ()
2212 "Display help for the StGit mode."
2213 (interactive)
2214 (describe-function 'stgit-mode))
3a59f3db 2215
e8faa44b
DK
2216(defun stgit-execute-process-sentinel (process sentinel)
2217 (let (old-sentinel stgit-buf)
2218 (with-current-buffer (process-buffer process)
2219 (setq old-sentinel old-process-sentinel
2220 stgit-buf stgit-buffer))
2221 (and (memq (process-status process) '(exit signal))
2222 (buffer-live-p stgit-buf)
2223 (with-current-buffer stgit-buf
2224 (stgit-reload)))
2225 (funcall old-sentinel process sentinel)))
2226
a4a01630
GH
2227(defun stgit-execute-process-filter (process output)
2228 (with-current-buffer (process-buffer process)
2229 (let* ((old-point (point))
2230 (pmark (process-mark process))
2231 (insert-at (marker-position pmark))
2232 (at-pmark (= insert-at old-point)))
2233 (goto-char insert-at)
2234 (insert-before-markers output)
2235 (comint-carriage-motion insert-at (point))
2236 (set-marker pmark (point))
2237 (unless at-pmark
2238 (goto-char old-point)))))
2239
e8faa44b
DK
2240(defun stgit-execute ()
2241 "Prompt for an stg command to execute in a shell.
2242
2243The names of any marked patches or the patch at point are
2244inserted in the command to be executed.
2245
2246If the command ends in an ampersand, run it asynchronously.
2247
2248When the command has finished, reload the stgit buffer."
2249 (interactive)
2250 (stgit-assert-mode)
2251 (let* ((patches (stgit-patches-marked-or-at-point nil t))
2252 (patch-names (mapcar 'symbol-name patches))
2253 (hyphens (find-if (lambda (s) (string-match "^-" s)) patch-names))
2254 (defaultcmd (if patches
2255 (concat "stg "
2256 (and hyphens "-- ")
2257 (mapconcat 'identity patch-names " "))
2258 "stg "))
2259 (cmd (read-from-minibuffer "Shell command: " (cons defaultcmd 5)
2260 nil nil 'shell-command-history))
2261 (async (string-match "&[ \t]*\\'" cmd))
2262 (buffer (get-buffer-create
2263 (if async
2264 "*Async Shell Command*"
2265 "*Shell Command Output*"))))
2266 ;; cannot use minibuffer as stgit-reload would overwrite it; if we
2267 ;; show the buffer, shell-command will not use the minibuffer
2268 (display-buffer buffer)
2269 (shell-command cmd)
2270 (if async
2271 (let ((old-buffer (current-buffer)))
2272 (with-current-buffer buffer
2273 (let ((process (get-buffer-process buffer)))
2274 (set (make-local-variable 'old-process-sentinel)
2275 (process-sentinel process))
2276 (set (make-local-variable 'stgit-buffer)
2277 old-buffer)
a4a01630 2278 (set-process-filter process 'stgit-execute-process-filter)
e8faa44b 2279 (set-process-sentinel process 'stgit-execute-process-sentinel))))
a4a01630
GH
2280 (with-current-buffer buffer
2281 (comint-carriage-motion (point-min) (point-max)))
e8faa44b
DK
2282 (shrink-window-if-larger-than-buffer (get-buffer-window buffer))
2283 (stgit-reload))))
2284
6c2d4962
GH
2285(defun stgit-undo-or-redo (redo hard)
2286 "Run stg undo or, if REDO is non-nil, stg redo.
2287
2288If HARD is non-nil, use the --hard flag."
2289 (stgit-assert-mode)
2290 (let ((cmd (if redo "redo" "undo")))
2291 (stgit-capture-output nil
2292 (if arg
2293 (when (or (and (stgit-index-empty-p)
2294 (stgit-work-tree-empty-p))
2295 (y-or-n-p (format "Hard %s may overwrite index/work tree changes. Continue? "
2296 cmd)))
2297 (stgit-run cmd "--hard"))
2298 (stgit-run cmd))))
2299 (stgit-reload))
2300
83e51dbf
DK
2301(defun stgit-undo (&optional arg)
2302 "Run stg undo.
b8463f1d
GH
2303With prefix argument, run it with the --hard flag.
2304
2305See also `stgit-redo'."
83e51dbf 2306 (interactive "P")
6c2d4962 2307 (stgit-undo-or-redo nil arg))
83e51dbf 2308
b8463f1d
GH
2309(defun stgit-redo (&optional arg)
2310 "Run stg redo.
2311With prefix argument, run it with the --hard flag.
2312
2313See also `stgit-undo'."
2314 (interactive "P")
6c2d4962 2315 (stgit-undo-or-redo t arg))
b8463f1d 2316
4d73c4d8
DK
2317(defun stgit-refresh (&optional arg)
2318 "Run stg refresh.
36a4eacd
GH
2319If the index contains any changes, only refresh from index.
2320
a53347d9 2321With prefix argument, refresh the marked patch or the patch under point."
4d73c4d8 2322 (interactive "P")
9d04c657 2323 (stgit-assert-mode)
4d73c4d8 2324 (let ((patchargs (if arg
beac0f14
GH
2325 (let ((patches (stgit-patches-marked-or-at-point nil t)))
2326 (when (> (length patches) 1)
2327 (error "Too many patches marked"))
2328 (cons "-p" patches))
b0424080 2329 nil)))
36a4eacd
GH
2330 (unless (stgit-index-empty-p)
2331 (setq patchargs (cons "--index" patchargs)))
4d73c4d8 2332 (stgit-capture-output nil
074a4fb0
GH
2333 (apply 'stgit-run "refresh" patchargs))
2334 (stgit-refresh-git-status))
4d73c4d8
DK
2335 (stgit-reload))
2336
ce3b6130 2337(defvar stgit-show-worktree nil
8f702de4 2338 "If nil, inhibit showing work tree and index in the stgit buffer.
ce3b6130 2339
8f702de4 2340See also `stgit-show-worktree-mode'.")
ce3b6130 2341
d9473917
GH
2342(defvar stgit-show-ignored nil
2343 "If nil, inhibit showing files ignored by git.")
2344
2345(defvar stgit-show-unknown nil
2346 "If nil, inhibit showing files not registered with git.")
2347
a0045b87
DK
2348(defvar stgit-show-patch-names t
2349 "If nil, inhibit showing patch names.")
2350
ce3b6130
DK
2351(defun stgit-toggle-worktree (&optional arg)
2352 "Toggle the visibility of the work tree.
2d7bcbd9 2353With ARG, show the work tree if ARG is positive.
ce3b6130 2354
8f702de4
GH
2355Its initial setting is controlled by `stgit-default-show-worktree'.
2356
2357`stgit-show-worktree-mode' controls where on screen the index and
2358work tree will show up."
ce3b6130 2359 (interactive)
9d04c657 2360 (stgit-assert-mode)
ce3b6130
DK
2361 (setq stgit-show-worktree
2362 (if (numberp arg)
2363 (> arg 0)
2364 (not stgit-show-worktree)))
2365 (stgit-reload))
2366
d9473917
GH
2367(defun stgit-toggle-ignored (&optional arg)
2368 "Toggle the visibility of files ignored by git in the work
2369tree. With ARG, show these files if ARG is positive.
2370
2371Use \\[stgit-toggle-worktree] to show the work tree."
2372 (interactive)
9d04c657 2373 (stgit-assert-mode)
d9473917
GH
2374 (setq stgit-show-ignored
2375 (if (numberp arg)
2376 (> arg 0)
2377 (not stgit-show-ignored)))
2378 (stgit-reload))
2379
2380(defun stgit-toggle-unknown (&optional arg)
2381 "Toggle the visibility of files not registered with git in the
2382work tree. With ARG, show these files if ARG is positive.
2383
2384Use \\[stgit-toggle-worktree] to show the work tree."
2385 (interactive)
9d04c657 2386 (stgit-assert-mode)
d9473917
GH
2387 (setq stgit-show-unknown
2388 (if (numberp arg)
2389 (> arg 0)
2390 (not stgit-show-unknown)))
2391 (stgit-reload))
2392
a0045b87
DK
2393(defun stgit-toggle-patch-names (&optional arg)
2394 "Toggle the visibility of patch names. With ARG, show patch names
2395if ARG is positive.
2396
2397The initial setting is controlled by `stgit-default-show-patch-names'."
2398 (interactive)
2399 (stgit-assert-mode)
2400 (setq stgit-show-patch-names
2401 (if (numberp arg)
2402 (> arg 0)
2403 (not stgit-show-patch-names)))
2404 (stgit-reload))
2405
3a59f3db 2406(provide 'stgit)