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