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'
13 "Manage stgit patches"
14 (interactive "DDirectory: \n")
15 (switch-to-stgit-buffer (git-get-top-dir dir))
18 (defun git-get-top-dir (dir)
19 "Retrieve the top-level directory of a git tree."
20 (let ((cdup (with-output-to-string
21 (with-current-buffer standard-output
23 (unless (eq 0 (call-process "git" nil t nil
24 "rev-parse" "--show-cdup"))
25 (error "cannot find top-level git tree for %s." dir))))))
26 (expand-file-name (concat (file-name-as-directory dir)
27 (car (split-string cdup "\n"))))))
29 (defun switch-to-stgit-buffer (dir)
30 "Switch to a (possibly new) buffer displaying StGit patches for DIR"
31 (setq dir (file-name-as-directory dir))
32 (let ((buffers (buffer-list)))
34 (not (with-current-buffer (car buffers)
35 (and (eq major-mode 'stgit-mode)
36 (string= default-directory dir)))))
37 (setq buffers (cdr buffers)))
38 (switch-to-buffer (if buffers
40 (create-stgit-buffer dir)))))
42 (defun create-stgit-buffer (dir)
43 "Create a buffer for showing StGit patches.
44 Argument DIR is the repository path."
45 (let ((buf (create-file-buffer (concat dir "*stgit*")))
46 (inhibit-read-only t))
47 (with-current-buffer buf
48 (setq default-directory dir)
50 (setq buffer-read-only t))
53 (defmacro stgit-capture-output (name &rest body)
54 "Capture StGit output and show it in a window at the end"
55 `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
56 (stgit-dir default-directory)
57 (inhibit-read-only t))
58 (with-current-buffer output-buf
60 (setq default-directory stgit-dir)
61 (setq buffer-read-only t))
62 (let ((standard-output output-buf))
64 (with-current-buffer output-buf
65 (set-buffer-modified-p nil)
66 (setq buffer-read-only t)
67 (if (< (point-min) (point-max))
68 (display-buffer output-buf t)))))
69 (put 'stgit-capture-output 'lisp-indent-function 1)
71 (defun stgit-run-silent (&rest args)
72 (apply 'call-process "stg" nil standard-output nil args))
74 (defun stgit-run (&rest args)
75 (let ((msgcmd (mapconcat #'identity args " ")))
76 (message "Running stg %s..." msgcmd)
77 (apply 'call-process "stg" nil standard-output nil args)
78 (message "Running stg %s...done" msgcmd)))
80 (defun stgit-reload ()
81 "Update the contents of the stgit buffer"
83 (let ((inhibit-read-only t)
84 (curline (line-number-at-pos))
85 (curpatch (stgit-patch-at-point)))
88 (stgit-run-silent "branch")
89 (stgit-run-silent "series" "--description")
92 (stgit-goto-patch curpatch)
93 (goto-line curline))))
95 (defface stgit-description-face
96 '((((background dark)) (:foreground "tan"))
97 (((background light)) (:foreground "dark red")))
98 "The face used for StGit desriptions")
100 (defface stgit-top-patch-face
101 '((((background dark)) (:weight bold :foreground "yellow"))
102 (((background light)) (:weight bold :foreground "purple"))
104 "The face used for the top patch names")
106 (defface stgit-applied-patch-face
107 '((((background dark)) (:foreground "light yellow"))
108 (((background light)) (:foreground "purple"))
110 "The face used for applied patch names")
112 (defface stgit-unapplied-patch-face
113 '((((background dark)) (:foreground "gray80"))
114 (((background light)) (:foreground "orchid"))
116 "The face used for unapplied patch names")
118 (defun stgit-rescan ()
119 "Rescan the status buffer."
122 (goto-char (point-min))
124 (cond ((looking-at "Branch: \\(.*\\)")
125 (put-text-property (match-beginning 1) (match-end 1)
127 ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
128 (let ((state (match-string 1))
129 (patchsym (intern (match-string 3))))
131 (match-beginning 3) (match-end 3) 'face
132 (cond ((string= state ">") 'stgit-top-patch-face)
133 ((string= state "+") 'stgit-applied-patch-face)
134 ((string= state "-") 'stgit-unapplied-patch-face)))
135 (put-text-property (match-beginning 4) (match-end 4)
136 'face 'stgit-description-face)
137 (when (memq patchsym stgit-marked-patches)
138 (replace-match "*" nil nil nil 2)
139 (setq marked (cons patchsym marked)))))
140 ((or (looking-at "stg series: Branch \".*\" not initialised")
141 (looking-at "stg series: .*: branch not initialized"))
143 (insert "Run M-x stgit-init to initialise")))
145 (setq stgit-marked-patches (nreverse marked)))))
148 "Hide the stgit buffer"
152 (defvar stgit-mode-hook nil
153 "Run after `stgit-mode' is setup.")
155 (defvar stgit-mode-map nil
156 "Keymap for StGit major mode.")
158 (unless stgit-mode-map
159 (setq stgit-mode-map (make-keymap))
160 (suppress-keymap stgit-mode-map)
161 (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
164 ("\d" . stgit-unmark)
167 ("p" . previous-line)
170 ("r" . stgit-refresh)
171 ("\C-c\C-r" . stgit-rename)
173 ("c" . stgit-coalesce)
177 ("U" . stgit-uncommit)
178 (">" . stgit-push-next)
179 ("<" . stgit-pop-next)
180 ("P" . stgit-push-or-pop)
184 ([(control ?/)] . stgit-undo)
185 ("\C-_" . stgit-undo)
186 ("q" . stgit-quit))))
189 "Major mode for interacting with StGit.
192 (kill-all-local-variables)
193 (buffer-disable-undo)
194 (setq mode-name "StGit"
195 major-mode 'stgit-mode
197 (use-local-map stgit-mode-map)
198 (set (make-local-variable 'list-buffers-directory) default-directory)
199 (set (make-local-variable 'stgit-marked-patches) nil)
200 (set-variable 'truncate-lines 't)
201 (run-hooks 'stgit-mode-hook))
203 (defun stgit-add-mark (patch)
204 (let ((patchsym (intern patch)))
205 (setq stgit-marked-patches (cons patchsym stgit-marked-patches))))
207 (defun stgit-remove-mark (patch)
208 (let ((patchsym (intern patch)))
209 (setq stgit-marked-patches (delq patchsym stgit-marked-patches))))
211 (defun stgit-clear-marks ()
212 (setq stgit-marked-patches '()))
214 (defun stgit-marked-patches ()
215 "Return the names of the marked patches."
216 (mapcar 'symbol-name stgit-marked-patches))
218 (defun stgit-patch-at-point ()
219 "Return the patch name on the current line"
222 (if (looking-at "[>+-][ *]\\([^ ]*\\)")
223 (match-string-no-properties 1)
226 (defun stgit-patches-marked-or-at-point ()
227 "Return the names of the marked patches, or the patch on the current line."
228 (if stgit-marked-patches
229 (stgit-marked-patches)
230 (let ((patch (stgit-patch-at-point)))
235 (defun stgit-goto-patch (patch)
236 "Move point to the line containing PATCH"
238 (goto-char (point-min))
239 (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t)
240 (progn (move-to-column goal-column)
248 (stgit-capture-output nil
253 "Mark the patch under point"
255 (let ((patch (stgit-patch-at-point)))
256 (stgit-add-mark patch)
260 (defun stgit-unmark ()
261 "Mark the patch on the previous line"
264 (let ((patch (stgit-patch-at-point)))
265 (stgit-remove-mark patch)
268 (defun stgit-rename (name)
269 "Rename the patch under point"
270 (interactive (list (read-string "Patch name: " (stgit-patch-at-point))))
271 (let ((old-name (stgit-patch-at-point)))
273 (error "No patch on this line"))
274 (stgit-capture-output nil
275 (stgit-run "rename" old-name name))
277 (stgit-goto-patch name)))
279 (defun stgit-repair ()
282 (stgit-capture-output nil
283 (stgit-run "repair"))
286 (defun stgit-commit ()
289 (stgit-capture-output nil (stgit-run "commit"))
292 (defun stgit-uncommit (arg)
293 "Run stg uncommit. Numeric arg determines number of patches to uncommit."
295 (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg)))
298 (defun stgit-push-next (npatches)
299 "Push the first unapplied patch.
300 With numeric prefix argument, push that many patches."
302 (stgit-capture-output nil (stgit-run "push" "-n"
303 (number-to-string npatches)))
306 (defun stgit-pop-next (npatches)
307 "Pop the topmost applied patch.
308 With numeric prefix argument, pop that many patches."
310 (stgit-capture-output nil (stgit-run "pop" "-n" (number-to-string npatches)))
313 (defun stgit-applied-at-point ()
314 "Is the patch on the current line applied?"
317 (looking-at "[>+]")))
319 (defun stgit-push-or-pop ()
320 "Push or pop the patch on the current line"
322 (let ((patch (stgit-patch-at-point))
323 (applied (stgit-applied-at-point)))
324 (stgit-capture-output nil
325 (stgit-run (if applied "pop" "push") patch))
329 "Go to the patch on the current line"
331 (let ((patch (stgit-patch-at-point)))
332 (stgit-capture-output nil
333 (stgit-run "goto" patch))
337 "Show the patch on the current line"
339 (stgit-capture-output "*StGit patch*"
340 (stgit-run "show" (stgit-patch-at-point))
341 (with-current-buffer standard-output
342 (goto-char (point-min))
346 "Edit the patch on the current line"
348 (let ((patch (stgit-patch-at-point))
349 (edit-buf (get-buffer-create "*StGit edit*"))
350 (dir default-directory))
351 (log-edit 'stgit-confirm-edit t nil edit-buf)
352 (set (make-local-variable 'stgit-edit-patch) patch)
353 (setq default-directory dir)
354 (let ((standard-output edit-buf))
355 (stgit-run-silent "edit" "--save-template=-" patch))))
357 (defun stgit-confirm-edit ()
359 (let ((file (make-temp-file "stgit-edit-")))
360 (write-region (point-min) (point-max) file)
361 (stgit-capture-output nil
362 (stgit-run "edit" "-f" file stgit-edit-patch))
363 (with-current-buffer log-edit-parent-buffer
369 (let ((edit-buf (get-buffer-create "*StGit edit*")))
370 (log-edit 'stgit-confirm-new t nil edit-buf)))
372 (defun stgit-confirm-new ()
374 (let ((file (make-temp-file "stgit-edit-")))
375 (write-region (point-min) (point-max) file)
376 (stgit-capture-output nil
377 (stgit-run "new" "-f" file))
378 (with-current-buffer log-edit-parent-buffer
381 (defun stgit-create-patch-name (description)
382 "Create a patch name from a long description"
384 (while (> (length description) 0)
385 (cond ((string-match "\\`[a-zA-Z_-]+" description)
386 (setq patch (downcase (concat patch (match-string 0 description))))
387 (setq description (substring description (match-end 0))))
388 ((string-match "\\` +" description)
389 (setq patch (concat patch "-"))
390 (setq description (substring description (match-end 0))))
391 ((string-match "\\`[^a-zA-Z_-]+" description)
392 (setq description (substring description (match-end 0))))))
393 (cond ((= (length patch) 0)
395 ((> (length patch) 20)
396 (substring patch 0 20))
399 (defun stgit-delete (patch-names)
400 "Delete the named patches"
401 (interactive (list (stgit-patches-marked-or-at-point)))
402 (if (zerop (length patch-names))
403 (error "No patches to delete")
404 (when (yes-or-no-p (format "Really delete %d patches? "
405 (length patch-names)))
406 (stgit-capture-output nil
407 (apply 'stgit-run "delete" patch-names))
410 (defun stgit-coalesce (patch-names)
411 "Run stg coalesce on the named patches"
412 (interactive (list (stgit-marked-patches)))
413 (let ((edit-buf (get-buffer-create "*StGit edit*"))
414 (dir default-directory))
415 (log-edit 'stgit-confirm-coalesce t nil edit-buf)
416 (set (make-local-variable 'stgit-patches) patch-names)
417 (setq default-directory dir)
418 (let ((standard-output edit-buf))
419 (apply 'stgit-run-silent "coalesce" "--save-template=-" patch-names))))
421 (defun stgit-confirm-coalesce ()
423 (let ((file (make-temp-file "stgit-edit-")))
424 (write-region (point-min) (point-max) file)
425 (stgit-capture-output nil
426 (apply 'stgit-run "coalesce" "-f" file stgit-patches))
427 (with-current-buffer log-edit-parent-buffer
429 ;; Go to first marked patch and stay there
430 (goto-char (point-min))
431 (re-search-forward (concat "^[>+-]\\*") nil t)
432 (move-to-column goal-column)
438 "Display help for the StGit mode."
440 (describe-function 'stgit-mode))
442 (defun stgit-undo (&optional arg)
444 With prefix argument, run it with the --hard flag."
446 (stgit-capture-output nil
448 (stgit-run "undo" "--hard")
452 (defun stgit-refresh (&optional arg)
454 With prefix argument, refresh the patch under point."
456 (let ((patchargs (if arg
457 (let ((patches (stgit-patches-marked-or-at-point)))
458 (cond ((null patches)
459 (error "no patch to update"))
460 ((> (length patches) 1)
461 (error "too many patches selected"))
463 (cons "-p" patches))))
465 (stgit-capture-output nil
466 (apply 'stgit-run "refresh" patchargs)))