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