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