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