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