1 ;; stgit.el: An emacs mode for StGit
3 ;; Copyright (C) 2007 David Kågedal <davidk@lysator.liu.se>
5 ;; To install: put this file on the load-path and place the following
6 ;; in your .emacs file:
10 ;; To start: `M-x stgit'
15 "Manage StGit patches for the tree in DIR."
16 (interactive "DDirectory: \n")
17 (switch-to-stgit-buffer (git-get-top-dir dir))
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
26 (unless (eq 0 (call-process "git" nil t nil
27 "rev-parse" "--show-cdup"))
28 (error "cannot find top-level git tree for %s." dir))))))
29 (expand-file-name (concat (file-name-as-directory dir)
30 (car (split-string cdup "\n")))))))
32 (defun stgit-refresh-git-status (&optional dir)
33 "If it exists, refresh the `git-status' buffer belonging to
34 directory 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))))))
43 (defun switch-to-stgit-buffer (dir)
44 "Switch to a (possibly new) buffer displaying StGit patches for DIR."
45 (setq dir (file-name-as-directory dir))
46 (let ((buffers (buffer-list)))
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
54 (create-stgit-buffer dir)))))
56 (defun create-stgit-buffer (dir)
57 "Create a buffer for showing StGit patches.
58 Argument 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)
64 (setq buffer-read-only t))
67 (defmacro stgit-capture-output (name &rest body)
68 "Capture StGit output and show it in a window at the end."
69 `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
70 (stgit-dir default-directory)
71 (inhibit-read-only t))
72 (with-current-buffer output-buf
74 (setq default-directory stgit-dir)
75 (setq buffer-read-only t))
76 (let ((standard-output output-buf))
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)))))
83 (put 'stgit-capture-output 'lisp-indent-function 1)
85 (defun stgit-run-silent (&rest args)
86 (apply 'call-process "stg" nil standard-output nil args))
88 (defun stgit-run (&rest args)
89 (let ((msgcmd (mapconcat #'identity args " ")))
90 (message "Running stg %s..." msgcmd)
91 (apply 'call-process "stg" nil standard-output nil args)
92 (message "Running stg %s...done" msgcmd)))
94 (defun stgit-run-git (&rest args)
95 (let ((msgcmd (mapconcat #'identity args " ")))
96 (message "Running git %s..." msgcmd)
97 (apply 'call-process "git" nil standard-output nil args)
98 (message "Running git %s...done" msgcmd)))
100 (defun stgit-run-git-silent (&rest args)
101 (apply 'call-process "git" nil standard-output nil args))
103 (defun stgit-reload ()
104 "Update the contents of the StGit buffer."
106 (let ((inhibit-read-only t)
107 (curline (line-number-at-pos))
108 (curpatch (stgit-patch-at-point)))
111 (stgit-run-silent "branch")
112 (stgit-run-silent "series" "--description")
115 (stgit-goto-patch curpatch)
116 (goto-line curline)))
117 (stgit-refresh-git-status))
120 "A user interface for the StGit patch maintenance tool."
123 (defface stgit-description-face
124 '((((background dark)) (:foreground "tan"))
125 (((background light)) (:foreground "dark red")))
126 "The face used for StGit descriptions"
129 (defface stgit-top-patch-face
130 '((((background dark)) (:weight bold :foreground "yellow"))
131 (((background light)) (:weight bold :foreground "purple"))
133 "The face used for the top patch names"
136 (defface stgit-applied-patch-face
137 '((((background dark)) (:foreground "light yellow"))
138 (((background light)) (:foreground "purple"))
140 "The face used for applied patch names"
143 (defface stgit-unapplied-patch-face
144 '((((background dark)) (:foreground "gray80"))
145 (((background light)) (:foreground "orchid"))
147 "The face used for unapplied patch names"
150 (defface stgit-modified-file-face
151 '((((class color) (background light)) (:foreground "purple"))
152 (((class color) (background dark)) (:foreground "salmon")))
153 "StGit mode face used for modified file status"
156 (defface stgit-unmerged-file-face
157 '((((class color) (background light)) (:foreground "red" :bold t))
158 (((class color) (background dark)) (:foreground "red" :bold t)))
159 "StGit mode face used for unmerged file status"
162 (defface stgit-unknown-file-face
163 '((((class color) (background light)) (:foreground "goldenrod" :bold t))
164 (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
165 "StGit mode face used for unknown file status"
168 (defface stgit-file-permission-face
169 '((((class color) (background light)) (:foreground "green" :bold t))
170 (((class color) (background dark)) (:foreground "green" :bold t)))
171 "StGit mode face used for permission changes."
174 (defcustom stgit-expand-find-copies-harder
176 "Try harder to find copied files when listing patches.
178 When not nil, runs git diff-tree with the --find-copies-harder
179 flag, which reduces performance."
183 (defconst stgit-file-status-code-strings
184 (mapcar (lambda (arg)
186 (propertize (cadr arg) 'face (car (cddr arg)))))
187 '((add "Added" stgit-modified-file-face)
188 (copy "Copied" stgit-modified-file-face)
189 (delete "Deleted" stgit-modified-file-face)
190 (modify "Modified" stgit-modified-file-face)
191 (rename "Renamed" stgit-modified-file-face)
192 (mode-change "Mode change" stgit-modified-file-face)
193 (unmerged "Unmerged" stgit-unmerged-file-face)
194 (unknown "Unknown" stgit-unknown-file-face)))
195 "Alist of code symbols to description strings")
197 (defun stgit-file-status-code-as-string (code)
198 "Return stgit status code as string"
199 (let ((str (assq (if (consp code) (car code) code)
200 stgit-file-status-code-strings)))
203 (if (and str (consp code) (/= (cdr code) 100))
204 (format "%s %s" (cdr str)
205 (propertize (format "%d%%" (cdr code))
206 'face 'stgit-description-face))
209 (defun stgit-file-status-code (str &optional score)
210 "Return stgit status code from git status string"
211 (let ((code (assoc str '(("A" . add)
219 (setq code (if code (cdr code) 'unknown))
220 (when (stringp score)
221 (if (> (length score) 0)
222 (setq score (string-to-number score))
224 (if score (cons code score) code)))
226 (defconst stgit-file-type-strings
229 (#o160 . "subproject"))
230 "Alist of names of file types")
232 (defun stgit-file-type-string (type)
233 (let ((type-str (assoc type stgit-file-type-strings)))
234 (or (and type-str (cdr type-str))
235 (format "unknown type %o" type))))
237 (defun stgit-file-type-change-string (old-perm new-perm)
238 (let ((old-type (lsh old-perm -9))
239 (new-type (lsh new-perm -9)))
240 (cond ((= old-type new-type) "")
241 ((zerop new-type) "")
243 (if (= new-type #o100)
245 (format " (%s)" (stgit-file-type-string new-type))))
246 (t (format " (%s -> %s)"
247 (stgit-file-type-string old-type)
248 (stgit-file-type-string new-type))))))
250 (defun stgit-file-mode-change-string (old-perm new-perm)
251 (setq old-perm (logand old-perm #o777)
252 new-perm (logand new-perm #o777))
253 (if (or (= old-perm new-perm)
257 (let* ((modified (logxor old-perm new-perm))
258 (not-x-modified (logand (logxor old-perm new-perm) #o666)))
259 (cond ((zerop modified) "")
260 ((and (zerop not-x-modified)
261 (or (and (eq #o111 (logand old-perm #o111))
262 (propertize "-x" 'face 'stgit-file-permission-face))
263 (and (eq #o111 (logand new-perm #o111))
264 (propertize "+x" 'face
265 'stgit-file-permission-face)))))
266 (t (concat (propertize (format "%o" old-perm)
267 'face 'stgit-file-permission-face)
269 'face 'stgit-description-face)
270 (propertize (format "%o" new-perm)
271 'face 'stgit-file-permission-face)))))))
273 (defun stgit-expand-patch (patchsym)
276 (let* ((start (point))
277 (result (with-output-to-string
278 (stgit-run-git "diff-tree" "-r" "-z"
279 (if stgit-expand-find-copies-harder
280 "--find-copies-harder"
282 (stgit-id (symbol-name patchsym))))))
284 (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]*\\)\\)"
286 (let ((copy-or-rename (match-string 4 result))
287 (old-perm (read (format "#o%s" (match-string 1 result))))
288 (new-perm (read (format "#o%s" (match-string 2 result))))
295 (let ((cr-score (match-string 5 result))
296 (cr-from-file (match-string 6 result))
297 (cr-to-file (match-string 7 result)))
298 (setq status (stgit-file-status-code copy-or-rename
300 properties (list 'stgit-old-file cr-from-file
301 'stgit-new-file cr-to-file)
305 'face 'stgit-description-face)
307 (setq status (stgit-file-status-code (match-string 8 result))
308 properties (list 'stgit-file (match-string 9 result))
309 change (match-string 9 result)))
311 (let ((mode-change (stgit-file-mode-change-string old-perm
313 (insert (format "%-12s" (stgit-file-status-code-as-string
316 (if (> (length mode-change) 0) " " "")
318 (propertize (stgit-file-type-change-string old-perm
320 'face 'stgit-description-face)
322 (add-text-properties line-start (point) properties))
323 (setq mstart (match-end 0))))
324 (when (= start (point))
325 (insert " <no files>\n"))
326 (put-text-property start (point) 'stgit-patchsym patchsym))))
328 (defun stgit-rescan ()
329 "Rescan the status buffer."
332 (goto-char (point-min))
334 (cond ((looking-at "Branch: \\(.*\\)")
335 (put-text-property (match-beginning 1) (match-end 1)
337 ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
338 (let ((state (match-string 1))
339 (patchsym (intern (match-string 3))))
341 (match-beginning 3) (match-end 3) 'face
342 (cond ((string= state ">") 'stgit-top-patch-face)
343 ((string= state "+") 'stgit-applied-patch-face)
344 ((string= state "-") 'stgit-unapplied-patch-face)))
345 (put-text-property (match-beginning 4) (match-end 4)
346 'face 'stgit-description-face)
347 (when (memq patchsym stgit-marked-patches)
348 (replace-match "*" nil nil nil 2)
349 (setq marked (cons patchsym marked)))
350 (when (memq patchsym stgit-expanded-patches)
351 (stgit-expand-patch patchsym))
353 ((or (looking-at "stg series: Branch \".*\" not initialised")
354 (looking-at "stg series: .*: branch not initialized"))
356 (insert "Run M-x stgit-init to initialise")))
358 (setq stgit-marked-patches (nreverse marked)))))
360 (defun stgit-select ()
361 "Expand or collapse the current entry"
363 (let ((curpatch (stgit-patch-at-point)))
365 (let ((patched-file (stgit-patched-file-at-point)))
367 (error "No patch or file on the current line"))
368 (let ((filename (expand-file-name (cdr patched-file))))
369 (unless (file-exists-p filename)
370 (error "File does not exist"))
371 (find-file filename)))
372 (setq curpatch (intern curpatch))
373 (setq stgit-expanded-patches
374 (if (memq curpatch stgit-expanded-patches)
375 (delq curpatch stgit-expanded-patches)
376 (cons curpatch stgit-expanded-patches)))
379 (defun stgit-find-file-other-window ()
380 "Open file at point in other window"
382 (let ((patched-file (stgit-patched-file-at-point)))
384 (error "No file on the current line"))
385 (let ((filename (expand-file-name (cdr patched-file))))
386 (unless (file-exists-p filename)
387 (error "File does not exist"))
388 (find-file-other-window filename))))
391 "Hide the stgit buffer."
395 (defun stgit-git-status ()
396 "Show status using `git-status'."
398 (unless (fboundp 'git-status)
399 (error "stgit-git-status requires git-status"))
400 (let ((dir default-directory))
401 (save-selected-window
405 (defun stgit-next-line (&optional arg try-vscroll)
406 "Move cursor vertically down ARG lines"
408 (next-line arg try-vscroll)
409 (when (looking-at " \\S-")
412 (defun stgit-previous-line (&optional arg try-vscroll)
413 "Move cursor vertically up ARG lines"
415 (previous-line arg try-vscroll)
416 (when (looking-at " \\S-")
419 (defun stgit-next-patch (&optional arg)
420 "Move cursor down ARG patches"
425 (stgit-previous-patch (- arg))
426 (while (not (zerop arg))
428 (while (progn (stgit-next-line)
429 (not (stgit-patch-at-point)))))))
431 (defun stgit-previous-patch (&optional arg)
432 "Move cursor up ARG patches"
437 (stgit-next-patch (- arg))
438 (while (not (zerop arg))
440 (while (progn (stgit-previous-line)
441 (not (stgit-patch-at-point)))))))
443 (defvar stgit-mode-hook nil
444 "Run after `stgit-mode' is setup.")
446 (defvar stgit-mode-map nil
447 "Keymap for StGit major mode.")
449 (unless stgit-mode-map
450 (setq stgit-mode-map (make-keymap))
451 (suppress-keymap stgit-mode-map)
452 (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
455 ("\d" . stgit-unmark-up)
456 ("u" . stgit-unmark-down)
459 ("p" . stgit-previous-line)
460 ("n" . stgit-next-line)
461 ("\C-p" . stgit-previous-patch)
462 ("\C-n" . stgit-next-patch)
463 ("\M-{" . stgit-previous-patch)
464 ("\M-}" . stgit-next-patch)
465 ("s" . stgit-git-status)
467 ("r" . stgit-refresh)
468 ("\C-c\C-r" . stgit-rename)
470 ("c" . stgit-coalesce)
474 ("U" . stgit-uncommit)
475 ("\r" . stgit-select)
476 ("o" . stgit-find-file-other-window)
477 (">" . stgit-push-next)
478 ("<" . stgit-pop-next)
479 ("P" . stgit-push-or-pop)
483 ([(control ?/)] . stgit-undo)
484 ("\C-_" . stgit-undo)
485 ("q" . stgit-quit))))
488 "Major mode for interacting with StGit.
491 (kill-all-local-variables)
492 (buffer-disable-undo)
493 (setq mode-name "StGit"
494 major-mode 'stgit-mode
496 (use-local-map stgit-mode-map)
497 (set (make-local-variable 'list-buffers-directory) default-directory)
498 (set (make-local-variable 'stgit-marked-patches) nil)
499 (set (make-local-variable 'stgit-expanded-patches) nil)
500 (set-variable 'truncate-lines 't)
501 (run-hooks 'stgit-mode-hook))
503 (defun stgit-add-mark (patch)
504 (let ((patchsym (intern patch)))
505 (setq stgit-marked-patches (cons patchsym stgit-marked-patches))))
507 (defun stgit-remove-mark (patch)
508 (let ((patchsym (intern patch)))
509 (setq stgit-marked-patches (delq patchsym stgit-marked-patches))))
511 (defun stgit-clear-marks ()
512 (setq stgit-marked-patches '()))
514 (defun stgit-marked-patches ()
515 "Return the names of the marked patches."
516 (mapcar 'symbol-name stgit-marked-patches))
518 (defun stgit-patch-at-point (&optional cause-error allow-file)
519 "Return the patch name on the current line.
520 If CAUSE-ERROR is not nil, signal an error if none found.
521 If ALLOW-FILE is not nil, also handle when point is on a file of
524 (let ((patchsym (get-text-property (point) 'stgit-patchsym)))
526 (symbol-name patchsym))))
529 (and (looking-at "[>+-][ *]\\([^ ]*\\)")
530 (match-string-no-properties 1)))
532 (error "No patch on this line"))))
534 (defun stgit-patched-file-at-point (&optional both-files)
535 "Returns a cons of the patchsym and file name at point. For
536 copies and renames, return the new file if the patch is either
537 applied. If BOTH-FILES is non-nil, return a cons of the old and
538 the new file names instead of just one name."
539 (let ((patchsym (get-text-property (point) 'stgit-patchsym))
540 (file (get-text-property (point) 'stgit-file)))
541 (cond ((not patchsym) nil)
542 (file (cons patchsym file))
544 (cons patchsym (cons (get-text-property (point) 'stgit-old-file)
545 (get-text-property (point) 'stgit-new-file))))
547 (let ((file-sym (save-excursion
548 (stgit-previous-patch)
549 (unless (equal (stgit-patch-at-point)
550 (symbol-name patchsym))
551 (error "Cannot find the %s patch" patchsym))
553 (if (= (char-after) ?-)
556 (cons patchsym (get-text-property (point) file-sym)))))))
558 (defun stgit-patches-marked-or-at-point ()
559 "Return the names of the marked patches, or the patch on the current line."
560 (if stgit-marked-patches
561 (stgit-marked-patches)
562 (let ((patch (stgit-patch-at-point)))
567 (defun stgit-goto-patch (patch)
568 "Move point to the line containing PATCH."
570 (goto-char (point-min))
571 (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ")
573 (progn (move-to-column goal-column)
581 (stgit-capture-output nil
586 "Mark the patch under point."
588 (let ((patch (stgit-patch-at-point t)))
589 (stgit-add-mark patch)
593 (defun stgit-unmark-up ()
594 "Remove mark from the patch on the previous line."
596 (stgit-previous-patch)
597 (stgit-remove-mark (stgit-patch-at-point t))
600 (defun stgit-unmark-down ()
601 "Remove mark from the patch on the current line."
603 (stgit-remove-mark (stgit-patch-at-point t))
607 (defun stgit-rename (name)
608 "Rename the patch under point to NAME."
609 (interactive (list (read-string "Patch name: " (stgit-patch-at-point t))))
610 (let ((old-name (stgit-patch-at-point t)))
611 (stgit-capture-output nil
612 (stgit-run "rename" old-name name))
613 (let ((old-name-sym (intern old-name))
614 (name-sym (intern name)))
615 (when (memq old-name-sym stgit-expanded-patches)
616 (setq stgit-expanded-patches
617 (cons name-sym (delq old-name-sym stgit-expanded-patches))))
618 (when (memq old-name-sym stgit-marked-patches)
619 (setq stgit-marked-patches
620 (cons name-sym (delq old-name-sym stgit-marked-patches)))))
622 (stgit-goto-patch name)))
624 (defun stgit-repair ()
627 (stgit-capture-output nil
628 (stgit-run "repair"))
631 (defun stgit-commit ()
634 (stgit-capture-output nil (stgit-run "commit"))
637 (defun stgit-uncommit (arg)
638 "Run stg uncommit. Numeric arg determines number of patches to uncommit."
640 (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg)))
643 (defun stgit-push-next (npatches)
644 "Push the first unapplied patch.
645 With numeric prefix argument, push that many patches."
647 (stgit-capture-output nil (stgit-run "push" "-n"
648 (number-to-string npatches)))
650 (stgit-refresh-git-status))
652 (defun stgit-pop-next (npatches)
653 "Pop the topmost applied patch.
654 With numeric prefix argument, pop that many patches."
656 (stgit-capture-output nil (stgit-run "pop" "-n" (number-to-string npatches)))
658 (stgit-refresh-git-status))
660 (defun stgit-applied-at-point ()
661 "Is the patch on the current line applied?"
664 (looking-at "[>+]")))
666 (defun stgit-push-or-pop ()
667 "Push or pop the patch on the current line."
669 (let ((patch (stgit-patch-at-point t))
670 (applied (stgit-applied-at-point)))
671 (stgit-capture-output nil
672 (stgit-run (if applied "pop" "push") patch))
676 "Go to the patch on the current line."
678 (let ((patch (stgit-patch-at-point t)))
679 (stgit-capture-output nil
680 (stgit-run "goto" patch))
683 (defun stgit-id (patch)
684 "Return the git commit id for PATCH"
685 (let ((result (with-output-to-string
686 (stgit-run-silent "id" patch))))
687 (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
688 (error "Cannot find commit id for %s" patch))
689 (match-string 1 result)))
692 "Show the patch on the current line."
694 (stgit-capture-output "*StGit patch*"
695 (let ((patch (stgit-patch-at-point)))
697 (let ((patched-file (stgit-patched-file-at-point t)))
699 (error "No patch or file at point"))
700 (let ((id (stgit-id (symbol-name (car patched-file)))))
701 (with-output-to-temp-buffer "*StGit diff*"
702 (if (consp (cdr patched-file))
703 ;; two files (copy or rename)
704 (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
705 (cadr patched-file) (cddr patched-file))
707 (stgit-run-git "diff" (concat id "^") id "--"
709 (with-current-buffer standard-output
711 (stgit-run "show" (stgit-patch-at-point))
712 (with-current-buffer standard-output
713 (goto-char (point-min))
717 "Edit the patch on the current line."
719 (let ((patch (stgit-patch-at-point t))
720 (edit-buf (get-buffer-create "*StGit edit*"))
721 (dir default-directory))
722 (log-edit 'stgit-confirm-edit t nil edit-buf)
723 (set (make-local-variable 'stgit-edit-patch) patch)
724 (setq default-directory dir)
725 (let ((standard-output edit-buf))
726 (stgit-run-silent "edit" "--save-template=-" patch))))
728 (defun stgit-confirm-edit ()
730 (let ((file (make-temp-file "stgit-edit-")))
731 (write-region (point-min) (point-max) file)
732 (stgit-capture-output nil
733 (stgit-run "edit" "-f" file stgit-edit-patch))
734 (with-current-buffer log-edit-parent-buffer
737 (defun stgit-new (add-sign)
739 With a prefix argument, include a \"Signed-off-by:\" line at the
742 (let ((edit-buf (get-buffer-create "*StGit edit*"))
743 (dir default-directory))
744 (log-edit 'stgit-confirm-new t nil edit-buf)
745 (setq default-directory dir)
748 (let ((standard-output (current-buffer)))
749 (stgit-run-silent "new" "--sign" "--save-template=-"))))))
751 (defun stgit-confirm-new ()
753 (let ((file (make-temp-file "stgit-edit-")))
754 (write-region (point-min) (point-max) file)
755 (stgit-capture-output nil
756 (stgit-run "new" "-f" file))
757 (with-current-buffer log-edit-parent-buffer
760 (defun stgit-create-patch-name (description)
761 "Create a patch name from a long description"
763 (while (> (length description) 0)
764 (cond ((string-match "\\`[a-zA-Z_-]+" description)
765 (setq patch (downcase (concat patch
766 (match-string 0 description))))
767 (setq description (substring description (match-end 0))))
768 ((string-match "\\` +" description)
769 (setq patch (concat patch "-"))
770 (setq description (substring description (match-end 0))))
771 ((string-match "\\`[^a-zA-Z_-]+" description)
772 (setq description (substring description (match-end 0))))))
773 (cond ((= (length patch) 0)
775 ((> (length patch) 20)
776 (substring patch 0 20))
779 (defun stgit-delete (patch-names)
780 "Delete the named patches."
781 (interactive (list (stgit-patches-marked-or-at-point)))
782 (if (zerop (length patch-names))
783 (error "No patches to delete")
784 (when (yes-or-no-p (format "Really delete %d patches? "
785 (length patch-names)))
786 (stgit-capture-output nil
787 (apply 'stgit-run "delete" patch-names))
790 (defun stgit-coalesce (patch-names)
791 "Run stg coalesce on the named patches."
792 (interactive (list (stgit-marked-patches)))
793 (let ((edit-buf (get-buffer-create "*StGit edit*"))
794 (dir default-directory))
795 (log-edit 'stgit-confirm-coalesce t nil edit-buf)
796 (set (make-local-variable 'stgit-patches) patch-names)
797 (setq default-directory dir)
798 (let ((standard-output edit-buf))
799 (apply 'stgit-run-silent "coalesce" "--save-template=-" patch-names))))
801 (defun stgit-confirm-coalesce ()
803 (let ((file (make-temp-file "stgit-edit-")))
804 (write-region (point-min) (point-max) file)
805 (stgit-capture-output nil
806 (apply 'stgit-run "coalesce" "-f" file stgit-patches))
807 (with-current-buffer log-edit-parent-buffer
809 ;; Go to first marked patch and stay there
810 (goto-char (point-min))
811 (re-search-forward (concat "^[>+-]\\*") nil t)
812 (move-to-column goal-column)
818 "Display help for the StGit mode."
820 (describe-function 'stgit-mode))
822 (defun stgit-undo (&optional arg)
824 With prefix argument, run it with the --hard flag."
826 (stgit-capture-output nil
828 (stgit-run "undo" "--hard")
832 (defun stgit-refresh (&optional arg)
834 With prefix argument, refresh the marked patch or the patch under point."
836 (let ((patchargs (if arg
837 (let ((patches (stgit-patches-marked-or-at-point)))
838 (cond ((null patches)
839 (error "no patch to update"))
840 ((> (length patches) 1)
841 (error "too many patches selected"))
843 (cons "-p" patches))))
845 (stgit-capture-output nil
846 (apply 'stgit-run "refresh" patchargs))
847 (stgit-refresh-git-status))