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 (&rest args
)
72 (apply 'call-process
"stg" nil standard-output nil args
))
74 (defun stgit-refresh ()
75 "Update the contents of the stgit buffer"
77 (let ((inhibit-read-only t
)
78 (curline (line-number-at-pos))
79 (curpatch (stgit-patch-at-point)))
83 (stgit-run "series" "--description")
86 (stgit-goto-patch curpatch
)
87 (goto-line curline
))))
89 (defface stgit-description-face
90 '((((background dark
)) (:foreground
"tan"))
91 (((background light
)) (:foreground
"dark red")))
92 "The face used for StGit desriptions")
94 (defface stgit-top-patch-face
95 '((((background dark
)) (:weight bold
:foreground
"yellow"))
96 (((background light
)) (:weight bold
:foreground
"purple"))
98 "The face used for the top patch names")
100 (defface stgit-applied-patch-face
101 '((((background dark
)) (:foreground
"light yellow"))
102 (((background light
)) (:foreground
"purple"))
104 "The face used for applied patch names")
106 (defface stgit-unapplied-patch-face
107 '((((background dark
)) (:foreground
"gray80"))
108 (((background light
)) (:foreground
"orchid"))
110 "The face used for unapplied patch names")
112 (defun stgit-rescan ()
113 "Rescan the status buffer."
116 (goto-char (point-min))
118 (cond ((looking-at "Branch: \\(.*\\)")
119 (put-text-property (match-beginning 1) (match-end 1)
121 ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
122 (let ((state (match-string 1))
123 (patchsym (intern (match-string 3))))
125 (match-beginning 3) (match-end 3) 'face
126 (cond ((string= state
">") 'stgit-top-patch-face
)
127 ((string= state
"+") 'stgit-applied-patch-face
)
128 ((string= state
"-") 'stgit-unapplied-patch-face
)))
129 (put-text-property (match-beginning 4) (match-end 4)
130 'face
'stgit-description-face
)
131 (when (memq patchsym stgit-marked-patches
)
132 (replace-match "*" nil nil nil
2)
133 (setq marked
(cons patchsym marked
))))))
135 (setq stgit-marked-patches
(nreverse marked
)))))
137 (defvar stgit-mode-hook nil
138 "Run after `stgit-mode' is setup.")
140 (defvar stgit-mode-map nil
141 "Keymap for StGit major mode.")
143 (unless stgit-mode-map
144 (setq stgit-mode-map
(make-keymap))
145 (suppress-keymap stgit-mode-map
)
146 (define-key stgit-mode-map
" " 'stgit-mark
)
147 (define-key stgit-mode-map
"\d" 'stgit-unmark
)
148 (define-key stgit-mode-map
"?" 'stgit-help
)
149 (define-key stgit-mode-map
"h" 'stgit-help
)
150 (define-key stgit-mode-map
"p" 'previous-line
)
151 (define-key stgit-mode-map
"n" 'next-line
)
152 (define-key stgit-mode-map
"g" 'stgit-refresh
)
153 (define-key stgit-mode-map
"r" 'stgit-rename
)
154 (define-key stgit-mode-map
"e" 'stgit-edit
)
155 (define-key stgit-mode-map
"c" 'stgit-coalesce
)
156 (define-key stgit-mode-map
"N" 'stgit-new
)
157 (define-key stgit-mode-map
"R" 'stgit-repair
)
158 (define-key stgit-mode-map
"C" 'stgit-commit
)
159 (define-key stgit-mode-map
"U" 'stgit-uncommit
)
160 (define-key stgit-mode-map
">" 'stgit-push-next
)
161 (define-key stgit-mode-map
"<" 'stgit-pop-next
)
162 (define-key stgit-mode-map
"P" 'stgit-push-or-pop
)
163 (define-key stgit-mode-map
"G" 'stgit-goto
)
164 (define-key stgit-mode-map
"=" 'stgit-show
)
165 (define-key stgit-mode-map
"D" 'stgit-delete
))
168 "Major mode for interacting with StGit.
171 (kill-all-local-variables)
172 (buffer-disable-undo)
173 (setq mode-name
"StGit"
174 major-mode
'stgit-mode
176 (use-local-map stgit-mode-map
)
177 (set (make-local-variable 'list-buffers-directory
) default-directory
)
178 (set (make-local-variable 'stgit-marked-patches
) nil
)
179 (set-variable 'truncate-lines
't
)
180 (run-hooks 'stgit-mode-hook
))
182 (defun stgit-add-mark (patch)
183 (let ((patchsym (intern patch
)))
184 (setq stgit-marked-patches
(cons patchsym stgit-marked-patches
))))
186 (defun stgit-remove-mark (patch)
187 (let ((patchsym (intern patch
)))
188 (setq stgit-marked-patches
(delq patchsym stgit-marked-patches
))))
190 (defun stgit-marked-patches ()
191 "Return the names of the marked patches."
192 (mapcar 'symbol-name stgit-marked-patches
))
194 (defun stgit-patch-at-point ()
195 "Return the patch name on the current line"
198 (if (looking-at "[>+-][ *]\\([^ ]*\\)")
199 (match-string-no-properties 1)
202 (defun stgit-patches-marked-or-at-point ()
203 "Return the names of the marked patches, or the patch on the current line."
204 (if stgit-marked-patches
205 (stgit-marked-patches)
206 (let ((patch (stgit-patch-at-point)))
211 (defun stgit-goto-patch (patch)
212 "Move point to the line containing PATCH"
214 (goto-char (point-min))
215 (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch
) " ") nil t
)
216 (progn (move-to-column goal-column
)
222 "Mark the patch under point"
224 (let ((patch (stgit-patch-at-point)))
225 (stgit-add-mark patch
)
229 (defun stgit-unmark ()
230 "Mark the patch on the previous line"
233 (let ((patch (stgit-patch-at-point)))
234 (stgit-remove-mark patch
)
237 (defun stgit-rename (name)
238 "Rename the patch under point"
239 (interactive (list (read-string "Patch name: " (stgit-patch-at-point))))
240 (let ((old-name (stgit-patch-at-point)))
242 (error "No patch on this line"))
243 (stgit-capture-output nil
244 (stgit-run "rename" old-name name
))
246 (stgit-goto-patch name
)))
248 (defun stgit-repair ()
251 (stgit-capture-output nil
252 (stgit-run "repair"))
255 (defun stgit-commit ()
258 (stgit-capture-output nil
(stgit-run "commit"))
261 (defun stgit-uncommit (arg)
262 "Run stg uncommit. Numeric arg determines number of patches to uncommit."
264 (stgit-capture-output nil
(stgit-run "uncommit" "-n" (number-to-string arg
)))
267 (defun stgit-push-next ()
268 "Push the first unapplied patch"
270 (stgit-capture-output nil
(stgit-run "push"))
273 (defun stgit-pop-next ()
274 "Pop the topmost applied patch"
276 (stgit-capture-output nil
(stgit-run "pop"))
279 (defun stgit-applied-at-point ()
280 "Is the patch on the current line applied?"
283 (looking-at "[>+]")))
285 (defun stgit-push-or-pop ()
286 "Push or pop the patch on the current line"
288 (let ((patch (stgit-patch-at-point))
289 (applied (stgit-applied-at-point)))
290 (stgit-capture-output nil
291 (stgit-run (if applied
"pop" "push") patch
))
295 "Go to the patch on the current line"
297 (let ((patch (stgit-patch-at-point)))
298 (stgit-capture-output nil
299 (stgit-run "goto" patch
))
303 "Show the patch on the current line"
305 (stgit-capture-output "*StGit patch*"
306 (stgit-run "show" (stgit-patch-at-point))
307 (with-current-buffer standard-output
308 (goto-char (point-min))
312 "Edit the patch on the current line"
314 (let ((patch (stgit-patch-at-point))
315 (edit-buf (get-buffer-create "*StGit edit*"))
316 (dir default-directory
))
317 (log-edit 'stgit-confirm-edit t nil edit-buf
)
318 (set (make-local-variable 'stgit-edit-patch
) patch
)
319 (setq default-directory dir
)
320 (let ((standard-output edit-buf
))
321 (stgit-run "edit" "--save-template=-" patch
))))
323 (defun stgit-confirm-edit ()
325 (let ((file (make-temp-file "stgit-edit-")))
326 (write-region (point-min) (point-max) file
)
327 (stgit-capture-output nil
328 (stgit-run "edit" "-f" file stgit-edit-patch
))
329 (with-current-buffer log-edit-parent-buffer
335 (let ((edit-buf (get-buffer-create "*StGit edit*")))
336 (log-edit 'stgit-confirm-new t nil edit-buf
)))
338 (defun stgit-confirm-new ()
340 (let ((file (make-temp-file "stgit-edit-")))
341 (write-region (point-min) (point-max) file
)
342 (stgit-capture-output nil
343 (stgit-run "new" "-f" file
))
344 (with-current-buffer log-edit-parent-buffer
347 (defun stgit-create-patch-name (description)
348 "Create a patch name from a long description"
350 (while (> (length description
) 0)
351 (cond ((string-match "\\`[a-zA-Z_-]+" description
)
352 (setq patch
(downcase (concat patch
(match-string 0 description
))))
353 (setq description
(substring description
(match-end 0))))
354 ((string-match "\\` +" description
)
355 (setq patch
(concat patch
"-"))
356 (setq description
(substring description
(match-end 0))))
357 ((string-match "\\`[^a-zA-Z_-]+" description
)
358 (setq description
(substring description
(match-end 0))))))
359 (cond ((= (length patch
) 0)
361 ((> (length patch
) 20)
362 (substring patch
0 20))
365 (defun stgit-delete (patch-names)
366 "Delete the named patches"
367 (interactive (list (stgit-patches-marked-or-at-point)))
368 (if (zerop (length patch-names
))
369 (error "No patches to delete")
370 (when (yes-or-no-p (format "Really delete %d patches? "
371 (length patch-names
)))
372 (stgit-capture-output nil
373 (apply 'stgit-run
"delete" patch-names
))
376 (defun stgit-coalesce (patch-names)
377 "Run stg coalesce on the named patches"
378 (interactive (list (stgit-marked-patches)))
379 (let ((edit-buf (get-buffer-create "*StGit edit*"))
380 (dir default-directory
))
381 (log-edit 'stgit-confirm-coalesce t nil edit-buf
)
382 (set (make-local-variable 'stgit-patches
) patch-names
)
383 (setq default-directory dir
)
384 (let ((standard-output edit-buf
))
385 (apply 'stgit-run
"coalesce" "--save-template=-" patch-names
))))
387 (defun stgit-confirm-coalesce ()
389 (let ((file (make-temp-file "stgit-edit-")))
390 (write-region (point-min) (point-max) file
)
391 (stgit-capture-output nil
392 (apply 'stgit-run
"coalesce" "-f" file stgit-patches
))
393 (with-current-buffer log-edit-parent-buffer
397 "Display help for the StGit mode."
399 (describe-function 'stgit-mode
))