stgit.el: Clarify documentation of stgit-capture-output
[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
0f076fe6
GH
12(require 'git nil t)
13
56d81fe5 14(defun stgit (dir)
a53347d9 15 "Manage StGit patches for the tree in DIR."
56d81fe5 16 (interactive "DDirectory: \n")
52144ce5 17 (switch-to-stgit-buffer (git-get-top-dir dir))
1f0bf00f 18 (stgit-reload))
56d81fe5 19
074a4fb0
GH
20(unless (fboundp 'git-get-top-dir)
21 (defun git-get-top-dir (dir)
22 "Retrieve the top-level directory of a git tree."
23 (let ((cdup (with-output-to-string
24 (with-current-buffer standard-output
25 (cd dir)
26 (unless (eq 0 (call-process "git" nil t nil
27 "rev-parse" "--show-cdup"))
df283a8b 28 (error "Cannot find top-level git tree for %s" dir))))))
074a4fb0
GH
29 (expand-file-name (concat (file-name-as-directory dir)
30 (car (split-string cdup "\n")))))))
31
32(defun stgit-refresh-git-status (&optional dir)
33 "If it exists, refresh the `git-status' buffer belonging to
34directory DIR or `default-directory'"
35 (when (and (fboundp 'git-find-status-buffer)
36 (fboundp 'git-refresh-status))
37 (let* ((top-dir (git-get-top-dir (or dir default-directory)))
38 (git-status-buffer (and top-dir (git-find-status-buffer top-dir))))
39 (when git-status-buffer
40 (with-current-buffer git-status-buffer
41 (git-refresh-status))))))
52144ce5 42
56d81fe5 43(defun switch-to-stgit-buffer (dir)
a53347d9 44 "Switch to a (possibly new) buffer displaying StGit patches for DIR."
56d81fe5
DK
45 (setq dir (file-name-as-directory dir))
46 (let ((buffers (buffer-list)))
47 (while (and buffers
48 (not (with-current-buffer (car buffers)
49 (and (eq major-mode 'stgit-mode)
50 (string= default-directory dir)))))
51 (setq buffers (cdr buffers)))
52 (switch-to-buffer (if buffers
53 (car buffers)
54 (create-stgit-buffer dir)))))
55
56(defun create-stgit-buffer (dir)
57 "Create a buffer for showing StGit patches.
58Argument DIR is the repository path."
59 (let ((buf (create-file-buffer (concat dir "*stgit*")))
60 (inhibit-read-only t))
61 (with-current-buffer buf
62 (setq default-directory dir)
63 (stgit-mode)
64 (setq buffer-read-only t))
65 buf))
66
67(defmacro stgit-capture-output (name &rest body)
e558a4ab
GH
68 "Capture StGit output and, if there was any output, show it in a window
69at the end.
70Returns nil if there was no output."
34afb86c
DK
71 `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
72 (stgit-dir default-directory)
73 (inhibit-read-only t))
56d81fe5 74 (with-current-buffer output-buf
34afb86c
DK
75 (erase-buffer)
76 (setq default-directory stgit-dir)
77 (setq buffer-read-only t))
56d81fe5
DK
78 (let ((standard-output output-buf))
79 ,@body)
34afb86c
DK
80 (with-current-buffer output-buf
81 (set-buffer-modified-p nil)
82 (setq buffer-read-only t)
83 (if (< (point-min) (point-max))
84 (display-buffer output-buf t)))))
56d81fe5
DK
85(put 'stgit-capture-output 'lisp-indent-function 1)
86
d51722b7
GH
87(defun stgit-make-run-args (args)
88 "Return a copy of ARGS with its elements converted to strings."
89 (mapcar (lambda (x)
90 ;; don't use (format "%s" ...) to limit type errors
91 (cond ((stringp x) x)
92 ((integerp x) (number-to-string x))
93 ((symbolp x) (symbol-name x))
94 (t
95 (error "Bad element in stgit-make-run-args args: %S" x))))
96 args))
97
9aecd505 98(defun stgit-run-silent (&rest args)
d51722b7 99 (setq args (stgit-make-run-args args))
56d81fe5
DK
100 (apply 'call-process "stg" nil standard-output nil args))
101
9aecd505 102(defun stgit-run (&rest args)
d51722b7 103 (setq args (stgit-make-run-args args))
9aecd505
DK
104 (let ((msgcmd (mapconcat #'identity args " ")))
105 (message "Running stg %s..." msgcmd)
106 (apply 'call-process "stg" nil standard-output nil args)
107 (message "Running stg %s...done" msgcmd)))
108
378a003d 109(defun stgit-run-git (&rest args)
d51722b7 110 (setq args (stgit-make-run-args args))
378a003d
GH
111 (let ((msgcmd (mapconcat #'identity args " ")))
112 (message "Running git %s..." msgcmd)
113 (apply 'call-process "git" nil standard-output nil args)
114 (message "Running git %s...done" msgcmd)))
115
1f60181a 116(defun stgit-run-git-silent (&rest args)
d51722b7 117 (setq args (stgit-make-run-args args))
1f60181a
GH
118 (apply 'call-process "git" nil standard-output nil args))
119
1f0bf00f 120(defun stgit-reload ()
a53347d9 121 "Update the contents of the StGit buffer."
56d81fe5
DK
122 (interactive)
123 (let ((inhibit-read-only t)
124 (curline (line-number-at-pos))
125 (curpatch (stgit-patch-at-point)))
126 (erase-buffer)
127 (insert "Branch: ")
9aecd505 128 (stgit-run-silent "branch")
bce79a6a 129 (stgit-run-silent "series" "--description" "--empty")
6df83d42 130 (stgit-rescan)
56d81fe5
DK
131 (if curpatch
132 (stgit-goto-patch curpatch)
074a4fb0
GH
133 (goto-line curline)))
134 (stgit-refresh-git-status))
56d81fe5 135
8f40753a
GH
136(defgroup stgit nil
137 "A user interface for the StGit patch maintenance tool."
138 :group 'tools)
139
07f464e0
DK
140(defface stgit-description-face
141 '((((background dark)) (:foreground "tan"))
142 (((background light)) (:foreground "dark red")))
8f40753a
GH
143 "The face used for StGit descriptions"
144 :group 'stgit)
07f464e0
DK
145
146(defface stgit-top-patch-face
147 '((((background dark)) (:weight bold :foreground "yellow"))
148 (((background light)) (:weight bold :foreground "purple"))
149 (t (:weight bold)))
8f40753a
GH
150 "The face used for the top patch names"
151 :group 'stgit)
07f464e0
DK
152
153(defface stgit-applied-patch-face
154 '((((background dark)) (:foreground "light yellow"))
155 (((background light)) (:foreground "purple"))
156 (t ()))
8f40753a
GH
157 "The face used for applied patch names"
158 :group 'stgit)
07f464e0
DK
159
160(defface stgit-unapplied-patch-face
161 '((((background dark)) (:foreground "gray80"))
162 (((background light)) (:foreground "orchid"))
163 (t ()))
8f40753a
GH
164 "The face used for unapplied patch names"
165 :group 'stgit)
07f464e0 166
1f60181a
GH
167(defface stgit-modified-file-face
168 '((((class color) (background light)) (:foreground "purple"))
169 (((class color) (background dark)) (:foreground "salmon")))
170 "StGit mode face used for modified file status"
171 :group 'stgit)
172
173(defface stgit-unmerged-file-face
174 '((((class color) (background light)) (:foreground "red" :bold t))
175 (((class color) (background dark)) (:foreground "red" :bold t)))
176 "StGit mode face used for unmerged file status"
177 :group 'stgit)
178
179(defface stgit-unknown-file-face
180 '((((class color) (background light)) (:foreground "goldenrod" :bold t))
181 (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
182 "StGit mode face used for unknown file status"
183 :group 'stgit)
184
a6d9a852
GH
185(defface stgit-file-permission-face
186 '((((class color) (background light)) (:foreground "green" :bold t))
187 (((class color) (background dark)) (:foreground "green" :bold t)))
188 "StGit mode face used for permission changes."
189 :group 'stgit)
190
1f60181a
GH
191(defcustom stgit-expand-find-copies-harder
192 nil
193 "Try harder to find copied files when listing patches.
194
195When not nil, runs git diff-tree with the --find-copies-harder
196flag, which reduces performance."
197 :type 'boolean
198 :group 'stgit)
199
200(defconst stgit-file-status-code-strings
201 (mapcar (lambda (arg)
202 (cons (car arg)
a6d9a852
GH
203 (propertize (cadr arg) 'face (car (cddr arg)))))
204 '((add "Added" stgit-modified-file-face)
205 (copy "Copied" stgit-modified-file-face)
206 (delete "Deleted" stgit-modified-file-face)
207 (modify "Modified" stgit-modified-file-face)
208 (rename "Renamed" stgit-modified-file-face)
209 (mode-change "Mode change" stgit-modified-file-face)
210 (unmerged "Unmerged" stgit-unmerged-file-face)
211 (unknown "Unknown" stgit-unknown-file-face)))
1f60181a
GH
212 "Alist of code symbols to description strings")
213
214(defun stgit-file-status-code-as-string (code)
215 "Return stgit status code as string"
a6d9a852
GH
216 (let ((str (assq (if (consp code) (car code) code)
217 stgit-file-status-code-strings)))
218 (when str
219 (format "%-11s "
220 (if (and str (consp code) (/= (cdr code) 100))
221 (format "%s %s" (cdr str)
222 (propertize (format "%d%%" (cdr code))
223 'face 'stgit-description-face))
224 (cdr str))))))
1f60181a 225
a6d9a852 226(defun stgit-file-status-code (str &optional score)
1f60181a
GH
227 "Return stgit status code from git status string"
228 (let ((code (assoc str '(("A" . add)
229 ("C" . copy)
230 ("D" . delete)
231 ("M" . modify)
232 ("R" . rename)
233 ("T" . mode-change)
234 ("U" . unmerged)
235 ("X" . unknown)))))
a6d9a852
GH
236 (setq code (if code (cdr code) 'unknown))
237 (when (stringp score)
238 (if (> (length score) 0)
239 (setq score (string-to-number score))
240 (setq score nil)))
241 (if score (cons code score) code)))
242
243(defconst stgit-file-type-strings
244 '((#o100 . "file")
245 (#o120 . "symlink")
246 (#o160 . "subproject"))
247 "Alist of names of file types")
248
249(defun stgit-file-type-string (type)
47271f41
GH
250 "Return string describing file type TYPE (the high bits of file permission).
251Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
a6d9a852
GH
252 (let ((type-str (assoc type stgit-file-type-strings)))
253 (or (and type-str (cdr type-str))
254 (format "unknown type %o" type))))
255
256(defun stgit-file-type-change-string (old-perm new-perm)
47271f41
GH
257 "Return string describing file type change from OLD-PERM to NEW-PERM.
258Cf. `stgit-file-type-string'."
a6d9a852
GH
259 (let ((old-type (lsh old-perm -9))
260 (new-type (lsh new-perm -9)))
261 (cond ((= old-type new-type) "")
262 ((zerop new-type) "")
263 ((zerop old-type)
264 (if (= new-type #o100)
265 ""
266 (format " (%s)" (stgit-file-type-string new-type))))
267 (t (format " (%s -> %s)"
268 (stgit-file-type-string old-type)
269 (stgit-file-type-string new-type))))))
270
271(defun stgit-file-mode-change-string (old-perm new-perm)
47271f41
GH
272 "Return string describing file mode change from OLD-PERM to NEW-PERM.
273Cf. `stgit-file-type-change-string'."
a6d9a852
GH
274 (setq old-perm (logand old-perm #o777)
275 new-perm (logand new-perm #o777))
276 (if (or (= old-perm new-perm)
277 (zerop old-perm)
278 (zerop new-perm))
279 ""
280 (let* ((modified (logxor old-perm new-perm))
281 (not-x-modified (logand (logxor old-perm new-perm) #o666)))
282 (cond ((zerop modified) "")
283 ((and (zerop not-x-modified)
284 (or (and (eq #o111 (logand old-perm #o111))
285 (propertize "-x" 'face 'stgit-file-permission-face))
286 (and (eq #o111 (logand new-perm #o111))
287 (propertize "+x" 'face
288 'stgit-file-permission-face)))))
289 (t (concat (propertize (format "%o" old-perm)
290 'face 'stgit-file-permission-face)
291 (propertize " -> "
292 'face 'stgit-description-face)
293 (propertize (format "%o" new-perm)
294 'face 'stgit-file-permission-face)))))))
1f60181a 295
378a003d 296(defun stgit-expand-patch (patchsym)
47271f41
GH
297 "Expand (show modification of) the patch with name PATCHSYM (a
298symbol) at point.
299`stgit-expand-find-copies-harder' controls how hard to try to
300find copied files."
378a003d
GH
301 (save-excursion
302 (forward-line)
1f60181a
GH
303 (let* ((start (point))
304 (result (with-output-to-string
305 (stgit-run-git "diff-tree" "-r" "-z"
306 (if stgit-expand-find-copies-harder
307 "--find-copies-harder"
308 "-C")
d51722b7 309 (stgit-id patchsym)))))
1f60181a 310 (let (mstart)
a6d9a852 311 (while (string-match "\0:\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} \\(\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\\|\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\\)"
1f60181a 312 result mstart)
a6d9a852
GH
313 (let ((copy-or-rename (match-string 4 result))
314 (old-perm (read (format "#o%s" (match-string 1 result))))
315 (new-perm (read (format "#o%s" (match-string 2 result))))
1f60181a 316 (line-start (point))
a6d9a852
GH
317 status
318 change
1f60181a
GH
319 properties)
320 (insert " ")
321 (if copy-or-rename
a6d9a852
GH
322 (let ((cr-score (match-string 5 result))
323 (cr-from-file (match-string 6 result))
324 (cr-to-file (match-string 7 result)))
325 (setq status (stgit-file-status-code copy-or-rename
326 cr-score)
327 properties (list 'stgit-old-file cr-from-file
328 'stgit-new-file cr-to-file)
329 change (concat
330 cr-from-file
331 (propertize " -> "
332 'face 'stgit-description-face)
333 cr-to-file)))
334 (setq status (stgit-file-status-code (match-string 8 result))
335 properties (list 'stgit-file (match-string 9 result))
336 change (match-string 9 result)))
337
338 (let ((mode-change (stgit-file-mode-change-string old-perm
339 new-perm)))
340 (insert (format "%-12s" (stgit-file-status-code-as-string
341 status))
342 mode-change
343 (if (> (length mode-change) 0) " " "")
344 change
345 (propertize (stgit-file-type-change-string old-perm
346 new-perm)
347 'face 'stgit-description-face)
348 ?\n))
1f60181a
GH
349 (add-text-properties line-start (point) properties))
350 (setq mstart (match-end 0))))
351 (when (= start (point))
352 (insert " <no files>\n"))
d51722b7 353 (put-text-property start (point) 'stgit-file-patchsym patchsym))))
378a003d 354
acc5652f
DK
355(defun stgit-collapse-patch (patchsym)
356 "Collapse the patch with name PATCHSYM after the line at point."
357 (save-excursion
358 (forward-line)
359 (let ((start (point)))
360 (while (eq (get-text-property (point) 'stgit-file-patchsym) patchsym)
361 (forward-line))
362 (delete-region start (point)))))
363
6df83d42
DK
364(defun stgit-rescan ()
365 "Rescan the status buffer."
07f464e0 366 (save-excursion
3a1cf814
GH
367 (let ((marked ())
368 found-any)
6df83d42
DK
369 (goto-char (point-min))
370 (while (not (eobp))
371 (cond ((looking-at "Branch: \\(.*\\)")
372 (put-text-property (match-beginning 1) (match-end 1)
373 'face 'bold))
bce79a6a 374 ((looking-at "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
3a1cf814 375 (setq found-any t)
bce79a6a
GH
376 (let ((empty (match-string 1))
377 (state (match-string 2))
378 (patchsym (intern (match-string 4))))
6df83d42 379 (put-text-property
bce79a6a 380 (match-beginning 4) (match-end 4) 'face
6df83d42
DK
381 (cond ((string= state ">") 'stgit-top-patch-face)
382 ((string= state "+") 'stgit-applied-patch-face)
383 ((string= state "-") 'stgit-unapplied-patch-face)))
bce79a6a 384 (put-text-property (match-beginning 5) (match-end 5)
6df83d42
DK
385 'face 'stgit-description-face)
386 (when (memq patchsym stgit-marked-patches)
bce79a6a
GH
387 (save-excursion
388 (replace-match "*" nil nil nil 3))
378a003d 389 (setq marked (cons patchsym marked)))
d51722b7
GH
390 (put-text-property (match-beginning 0) (match-end 0)
391 'stgit-patchsym patchsym)
378a003d
GH
392 (when (memq patchsym stgit-expanded-patches)
393 (stgit-expand-patch patchsym))
bce79a6a
GH
394 (when (equal "0" empty)
395 (save-excursion
396 (goto-char (match-beginning 5))
397 (insert "(empty) ")))
398 (delete-char 1)
378a003d 399 ))
ad80ce22
DK
400 ((or (looking-at "stg series: Branch \".*\" not initialised")
401 (looking-at "stg series: .*: branch not initialized"))
3a1cf814 402 (setq found-any t)
1c2426dc
DK
403 (forward-line 1)
404 (insert "Run M-x stgit-init to initialise")))
6df83d42 405 (forward-line 1))
3a1cf814
GH
406 (setq stgit-marked-patches (nreverse marked))
407 (unless found-any
408 (insert "\n "
409 (propertize "no patches in series"
410 'face 'stgit-description-face))))))
07f464e0 411
acc5652f
DK
412(defun stgit-select-file ()
413 (let ((patched-file (stgit-patched-file-at-point)))
414 (unless patched-file
415 (error "No patch or file on the current line"))
416 (let ((filename (expand-file-name (cdr patched-file))))
417 (unless (file-exists-p filename)
418 (error "File does not exist"))
419 (find-file filename))))
420
421(defun stgit-toggle-patch-file-list (curpath)
422 (let ((inhibit-read-only t))
423 (if (memq curpatch stgit-expanded-patches)
424 (save-excursion
425 (setq stgit-expanded-patches (delq curpatch stgit-expanded-patches))
426 (stgit-collapse-patch curpatch))
427 (progn
428 (setq stgit-expanded-patches (cons curpatch stgit-expanded-patches))
429 (stgit-expand-patch curpatch)))))
430
378a003d
GH
431(defun stgit-select ()
432 "Expand or collapse the current entry"
433 (interactive)
434 (let ((curpatch (stgit-patch-at-point)))
acc5652f
DK
435 (if curpatch
436 (stgit-toggle-patch-file-list curpatch)
437 (stgit-select-file))))
438
378a003d
GH
439
440(defun stgit-find-file-other-window ()
441 "Open file at point in other window"
442 (interactive)
443 (let ((patched-file (stgit-patched-file-at-point)))
444 (unless patched-file
445 (error "No file on the current line"))
446 (let ((filename (expand-file-name (cdr patched-file))))
447 (unless (file-exists-p filename)
448 (error "File does not exist"))
449 (find-file-other-window filename))))
450
83327d53 451(defun stgit-quit ()
a53347d9 452 "Hide the stgit buffer."
83327d53
GH
453 (interactive)
454 (bury-buffer))
455
0f076fe6 456(defun stgit-git-status ()
a53347d9 457 "Show status using `git-status'."
0f076fe6
GH
458 (interactive)
459 (unless (fboundp 'git-status)
df283a8b 460 (error "The stgit-git-status command requires git-status"))
0f076fe6
GH
461 (let ((dir default-directory))
462 (save-selected-window
463 (pop-to-buffer nil)
464 (git-status dir))))
465
378a003d
GH
466(defun stgit-next-line (&optional arg try-vscroll)
467 "Move cursor vertically down ARG lines"
468 (interactive "p\np")
469 (next-line arg try-vscroll)
470 (when (looking-at " \\S-")
471 (forward-char 2)))
472
473(defun stgit-previous-line (&optional arg try-vscroll)
474 "Move cursor vertically up ARG lines"
475 (interactive "p\np")
476 (previous-line arg try-vscroll)
477 (when (looking-at " \\S-")
478 (forward-char 2)))
479
480(defun stgit-next-patch (&optional arg)
481 "Move cursor down ARG patches"
482 (interactive "p")
483 (unless arg
484 (setq arg 1))
485 (if (< arg 0)
486 (stgit-previous-patch (- arg))
487 (while (not (zerop arg))
488 (setq arg (1- arg))
489 (while (progn (stgit-next-line)
490 (not (stgit-patch-at-point)))))))
491
492(defun stgit-previous-patch (&optional arg)
493 "Move cursor up ARG patches"
494 (interactive "p")
495 (unless arg
496 (setq arg 1))
497 (if (< arg 0)
498 (stgit-next-patch (- arg))
499 (while (not (zerop arg))
500 (setq arg (1- arg))
501 (while (progn (stgit-previous-line)
502 (not (stgit-patch-at-point)))))))
503
56d81fe5
DK
504(defvar stgit-mode-hook nil
505 "Run after `stgit-mode' is setup.")
506
507(defvar stgit-mode-map nil
508 "Keymap for StGit major mode.")
509
510(unless stgit-mode-map
511 (setq stgit-mode-map (make-keymap))
512 (suppress-keymap stgit-mode-map)
022a3664
GH
513 (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
514 '((" " . stgit-mark)
3dccdc9b 515 ("m" . stgit-mark)
9b151b27
GH
516 ("\d" . stgit-unmark-up)
517 ("u" . stgit-unmark-down)
022a3664
GH
518 ("?" . stgit-help)
519 ("h" . stgit-help)
378a003d
GH
520 ("p" . stgit-previous-line)
521 ("n" . stgit-next-line)
522 ("\C-p" . stgit-previous-patch)
523 ("\C-n" . stgit-next-patch)
524 ("\M-{" . stgit-previous-patch)
525 ("\M-}" . stgit-next-patch)
0f076fe6 526 ("s" . stgit-git-status)
022a3664
GH
527 ("g" . stgit-reload)
528 ("r" . stgit-refresh)
529 ("\C-c\C-r" . stgit-rename)
530 ("e" . stgit-edit)
594aa463 531 ("S" . stgit-squash)
022a3664
GH
532 ("N" . stgit-new)
533 ("R" . stgit-repair)
534 ("C" . stgit-commit)
535 ("U" . stgit-uncommit)
378a003d
GH
536 ("\r" . stgit-select)
537 ("o" . stgit-find-file-other-window)
022a3664
GH
538 (">" . stgit-push-next)
539 ("<" . stgit-pop-next)
540 ("P" . stgit-push-or-pop)
541 ("G" . stgit-goto)
542 ("=" . stgit-show)
543 ("D" . stgit-delete)
544 ([(control ?/)] . stgit-undo)
83327d53 545 ("\C-_" . stgit-undo)
adeef6bc
GH
546 ("B" . stgit-branch)
547 ("q" . stgit-quit))))
56d81fe5
DK
548
549(defun stgit-mode ()
550 "Major mode for interacting with StGit.
551Commands:
552\\{stgit-mode-map}"
553 (kill-all-local-variables)
554 (buffer-disable-undo)
555 (setq mode-name "StGit"
556 major-mode 'stgit-mode
557 goal-column 2)
558 (use-local-map stgit-mode-map)
559 (set (make-local-variable 'list-buffers-directory) default-directory)
6df83d42 560 (set (make-local-variable 'stgit-marked-patches) nil)
378a003d 561 (set (make-local-variable 'stgit-expanded-patches) nil)
2870f8b8 562 (set-variable 'truncate-lines 't)
56d81fe5
DK
563 (run-hooks 'stgit-mode-hook))
564
d51722b7
GH
565(defun stgit-add-mark (patchsym)
566 "Mark the patch PATCHSYM."
980ccd21
GH
567 (setq stgit-marked-patches (cons patchsym stgit-marked-patches))
568 (save-excursion
569 (when (stgit-goto-patch patchsym)
570 (move-to-column 1)
571 (let ((inhibit-read-only t))
572 (insert-and-inherit ?*)
573 (delete-char 1)))))
6df83d42 574
d51722b7
GH
575(defun stgit-remove-mark (patchsym)
576 "Unmark the patch PATCHSYM."
980ccd21
GH
577 (setq stgit-marked-patches (delq patchsym stgit-marked-patches))
578 (save-excursion
579 (when (stgit-goto-patch patchsym)
580 (move-to-column 1)
581 (let ((inhibit-read-only t))
582 (insert-and-inherit ? )
583 (delete-char 1)))))
6df83d42 584
e6b1fdae 585(defun stgit-clear-marks ()
47271f41 586 "Unmark all patches."
e6b1fdae
DK
587 (setq stgit-marked-patches '()))
588
378a003d 589(defun stgit-patch-at-point (&optional cause-error allow-file)
d51722b7 590 "Return the patch name on the current line as a symbol.
378a003d
GH
591If CAUSE-ERROR is not nil, signal an error if none found.
592If ALLOW-FILE is not nil, also handle when point is on a file of
593a patch."
d51722b7
GH
594 (or (get-text-property (point) 'stgit-patchsym)
595 (and allow-file
596 (get-text-property (point) 'stgit-file-patchsym))
597 (when cause-error
598 (error "No patch on this line"))))
378a003d 599
1f60181a
GH
600(defun stgit-patched-file-at-point (&optional both-files)
601 "Returns a cons of the patchsym and file name at point. For
602copies and renames, return the new file if the patch is either
603applied. If BOTH-FILES is non-nil, return a cons of the old and
604the new file names instead of just one name."
d51722b7 605 (let ((patchsym (get-text-property (point) 'stgit-file-patchsym))
1f60181a
GH
606 (file (get-text-property (point) 'stgit-file)))
607 (cond ((not patchsym) nil)
608 (file (cons patchsym file))
609 (both-files
610 (cons patchsym (cons (get-text-property (point) 'stgit-old-file)
611 (get-text-property (point) 'stgit-new-file))))
612 (t
613 (let ((file-sym (save-excursion
614 (stgit-previous-patch)
d51722b7
GH
615 (unless (eq (stgit-patch-at-point)
616 patchsym)
1f60181a
GH
617 (error "Cannot find the %s patch" patchsym))
618 (beginning-of-line)
619 (if (= (char-after) ?-)
620 'stgit-old-file
621 'stgit-new-file))))
622 (cons patchsym (get-text-property (point) file-sym)))))))
56d81fe5 623
7755d7f1 624(defun stgit-patches-marked-or-at-point ()
d51722b7 625 "Return the symbols of the marked patches, or the patch on the current line."
7755d7f1 626 (if stgit-marked-patches
d51722b7 627 stgit-marked-patches
7755d7f1
KH
628 (let ((patch (stgit-patch-at-point)))
629 (if patch
630 (list patch)
631 '()))))
632
d51722b7
GH
633(defun stgit-goto-patch (patchsym)
634 "Move point to the line containing patch PATCHSYM.
635If that patch cannot be found, return nil."
636 (let ((p (text-property-any (point-min) (point-max)
637 'stgit-patchsym patchsym)))
638 (when p
56d81fe5 639 (goto-char p)
d51722b7 640 (move-to-column goal-column))))
56d81fe5 641
1c2426dc 642(defun stgit-init ()
a53347d9 643 "Run stg init."
1c2426dc
DK
644 (interactive)
645 (stgit-capture-output nil
b0424080 646 (stgit-run "init"))
1f0bf00f 647 (stgit-reload))
1c2426dc 648
6df83d42 649(defun stgit-mark ()
a53347d9 650 "Mark the patch under point."
6df83d42 651 (interactive)
018fa1ac 652 (let ((patch (stgit-patch-at-point t)))
980ccd21 653 (stgit-add-mark patch))
378a003d 654 (stgit-next-patch))
6df83d42 655
9b151b27 656(defun stgit-unmark-up ()
a53347d9 657 "Remove mark from the patch on the previous line."
6df83d42 658 (interactive)
378a003d 659 (stgit-previous-patch)
980ccd21 660 (stgit-remove-mark (stgit-patch-at-point t)))
9b151b27
GH
661
662(defun stgit-unmark-down ()
a53347d9 663 "Remove mark from the patch on the current line."
9b151b27 664 (interactive)
018fa1ac 665 (stgit-remove-mark (stgit-patch-at-point t))
1288eda2 666 (stgit-next-patch))
6df83d42 667
56d81fe5 668(defun stgit-rename (name)
018fa1ac 669 "Rename the patch under point to NAME."
d51722b7
GH
670 (interactive (list (read-string "Patch name: "
671 (symbol-name (stgit-patch-at-point t)))))
672 (let ((old-patchsym (stgit-patch-at-point t)))
56d81fe5 673 (stgit-capture-output nil
d51722b7
GH
674 (stgit-run "rename" old-patchsym name))
675 (let ((name-sym (intern name)))
676 (when (memq old-patchsym stgit-expanded-patches)
378a003d 677 (setq stgit-expanded-patches
d51722b7
GH
678 (cons name-sym (delq old-patchsym stgit-expanded-patches))))
679 (when (memq old-patchsym stgit-marked-patches)
378a003d 680 (setq stgit-marked-patches
d51722b7
GH
681 (cons name-sym (delq old-patchsym stgit-marked-patches))))
682 (stgit-reload)
683 (stgit-goto-patch name-sym))))
56d81fe5 684
26201d96 685(defun stgit-repair ()
a53347d9 686 "Run stg repair."
26201d96
DK
687 (interactive)
688 (stgit-capture-output nil
b0424080 689 (stgit-run "repair"))
1f0bf00f 690 (stgit-reload))
26201d96 691
adeef6bc
GH
692(defun stgit-available-branches ()
693 "Returns a list of the available stg branches"
694 (let ((output (with-output-to-string
695 (stgit-run "branch" "--list")))
696 (start 0)
697 result)
698 (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start)
699 (setq result (cons (match-string 1 output) result))
700 (setq start (match-end 0)))
701 result))
702
703(defun stgit-branch (branch)
704 "Switch to branch BRANCH."
705 (interactive (list (completing-read "Switch to branch: "
706 (stgit-available-branches))))
707 (stgit-capture-output nil (stgit-run "branch" "--" branch))
708 (stgit-reload))
709
41c1c59c
GH
710(defun stgit-commit (count)
711 "Run stg commit on COUNT commits.
712Interactively, the prefix argument is used as COUNT."
713 (interactive "p")
714 (stgit-capture-output nil (stgit-run "commit" "-n" count))
1f0bf00f 715 (stgit-reload))
c4aad9a7 716
41c1c59c
GH
717(defun stgit-uncommit (count)
718 "Run stg uncommit on COUNT commits.
719Interactively, the prefix argument is used as COUNT."
c4aad9a7 720 (interactive "p")
41c1c59c 721 (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
1f0bf00f 722 (stgit-reload))
c4aad9a7 723
0b661144
DK
724(defun stgit-push-next (npatches)
725 "Push the first unapplied patch.
726With numeric prefix argument, push that many patches."
727 (interactive "p")
d51722b7 728 (stgit-capture-output nil (stgit-run "push" "-n" npatches))
074a4fb0
GH
729 (stgit-reload)
730 (stgit-refresh-git-status))
56d81fe5 731
0b661144
DK
732(defun stgit-pop-next (npatches)
733 "Pop the topmost applied patch.
734With numeric prefix argument, pop that many patches."
735 (interactive "p")
d51722b7 736 (stgit-capture-output nil (stgit-run "pop" "-n" npatches))
074a4fb0
GH
737 (stgit-reload)
738 (stgit-refresh-git-status))
56d81fe5 739
f9182fca
KH
740(defun stgit-applied-at-point ()
741 "Is the patch on the current line applied?"
742 (save-excursion
743 (beginning-of-line)
744 (looking-at "[>+]")))
745
746(defun stgit-push-or-pop ()
a53347d9 747 "Push or pop the patch on the current line."
f9182fca 748 (interactive)
d51722b7 749 (let ((patchsym (stgit-patch-at-point t))
f9182fca
KH
750 (applied (stgit-applied-at-point)))
751 (stgit-capture-output nil
d51722b7 752 (stgit-run (if applied "pop" "push") patchsym))
1f0bf00f 753 (stgit-reload)))
f9182fca 754
c7adf5ef 755(defun stgit-goto ()
a53347d9 756 "Go to the patch on the current line."
c7adf5ef 757 (interactive)
d51722b7 758 (let ((patchsym (stgit-patch-at-point t)))
c7adf5ef 759 (stgit-capture-output nil
d51722b7 760 (stgit-run "goto" patchsym))
1f0bf00f 761 (stgit-reload)))
c7adf5ef 762
d51722b7
GH
763(defun stgit-id (patchsym)
764 "Return the git commit id for PATCHSYM."
378a003d 765 (let ((result (with-output-to-string
d51722b7 766 (stgit-run-silent "id" patchsym))))
378a003d 767 (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
d51722b7 768 (error "Cannot find commit id for %s" patchsym))
378a003d
GH
769 (match-string 1 result)))
770
56d81fe5 771(defun stgit-show ()
a53347d9 772 "Show the patch on the current line."
56d81fe5
DK
773 (interactive)
774 (stgit-capture-output "*StGit patch*"
d51722b7
GH
775 (let ((patchsym (stgit-patch-at-point)))
776 (if (not patchsym)
1f60181a 777 (let ((patched-file (stgit-patched-file-at-point t)))
378a003d
GH
778 (unless patched-file
779 (error "No patch or file at point"))
d51722b7 780 (let ((id (stgit-id (car patched-file))))
5f1b0013
GH
781 (if (consp (cdr patched-file))
782 ;; two files (copy or rename)
783 (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
784 (cadr patched-file) (cddr patched-file))
785 ;; just one file
786 (stgit-run-git "diff" (concat id "^") id "--"
787 (cdr patched-file)))))
b557489f 788 (stgit-run "show" "-O" "--patch-with-stat" patchsym))
5f1b0013
GH
789 (with-current-buffer standard-output
790 (goto-char (point-min))
791 (diff-mode)))))
0663524d 792
0bca35c8 793(defun stgit-edit ()
a53347d9 794 "Edit the patch on the current line."
0bca35c8 795 (interactive)
d51722b7 796 (let ((patchsym (stgit-patch-at-point t))
0780be79 797 (edit-buf (get-buffer-create "*StGit edit*"))
0bca35c8
DK
798 (dir default-directory))
799 (log-edit 'stgit-confirm-edit t nil edit-buf)
d51722b7 800 (set (make-local-variable 'stgit-edit-patchsym) patchsym)
0bca35c8
DK
801 (setq default-directory dir)
802 (let ((standard-output edit-buf))
d51722b7 803 (stgit-run-silent "edit" "--save-template=-" patchsym))))
0bca35c8
DK
804
805(defun stgit-confirm-edit ()
806 (interactive)
807 (let ((file (make-temp-file "stgit-edit-")))
808 (write-region (point-min) (point-max) file)
809 (stgit-capture-output nil
d51722b7 810 (stgit-run "edit" "-f" file stgit-edit-patchsym))
0bca35c8 811 (with-current-buffer log-edit-parent-buffer
1f0bf00f 812 (stgit-reload))))
0bca35c8 813
aa04f831
GH
814(defun stgit-new (add-sign)
815 "Create a new patch.
816With a prefix argument, include a \"Signed-off-by:\" line at the
817end of the patch."
818 (interactive "P")
c5d45b92
GH
819 (let ((edit-buf (get-buffer-create "*StGit edit*"))
820 (dir default-directory))
821 (log-edit 'stgit-confirm-new t nil edit-buf)
aa04f831
GH
822 (setq default-directory dir)
823 (when add-sign
824 (save-excursion
825 (let ((standard-output (current-buffer)))
826 (stgit-run-silent "new" "--sign" "--save-template=-"))))))
64c097a0
DK
827
828(defun stgit-confirm-new ()
829 (interactive)
27b0f9e4 830 (let ((file (make-temp-file "stgit-edit-")))
64c097a0
DK
831 (write-region (point-min) (point-max) file)
832 (stgit-capture-output nil
27b0f9e4 833 (stgit-run "new" "-f" file))
64c097a0 834 (with-current-buffer log-edit-parent-buffer
1f0bf00f 835 (stgit-reload))))
64c097a0
DK
836
837(defun stgit-create-patch-name (description)
838 "Create a patch name from a long description"
839 (let ((patch ""))
840 (while (> (length description) 0)
841 (cond ((string-match "\\`[a-zA-Z_-]+" description)
8439f657
GH
842 (setq patch (downcase (concat patch
843 (match-string 0 description))))
64c097a0
DK
844 (setq description (substring description (match-end 0))))
845 ((string-match "\\` +" description)
846 (setq patch (concat patch "-"))
847 (setq description (substring description (match-end 0))))
848 ((string-match "\\`[^a-zA-Z_-]+" description)
849 (setq description (substring description (match-end 0))))))
850 (cond ((= (length patch) 0)
851 "patch")
852 ((> (length patch) 20)
853 (substring patch 0 20))
854 (t patch))))
0bca35c8 855
9008e45b 856(defun stgit-delete (patchsyms &optional spill-p)
d51722b7 857 "Delete the patches in PATCHSYMS.
9008e45b
GH
858Interactively, delete the marked patches, or the patch at point.
859
860With a prefix argument, or SPILL-P, spill the patch contents to
861the work tree and index."
862 (interactive (list (stgit-patches-marked-or-at-point)
863 current-prefix-arg))
e7231e4f
GH
864 (unless patchsyms
865 (error "No patches to delete"))
d51722b7 866 (let ((npatches (length patchsyms)))
9008e45b 867 (when (yes-or-no-p (format "Really delete %d patch%s%s? "
e7231e4f 868 npatches
9008e45b
GH
869 (if (= 1 npatches) "" "es")
870 (if spill-p
871 " (spilling contents to index)"
872 "")))
873 (let ((args (if spill-p
874 (cons "--spill" patchsyms)
875 patchsyms)))
876 (stgit-capture-output nil
877 (apply 'stgit-run "delete" args))
878 (stgit-reload)))))
d51722b7 879
594aa463
KH
880(defun stgit-squash (patchsyms)
881 "Squash the patches in PATCHSYMS.
882Interactively, squash the marked patches."
d51722b7
GH
883 (interactive (list stgit-marked-patches))
884 (when (< (length patchsyms) 2)
594aa463 885 (error "Need at least two patches to squash"))
0780be79 886 (let ((edit-buf (get-buffer-create "*StGit edit*"))
ea0def18 887 (dir default-directory))
594aa463 888 (log-edit 'stgit-confirm-squash t nil edit-buf)
d51722b7 889 (set (make-local-variable 'stgit-patchsyms) patchsyms)
ea0def18
DK
890 (setq default-directory dir)
891 (let ((standard-output edit-buf))
594aa463 892 (apply 'stgit-run-silent "squash" "--save-template=-" patchsyms))))
ea0def18 893
594aa463 894(defun stgit-confirm-squash ()
ea0def18
DK
895 (interactive)
896 (let ((file (make-temp-file "stgit-edit-")))
897 (write-region (point-min) (point-max) file)
898 (stgit-capture-output nil
594aa463 899 (apply 'stgit-run "squash" "-f" file stgit-patchsyms))
ea0def18 900 (with-current-buffer log-edit-parent-buffer
e6b1fdae
DK
901 (stgit-clear-marks)
902 ;; Go to first marked patch and stay there
903 (goto-char (point-min))
904 (re-search-forward (concat "^[>+-]\\*") nil t)
905 (move-to-column goal-column)
906 (let ((pos (point)))
1f0bf00f 907 (stgit-reload)
e6b1fdae 908 (goto-char pos)))))
ea0def18 909
0663524d
KH
910(defun stgit-help ()
911 "Display help for the StGit mode."
912 (interactive)
913 (describe-function 'stgit-mode))
3a59f3db 914
83e51dbf
DK
915(defun stgit-undo (&optional arg)
916 "Run stg undo.
917With prefix argument, run it with the --hard flag."
918 (interactive "P")
919 (stgit-capture-output nil
920 (if arg
921 (stgit-run "undo" "--hard")
922 (stgit-run "undo")))
1f0bf00f 923 (stgit-reload))
83e51dbf 924
4d73c4d8
DK
925(defun stgit-refresh (&optional arg)
926 "Run stg refresh.
a53347d9 927With prefix argument, refresh the marked patch or the patch under point."
4d73c4d8
DK
928 (interactive "P")
929 (let ((patchargs (if arg
b0424080
GH
930 (let ((patches (stgit-patches-marked-or-at-point)))
931 (cond ((null patches)
df283a8b 932 (error "No patch to update"))
b0424080 933 ((> (length patches) 1)
df283a8b 934 (error "Too many patches selected"))
b0424080
GH
935 (t
936 (cons "-p" patches))))
937 nil)))
4d73c4d8 938 (stgit-capture-output nil
074a4fb0
GH
939 (apply 'stgit-run "refresh" patchargs))
940 (stgit-refresh-git-status))
4d73c4d8
DK
941 (stgit-reload))
942
3a59f3db 943(provide 'stgit)