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