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 "Return string describing file type TYPE (the high bits of file permission).
234 Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
235 (let ((type-str (assoc type stgit-file-type-strings)))
236 (or (and type-str (cdr type-str))
237 (format "unknown type %o" type))))
239 (defun stgit-file-type-change-string (old-perm new-perm)
240 "Return string describing file type change from OLD-PERM to NEW-PERM.
241 Cf. `stgit-file-type-string'."
242 (let ((old-type (lsh old-perm -9))
243 (new-type (lsh new-perm -9)))
244 (cond ((= old-type new-type) "")
245 ((zerop new-type) "")
247 (if (= new-type #o100)
249 (format " (%s)" (stgit-file-type-string new-type))))
250 (t (format " (%s -> %s)"
251 (stgit-file-type-string old-type)
252 (stgit-file-type-string new-type))))))
254 (defun stgit-file-mode-change-string (old-perm new-perm)
255 "Return string describing file mode change from OLD-PERM to NEW-PERM.
256 Cf. `stgit-file-type-change-string'."
257 (setq old-perm (logand old-perm #o777)
258 new-perm (logand new-perm #o777))
259 (if (or (= old-perm new-perm)
263 (let* ((modified (logxor old-perm new-perm))
264 (not-x-modified (logand (logxor old-perm new-perm) #o666)))
265 (cond ((zerop modified) "")
266 ((and (zerop not-x-modified)
267 (or (and (eq #o111 (logand old-perm #o111))
268 (propertize "-x" 'face 'stgit-file-permission-face))
269 (and (eq #o111 (logand new-perm #o111))
270 (propertize "+x" 'face
271 'stgit-file-permission-face)))))
272 (t (concat (propertize (format "%o" old-perm)
273 'face 'stgit-file-permission-face)
275 'face 'stgit-description-face)
276 (propertize (format "%o" new-perm)
277 'face 'stgit-file-permission-face)))))))
279 (defun stgit-expand-patch (patchsym)
280 "Expand (show modification of) the patch with name PATCHSYM (a
282 `stgit-expand-find-copies-harder' controls how hard to try to
286 (let* ((start (point))
287 (result (with-output-to-string
288 (stgit-run-git "diff-tree" "-r" "-z"
289 (if stgit-expand-find-copies-harder
290 "--find-copies-harder"
292 (stgit-id (symbol-name patchsym))))))
294 (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]*\\)\\)"
296 (let ((copy-or-rename (match-string 4 result))
297 (old-perm (read (format "#o%s" (match-string 1 result))))
298 (new-perm (read (format "#o%s" (match-string 2 result))))
305 (let ((cr-score (match-string 5 result))
306 (cr-from-file (match-string 6 result))
307 (cr-to-file (match-string 7 result)))
308 (setq status (stgit-file-status-code copy-or-rename
310 properties (list 'stgit-old-file cr-from-file
311 'stgit-new-file cr-to-file)
315 'face 'stgit-description-face)
317 (setq status (stgit-file-status-code (match-string 8 result))
318 properties (list 'stgit-file (match-string 9 result))
319 change (match-string 9 result)))
321 (let ((mode-change (stgit-file-mode-change-string old-perm
323 (insert (format "%-12s" (stgit-file-status-code-as-string
326 (if (> (length mode-change) 0) " " "")
328 (propertize (stgit-file-type-change-string old-perm
330 'face 'stgit-description-face)
332 (add-text-properties line-start (point) properties))
333 (setq mstart (match-end 0))))
334 (when (= start (point))
335 (insert " <no files>\n"))
336 (put-text-property start (point) 'stgit-patchsym patchsym))))
338 (defun stgit-rescan ()
339 "Rescan the status buffer."
342 (goto-char (point-min))
344 (cond ((looking-at "Branch: \\(.*\\)")
345 (put-text-property (match-beginning 1) (match-end 1)
347 ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
348 (let ((state (match-string 1))
349 (patchsym (intern (match-string 3))))
351 (match-beginning 3) (match-end 3) 'face
352 (cond ((string= state ">") 'stgit-top-patch-face)
353 ((string= state "+") 'stgit-applied-patch-face)
354 ((string= state "-") 'stgit-unapplied-patch-face)))
355 (put-text-property (match-beginning 4) (match-end 4)
356 'face 'stgit-description-face)
357 (when (memq patchsym stgit-marked-patches)
358 (replace-match "*" nil nil nil 2)
359 (setq marked (cons patchsym marked)))
360 (when (memq patchsym stgit-expanded-patches)
361 (stgit-expand-patch patchsym))
363 ((or (looking-at "stg series: Branch \".*\" not initialised")
364 (looking-at "stg series: .*: branch not initialized"))
366 (insert "Run M-x stgit-init to initialise")))
368 (setq stgit-marked-patches (nreverse marked)))))
370 (defun stgit-select ()
371 "Expand or collapse the current entry"
373 (let ((curpatch (stgit-patch-at-point)))
375 (let ((patched-file (stgit-patched-file-at-point)))
377 (error "No patch or file on the current line"))
378 (let ((filename (expand-file-name (cdr patched-file))))
379 (unless (file-exists-p filename)
380 (error "File does not exist"))
381 (find-file filename)))
382 (setq curpatch (intern curpatch))
383 (setq stgit-expanded-patches
384 (if (memq curpatch stgit-expanded-patches)
385 (delq curpatch stgit-expanded-patches)
386 (cons curpatch stgit-expanded-patches)))
389 (defun stgit-find-file-other-window ()
390 "Open file at point in other window"
392 (let ((patched-file (stgit-patched-file-at-point)))
394 (error "No file on the current line"))
395 (let ((filename (expand-file-name (cdr patched-file))))
396 (unless (file-exists-p filename)
397 (error "File does not exist"))
398 (find-file-other-window filename))))
401 "Hide the stgit buffer."
405 (defun stgit-git-status ()
406 "Show status using `git-status'."
408 (unless (fboundp 'git-status)
409 (error "The stgit-git-status command requires git-status"))
410 (let ((dir default-directory))
411 (save-selected-window
415 (defun stgit-next-line (&optional arg try-vscroll)
416 "Move cursor vertically down ARG lines"
418 (next-line arg try-vscroll)
419 (when (looking-at " \\S-")
422 (defun stgit-previous-line (&optional arg try-vscroll)
423 "Move cursor vertically up ARG lines"
425 (previous-line arg try-vscroll)
426 (when (looking-at " \\S-")
429 (defun stgit-next-patch (&optional arg)
430 "Move cursor down ARG patches"
435 (stgit-previous-patch (- arg))
436 (while (not (zerop arg))
438 (while (progn (stgit-next-line)
439 (not (stgit-patch-at-point)))))))
441 (defun stgit-previous-patch (&optional arg)
442 "Move cursor up ARG patches"
447 (stgit-next-patch (- arg))
448 (while (not (zerop arg))
450 (while (progn (stgit-previous-line)
451 (not (stgit-patch-at-point)))))))
453 (defvar stgit-mode-hook nil
454 "Run after `stgit-mode' is setup.")
456 (defvar stgit-mode-map nil
457 "Keymap for StGit major mode.")
459 (unless stgit-mode-map
460 (setq stgit-mode-map (make-keymap))
461 (suppress-keymap stgit-mode-map)
462 (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
465 ("\d" . stgit-unmark-up)
466 ("u" . stgit-unmark-down)
469 ("p" . stgit-previous-line)
470 ("n" . stgit-next-line)
471 ("\C-p" . stgit-previous-patch)
472 ("\C-n" . stgit-next-patch)
473 ("\M-{" . stgit-previous-patch)
474 ("\M-}" . stgit-next-patch)
475 ("s" . stgit-git-status)
477 ("r" . stgit-refresh)
478 ("\C-c\C-r" . stgit-rename)
480 ("c" . stgit-coalesce)
484 ("U" . stgit-uncommit)
485 ("\r" . stgit-select)
486 ("o" . stgit-find-file-other-window)
487 (">" . stgit-push-next)
488 ("<" . stgit-pop-next)
489 ("P" . stgit-push-or-pop)
493 ([(control ?/)] . stgit-undo)
494 ("\C-_" . stgit-undo)
495 ("q" . stgit-quit))))
498 "Major mode for interacting with StGit.
501 (kill-all-local-variables)
502 (buffer-disable-undo)
503 (setq mode-name "StGit"
504 major-mode 'stgit-mode
506 (use-local-map stgit-mode-map)
507 (set (make-local-variable 'list-buffers-directory) default-directory)
508 (set (make-local-variable 'stgit-marked-patches) nil)
509 (set (make-local-variable 'stgit-expanded-patches) nil)
510 (set-variable 'truncate-lines 't)
511 (run-hooks 'stgit-mode-hook))
513 (defun stgit-add-mark (patch)
514 "Mark the patch named PATCH."
515 (let ((patchsym (intern patch)))
516 (setq stgit-marked-patches (cons patchsym stgit-marked-patches))))
518 (defun stgit-remove-mark (patch)
519 "Unmark the patch named PATCH."
520 (let ((patchsym (intern patch)))
521 (setq stgit-marked-patches (delq patchsym stgit-marked-patches))))
523 (defun stgit-clear-marks ()
524 "Unmark all patches."
525 (setq stgit-marked-patches '()))
527 (defun stgit-marked-patches ()
528 "Return the names of the marked patches."
529 (mapcar 'symbol-name stgit-marked-patches))
531 (defun stgit-patch-at-point (&optional cause-error allow-file)
532 "Return the patch name on the current line.
533 If CAUSE-ERROR is not nil, signal an error if none found.
534 If ALLOW-FILE is not nil, also handle when point is on a file of
537 (let ((patchsym (get-text-property (point) 'stgit-patchsym)))
539 (symbol-name patchsym))))
542 (and (looking-at "[>+-][ *]\\([^ ]*\\)")
543 (match-string-no-properties 1)))
545 (error "No patch on this line"))))
547 (defun stgit-patched-file-at-point (&optional both-files)
548 "Returns a cons of the patchsym and file name at point. For
549 copies and renames, return the new file if the patch is either
550 applied. If BOTH-FILES is non-nil, return a cons of the old and
551 the new file names instead of just one name."
552 (let ((patchsym (get-text-property (point) 'stgit-patchsym))
553 (file (get-text-property (point) 'stgit-file)))
554 (cond ((not patchsym) nil)
555 (file (cons patchsym file))
557 (cons patchsym (cons (get-text-property (point) 'stgit-old-file)
558 (get-text-property (point) 'stgit-new-file))))
560 (let ((file-sym (save-excursion
561 (stgit-previous-patch)
562 (unless (equal (stgit-patch-at-point)
563 (symbol-name patchsym))
564 (error "Cannot find the %s patch" patchsym))
566 (if (= (char-after) ?-)
569 (cons patchsym (get-text-property (point) file-sym)))))))
571 (defun stgit-patches-marked-or-at-point ()
572 "Return the names of the marked patches, or the patch on the current line."
573 (if stgit-marked-patches
574 (stgit-marked-patches)
575 (let ((patch (stgit-patch-at-point)))
580 (defun stgit-goto-patch (patch)
581 "Move point to the line containing PATCH."
583 (goto-char (point-min))
584 (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ")
586 (progn (move-to-column goal-column)
594 (stgit-capture-output nil
599 "Mark the patch under point."
601 (let ((patch (stgit-patch-at-point t)))
602 (stgit-add-mark patch)
606 (defun stgit-unmark-up ()
607 "Remove mark from the patch on the previous line."
609 (stgit-previous-patch)
610 (stgit-remove-mark (stgit-patch-at-point t))
613 (defun stgit-unmark-down ()
614 "Remove mark from the patch on the current line."
616 (stgit-remove-mark (stgit-patch-at-point t))
620 (defun stgit-rename (name)
621 "Rename the patch under point to NAME."
622 (interactive (list (read-string "Patch name: " (stgit-patch-at-point t))))
623 (let ((old-name (stgit-patch-at-point t)))
624 (stgit-capture-output nil
625 (stgit-run "rename" old-name name))
626 (let ((old-name-sym (intern old-name))
627 (name-sym (intern name)))
628 (when (memq old-name-sym stgit-expanded-patches)
629 (setq stgit-expanded-patches
630 (cons name-sym (delq old-name-sym stgit-expanded-patches))))
631 (when (memq old-name-sym stgit-marked-patches)
632 (setq stgit-marked-patches
633 (cons name-sym (delq old-name-sym stgit-marked-patches)))))
635 (stgit-goto-patch name)))
637 (defun stgit-repair ()
640 (stgit-capture-output nil
641 (stgit-run "repair"))
644 (defun stgit-commit ()
647 (stgit-capture-output nil (stgit-run "commit"))
650 (defun stgit-uncommit (arg)
651 "Run stg uncommit. Numeric arg determines number of patches to uncommit."
653 (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg)))
656 (defun stgit-push-next (npatches)
657 "Push the first unapplied patch.
658 With numeric prefix argument, push that many patches."
660 (stgit-capture-output nil (stgit-run "push" "-n"
661 (number-to-string npatches)))
663 (stgit-refresh-git-status))
665 (defun stgit-pop-next (npatches)
666 "Pop the topmost applied patch.
667 With numeric prefix argument, pop that many patches."
669 (stgit-capture-output nil (stgit-run "pop" "-n" (number-to-string npatches)))
671 (stgit-refresh-git-status))
673 (defun stgit-applied-at-point ()
674 "Is the patch on the current line applied?"
677 (looking-at "[>+]")))
679 (defun stgit-push-or-pop ()
680 "Push or pop the patch on the current line."
682 (let ((patch (stgit-patch-at-point t))
683 (applied (stgit-applied-at-point)))
684 (stgit-capture-output nil
685 (stgit-run (if applied "pop" "push") patch))
689 "Go to the patch on the current line."
691 (let ((patch (stgit-patch-at-point t)))
692 (stgit-capture-output nil
693 (stgit-run "goto" patch))
696 (defun stgit-id (patch)
697 "Return the git commit id for PATCH"
698 (let ((result (with-output-to-string
699 (stgit-run-silent "id" patch))))
700 (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
701 (error "Cannot find commit id for %s" patch))
702 (match-string 1 result)))
705 "Show the patch on the current line."
707 (stgit-capture-output "*StGit patch*"
708 (let ((patch (stgit-patch-at-point)))
710 (let ((patched-file (stgit-patched-file-at-point t)))
712 (error "No patch or file at point"))
713 (let ((id (stgit-id (symbol-name (car patched-file)))))
714 (with-output-to-temp-buffer "*StGit diff*"
715 (if (consp (cdr patched-file))
716 ;; two files (copy or rename)
717 (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
718 (cadr patched-file) (cddr patched-file))
720 (stgit-run-git "diff" (concat id "^") id "--"
722 (with-current-buffer standard-output
724 (stgit-run "show" (stgit-patch-at-point))
725 (with-current-buffer standard-output
726 (goto-char (point-min))
730 "Edit the patch on the current line."
732 (let ((patch (stgit-patch-at-point t))
733 (edit-buf (get-buffer-create "*StGit edit*"))
734 (dir default-directory))
735 (log-edit 'stgit-confirm-edit t nil edit-buf)
736 (set (make-local-variable 'stgit-edit-patch) patch)
737 (setq default-directory dir)
738 (let ((standard-output edit-buf))
739 (stgit-run-silent "edit" "--save-template=-" patch))))
741 (defun stgit-confirm-edit ()
743 (let ((file (make-temp-file "stgit-edit-")))
744 (write-region (point-min) (point-max) file)
745 (stgit-capture-output nil
746 (stgit-run "edit" "-f" file stgit-edit-patch))
747 (with-current-buffer log-edit-parent-buffer
750 (defun stgit-new (add-sign)
752 With a prefix argument, include a \"Signed-off-by:\" line at the
755 (let ((edit-buf (get-buffer-create "*StGit edit*"))
756 (dir default-directory))
757 (log-edit 'stgit-confirm-new t nil edit-buf)
758 (setq default-directory dir)
761 (let ((standard-output (current-buffer)))
762 (stgit-run-silent "new" "--sign" "--save-template=-"))))))
764 (defun stgit-confirm-new ()
766 (let ((file (make-temp-file "stgit-edit-")))
767 (write-region (point-min) (point-max) file)
768 (stgit-capture-output nil
769 (stgit-run "new" "-f" file))
770 (with-current-buffer log-edit-parent-buffer
773 (defun stgit-create-patch-name (description)
774 "Create a patch name from a long description"
776 (while (> (length description) 0)
777 (cond ((string-match "\\`[a-zA-Z_-]+" description)
778 (setq patch (downcase (concat patch
779 (match-string 0 description))))
780 (setq description (substring description (match-end 0))))
781 ((string-match "\\` +" description)
782 (setq patch (concat patch "-"))
783 (setq description (substring description (match-end 0))))
784 ((string-match "\\`[^a-zA-Z_-]+" description)
785 (setq description (substring description (match-end 0))))))
786 (cond ((= (length patch) 0)
788 ((> (length patch) 20)
789 (substring patch 0 20))
792 (defun stgit-delete (patch-names)
793 "Delete the named patches."
794 (interactive (list (stgit-patches-marked-or-at-point)))
795 (if (zerop (length patch-names))
796 (error "No patches to delete")
797 (when (yes-or-no-p (format "Really delete %d patches? "
798 (length patch-names)))
799 (stgit-capture-output nil
800 (apply 'stgit-run "delete" patch-names))
803 (defun stgit-coalesce (patch-names)
804 "Run stg coalesce on the named patches."
805 (interactive (list (stgit-marked-patches)))
806 (let ((edit-buf (get-buffer-create "*StGit edit*"))
807 (dir default-directory))
808 (log-edit 'stgit-confirm-coalesce t nil edit-buf)
809 (set (make-local-variable 'stgit-patches) patch-names)
810 (setq default-directory dir)
811 (let ((standard-output edit-buf))
812 (apply 'stgit-run-silent "coalesce" "--save-template=-" patch-names))))
814 (defun stgit-confirm-coalesce ()
816 (let ((file (make-temp-file "stgit-edit-")))
817 (write-region (point-min) (point-max) file)
818 (stgit-capture-output nil
819 (apply 'stgit-run "coalesce" "-f" file stgit-patches))
820 (with-current-buffer log-edit-parent-buffer
822 ;; Go to first marked patch and stay there
823 (goto-char (point-min))
824 (re-search-forward (concat "^[>+-]\\*") nil t)
825 (move-to-column goal-column)
831 "Display help for the StGit mode."
833 (describe-function 'stgit-mode))
835 (defun stgit-undo (&optional arg)
837 With prefix argument, run it with the --hard flag."
839 (stgit-capture-output nil
841 (stgit-run "undo" "--hard")
845 (defun stgit-refresh (&optional arg)
847 With prefix argument, refresh the marked patch or the patch under point."
849 (let ((patchargs (if arg
850 (let ((patches (stgit-patches-marked-or-at-point)))
851 (cond ((null patches)
852 (error "No patch to update"))
853 ((> (length patches) 1)
854 (error "Too many patches selected"))
856 (cons "-p" patches))))
858 (stgit-capture-output nil
859 (apply 'stgit-run "refresh" patchargs))
860 (stgit-refresh-git-status))