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