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