stgit.el: Make C-{up,down} move between groups of patches
[stgit] / contrib / stgit.el
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
12 (when (< emacs-major-version 22)
13 (error "Emacs older than 22 is not supported by stgit.el"))
14
15 (require 'git nil t)
16 (require 'cl)
17 (require 'comint)
18 (require 'ewoc)
19 (require 'easymenu)
20 (require 'format-spec)
21
22 (defun stgit-set-default (symbol value)
23 "Set default value of SYMBOL to VALUE using `set-default' and
24 reload all StGit buffers."
25 (set-default symbol value)
26 (dolist (buf (buffer-list))
27 (with-current-buffer buf
28 (when (eq major-mode 'stgit-mode)
29 (stgit-reload)))))
30
31 (defgroup stgit nil
32 "A user interface for the StGit patch maintenance tool."
33 :group 'tools
34 :link '(function-link stgit)
35 :link '(url-link "http://www.procode.org/stgit/"))
36
37 (defcustom stgit-abbreviate-copies-and-renames t
38 "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\"
39 instead of \"dir/old/file -> dir/new/file\"."
40 :type 'boolean
41 :group 'stgit
42 :set 'stgit-set-default)
43
44 (defcustom stgit-default-show-worktree t
45 "Set to non-nil to by default show the working tree in a new stgit buffer.
46
47 Use \\<stgit-mode-map>\\[stgit-toggle-worktree] to toggle this \
48 setting in an already-started StGit buffer."
49 :type 'boolean
50 :group 'stgit
51 :link '(variable-link stgit-show-worktree))
52
53 (defcustom stgit-default-show-unknown nil
54 "Set to non-nil to by default show unknown files a new stgit buffer.
55
56 Use \\<stgit-mode-map>\\[stgit-toggle-unknown] to toggle this \
57 setting in an already-started StGit buffer."
58 :type 'boolean
59 :group 'stgit
60 :link '(variable-link stgit-show-unknown))
61
62 (defcustom stgit-default-show-ignored nil
63 "Set to non-nil to by default show ignored files a new stgit buffer.
64
65 Use \\<stgit-mode-map>\\[stgit-toggle-ignored] to toggle this \
66 setting in an already-started StGit buffer."
67 :type 'boolean
68 :group 'stgit
69 :link '(variable-link stgit-show-ignored))
70
71 (defcustom stgit-default-show-svn t
72 "Set to non-nil to by default show subversion information in a
73 new stgit buffer.
74
75 Use \\<stgit-mode-map>\\[stgit-toggle-svn] to toggle this \
76 setting in an already-started StGit buffer."
77 :type 'boolean
78 :group 'stgit
79 :link '(variable-link stgit-show-worktree))
80
81 (defcustom stgit-find-copies-harder nil
82 "Try harder to find copied files when listing patches.
83
84 When not nil, runs git diff-tree with the --find-copies-harder
85 flag, which reduces performance."
86 :type 'boolean
87 :group 'stgit
88 :set 'stgit-set-default)
89
90 (defcustom stgit-show-worktree-mode 'center
91 "This variable controls where the \"Index\" and \"Work tree\"
92 will be shown on in the buffer.
93
94 It can be set to 'top (above all patches), 'center (show between
95 applied and unapplied patches), and 'bottom (below all patches)."
96 :type '(radio (const :tag "above all patches (top)" top)
97 (const :tag "between applied and unapplied patches (center)"
98 center)
99 (const :tag "below all patches (bottom)" bottom))
100 :group 'stgit
101 :link '(variable-link stgit-show-worktree)
102 :set 'stgit-set-default)
103
104 (defcustom stgit-patch-line-format "%s%m%-30n %e%d"
105 "The format string used to format patch lines.
106 The format string is passed to `format-spec' and the following
107 format characters are recognized:
108
109 %s - A '+', '-', '>' or space, depending on whether the patch is
110 applied, unapplied, top, or something else.
111
112 %m - An asterisk if the patch is marked, and a space otherwise.
113
114 %n - The patch name.
115
116 %e - The string \"(empty) \" if the patch is empty.
117
118 %d - The short patch description.
119
120 %D - The short patch description, or the patch name.
121
122 When `stgit-show-patch-names' is non-nil, the `stgit-noname-patch-line-format'
123 variable is used instead."
124 :type 'string
125 :group 'stgit
126 :set 'stgit-set-default)
127
128 (defcustom stgit-noname-patch-line-format "%s%m%e%D"
129 "The alternate format string used to format patch lines.
130 It has the same semantics as `stgit-patch-line-format', and the
131 display can be toggled between the two formats using \
132 \\<stgit-mode-map>\\[stgit-toggle-patch-names].
133
134 The alternate form is used when the patch name is hidden."
135 :type 'string
136 :group 'stgit
137 :set 'stgit-set-default)
138
139 (defcustom stgit-default-show-committed nil
140 "Set to nil to inhibit showing of historical git commits by default.
141
142 Use \\<stgit-mode-map>\\[stgit-toggle-committed] \
143 to toggle this setting and to control how many commits are
144 shown."
145 :type 'boolean
146 :group 'stgit
147 :link '(variable-link stgit-default-committed-count)
148 :link '(variable-link stgit-show-committed))
149
150 (defcustom stgit-default-committed-count 5
151 "The number of historical commits to show when `stgit-show-committed'
152 is enabled."
153 :type 'number
154 :link '(variable-link stgit-default-show-committed)
155 :link '(variable-link stgit-committed-count))
156
157 (defcustom stgit-default-show-patch-names t
158 "If non-nil, default to showing patch names in a new stgit buffer.
159
160 Use \\<stgit-mode-map>\\[stgit-toggle-patch-names] \
161 to toggle the this setting in an already-started StGit buffer."
162 :type 'boolean
163 :group 'stgit
164 :link '(variable-link stgit-show-patch-names))
165
166 (defcustom stgit-file-line-format " %-11s %-2m %n %c"
167 "The format string used to format file lines.
168 The format string is passed to `format-spec' and the following
169 format characters are recognized:
170
171 %s - A string describing the status of the file.
172
173 %m - Mode change information
174
175 %n - The file name.
176
177 %c - A description of file changes."
178 :type 'string
179 :group 'stgit
180 :set 'stgit-set-default)
181
182 (defface stgit-branch-name-face
183 '((t :inherit bold))
184 "The face used for the StGit branch name"
185 :group 'stgit)
186
187 (defface stgit-top-patch-face
188 '((((background dark)) (:weight bold :foreground "yellow"))
189 (((background light)) (:weight bold :foreground "purple"))
190 (t (:weight bold)))
191 "The face used for the top patch names"
192 :group 'stgit)
193
194 (defface stgit-applied-patch-face
195 '((((background dark)) (:foreground "light yellow"))
196 (((background light)) (:foreground "purple"))
197 (t ()))
198 "The face used for applied patch names"
199 :group 'stgit)
200
201 (defface stgit-unapplied-patch-face
202 '((((background dark)) (:foreground "gray80"))
203 (((background light)) (:foreground "orchid"))
204 (t ()))
205 "The face used for unapplied patch names"
206 :group 'stgit)
207
208 (defface stgit-committed-patch-face
209 '((((background dark)) (:foreground "gray50"))
210 (((background light)) (:foreground "gray50"))
211 (t ()))
212 "The face used for already committed patch names"
213 :group 'stgit)
214
215 (defface stgit-description-face
216 '((((background dark)) (:foreground "tan"))
217 (((background light)) (:foreground "dark red")))
218 "The face used for StGit descriptions"
219 :group 'stgit)
220
221 (defface stgit-index-work-tree-title-face
222 '((((supports :slant italic)) :slant italic)
223 (t :inherit bold))
224 "StGit mode face used for the \"Index\" and \"Work tree\" titles"
225 :group 'stgit)
226
227 (defface stgit-unmerged-file-face
228 '((((class color) (background light)) (:foreground "red" :bold t))
229 (((class color) (background dark)) (:foreground "red" :bold t)))
230 "StGit mode face used for unmerged file status"
231 :group 'stgit)
232
233 (defface stgit-unknown-file-face
234 '((((class color) (background light)) (:foreground "goldenrod" :bold t))
235 (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
236 "StGit mode face used for unknown file status"
237 :group 'stgit)
238
239 (defface stgit-ignored-file-face
240 '((((class color) (background light)) (:foreground "grey60"))
241 (((class color) (background dark)) (:foreground "grey40")))
242 "StGit mode face used for ignored files")
243
244 (defface stgit-file-permission-face
245 '((((class color) (background light)) (:foreground "green" :bold t))
246 (((class color) (background dark)) (:foreground "green" :bold t)))
247 "StGit mode face used for permission changes."
248 :group 'stgit)
249
250 (defface stgit-modified-file-face
251 '((((class color) (background light)) (:foreground "purple"))
252 (((class color) (background dark)) (:foreground "salmon")))
253 "StGit mode face used for modified file status"
254 :group 'stgit)
255
256 (defun stgit (dir)
257 "Manage StGit patches for the tree in DIR.
258
259 See `stgit-mode' for commands available."
260 (interactive "DDirectory: \n")
261 (switch-to-stgit-buffer (git-get-top-dir dir))
262 (stgit-reload))
263
264 (defun stgit-assert-mode ()
265 "Signal an error if not in an StGit buffer."
266 (assert (derived-mode-p 'stgit-mode) nil "Not an StGit buffer"))
267
268 (unless (fboundp 'git-get-top-dir)
269 (defun git-get-top-dir (dir)
270 "Retrieve the top-level directory of a git tree."
271 (let ((cdup (with-output-to-string
272 (with-current-buffer standard-output
273 (cd dir)
274 (unless (eq 0 (call-process "git" nil t nil
275 "rev-parse" "--show-cdup"))
276 (error "Cannot find top-level git tree for %s" dir))))))
277 (expand-file-name (concat (file-name-as-directory dir)
278 (car (split-string cdup "\n")))))))
279
280 (defun stgit-refresh-git-status (&optional dir)
281 "If it exists, refresh the `git-status' buffer belonging to
282 directory DIR or `default-directory'"
283 (when (and (fboundp 'git-find-status-buffer)
284 (fboundp 'git-refresh-status))
285 (let* ((top-dir (git-get-top-dir (or dir default-directory)))
286 (git-status-buffer (and top-dir (git-find-status-buffer top-dir))))
287 (when git-status-buffer
288 (with-current-buffer git-status-buffer
289 (git-refresh-status))))))
290
291 (defun stgit-find-buffer (dir)
292 "Return the buffer displaying StGit patches for DIR, or nil if none."
293 (setq dir (file-name-as-directory dir))
294 (let ((buffers (buffer-list)))
295 (while (and buffers
296 (not (with-current-buffer (car buffers)
297 (and (eq major-mode 'stgit-mode)
298 (string= default-directory dir)))))
299 (setq buffers (cdr buffers)))
300 (and buffers (car buffers))))
301
302 (defun switch-to-stgit-buffer (dir)
303 "Switch to a (possibly new) buffer displaying StGit patches for DIR."
304 (setq dir (file-name-as-directory dir))
305 (let ((buffer (stgit-find-buffer dir)))
306 (switch-to-buffer (or buffer
307 (create-stgit-buffer dir)))))
308
309 (defstruct (stgit-patch
310 (:conc-name stgit-patch->))
311 status name desc empty files-ewoc)
312
313 (defun stgit-patch-display-name (patch)
314 (let ((name (stgit-patch->name patch)))
315 (case name
316 (:index "Index")
317 (:work "Work Tree")
318 (t (symbol-name name)))))
319
320 (defun stgit-insert-without-trailing-whitespace (text)
321 "Insert TEXT in buffer using `insert', without trailing whitespace.
322 A newline is appended."
323 (unless (string-match "\\(.*?\\) *$" text)
324 (error))
325 (insert (match-string 1 text) ?\n))
326
327 (defun stgit-line-format ()
328 "Return the current line format; one of
329 `stgit-patch-line-format' and `stgit-noname-patch-line-format'"
330 (if stgit-show-patch-names
331 stgit-patch-line-format
332 stgit-noname-patch-line-format))
333
334 (defun stgit-patch-pp (patch)
335 (let* ((status (stgit-patch->status patch))
336 (start (point))
337 (name (stgit-patch->name patch))
338 (face (cdr (assq status stgit-patch-status-face-alist)))
339 (fmt (stgit-line-format))
340 (spec (format-spec-make
341 ?s (case status
342 ('applied "+")
343 ('top ">")
344 ('unapplied "-")
345 (t " "))
346 ?m (if (memq name stgit-marked-patches)
347 "*" " ")
348 ?n (propertize (stgit-patch-display-name patch)
349 'face face
350 'syntax-table (string-to-syntax "w"))
351 ?e (if (stgit-patch->empty patch) "(empty) " "")
352 ?d (propertize (or (stgit-patch->desc patch) "")
353 'face 'stgit-description-face)
354 ?D (propertize (let ((desc (stgit-patch->desc patch)))
355 (if (zerop (length desc))
356 (stgit-patch-display-name patch)
357 desc))
358 'face face)))
359 (text (format-spec fmt spec)))
360
361 (stgit-insert-without-trailing-whitespace text)
362 (put-text-property start (point) 'entry-type 'patch)
363 (when (memq name stgit-expanded-patches)
364 (stgit-insert-patch-files patch))
365 (put-text-property start (point) 'patch-data patch)))
366
367 (defun create-stgit-buffer (dir)
368 "Create a buffer for showing StGit patches.
369 Argument DIR is the repository path."
370 (let ((buf (create-file-buffer (concat dir "*stgit*")))
371 (inhibit-read-only t))
372 (with-current-buffer buf
373 (setq default-directory dir)
374 (stgit-mode)
375 (set (make-local-variable 'stgit-ewoc)
376 (ewoc-create #'stgit-patch-pp "Branch:\n\n" "--\n" t))
377 (setq buffer-read-only t))
378 buf))
379
380 (def-edebug-spec stgit-capture-output
381 (form body))
382 (defmacro stgit-capture-output (name &rest body)
383 "Capture StGit output and, if there was any output, show it in a window
384 at the end.
385 Returns nil if there was no output."
386 (declare (debug ([&or stringp null] body))
387 (indent 1))
388 `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
389 (stgit-dir default-directory)
390 (inhibit-read-only t))
391 (with-current-buffer output-buf
392 (buffer-disable-undo)
393 (erase-buffer)
394 (setq default-directory stgit-dir)
395 (setq buffer-read-only t))
396 (let ((standard-output output-buf))
397 ,@body)
398 (with-current-buffer output-buf
399 (set-buffer-modified-p nil)
400 (setq buffer-read-only t)
401 (if (< (point-min) (point-max))
402 (display-buffer output-buf t)))))
403
404 (defun stgit-make-run-args (args)
405 "Return a copy of ARGS with its elements converted to strings."
406 (mapcar (lambda (x)
407 ;; don't use (format "%s" ...) to limit type errors
408 (cond ((stringp x) x)
409 ((integerp x) (number-to-string x))
410 ((symbolp x) (symbol-name x))
411 (t
412 (error "Bad element in stgit-make-run-args args: %S" x))))
413 args))
414
415 (defvar stgit-inhibit-messages nil
416 "Set to non-nil to inhibit messages when running `stg' commands.
417 See also `stgit-message'.")
418 (defun stgit-message (format-spec &rest args)
419 "Call `message' on the arguments unless `stgit-inhibit-messages' is non-nil."
420 (unless stgit-inhibit-messages
421 (apply 'message format-spec args)))
422
423 (defun stgit-run (&rest args)
424 (setq args (stgit-make-run-args args))
425 (let ((msgcmd (mapconcat #'identity args " ")))
426 (stgit-message "Running stg %s..." msgcmd)
427 (prog1
428 (apply 'call-process "stg" nil standard-output nil args)
429 (stgit-message "Running stg %s...done" msgcmd))))
430
431 (defun stgit-run-silent (&rest args)
432 (let ((stgit-inhibit-messages t))
433 (apply 'stgit-run args)))
434
435 (defun stgit-run-git (&rest args)
436 (setq args (stgit-make-run-args args))
437 (let ((msgcmd (mapconcat #'identity args " ")))
438 (stgit-message "Running git %s..." msgcmd)
439 (prog1
440 (apply 'call-process "git" nil standard-output nil args)
441 (stgit-message "Running git %s...done" msgcmd))))
442
443 (defun stgit-run-git-silent (&rest args)
444 (let ((stgit-inhibit-messages t))
445 (apply 'stgit-run-git args)))
446
447 (defun stgit-index-empty-p ()
448 "Returns non-nil if the index contains no changes from HEAD."
449 (zerop (stgit-run-git-silent "diff-index" "--cached" "--quiet" "HEAD")))
450
451 (defun stgit-work-tree-empty-p ()
452 "Returns non-nil if the work tree contains no changes from index."
453 (zerop (stgit-run-git-silent "diff-files" "--quiet")))
454
455 (defvar stgit-did-advise nil
456 "Set to non-nil if appropriate (non-stgit) git functions have
457 been advised to update the stgit status when necessary.")
458
459 (defconst stgit-allowed-branch-name-re
460 ;; Disallow control characters, space, del, and "/:@^{}~" in
461 ;; "/"-separated parts; parts may not start with a period (.)
462 "^[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\
463 \\(/[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\\)*$"
464 "Regular expression that (new) branch names must match.")
465
466 (defun stgit-refresh-index ()
467 (when stgit-index-node
468 (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node))))
469
470 (defun stgit-refresh-worktree ()
471 (when stgit-worktree-node
472 (ewoc-invalidate (car stgit-worktree-node) (cdr stgit-worktree-node))))
473
474 (defun stgit-run-series-insert-index (ewoc)
475 (setq index-node (cons ewoc (ewoc-enter-last ewoc
476 (make-stgit-patch
477 :status 'index
478 :name :index
479 :desc nil
480 :empty nil)))
481 worktree-node (cons ewoc (ewoc-enter-last ewoc
482 (make-stgit-patch
483 :status 'work
484 :name :work
485 :desc nil
486 :empty nil)))))
487
488 (defun stgit-svn-find-rev (sha1 hash)
489 "Return the subversion revision corresponding to SHA1 as
490 reported by git svn.
491
492 Cached data is stored in HASH, which must have been created
493 using (make-hash-table :test 'equal)."
494 (let ((result (gethash sha1 hash t)))
495 (when (eq result t)
496 (let ((svn-rev (with-output-to-string
497 (stgit-run-git-silent "svn" "find-rev"
498 "--" sha1))))
499 (setq result (when (string-match "\\`[0-9]+" svn-rev)
500 (string-to-number (match-string 0 svn-rev))))
501 (puthash sha1 result hash)))
502 result))
503
504 (defun stgit-run-series (ewoc)
505 (setq stgit-index-node nil
506 stgit-worktree-node nil)
507 (let (all-patchsyms)
508 (when stgit-show-committed
509 (let* ((show-svn stgit-show-svn)
510 (svn-hash stgit-svn-find-rev-hash)
511 (base (stgit-id "{base}"))
512 (range (format "%s~%d..%s" base stgit-committed-count base)))
513 (with-temp-buffer
514 (let* ((standard-output (current-buffer))
515 (fmt (stgit-line-format))
516 (commit-abbrev (when (string-match "%-\\([0-9]+\\)n" fmt)
517 (string-to-number (match-string 1 fmt))))
518 (exit-status (stgit-run-git-silent "--no-pager" "log"
519 "--reverse"
520 "--pretty=oneline"
521 range)))
522 (goto-char (point-min))
523 (if (not (zerop exit-status))
524 (message "Failed to run git log")
525 (while (not (eobp))
526 (unless (looking-at
527 "\\([0-9a-f]+\\)\\(\\.\\.\\.\\)? \\(.*\\)")
528 (error "Syntax error in output from git log"))
529 (let* ((state 'committed)
530 (name (match-string 1))
531 (desc (match-string 3))
532 (empty nil))
533
534 (when show-svn
535 (let ((svn-rev (stgit-svn-find-rev name svn-hash)))
536 (when svn-rev
537 (setq desc (format "(r%s) %s" svn-rev desc)))))
538
539 (and commit-abbrev
540 (< commit-abbrev (length name))
541 (setq name (substring name 0 commit-abbrev)))
542
543 (setq name (intern name))
544
545 (setq all-patchsyms (cons name all-patchsyms))
546 (ewoc-enter-last ewoc
547 (make-stgit-patch
548 :status state
549 :name name
550 :desc desc
551 :empty empty)))
552 (forward-line 1)))))))
553 (let ((inserted-index (not stgit-show-worktree))
554 index-node
555 worktree-node)
556 (with-temp-buffer
557 (let* ((standard-output (current-buffer))
558 (exit-status (stgit-run-silent "series"
559 "--description" "--empty")))
560 (goto-char (point-min))
561 (if (not (zerop exit-status))
562 (cond ((looking-at "stg series: \\(.*\\)")
563 (setq inserted-index t)
564 (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
565 (substitute-command-keys
566 "-- not initialized; run \\[stgit-init]")))
567 ((looking-at ".*")
568 (error "Error running stg: %s"
569 (match-string 0))))
570 (while (not (eobp))
571 (unless (looking-at
572 "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
573 (error "Syntax error in output from stg series"))
574 (let* ((state-str (match-string 2))
575 (state (cond ((string= state-str ">") 'top)
576 ((string= state-str "+") 'applied)
577 ((string= state-str "-") 'unapplied)))
578 (name (intern (match-string 4)))
579 (desc (match-string 5))
580 (empty (string= (match-string 1) "0")))
581 (unless inserted-index
582 (when (or (eq stgit-show-worktree-mode 'top)
583 (and (eq stgit-show-worktree-mode 'center)
584 (eq state 'unapplied)))
585 (setq inserted-index t)
586 (stgit-run-series-insert-index ewoc)))
587 (setq all-patchsyms (cons name all-patchsyms))
588 (ewoc-enter-last ewoc
589 (make-stgit-patch
590 :status state
591 :name name
592 :desc desc
593 :empty empty)))
594 (forward-line 1)))))
595 (unless inserted-index
596 (stgit-run-series-insert-index ewoc))
597 (setq stgit-index-node index-node
598 stgit-worktree-node worktree-node
599 stgit-marked-patches (intersection stgit-marked-patches
600 all-patchsyms)))))
601
602 (defun stgit-current-branch ()
603 "Return the name of the current branch."
604 (substring (with-output-to-string
605 (stgit-run-silent "branch"))
606 0 -1))
607
608 (defun stgit-reload (&optional description)
609 "Update the contents of the StGit buffer.
610
611 If DESCRIPTION is non-nil, it is displayed as a status message
612 during the operation."
613 (interactive)
614 (stgit-assert-mode)
615 (when description
616 (message "%s..." description))
617 (let ((inhibit-read-only t)
618 (curline (line-number-at-pos))
619 (curpatch (stgit-patch-name-at-point))
620 (curfile (stgit-patched-file-at-point))
621 (stgit-inhibit-messages description))
622 (ewoc-filter stgit-ewoc #'(lambda (x) nil))
623 (ewoc-set-hf stgit-ewoc
624 (concat "Branch: "
625 (propertize (stgit-current-branch)
626 'face 'stgit-branch-name-face)
627 "\n\n")
628 (if stgit-show-worktree
629 "--"
630 (propertize
631 (substitute-command-keys "--\n\"\\[stgit-toggle-worktree]\"\
632 shows the working tree\n")
633 'face 'stgit-description-face)))
634 (stgit-run-series stgit-ewoc)
635 (unless (and curpatch
636 (stgit-goto-patch curpatch
637 (and curfile (stgit-file->file curfile))))
638 (goto-char (point-min))
639 (forward-line (1- curline))
640 (move-to-column (stgit-goal-column)))
641 (stgit-refresh-git-status))
642 (when description
643 (message "%s...done" description)))
644
645 (defconst stgit-file-status-code-strings
646 (mapcar (lambda (arg)
647 (cons (car arg)
648 (propertize (cadr arg) 'face (car (cddr arg)))))
649 '((add "Added" stgit-modified-file-face)
650 (copy "Copied" stgit-modified-file-face)
651 (delete "Deleted" stgit-modified-file-face)
652 (modify "Modified" stgit-modified-file-face)
653 (rename "Renamed" stgit-modified-file-face)
654 (mode-change "Mode change" stgit-modified-file-face)
655 (unmerged "Unmerged" stgit-unmerged-file-face)
656 (unknown "Unknown" stgit-unknown-file-face)
657 (ignore "Ignored" stgit-ignored-file-face)))
658 "Alist of code symbols to description strings")
659
660 (defconst stgit-patch-status-face-alist
661 '((applied . stgit-applied-patch-face)
662 (top . stgit-top-patch-face)
663 (unapplied . stgit-unapplied-patch-face)
664 (committed . stgit-committed-patch-face)
665 (index . stgit-index-work-tree-title-face)
666 (work . stgit-index-work-tree-title-face))
667 "Alist of face to use for a given patch status")
668
669 (defun stgit-file-status-code-as-string (file)
670 "Return stgit status code for FILE as a string"
671 (let* ((code (assq (stgit-file->status file)
672 stgit-file-status-code-strings))
673 (score (stgit-file->cr-score file)))
674 (when code
675 (if (and score (/= score 100))
676 (format "%s %s" (cdr code)
677 (propertize (format "%d%%" score)
678 'face 'stgit-description-face))
679 (cdr code)))))
680
681 (defun stgit-file-status-code (str &optional score)
682 "Return stgit status code from git status string"
683 (let ((code (assoc str '(("A" . add)
684 ("C" . copy)
685 ("D" . delete)
686 ("I" . ignore)
687 ("M" . modify)
688 ("R" . rename)
689 ("T" . mode-change)
690 ("U" . unmerged)
691 ("X" . unknown)))))
692 (setq code (if code (cdr code) 'unknown))
693 (when (stringp score)
694 (if (> (length score) 0)
695 (setq score (string-to-number score))
696 (setq score nil)))
697 (if score (cons code score) code)))
698
699 (defconst stgit-file-type-strings
700 '((#o100 . "file")
701 (#o120 . "symlink")
702 (#o160 . "subproject"))
703 "Alist of names of file types")
704
705 (defun stgit-file-type-string (type)
706 "Return string describing file type TYPE (the high bits of file permission).
707 Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
708 (let ((type-str (assoc type stgit-file-type-strings)))
709 (or (and type-str (cdr type-str))
710 (format "unknown type %o" type))))
711
712 (defun stgit-file-type-change-string (old-perm new-perm)
713 "Return string describing file type change from OLD-PERM to NEW-PERM.
714 Cf. `stgit-file-type-string'."
715 (let ((old-type (lsh old-perm -9))
716 (new-type (lsh new-perm -9)))
717 (cond ((= old-type new-type) "")
718 ((zerop new-type) "")
719 ((zerop old-type)
720 (if (= new-type #o100)
721 ""
722 (format "(%s)" (stgit-file-type-string new-type))))
723 (t (format "(%s -> %s)"
724 (stgit-file-type-string old-type)
725 (stgit-file-type-string new-type))))))
726
727 (defun stgit-file-mode-change-string (old-perm new-perm)
728 "Return string describing file mode change from OLD-PERM to NEW-PERM.
729 Cf. `stgit-file-type-change-string'."
730 (setq old-perm (logand old-perm #o777)
731 new-perm (logand new-perm #o777))
732 (if (or (= old-perm new-perm)
733 (zerop old-perm)
734 (zerop new-perm))
735 ""
736 (let* ((modified (logxor old-perm new-perm))
737 (not-x-modified (logand (logxor old-perm new-perm) #o666)))
738 (cond ((zerop modified) "")
739 ((and (zerop not-x-modified)
740 (or (and (eq #o111 (logand old-perm #o111))
741 (propertize "-x" 'face 'stgit-file-permission-face))
742 (and (eq #o111 (logand new-perm #o111))
743 (propertize "+x" 'face
744 'stgit-file-permission-face)))))
745 (t (concat (propertize (format "%o" old-perm)
746 'face 'stgit-file-permission-face)
747 (propertize " -> "
748 'face 'stgit-description-face)
749 (propertize (format "%o" new-perm)
750 'face 'stgit-file-permission-face)))))))
751
752 (defstruct (stgit-file
753 (:conc-name stgit-file->))
754 old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
755
756 (defun stgit-describe-copy-or-rename (file)
757 (let ((arrow (concat " " (propertize "->" 'face 'stgit-description-face) " "))
758 from to common-head common-tail)
759
760 (when stgit-abbreviate-copies-and-renames
761 (setq from (split-string (stgit-file->cr-from file) "/")
762 to (split-string (stgit-file->cr-to file) "/"))
763
764 (while (and from to (cdr from) (cdr to)
765 (string-equal (car from) (car to)))
766 (setq common-head (cons (car from) common-head)
767 from (cdr from)
768 to (cdr to)))
769 (setq common-head (nreverse common-head)
770 from (nreverse from)
771 to (nreverse to))
772 (while (and from to (cdr from) (cdr to)
773 (string-equal (car from) (car to)))
774 (setq common-tail (cons (car from) common-tail)
775 from (cdr from)
776 to (cdr to)))
777 (setq from (nreverse from)
778 to (nreverse to)))
779
780 (if (or common-head common-tail)
781 (concat (if common-head
782 (mapconcat #'identity common-head "/")
783 "")
784 (if common-head "/" "")
785 (propertize "{" 'face 'stgit-description-face)
786 (mapconcat #'identity from "/")
787 arrow
788 (mapconcat #'identity to "/")
789 (propertize "}" 'face 'stgit-description-face)
790 (if common-tail "/" "")
791 (if common-tail
792 (mapconcat #'identity common-tail "/")
793 ""))
794 (concat (stgit-file->cr-from file) arrow (stgit-file->cr-to file)))))
795
796 (defun stgit-file-pp (file)
797 (let ((start (point))
798 (spec (format-spec-make
799 ?s (stgit-file-status-code-as-string file)
800 ?m (stgit-file-mode-change-string
801 (stgit-file->old-perm file)
802 (stgit-file->new-perm file))
803 ?n (if (stgit-file->copy-or-rename file)
804 (stgit-describe-copy-or-rename file)
805 (stgit-file->file file))
806 ?c (propertize (stgit-file-type-change-string
807 (stgit-file->old-perm file)
808 (stgit-file->new-perm file))
809 'face 'stgit-description-face))))
810 (stgit-insert-without-trailing-whitespace
811 (format-spec stgit-file-line-format spec))
812 (add-text-properties start (point)
813 (list 'entry-type 'file
814 'file-data file))))
815
816 (defun stgit-find-copies-harder-diff-arg ()
817 "Return the flag to use with `git-diff' depending on the
818 `stgit-find-copies-harder' flag."
819 (if stgit-find-copies-harder "--find-copies-harder" "-C"))
820
821 (defun stgit-insert-ls-files (args file-flag)
822 (let ((start (point)))
823 (apply 'stgit-run-git
824 (append '("ls-files" "--exclude-standard" "-z") args))
825 (goto-char start)
826 (while (looking-at "\\([^\0]*\\)\0")
827 (let ((name-len (- (match-end 0) (match-beginning 0))))
828 (insert ":0 0 0000000000000000000000000000000000000000 0000000000000000000000000000000000000000 " file-flag "\0")
829 (forward-char name-len)))))
830
831 (defun stgit-process-files (callback)
832 (goto-char (point-min))
833 (when (looking-at "[0-9A-Fa-f]\\{40\\}\0")
834 (goto-char (match-end 0)))
835 (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
836 (let ((old-perm (string-to-number (match-string 1) 8))
837 (new-perm (string-to-number (match-string 2) 8)))
838 (goto-char (match-end 0))
839 (let ((file
840 (cond ((looking-at
841 "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
842 (let* ((patch-status (stgit-patch->status patch))
843 (file-subexp (if (eq patch-status 'unapplied)
844 3
845 4))
846 (file (match-string file-subexp)))
847 (make-stgit-file
848 :old-perm old-perm
849 :new-perm new-perm
850 :copy-or-rename t
851 :cr-score (string-to-number (match-string 2))
852 :cr-from (match-string 3)
853 :cr-to (match-string 4)
854 :status (stgit-file-status-code
855 (match-string 1))
856 :file file)))
857 ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
858 (make-stgit-file
859 :old-perm old-perm
860 :new-perm new-perm
861 :copy-or-rename nil
862 :cr-score nil
863 :cr-from nil
864 :cr-to nil
865 :status (stgit-file-status-code
866 (match-string 1))
867 :file (match-string 2))))))
868 (goto-char (match-end 0))
869 (funcall callback file)))))
870
871
872 (defun stgit-insert-patch-files (patch)
873 "Expand (show modification of) the patch PATCH after the line
874 at point."
875 (let* ((patchsym (stgit-patch->name patch))
876 (end (point-marker))
877 (args (list "-z" (stgit-find-copies-harder-diff-arg)))
878 (ewoc (ewoc-create #'stgit-file-pp nil nil t))
879 (show-ignored stgit-show-ignored)
880 (show-unknown stgit-show-unknown))
881 (set-marker-insertion-type end t)
882 (setf (stgit-patch->files-ewoc patch) ewoc)
883 (with-temp-buffer
884 (let ((standard-output (current-buffer)))
885 (apply 'stgit-run-git
886 (cond ((eq patchsym :work)
887 (let (standard-output)
888 (stgit-run-git "update-index" "--refresh"))
889 `("diff-files" "-0" ,@args))
890 ((eq patchsym :index)
891 `("diff-index" ,@args "--cached" "HEAD"))
892 (t
893 `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
894
895 (when (and (eq patchsym :work))
896 (when show-ignored
897 (stgit-insert-ls-files '("--ignored" "--others") "I"))
898 (when show-unknown
899 (stgit-insert-ls-files '("--directory" "--no-empty-directory"
900 "--others")
901 "X"))
902 (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
903 (point-min) (point-max)))
904
905 (stgit-process-files (lambda (file) (ewoc-enter-last ewoc file)))
906
907 (unless (ewoc-nth ewoc 0)
908 (ewoc-set-hf ewoc ""
909 (concat " "
910 (propertize "<no files>"
911 'face 'stgit-description-face)
912 "\n")))))
913 (goto-char end)))
914
915 (defun stgit-find-file (&optional other-window)
916 (let* ((file (or (stgit-patched-file-at-point)
917 (error "No file at point")))
918 (filename (expand-file-name (stgit-file->file file))))
919 (unless (file-exists-p filename)
920 (error "File does not exist"))
921 (funcall (if other-window 'find-file-other-window 'find-file)
922 filename)
923 (when (eq (stgit-file->status file) 'unmerged)
924 (smerge-mode 1))))
925
926 (defun stgit-expand (&optional patches collapse)
927 "Show the contents of marked patches, or the patch at point.
928
929 See also `stgit-collapse'.
930
931 Non-interactively, operate on PATCHES, and collapse instead of
932 expand if COLLAPSE is not nil."
933 (interactive (list (stgit-patches-marked-or-at-point t)))
934 (stgit-assert-mode)
935 (let ((patches-diff (funcall (if collapse #'intersection #'set-difference)
936 patches stgit-expanded-patches)))
937 (setq stgit-expanded-patches
938 (if collapse
939 (set-difference stgit-expanded-patches patches-diff)
940 (append stgit-expanded-patches patches-diff)))
941 (ewoc-map #'(lambda (patch)
942 (memq (stgit-patch->name patch) patches-diff))
943 stgit-ewoc))
944 (move-to-column (stgit-goal-column)))
945
946 (defun stgit-collapse (&optional patches)
947 "Hide the contents of marked patches, or the patch at point.
948
949 See also `stgit-expand'."
950 (interactive (list (stgit-patches-marked-or-at-point t)))
951 (stgit-assert-mode)
952 (stgit-expand patches t))
953
954 (defun stgit-select-patch ()
955 (let ((patchname (stgit-patch-name-at-point)))
956 (stgit-expand (list patchname)
957 (memq patchname stgit-expanded-patches))))
958
959 (defun stgit-expand-directory (file)
960 (let* ((patch (stgit-patch-at-point))
961 (ewoc (stgit-patch->files-ewoc patch))
962 (node (ewoc-locate ewoc))
963 (filename (stgit-file->file file))
964 (start (make-marker))
965 (end (make-marker)))
966
967 (save-excursion
968 (forward-line 1)
969 (set-marker start (point))
970 (set-marker end (point))
971 (set-marker-insertion-type end t))
972
973 (assert (string-match "/$" filename))
974 ;; remove trailing "/"
975 (setf (stgit-file->file file) (substring filename 0 -1))
976 (ewoc-invalidate ewoc node)
977
978 (with-temp-buffer
979 (let ((standard-output (current-buffer)))
980 (stgit-insert-ls-files (list "--directory" "--others"
981 "--no-empty-directory" "--"
982 filename)
983 "X")
984 (stgit-process-files (lambda (f)
985 (setq node (ewoc-enter-after ewoc node f))))))
986
987 (move-to-column (stgit-goal-column))
988
989 (let ((inhibit-read-only t))
990 (put-text-property start end 'patch-data patch))))
991
992 (defun stgit-select-file ()
993 (let* ((file (or (stgit-patched-file-at-point)
994 (error "No file at point")))
995 (filename (stgit-file->file file)))
996 (if (string-match "/$" filename)
997 (stgit-expand-directory file)
998 (stgit-find-file))))
999
1000 (defun stgit-select ()
1001 "With point on a patch, toggle showing files in the patch.
1002
1003 With point on a file, open the associated file. Opens the target
1004 file for (applied) copies and renames."
1005 (interactive)
1006 (stgit-assert-mode)
1007 (case (get-text-property (point) 'entry-type)
1008 ('patch
1009 (stgit-select-patch))
1010 ('file
1011 (stgit-select-file))
1012 (t
1013 (error "No patch or file on line"))))
1014
1015 (defun stgit-find-file-other-window ()
1016 "Open file at point in other window"
1017 (interactive)
1018 (stgit-assert-mode)
1019 (stgit-find-file t))
1020
1021 (defun stgit-find-file-merge ()
1022 "Open file at point and merge it using `smerge-ediff'."
1023 (interactive)
1024 (stgit-assert-mode)
1025 (stgit-find-file t)
1026 (smerge-ediff))
1027
1028 (defun stgit-quit ()
1029 "Hide the stgit buffer."
1030 (interactive)
1031 (stgit-assert-mode)
1032 (bury-buffer))
1033
1034 (defun stgit-git-status ()
1035 "Show status using `git-status'."
1036 (interactive)
1037 (stgit-assert-mode)
1038 (unless (fboundp 'git-status)
1039 (error "The stgit-git-status command requires git-status"))
1040 (let ((dir default-directory))
1041 (save-selected-window
1042 (pop-to-buffer nil)
1043 (git-status dir))))
1044
1045 (defun stgit-goal-column ()
1046 "Return goal column for the current line"
1047 (case (get-text-property (point) 'entry-type)
1048 ('patch 2)
1049 ('file 4)
1050 (t 0)))
1051
1052 (defun stgit-next-line (&optional arg)
1053 "Move cursor vertically down ARG lines"
1054 (interactive "p")
1055 (stgit-assert-mode)
1056 (next-line arg)
1057 (move-to-column (stgit-goal-column)))
1058
1059 (defun stgit-previous-line (&optional arg)
1060 "Move cursor vertically up ARG lines"
1061 (interactive "p")
1062 (stgit-assert-mode)
1063 (previous-line arg)
1064 (move-to-column (stgit-goal-column)))
1065
1066 (defun stgit-next-patch (&optional arg)
1067 "Move cursor down ARG patches."
1068 (interactive "p")
1069 (stgit-assert-mode)
1070 (unless arg (setq arg 1))
1071 (cond ((< arg 0)
1072 (stgit-previous-patch (- arg)))
1073 ((zerop arg)
1074 (move-to-column (stgit-goal-column)))
1075 (t
1076 (when (stgit-at-header-p)
1077 (ewoc-goto-node stgit-ewoc (ewoc-nth stgit-ewoc 0))
1078 (setq arg (1- arg)))
1079 (ewoc-goto-next stgit-ewoc arg)
1080 (move-to-column goal-column))))
1081
1082 (defun stgit-previous-patch (&optional arg)
1083 "Move cursor up ARG patches."
1084 (interactive "p")
1085 (stgit-assert-mode)
1086 (unless arg (setq arg 1))
1087 (cond ((< arg 0)
1088 (stgit-next-patch (- arg)))
1089 ((zerop arg)
1090 (move-to-column (stgit-goal-column)))
1091 ((stgit-at-header-p)
1092 (goto-char (point-min)))
1093 (t
1094 (let ((opatch (stgit-patch-at-point)))
1095 (ewoc-goto-prev stgit-ewoc arg)
1096 (unless (zerop arg)
1097 (when (eq opatch (stgit-patch-at-point))
1098 (goto-char (point-min)))))
1099 (move-to-column (stgit-goal-column)))))
1100
1101 (defun stgit-previous-patch-group (&optional arg)
1102 "Move to the previous group of patches.
1103
1104 If ARG is non-nil, do this ARG times. If ARG is negative, move
1105 -ARG groups forward instead; cf. `stgit-next-patch-group'."
1106 (interactive "p")
1107 (stgit-assert-mode)
1108 (if (< arg 0)
1109 (stgit-previous-patch-group (- arg))
1110 (while (and (not (bobp))
1111 (> arg 0))
1112 (stgit-previous-patch 1)
1113 (let* ((opoint (point))
1114 (patch (stgit-patch-at-point))
1115 (status (and patch (stgit-patch->status patch))))
1116 (while (and (not (bobp))
1117 (let* ((npatch (stgit-patch-at-point))
1118 (nstatus (and npatch (stgit-patch->status npatch))))
1119 (eq status nstatus)))
1120 (setq opoint (point))
1121 (stgit-previous-patch 1))
1122 (goto-char opoint))
1123 (setq arg (1- arg)))))
1124
1125 (defun stgit-next-patch-group (&optional arg)
1126 "Move to the next group of patches.
1127
1128 If ARG is non-nil, do this ARG times. If ARG is negative, move
1129 -ARG groups backwards instead; cf. `stgit-previous-patch-group'."
1130 (interactive "p")
1131 (stgit-assert-mode)
1132 (if (< arg 0)
1133 (stgit-previous-patch-group (- arg))
1134 (while (and (not (eobp))
1135 (> arg 0))
1136 (let* ((patch (stgit-patch-at-point))
1137 (status (and patch (stgit-patch->status patch))))
1138 (while (and (not (eobp))
1139 (let* ((npatch (stgit-patch-at-point))
1140 (nstatus (and npatch (stgit-patch->status npatch))))
1141 (eq status nstatus)))
1142 (stgit-next-patch 1)))
1143 (setq arg (1- arg)))))
1144
1145 (defvar stgit-mode-hook nil
1146 "Run after `stgit-mode' is setup.")
1147
1148 (defvar stgit-mode-map nil
1149 "Keymap for StGit major mode.")
1150
1151 (unless stgit-mode-map
1152 (let ((diff-map (make-sparse-keymap))
1153 (toggle-map (make-sparse-keymap)))
1154 (mapc (lambda (arg) (define-key diff-map (car arg) (cdr arg)))
1155 '(("b" . stgit-diff-base)
1156 ("c" . stgit-diff-combined)
1157 ("m" . stgit-find-file-merge)
1158 ("o" . stgit-diff-ours)
1159 ("r" . stgit-diff-range)
1160 ("t" . stgit-diff-theirs)))
1161 (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
1162 '(("n" . stgit-toggle-patch-names)
1163 ("t" . stgit-toggle-worktree)
1164 ("h" . stgit-toggle-committed)
1165 ("i" . stgit-toggle-ignored)
1166 ("u" . stgit-toggle-unknown)
1167 ("s" . stgit-toggle-svn)))
1168 (setq stgit-mode-map (make-keymap))
1169 (suppress-keymap stgit-mode-map)
1170 (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
1171 `((" " . stgit-mark-down)
1172 ("m" . stgit-mark-down)
1173 ("\d" . stgit-unmark-up)
1174 ("u" . stgit-unmark-down)
1175 ("?" . stgit-help)
1176 ("h" . stgit-help)
1177 ("\C-p" . stgit-previous-line)
1178 ("\C-n" . stgit-next-line)
1179 ([up] . stgit-previous-line)
1180 ([down] . stgit-next-line)
1181 ("p" . stgit-previous-patch)
1182 ("n" . stgit-next-patch)
1183 ("\M-{" . stgit-previous-patch-group)
1184 ("\M-}" . stgit-next-patch-group)
1185 ([(control up)] . stgit-previous-patch-group)
1186 ([(control down)] . stgit-next-patch-group)
1187 ("s" . stgit-git-status)
1188 ("g" . stgit-reload-or-repair)
1189 ("r" . stgit-refresh)
1190 ("\C-c\C-r" . stgit-rename)
1191 ("e" . stgit-edit)
1192 ("M" . stgit-move-patches)
1193 ("S" . stgit-squash)
1194 ("N" . stgit-new)
1195 ("c" . stgit-new-and-refresh)
1196 ("\C-c\C-c" . stgit-commit)
1197 ("\C-c\C-u" . stgit-uncommit)
1198 ("U" . stgit-revert)
1199 ("R" . stgit-resolve-file)
1200 ("\r" . stgit-select)
1201 ("+" . stgit-expand)
1202 ("-" . stgit-collapse)
1203 ("o" . stgit-find-file-other-window)
1204 ("i" . stgit-toggle-index)
1205 (">" . stgit-push-next)
1206 ("<" . stgit-pop-next)
1207 ("P" . stgit-push-or-pop)
1208 ("G" . stgit-goto)
1209 ("=" . stgit-diff)
1210 ("D" . stgit-delete)
1211 ([?\C-/] . stgit-undo)
1212 ("\C-_" . stgit-undo)
1213 ([?\C-c ?\C-/] . stgit-redo)
1214 ("\C-c\C-_" . stgit-redo)
1215 ("B" . stgit-branch)
1216 ("\C-c\C-b" . stgit-rebase)
1217 ("t" . ,toggle-map)
1218 ("d" . ,diff-map)
1219 ("q" . stgit-quit)
1220 ("!" . stgit-execute))))
1221
1222 (let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point)))
1223 (and file (eq (stgit-file->status file)
1224 'unmerged))))
1225 (patch-collapsed-p '(lambda (p) (not (memq p stgit-expanded-patches)))))
1226 (easy-menu-define stgit-menu stgit-mode-map
1227 "StGit Menu"
1228 `("StGit"
1229 ["Reload" stgit-reload-or-repair
1230 :help "Reload StGit status from disk"]
1231 ["Repair" stgit-repair
1232 :keys "\\[universal-argument] \\[stgit-reload-or-repair]"
1233 :help "Repair StGit metadata"]
1234 "-"
1235 ["Undo" stgit-undo t]
1236 ["Redo" stgit-redo t]
1237 "-"
1238 ["Git status" stgit-git-status :active (fboundp 'git-status)]
1239 "-"
1240 ["New patch" stgit-new-and-refresh
1241 :help "Create a new patch from changes in index or work tree"
1242 :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))]
1243 ["New empty patch" stgit-new
1244 :help "Create a new, empty patch"]
1245 ["(Un)mark patch" stgit-toggle-mark
1246 :label (if (memq (stgit-patch-name-at-point nil t)
1247 stgit-marked-patches)
1248 "Unmark patch" "Mark patch")
1249 :active (stgit-patch-name-at-point nil t)]
1250 ["Expand/collapse patch"
1251 (let ((patches (stgit-patches-marked-or-at-point)))
1252 (if (member-if ,patch-collapsed-p patches)
1253 (stgit-expand patches)
1254 (stgit-collapse patches)))
1255 :label (if (member-if ,patch-collapsed-p
1256 (stgit-patches-marked-or-at-point))
1257 "Expand patches"
1258 "Collapse patches")
1259 :active (stgit-patches-marked-or-at-point)]
1260 ["Edit patch" stgit-edit
1261 :help "Edit patch comment"
1262 :active (stgit-patch-name-at-point nil t)]
1263 ["Rename patch" stgit-rename :active (stgit-patch-name-at-point nil t)]
1264 ["Push/pop patch" stgit-push-or-pop
1265 :label (if (subsetp (stgit-patches-marked-or-at-point nil t)
1266 (stgit-applied-patchsyms t))
1267 "Pop patches" "Push patches")]
1268 ["Delete patches" stgit-delete
1269 :active (stgit-patches-marked-or-at-point nil t)]
1270 "-"
1271 ["Move patches" stgit-move-patches
1272 :active stgit-marked-patches
1273 :help "Move marked patch(es) to point"]
1274 ["Squash patches" stgit-squash
1275 :active (> (length stgit-marked-patches) 1)
1276 :help "Merge marked patches into one"]
1277 "-"
1278 ["Refresh top patch" stgit-refresh
1279 :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))
1280 :help "Refresh the top patch with changes in index or work tree"]
1281 ["Refresh this patch" (stgit-refresh t)
1282 :keys "\\[universal-argument] \\[stgit-refresh]"
1283 :help "Refresh marked patch with changes in index or work tree"
1284 :active (and (not (and (stgit-index-empty-p)
1285 (stgit-work-tree-empty-p)))
1286 (stgit-patch-name-at-point nil t))]
1287 "-"
1288 ["Find file" stgit-select
1289 :active (eq (get-text-property (point) 'entry-type) 'file)]
1290 ["Open file" stgit-find-file-other-window
1291 :active (eq (get-text-property (point) 'entry-type) 'file)]
1292 ["Toggle file index" stgit-toggle-index
1293 :active (and (eq (get-text-property (point) 'entry-type) 'file)
1294 (memq (stgit-patch-name-at-point) '(:work :index)))
1295 :label (if (eq (stgit-patch-name-at-point) :work)
1296 "Move change to index"
1297 "Move change to work tree")]
1298 "-"
1299 ["Show diff" stgit-diff
1300 :active (get-text-property (point) 'entry-type)]
1301 ["Show diff for range of applied patches" stgit-diff-range
1302 :active (= (length stgit-marked-patches) 1)]
1303 ("Merge"
1304 :active (stgit-git-index-unmerged-p)
1305 ["Combined diff" stgit-diff-combined
1306 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1307 ["Diff against base" stgit-diff-base
1308 :help "Show diff against the common base"
1309 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1310 ["Diff against ours" stgit-diff-ours
1311 :help "Show diff against our branch"
1312 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1313 ["Diff against theirs" stgit-diff-theirs
1314 :help "Show diff against their branch"
1315 :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
1316 "-"
1317 ["Interactive merge" stgit-find-file-merge
1318 :help "Interactively merge the file"
1319 :active ,at-unmerged-file]
1320 ["Resolve file" stgit-resolve-file
1321 :help "Mark file conflict as resolved"
1322 :active ,at-unmerged-file]
1323 )
1324 "-"
1325 ["Show index & work tree" stgit-toggle-worktree :style toggle
1326 :selected stgit-show-worktree]
1327 ["Show unknown files" stgit-toggle-unknown :style toggle
1328 :selected stgit-show-unknown :active stgit-show-worktree]
1329 ["Show ignored files" stgit-toggle-ignored :style toggle
1330 :selected stgit-show-ignored :active stgit-show-worktree]
1331 ["Show patch names" stgit-toggle-patch-names :style toggle
1332 :selected stgit-show-patch-names]
1333 ["Show recent commits" stgit-toggle-committed :style toggle
1334 :selected stgit-show-committed]
1335 ["Show subversion info" stgit-toggle-svn :style toggle
1336 :selected stgit-show-svn]
1337 "-"
1338 ["Switch branches" stgit-branch t
1339 :help "Switch to or create another branch"]
1340 ["Rebase branch" stgit-rebase t
1341 :help "Rebase the current branch"]
1342 ))))
1343
1344 ;; disable tool bar editing buttons
1345 (put 'stgit-mode 'mode-class 'special)
1346
1347 (defun stgit-mode ()
1348 "Major mode for interacting with StGit.
1349
1350 Start StGit using \\[stgit].
1351
1352 Basic commands:
1353 \\<stgit-mode-map>\
1354 \\[stgit-help] Show this help text
1355 \\[stgit-quit] Hide the StGit buffer
1356 \\[describe-bindings] Show all key bindings
1357
1358 \\[stgit-reload-or-repair] Reload the StGit buffer
1359 \\[universal-argument] \\[stgit-reload-or-repair] Repair StGit metadata
1360
1361 \\[stgit-undo] Undo most recent StGit operation
1362 \\[stgit-redo] Undo recent undo
1363
1364 \\[stgit-git-status] Run `git-status' (if available)
1365
1366 \\[stgit-execute] Run an stg shell command
1367
1368 Movement commands:
1369 \\[stgit-previous-line] Move to previous line
1370 \\[stgit-next-line] Move to next line
1371 \\[stgit-previous-patch] Move to previous patch
1372 \\[stgit-next-patch] Move to next patch
1373 \\[stgit-previous-patch-group] Move to previous patch group
1374 \\[stgit-next-patch-group] Move to next patch group
1375
1376 \\[stgit-mark-down] Mark patch and move down
1377 \\[stgit-unmark-up] Unmark patch and move up
1378 \\[stgit-unmark-down] Unmark patch and move down
1379
1380 Commands for patches:
1381 \\[stgit-select] Toggle showing changed files in patch
1382 \\[stgit-refresh] Refresh patch with changes in index or work tree
1383 \\[stgit-diff] Show the patch log and diff
1384
1385 \\[stgit-expand] Show changes in marked patches
1386 \\[stgit-collapse] Hide changes in marked patches
1387
1388 \\[stgit-new-and-refresh] Create a new patch from index or work tree
1389 \\[stgit-new] Create a new, empty patch
1390
1391 \\[stgit-rename] Rename patch
1392 \\[stgit-edit] Edit patch description
1393 \\[stgit-delete] Delete patch(es)
1394
1395 \\[stgit-revert] Revert all changes in index or work tree
1396 \\[stgit-toggle-index] Toggle all changes between index and work tree
1397
1398 \\[stgit-push-next] Push next patch onto stack
1399 \\[stgit-pop-next] Pop current patch from stack
1400 \\[stgit-push-or-pop] Push or pop marked patches
1401 \\[stgit-goto] Make patch at point current by popping or pushing
1402
1403 \\[stgit-squash] Squash (meld together) patches
1404 \\[stgit-move-patches] Move marked patches to point
1405
1406 \\[stgit-commit] Commit patch(es)
1407 \\[stgit-uncommit] Uncommit patch(es)
1408
1409 Commands for files:
1410 \\[stgit-select] Open the file in this window
1411 \\[stgit-find-file-other-window] Open the file in another window
1412 \\[stgit-diff] Show the file's diff
1413
1414 \\[stgit-toggle-index] Toggle change between index and work tree
1415 \\[stgit-revert] Revert changes to file
1416
1417 Display commands:
1418 \\[stgit-toggle-patch-names] Toggle showing patch names
1419 \\[stgit-toggle-worktree] Toggle showing index and work tree
1420 \\[stgit-toggle-unknown] Toggle showing unknown files
1421 \\[stgit-toggle-ignored] Toggle showing ignored files
1422 \\[stgit-toggle-committed] Toggle showing recent commits
1423 \\[stgit-toggle-svn] Toggle showing subversion information
1424
1425 Commands for diffs:
1426 \\[stgit-diff] Show diff of patch or file
1427 \\[stgit-diff-range] Show diff for range of patches
1428 \\[stgit-diff-base] Show diff against the merge base
1429 \\[stgit-diff-ours] Show diff against our branch
1430 \\[stgit-diff-theirs] Show diff against their branch
1431
1432 With one prefix argument (e.g., \\[universal-argument] \\[stgit-diff]), \
1433 ignore space changes.
1434 With two prefix arguments (e.g., \\[universal-argument] \
1435 \\[universal-argument] \\[stgit-diff]), ignore all space changes.
1436
1437 Commands for merge conflicts:
1438 \\[stgit-find-file-merge] Resolve conflicts using `smerge-ediff'
1439 \\[stgit-resolve-file] Mark unmerged file as resolved
1440
1441 Commands for branches:
1442 \\[stgit-branch] Switch to or create another branch
1443 \\[stgit-rebase] Rebase the current branch
1444
1445 Customization variables:
1446 `stgit-abbreviate-copies-and-renames'
1447 `stgit-default-show-ignored'
1448 `stgit-default-show-patch-names'
1449 `stgit-default-show-unknown'
1450 `stgit-default-show-worktree'
1451 `stgit-default-show-committed'
1452 `stgit-default-show-svn'
1453 `stgit-default-committed-count'
1454 `stgit-find-copies-harder'
1455 `stgit-show-worktree-mode'
1456
1457 See also \\[customize-group] for the \"stgit\" group."
1458 (kill-all-local-variables)
1459 (buffer-disable-undo)
1460 (setq mode-name "StGit"
1461 major-mode 'stgit-mode
1462 goal-column 2)
1463 (use-local-map stgit-mode-map)
1464 (mapc (lambda (x) (set (make-local-variable (car x)) (cdr x)))
1465 `((list-buffers-directory . ,default-directory)
1466 (parse-sexp-lookup-properties . t)
1467 (stgit-expanded-patches . (:work :index))
1468 (stgit-index-node . nil)
1469 (stgit-worktree-node . nil)
1470 (stgit-marked-patches . nil)
1471 (stgit-svn-find-rev-hash . ,(make-hash-table :test 'equal))
1472 (stgit-committed-count . ,stgit-default-committed-count)
1473 (stgit-show-committed . ,stgit-default-show-committed)
1474 (stgit-show-ignored . ,stgit-default-show-ignored)
1475 (stgit-show-patch-names . ,stgit-default-show-patch-names)
1476 (stgit-show-svn . ,stgit-default-show-svn)
1477 (stgit-show-unknown . ,stgit-default-show-unknown)
1478 (stgit-show-worktree . ,stgit-default-show-worktree)))
1479 (set-variable 'truncate-lines 't)
1480 (add-hook 'after-save-hook 'stgit-update-stgit-for-buffer)
1481 (unless stgit-did-advise
1482 (stgit-advise)
1483 (setq stgit-did-advise t))
1484 (run-hooks 'stgit-mode-hook))
1485
1486 (defun stgit-advise-funlist (funlist)
1487 "Add advice to the functions in FUNLIST so we can refresh the
1488 stgit buffers as the git status of files change."
1489 (mapc (lambda (sym)
1490 (when (fboundp sym)
1491 (eval `(defadvice ,sym (after stgit-update-stgit-for-buffer)
1492 (stgit-update-stgit-for-buffer t)))
1493 (ad-activate sym)))
1494 funlist))
1495
1496 (defun stgit-advise ()
1497 "Add advice to appropriate (non-stgit) git functions so we can
1498 refresh the stgit buffers as the git status of files change."
1499 (mapc (lambda (arg)
1500 (let ((feature (car arg))
1501 (funlist (cdr arg)))
1502 (if (featurep feature)
1503 (stgit-advise-funlist funlist)
1504 (add-to-list 'after-load-alist
1505 `(,feature (stgit-advise-funlist
1506 (quote ,funlist)))))))
1507 ;; lists of (<feature> <function> <function> ...) to be advised
1508 '((vc-git vc-git-rename-file vc-git-revert vc-git-register)
1509 (git git-add-file git-checkout git-revert-file git-remove-file)
1510 (dired dired-delete-file))))
1511
1512 (defvar stgit-pending-refresh-buffers nil
1513 "Alist of (cons `buffer' `refresh-index') of buffers that need
1514 to be refreshed. `refresh-index' is non-nil if both work tree
1515 and index need to be refreshed.")
1516
1517 (defun stgit-run-pending-refreshs ()
1518 "Run all pending stgit buffer updates as posted by `stgit-post-refresh'."
1519 (let ((buffers stgit-pending-refresh-buffers)
1520 (stgit-inhibit-messages t))
1521 (setq stgit-pending-refresh-buffers nil)
1522 (while buffers
1523 (let* ((elem (car buffers))
1524 (buffer (car elem))
1525 (refresh-index (cdr elem)))
1526 (when (buffer-name buffer)
1527 (with-current-buffer buffer
1528 (stgit-refresh-worktree)
1529 (when refresh-index (stgit-refresh-index)))))
1530 (setq buffers (cdr buffers)))))
1531
1532 (defun stgit-post-refresh (buffer refresh-index)
1533 "Update worktree status in BUFFER when Emacs becomes idle. If
1534 REFRESH-INDEX is non-nil, also update the index."
1535 (unless stgit-pending-refresh-buffers
1536 (run-with-idle-timer 0.1 nil 'stgit-run-pending-refreshs))
1537 (let ((elem (assq buffer stgit-pending-refresh-buffers)))
1538 (if elem
1539 ;; if buffer is already present, set its refresh-index flag if
1540 ;; necessary
1541 (when refresh-index
1542 (setcdr elem t))
1543 ;; new entry
1544 (setq stgit-pending-refresh-buffers
1545 (cons (cons buffer refresh-index)
1546 stgit-pending-refresh-buffers)))))
1547
1548 (defun stgit-update-stgit-for-buffer (&optional refresh-index)
1549 "When Emacs becomes idle, refresh worktree status in any
1550 `stgit-mode' buffer that shows the status of the current buffer.
1551
1552 If REFRESH-INDEX is non-nil, also update the index."
1553 (let* ((dir (cond ((derived-mode-p 'stgit-status-mode 'dired-mode)
1554 default-directory)
1555 (buffer-file-name
1556 (file-name-directory
1557 (expand-file-name buffer-file-name)))))
1558 (gitdir (and dir (condition-case nil (git-get-top-dir dir)
1559 (error nil))))
1560 (buffer (and gitdir (stgit-find-buffer gitdir))))
1561 (when buffer
1562 (stgit-post-refresh buffer refresh-index))))
1563
1564 (defun stgit-add-mark (patchsym)
1565 "Mark the patch PATCHSYM."
1566 (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
1567
1568 (defun stgit-remove-mark (patchsym)
1569 "Unmark the patch PATCHSYM."
1570 (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))
1571
1572 (defun stgit-clear-marks ()
1573 "Unmark all patches."
1574 (setq stgit-marked-patches '()))
1575
1576 (defun stgit-patch-at-point (&optional cause-error)
1577 (get-text-property (point) 'patch-data))
1578
1579 (defun stgit-patch-name-at-point (&optional cause-error types)
1580 "Return the patch name on the current line as a symbol.
1581 If CAUSE-ERROR is not nil, signal an error if none found.
1582
1583 TYPES controls which types of commits and patches can be returned.
1584 If it is t, only allow stgit patches; if 'allow-committed, also
1585 allow historical commits; if nil, also allow work tree and index."
1586 (let ((patch (stgit-patch-at-point)))
1587 (and patch
1588 (memq (stgit-patch->status patch)
1589 (case types
1590 ((nil) nil)
1591 ((allow-committed) '(work index))
1592 ((t) '(work index committed))
1593 (t (error "Bad value"))))
1594 (setq patch nil))
1595 (cond (patch
1596 (stgit-patch->name patch))
1597 (cause-error
1598 (error "No patch on this line")))))
1599
1600 (defun stgit-patched-file-at-point ()
1601 (get-text-property (point) 'file-data))
1602
1603 (defun stgit-patches-marked-or-at-point (&optional cause-error types)
1604 "Return the symbols of the marked patches, or the patch on the current line.
1605 If CAUSE-ERRROR is not nil, signal an error if none found.
1606
1607 TYPES controls which types of commits and patches can be returned.
1608 If it is t, only allow stgit patches; if 'allow-committed, also
1609 allow historical commits; if nil, also allow work tree and index."
1610 (if stgit-marked-patches
1611 stgit-marked-patches
1612 (let ((patch (stgit-patch-name-at-point nil types)))
1613 (cond (patch (list patch))
1614 (cause-error (error "No patches marked or at this line"))
1615 (t nil)))))
1616
1617 (defun stgit-goto-patch (patchsym &optional file)
1618 "Move point to the line containing patch PATCHSYM and return non-nil.
1619 If that patch cannot be found, do nothing and return nil.
1620
1621 If the patch was found and FILE is not nil, instead move to that
1622 file's line. If FILE cannot be found, stay on the line of
1623 PATCHSYM."
1624 (let ((node (ewoc-nth stgit-ewoc 0)))
1625 (while (and node (not (eq (stgit-patch->name (ewoc-data node))
1626 patchsym)))
1627 (setq node (ewoc-next stgit-ewoc node)))
1628 (when (and node file)
1629 (let* ((file-ewoc (stgit-patch->files-ewoc (ewoc-data node)))
1630 (file-node (ewoc-nth file-ewoc 0)))
1631 (while (and file-node
1632 (not (equal (stgit-file->file (ewoc-data file-node))
1633 file)))
1634 (setq file-node (ewoc-next file-ewoc file-node)))
1635 (when file-node
1636 (ewoc-goto-node file-ewoc file-node)
1637 (move-to-column (stgit-goal-column))
1638 (setq node nil))))
1639 (when node
1640 (ewoc-goto-node stgit-ewoc node)
1641 (move-to-column goal-column))))
1642
1643 (defun stgit-init ()
1644 "Run stg init."
1645 (interactive)
1646 (stgit-assert-mode)
1647 (stgit-capture-output nil
1648 (stgit-run "init"))
1649 (stgit-reload))
1650
1651 (defun stgit-toggle-mark ()
1652 "Toggle mark on the patch under point."
1653 (interactive)
1654 (stgit-assert-mode)
1655 (if (memq (stgit-patch-name-at-point t t) stgit-marked-patches)
1656 (stgit-unmark)
1657 (stgit-mark)))
1658
1659 (defun stgit-mark ()
1660 "Mark the patch under point."
1661 (interactive)
1662 (stgit-assert-mode)
1663 (let* ((node (ewoc-locate stgit-ewoc))
1664 (patch (ewoc-data node)))
1665 (case (stgit-patch->status patch)
1666 (work (error "Cannot mark the work tree"))
1667 (index (error "Cannot mark the index"))
1668 (committed (error "Cannot mark a committed patch")))
1669 (stgit-add-mark (stgit-patch->name patch))
1670 (let ((column (current-column)))
1671 (ewoc-invalidate stgit-ewoc node)
1672 (move-to-column column))))
1673
1674 (defun stgit-mark-down ()
1675 "Mark the patch under point and move to the next patch."
1676 (interactive)
1677 (stgit-mark)
1678 (stgit-next-patch))
1679
1680 (defun stgit-unmark ()
1681 "Remove mark from the patch on the current line."
1682 (interactive)
1683 (stgit-assert-mode)
1684 (let* ((node (ewoc-locate stgit-ewoc))
1685 (patch (ewoc-data node)))
1686 (stgit-remove-mark (stgit-patch->name patch))
1687 (let ((column (current-column)))
1688 (ewoc-invalidate stgit-ewoc node)
1689 (move-to-column column))))
1690
1691 (defun stgit-unmark-up ()
1692 "Remove mark from the patch on the previous line."
1693 (interactive)
1694 (stgit-assert-mode)
1695 (stgit-previous-patch)
1696 (stgit-unmark))
1697
1698 (defun stgit-unmark-down ()
1699 "Remove mark from the patch on the current line."
1700 (interactive)
1701 (stgit-assert-mode)
1702 (stgit-unmark)
1703 (stgit-next-patch))
1704
1705 (defun stgit-rename (name)
1706 "Rename the patch under point to NAME."
1707 (interactive (list
1708 (read-string "Patch name: "
1709 (symbol-name (stgit-patch-name-at-point t t)))))
1710 (stgit-assert-mode)
1711 (let ((old-patchsym (stgit-patch-name-at-point t t)))
1712 (stgit-capture-output nil
1713 (stgit-run "rename" "--" old-patchsym name))
1714 (let ((name-sym (intern name)))
1715 (when (memq old-patchsym stgit-expanded-patches)
1716 (setq stgit-expanded-patches
1717 (cons name-sym (delq old-patchsym stgit-expanded-patches))))
1718 (when (memq old-patchsym stgit-marked-patches)
1719 (setq stgit-marked-patches
1720 (cons name-sym (delq old-patchsym stgit-marked-patches))))
1721 (stgit-reload)
1722 (stgit-goto-patch name-sym))))
1723
1724 (defun stgit-reload-or-repair (repair)
1725 "Update the contents of the StGit buffer (`stgit-reload').
1726
1727 With a prefix argument, repair the StGit metadata if the branch
1728 was modified with git commands (`stgit-repair')."
1729 (interactive "P")
1730 (stgit-assert-mode)
1731 (if repair
1732 (stgit-repair)
1733 (stgit-reload)))
1734
1735 (defun stgit-repair ()
1736 "Run stg repair."
1737 (interactive)
1738 (stgit-assert-mode)
1739 (stgit-capture-output nil
1740 (stgit-run "repair"))
1741 (stgit-reload))
1742
1743 (defun stgit-available-branches (&optional all)
1744 "Returns a list of the names of the available stg branches as strings.
1745
1746 If ALL is not nil, also return non-stgit branches."
1747 (let ((output (with-output-to-string
1748 (stgit-run "branch" "--list")))
1749 (pattern (format "^>?\\s-+%c\\s-+\\(\\S-+\\)"
1750 (if all ?. ?s)))
1751 (start 0)
1752 result)
1753 (while (string-match pattern output start)
1754 (setq result (cons (match-string 1 output) result))
1755 (setq start (match-end 0)))
1756 result))
1757
1758 (defun stgit-branch (branch)
1759 "Switch to or create branch BRANCH."
1760 (interactive (list (completing-read "Switch to branch: "
1761 (stgit-available-branches))))
1762 (stgit-assert-mode)
1763 (when (cond ((equal branch (stgit-current-branch))
1764 (error "Branch is already current"))
1765 ((member branch (stgit-available-branches t))
1766 (stgit-capture-output nil (stgit-run "branch" "--" branch))
1767 t)
1768 ((not (string-match stgit-allowed-branch-name-re branch))
1769 (error "Invalid branch name"))
1770 ((yes-or-no-p (format "Create branch \"%s\"? " branch))
1771 (let ((branch-point (completing-read
1772 "Branch from (default current branch): "
1773 (stgit-available-branches))))
1774 (stgit-capture-output nil
1775 (apply 'stgit-run
1776 `("branch" "--create" "--"
1777 ,branch
1778 ,@(unless (zerop (length branch-point))
1779 (list branch-point)))))
1780 t)))
1781 (stgit-reload)))
1782
1783 (defun stgit-available-refs (&optional omit-stgit)
1784 "Returns a list of the available git refs.
1785 If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"."
1786 (let* ((output (with-output-to-string
1787 (stgit-run-git-silent "for-each-ref" "--format=%(refname)"
1788 "refs/tags" "refs/heads"
1789 "refs/remotes")))
1790 (result (split-string output "\n" t)))
1791 (mapcar (lambda (s)
1792 (if (string-match "^refs/\\(heads\\|tags\\|remotes\\)/" s)
1793 (substring s (match-end 0))
1794 s))
1795 (if omit-stgit
1796 (delete-if (lambda (s)
1797 (string-match "^refs/heads/.*\\.stgit$" s))
1798 result)
1799 result))))
1800
1801 (defun stgit-parent-branch ()
1802 "Return the parent branch of the current stg branch as per
1803 git-config setting branch.<branch>.stgit.parentbranch."
1804 (let ((output (with-output-to-string
1805 (stgit-run-git-silent "config"
1806 (format "branch.%s.stgit.parentbranch"
1807 (stgit-current-branch))))))
1808 (when (string-match ".*" output)
1809 (match-string 0 output))))
1810
1811 (defun stgit-rebase (new-base)
1812 "Rebase the current branch to NEW-BASE.
1813
1814 Interactively, first ask which branch to rebase to. Defaults to
1815 what git-config branch.<branch>.stgit.parentbranch is set to."
1816 (interactive (list (completing-read "Rebase to: "
1817 (stgit-available-refs t)
1818 nil nil
1819 (stgit-parent-branch))))
1820 (stgit-assert-mode)
1821 (stgit-capture-output nil (stgit-run "rebase" "--" new-base))
1822 (stgit-reload))
1823
1824 (defun stgit-commit (count)
1825 "Run stg commit on COUNT commits.
1826 Interactively, the prefix argument is used as COUNT.
1827 A negative COUNT will uncommit instead."
1828 (interactive "p")
1829 (stgit-assert-mode)
1830 (if (< count 0)
1831 (stgit-uncommit (- count))
1832 (stgit-capture-output nil (stgit-run "commit" "-n" count))
1833 (stgit-reload)))
1834
1835 (defun stgit-uncommit (count)
1836 "Run stg uncommit on COUNT commits.
1837 Interactively, the prefix argument is used as COUNT.
1838 A negative COUNT will commit instead."
1839 (interactive "p")
1840 (stgit-assert-mode)
1841 (if (< count 0)
1842 (stgit-commit (- count))
1843 (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
1844 (stgit-reload)))
1845
1846 (defun stgit-neighbour-file ()
1847 "Return the file name of the next file after point, or the
1848 previous file if point is at the last file within a patch."
1849 (let ((old-point (point))
1850 neighbour-file)
1851 (and (zerop (forward-line 1))
1852 (let ((f (stgit-patched-file-at-point)))
1853 (and f (setq neighbour-file (stgit-file->file f)))))
1854 (goto-char old-point)
1855 (unless neighbour-file
1856 (and (zerop (forward-line -1))
1857 (let ((f (stgit-patched-file-at-point)))
1858 (and f (setq neighbour-file (stgit-file->file f)))))
1859 (goto-char old-point))
1860 neighbour-file))
1861
1862 (defun stgit-revert-file ()
1863 "Revert the file at point, which must be in the index or the
1864 working tree."
1865 (interactive)
1866 (stgit-assert-mode)
1867 (let* ((patched-file (or (stgit-patched-file-at-point)
1868 (error "No file on the current line")))
1869 (patch-name (stgit-patch-name-at-point))
1870 (file-status (stgit-file->status patched-file))
1871 (rm-file (cond ((stgit-file->copy-or-rename patched-file)
1872 (stgit-file->cr-to patched-file))
1873 ((eq file-status 'add)
1874 (stgit-file->file patched-file))))
1875 (co-file (cond ((eq file-status 'rename)
1876 (stgit-file->cr-from patched-file))
1877 ((not (memq file-status '(copy add)))
1878 (stgit-file->file patched-file))))
1879 (next-file (stgit-neighbour-file)))
1880
1881 (unless (memq patch-name '(:work :index))
1882 (error "No index or working tree file on this line"))
1883
1884 (when (eq file-status 'ignore)
1885 (error "Cannot revert ignored files"))
1886
1887 (when (eq file-status 'unknown)
1888 (error "Cannot revert unknown files"))
1889
1890 (let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
1891 (when (yes-or-no-p (format "Revert %d file%s? "
1892 nfiles
1893 (if (= nfiles 1) "" "s")))
1894 (stgit-capture-output nil
1895 (when rm-file
1896 (stgit-run-git "rm" "-f" "-q" "--" rm-file))
1897 (when co-file
1898 (stgit-run-git "checkout" "HEAD" co-file)))
1899 (stgit-reload)
1900 (stgit-goto-patch patch-name next-file)))))
1901
1902 (defun stgit-revert ()
1903 "Revert the change at point, which must be the index, the work
1904 tree, or a single change in either."
1905 (interactive)
1906 (stgit-assert-mode)
1907 (let ((patched-file (stgit-patched-file-at-point)))
1908 (if patched-file
1909 (stgit-revert-file)
1910 (let* ((patch-name (or (stgit-patch-name-at-point)
1911 (error "No patch or file at point")))
1912 (patch-desc (case patch-name
1913 (:index "index")
1914 (:work "work tree")
1915 (t (error (substitute-command-keys
1916 "Use \\[stgit-delete] to delete a patch"))))))
1917 (when (if (eq patch-name :work)
1918 (stgit-work-tree-empty-p)
1919 (stgit-index-empty-p))
1920 (error (format "There are no changes in the %s to revert"
1921 patch-desc)))
1922 (and (eq patch-name :index)
1923 (not (stgit-work-tree-empty-p))
1924 (error "Cannot revert index as work tree contains unstaged changes"))
1925
1926 (when (yes-or-no-p (format "Revert all changes in the %s? "
1927 patch-desc))
1928 (if (eq patch-name :index)
1929 (stgit-run-git-silent "reset" "--hard" "-q")
1930 (stgit-run-git-silent "checkout" "--" "."))
1931 (stgit-refresh-index)
1932 (stgit-refresh-worktree)
1933 (stgit-goto-patch patch-name))))))
1934
1935 (defun stgit-resolve-file ()
1936 "Resolve conflict in the file at point."
1937 (interactive)
1938 (stgit-assert-mode)
1939 (let* ((patched-file (stgit-patched-file-at-point))
1940 (patch (stgit-patch-at-point))
1941 (patch-name (and patch (stgit-patch->name patch)))
1942 (status (and patched-file (stgit-file->status patched-file))))
1943
1944 (unless (memq patch-name '(:work :index))
1945 (error "No index or working tree file on this line"))
1946
1947 (unless (eq status 'unmerged)
1948 (error "No conflict to resolve at the current line"))
1949
1950 (stgit-capture-output nil
1951 (stgit-move-change-to-index (stgit-file->file patched-file)))
1952
1953 (stgit-reload)))
1954
1955 (defun stgit-push-or-pop-patches (do-push npatches)
1956 "Push (if DO-PUSH is not nil) or pop (if DO-PUSH is nil)
1957 NPATCHES patches, or all patches if NPATCHES is t."
1958 (stgit-assert-mode)
1959 (stgit-capture-output nil
1960 (apply 'stgit-run
1961 (if do-push "push" "pop")
1962 (if (eq npatches t)
1963 '("--all")
1964 (list "-n" npatches))))
1965 (stgit-reload)
1966 (stgit-refresh-git-status))
1967
1968 (defun stgit-push-next (npatches)
1969 "Push the first unapplied patch.
1970 With numeric prefix argument, push that many patches."
1971 (interactive "p")
1972 (stgit-push-or-pop-patches t npatches))
1973
1974 (defun stgit-pop-next (npatches)
1975 "Pop the topmost applied patch.
1976 With numeric prefix argument, pop that many patches.
1977
1978 If NPATCHES is t, pop all patches."
1979 (interactive "p")
1980 (stgit-push-or-pop-patches nil npatches))
1981
1982 (defun stgit-applied-patches (&optional only-patches)
1983 "Return a list of the applied patches.
1984
1985 If ONLY-PATCHES is not nil, exclude index and work tree."
1986 (let ((states (if only-patches
1987 '(applied top)
1988 '(applied top index work)))
1989 result)
1990 (ewoc-map (lambda (patch)
1991 (when (memq (stgit-patch->status patch) states)
1992 (setq result (cons patch result)))
1993 nil)
1994 stgit-ewoc)
1995 result))
1996
1997 (defun stgit-applied-patchsyms (&optional only-patches)
1998 "Return a list of the symbols of the applied patches.
1999
2000 If ONLY-PATCHES is not nil, exclude index and work tree."
2001 (mapcar #'stgit-patch->name (stgit-applied-patches only-patches)))
2002
2003 (defun stgit-push-or-pop ()
2004 "Push or pop the marked patches."
2005 (interactive)
2006 (stgit-assert-mode)
2007 (let* ((patchsyms (stgit-patches-marked-or-at-point t t))
2008 (applied-syms (stgit-applied-patchsyms t))
2009 (unapplied (set-difference patchsyms applied-syms)))
2010 (stgit-capture-output nil
2011 (apply 'stgit-run
2012 (if unapplied "push" "pop")
2013 "--"
2014 (stgit-sort-patches (if unapplied unapplied patchsyms)))))
2015 (stgit-reload))
2016
2017 (defun stgit-at-header-p ()
2018 "Return non-nil if point is in the header area above all patches."
2019 (not (previous-single-property-change (point) 'patch-data)))
2020
2021 (defun stgit-at-footer-p ()
2022 "Return non-nil if point is in the footer area below all patches."
2023 (not (next-single-property-change (point) 'patch-data)))
2024
2025 (defun stgit-goto-target ()
2026 "Return the goto target at point: a patchsym, :top,
2027 or :bottom."
2028 (let ((patch (stgit-patch-at-point)))
2029 (cond (patch
2030 (case (stgit-patch->status patch)
2031 ((work index) nil)
2032 ((committed) :bottom)
2033 (t (stgit-patch->name patch))))
2034 ((stgit-at-footer-p)
2035 :top)
2036 ((stgit-at-header-p)
2037 :bottom))))
2038
2039 (defun stgit-goto ()
2040 "Go to the patch on the current line.
2041
2042 Push or pop patches to make this patch topmost. Push or pop all
2043 patches if used on a line after or before all patches."
2044 (interactive)
2045 (stgit-assert-mode)
2046 (let ((patchsym (stgit-goto-target)))
2047 (unless patchsym
2048 (error "No patch to go to on this line"))
2049 (case patchsym
2050 (:top (stgit-push-or-pop-patches t t))
2051 (:bottom (stgit-push-or-pop-patches nil t))
2052 (t (stgit-capture-output nil
2053 (stgit-run "goto" "--" patchsym))
2054 (stgit-reload)))))
2055
2056 (defun stgit-id (patchsym)
2057 "Return the git commit id for PATCHSYM.
2058 If PATCHSYM is a keyword, returns PATCHSYM unmodified."
2059 (if (keywordp patchsym)
2060 patchsym
2061 (let ((result (with-output-to-string
2062 (stgit-run-silent "id" "--" patchsym))))
2063 (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
2064 (error "Cannot find commit id for %s" patchsym))
2065 (match-string 1 result))))
2066
2067 (defun stgit-whitespace-diff-arg (arg)
2068 (when (numberp arg)
2069 (cond ((> arg 4) "--ignore-all-space")
2070 ((> arg 1) "--ignore-space-change"))))
2071
2072 (defun stgit-show-patch (unmerged-stage ignore-whitespace)
2073 "Show the patch on the current line.
2074
2075 UNMERGED-STAGE is the argument to `git-diff' that that selects
2076 which stage to diff against in the case of unmerged files."
2077 (let ((space-arg (stgit-whitespace-diff-arg ignore-whitespace))
2078 (patch-name (stgit-patch-name-at-point t)))
2079 (stgit-capture-output "*StGit patch*"
2080 (case (get-text-property (point) 'entry-type)
2081 ('file
2082 (let* ((patched-file (stgit-patched-file-at-point))
2083 (patch-id (let ((id (stgit-id patch-name)))
2084 (if (and (eq id :index)
2085 (eq (stgit-file->status patched-file)
2086 'unmerged))
2087 :work
2088 id)))
2089 (args (append (and space-arg (list space-arg))
2090 (and (stgit-file->cr-from patched-file)
2091 (list (stgit-find-copies-harder-diff-arg)))
2092 (cond ((eq patch-id :index)
2093 '("--cached"))
2094 ((eq patch-id :work)
2095 (list unmerged-stage))
2096 (t
2097 (list (concat patch-id "^") patch-id)))
2098 (and (eq (stgit-file->status patched-file) 'copy)
2099 '("--diff-filter=C"))
2100 '("--")
2101 (if (stgit-file->copy-or-rename patched-file)
2102 (list (stgit-file->cr-from patched-file)
2103 (stgit-file->cr-to patched-file))
2104 (list (stgit-file->file patched-file))))))
2105 (apply 'stgit-run-git "diff" args)))
2106 ('patch
2107 (let* ((patch-id (stgit-id patch-name)))
2108 (if (or (eq patch-id :index) (eq patch-id :work))
2109 (apply 'stgit-run-git "diff"
2110 (stgit-find-copies-harder-diff-arg)
2111 (append (and space-arg (list space-arg))
2112 (if (eq patch-id :index)
2113 '("--cached")
2114 (list unmerged-stage))))
2115 (let ((args (append '("show" "-O" "--patch-with-stat")
2116 `("-O" ,(stgit-find-copies-harder-diff-arg))
2117 (and space-arg (list "-O" space-arg))
2118 '("--")
2119 (list (stgit-patch-name-at-point)))))
2120 (apply 'stgit-run args)))))
2121 (t
2122 (error "No patch or file at point")))
2123 (with-current-buffer standard-output
2124 (goto-char (point-min))
2125 (diff-mode)))))
2126
2127 (defmacro stgit-define-diff (name diff-arg &optional unmerged-action)
2128 `(defun ,name (&optional ignore-whitespace)
2129 ,(format "Show the patch on the current line.
2130
2131 %sWith a prefix argument, ignore whitespace. With a prefix argument
2132 greater than four (e.g., \\[universal-argument] \
2133 \\[universal-argument] \\[%s]), ignore all whitespace."
2134 (if unmerged-action
2135 (format "For unmerged files, %s.\n\n" unmerged-action)
2136 "")
2137 name)
2138 (interactive "p")
2139 (stgit-assert-mode)
2140 (stgit-show-patch ,diff-arg ignore-whitespace)))
2141
2142 (stgit-define-diff stgit-diff
2143 "--ours" nil)
2144 (stgit-define-diff stgit-diff-ours
2145 "--ours"
2146 "diff against our branch")
2147 (stgit-define-diff stgit-diff-theirs
2148 "--theirs"
2149 "diff against their branch")
2150 (stgit-define-diff stgit-diff-base
2151 "--base"
2152 "diff against the merge base")
2153 (stgit-define-diff stgit-diff-combined
2154 "--cc"
2155 "show a combined diff")
2156
2157 (defun stgit-diff-range (&optional ignore-whitespace)
2158 "Show diff for the range of patches between point and the marked patch.
2159
2160 With a prefix argument, ignore whitespace. With a prefix argument
2161 greater than four (e.g., \\[universal-argument] \
2162 \\[universal-argument] \\[stgit-diff-range]), ignore all whitespace."
2163 (interactive "p")
2164 (stgit-assert-mode)
2165 (unless (= (length stgit-marked-patches) 1)
2166 (error "Need exactly one patch marked"))
2167 (let* ((patches (stgit-sort-patches
2168 (cons (stgit-patch-name-at-point t 'allow-committed)
2169 stgit-marked-patches)
2170 t))
2171 (first-patch (car patches))
2172 (second-patch (if (cdr patches) (cadr patches) first-patch))
2173 (whitespace-arg (stgit-whitespace-diff-arg ignore-whitespace))
2174 (applied (stgit-applied-patchsyms t)))
2175 (unless (and (memq first-patch applied) (memq second-patch applied))
2176 (error "Can only show diff range for applied patches"))
2177 (stgit-capture-output (format "*StGit diff %s..%s*"
2178 first-patch second-patch)
2179 (apply 'stgit-run-git
2180 "diff" "--patch-with-stat"
2181 (stgit-find-copies-harder-diff-arg)
2182 (append (and whitespace-arg (list whitespace-arg))
2183 (list (format "%s^" (stgit-id first-patch))
2184 (stgit-id second-patch))))
2185 (with-current-buffer standard-output
2186 (goto-char (point-min))
2187 (diff-mode)))))
2188
2189 (defun stgit-move-change-to-index (file &optional force)
2190 "Copies the work tree state of FILE to index, using git add or git rm.
2191
2192 If FORCE is not nil, use --force."
2193 (let ((op (if (or (file-exists-p file) (file-symlink-p file))
2194 '("add") '("rm" "-q"))))
2195 (stgit-capture-output "*git output*"
2196 (apply 'stgit-run-git (append op (and force '("--force"))
2197 '("--") (list file))))))
2198
2199 (defun stgit-remove-change-from-index (file)
2200 "Unstages the change in FILE from the index"
2201 (stgit-capture-output "*git output*"
2202 (stgit-run-git "reset" "-q" "--" file)))
2203
2204 (defun stgit-git-index-unmerged-p ()
2205 (let (result)
2206 (with-output-to-string
2207 (setq result (not (zerop (stgit-run-git-silent "diff-index" "--cached"
2208 "--diff-filter=U"
2209 "--quiet" "HEAD")))))
2210 result))
2211
2212 (defun stgit-file-toggle-index ()
2213 "Move modified file in or out of the index.
2214
2215 Leaves the point where it is, but moves the mark to where the
2216 file ended up. You can then jump to the file with \
2217 \\[exchange-point-and-mark]."
2218 (interactive)
2219 (stgit-assert-mode)
2220 (let* ((patched-file (or (stgit-patched-file-at-point)
2221 (error "No file on the current line")))
2222 (patched-status (stgit-file->status patched-file)))
2223 (when (eq patched-status 'unmerged)
2224 (error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index")))
2225 (let* ((patch (stgit-patch-at-point))
2226 (patch-name (stgit-patch->name patch))
2227 (mark-file (if (eq patched-status 'rename)
2228 (stgit-file->cr-to patched-file)
2229 (stgit-file->file patched-file)))
2230 (point-file (if (eq patched-status 'rename)
2231 (stgit-file->cr-from patched-file)
2232 (stgit-neighbour-file))))
2233
2234 (cond ((eq patch-name :work)
2235 (stgit-move-change-to-index (stgit-file->file patched-file)
2236 (eq patched-status 'ignore)))
2237 ((eq patch-name :index)
2238 (stgit-remove-change-from-index (stgit-file->file patched-file)))
2239 (t
2240 (error "Can only move files between working tree and index")))
2241 (stgit-refresh-worktree)
2242 (stgit-refresh-index)
2243 (stgit-goto-patch (if (eq patch-name :index) :work :index) mark-file)
2244 (push-mark nil t t)
2245 (stgit-goto-patch patch-name point-file))))
2246
2247 (defun stgit-toggle-index ()
2248 "Move change in or out of the index.
2249
2250 Works on index and work tree, as well as files in either.
2251
2252 Leaves the point where it is, but moves the mark to where the
2253 file ended up. You can then jump to the file with \
2254 \\[exchange-point-and-mark]."
2255 (interactive)
2256 (stgit-assert-mode)
2257 (if (stgit-patched-file-at-point)
2258 (stgit-file-toggle-index)
2259 (let ((patch-name (stgit-patch-name-at-point)))
2260 (unless (memq patch-name '(:index :work))
2261 (error "Can only move changes between working tree and index"))
2262 (when (stgit-git-index-unmerged-p)
2263 (error "Resolve unmerged changes with \\[stgit-resolve-file] first"))
2264 (if (if (eq patch-name :index)
2265 (stgit-index-empty-p)
2266 (stgit-work-tree-empty-p))
2267 (message "No changes to be moved")
2268 (stgit-capture-output nil
2269 (if (eq patch-name :work)
2270 (stgit-run-git "add" "--update")
2271 (stgit-run-git "reset" "--mixed" "-q")))
2272 (stgit-refresh-worktree)
2273 (stgit-refresh-index))
2274 (stgit-goto-patch (if (eq patch-name :index) :work :index)))))
2275
2276 (defun stgit-edit ()
2277 "Edit the patch on the current line."
2278 (interactive)
2279 (stgit-assert-mode)
2280 (let ((patchsym (stgit-patch-name-at-point t t))
2281 (edit-buf (get-buffer-create "*StGit edit*"))
2282 (dir default-directory))
2283 (log-edit 'stgit-confirm-edit t nil edit-buf)
2284 (set (make-local-variable 'stgit-edit-patchsym) patchsym)
2285 (setq default-directory dir)
2286 (let ((standard-output edit-buf))
2287 (save-excursion
2288 (stgit-run-silent "edit" "--save-template=-" "--" patchsym)))))
2289
2290 (defun stgit-confirm-edit ()
2291 (interactive)
2292 (let ((file (make-temp-file "stgit-edit-")))
2293 (write-region (point-min) (point-max) file)
2294 (stgit-capture-output nil
2295 (stgit-run "edit" "-f" file "--" stgit-edit-patchsym))
2296 (with-current-buffer log-edit-parent-buffer
2297 (stgit-reload))))
2298
2299 (defun stgit-new (add-sign &optional refresh)
2300 "Create a new patch.
2301 With a prefix argument, include a \"Signed-off-by:\" line at the
2302 end of the patch."
2303 (interactive "P")
2304 (stgit-assert-mode)
2305 (let ((edit-buf (get-buffer-create "*StGit edit*"))
2306 (dir default-directory))
2307 (log-edit 'stgit-confirm-new t nil edit-buf)
2308 (setq default-directory dir)
2309 (set (make-local-variable 'stgit-refresh-after-new) refresh)
2310 (when add-sign
2311 (save-excursion
2312 (let ((standard-output (current-buffer)))
2313 (stgit-run-silent "new" "--sign" "--save-template=-"))))))
2314
2315 (defun stgit-confirm-new ()
2316 (interactive)
2317 (let ((file (make-temp-file "stgit-edit-"))
2318 (refresh stgit-refresh-after-new))
2319 (write-region (point-min) (point-max) file)
2320 (stgit-capture-output nil
2321 (stgit-run "new" "-f" file))
2322 (with-current-buffer log-edit-parent-buffer
2323 (if refresh
2324 (stgit-refresh)
2325 (stgit-reload)))))
2326
2327 (defun stgit-new-and-refresh (add-sign)
2328 "Create a new patch and refresh it with the current changes.
2329
2330 With a prefix argument, include a \"Signed-off-by:\" line at the
2331 end of the patch.
2332
2333 This works just like running `stgit-new' followed by `stgit-refresh'."
2334 (interactive "P")
2335 (stgit-assert-mode)
2336 (stgit-new add-sign t))
2337
2338 (defun stgit-create-patch-name (description)
2339 "Create a patch name from a long description"
2340 (let ((patch ""))
2341 (while (> (length description) 0)
2342 (cond ((string-match "\\`[a-zA-Z_-]+" description)
2343 (setq patch (downcase (concat patch
2344 (match-string 0 description))))
2345 (setq description (substring description (match-end 0))))
2346 ((string-match "\\` +" description)
2347 (setq patch (concat patch "-"))
2348 (setq description (substring description (match-end 0))))
2349 ((string-match "\\`[^a-zA-Z_-]+" description)
2350 (setq description (substring description (match-end 0))))))
2351 (cond ((= (length patch) 0)
2352 "patch")
2353 ((> (length patch) 20)
2354 (substring patch 0 20))
2355 (t patch))))
2356
2357 (defun stgit-delete (patchsyms &optional spill-p)
2358 "Delete the patches in PATCHSYMS.
2359 Interactively, delete the marked patches, or the patch at point.
2360
2361 With a prefix argument, or SPILL-P, spill the patch contents to
2362 the work tree and index."
2363 (interactive (list (stgit-patches-marked-or-at-point t t)
2364 current-prefix-arg))
2365 (stgit-assert-mode)
2366 (unless patchsyms
2367 (error "No patches to delete"))
2368 (when (memq :index patchsyms)
2369 (error "Cannot delete the index"))
2370 (when (memq :work patchsyms)
2371 (error "Cannot delete the work tree"))
2372
2373 (let ((npatches (length patchsyms)))
2374 (when (yes-or-no-p (format "Really delete %d patch%s%s? "
2375 npatches
2376 (if (= 1 npatches) "" "es")
2377 (if spill-p
2378 " (spilling contents to index)"
2379 "")))
2380 (let ((args (append (when spill-p '("--spill"))
2381 '("--")
2382 patchsyms)))
2383 (stgit-capture-output nil
2384 (apply 'stgit-run "delete" args))
2385 (stgit-reload)))))
2386
2387 (defun stgit-move-patches-target ()
2388 "Return the patchsym indicating a target patch for
2389 `stgit-move-patches'.
2390
2391 This is either the first unmarked patch at or after point, or one
2392 of :top and :bottom if the point is after or before the applied
2393 patches."
2394
2395 (save-excursion
2396 (let (result)
2397 (while (not result)
2398 (let ((patchsym (stgit-patch-name-at-point)))
2399 (cond ((memq patchsym '(:work :index)) (setq result :top))
2400 (patchsym (if (memq patchsym stgit-marked-patches)
2401 (stgit-next-patch)
2402 (setq result patchsym)))
2403 ((re-search-backward "^>" nil t) (setq result :top))
2404 (t (setq result :bottom)))))
2405 result)))
2406
2407 (defun stgit-sort-patches (patchsyms &optional allow-duplicates)
2408 "Returns the list of patches in PATCHSYMS sorted according to
2409 their position in the patch series, bottommost first.
2410
2411 PATCHSYMS must not contain duplicate entries, unless
2412 ALLOW-DUPLICATES is not nil."
2413 (let (sorted-patchsyms)
2414 (ewoc-map #'(lambda (patch)
2415 (let ((name (stgit-patch->name patch)))
2416 (when (memq name patchsyms)
2417 (setq sorted-patchsyms (cons name sorted-patchsyms))))
2418 nil)
2419 stgit-ewoc)
2420 (setq sorted-patchsyms (nreverse sorted-patchsyms))
2421
2422 (unless allow-duplicates
2423 (unless (= (length patchsyms) (length sorted-patchsyms))
2424 (error "Internal error")))
2425
2426 sorted-patchsyms))
2427
2428 (defun stgit-move-patches (patchsyms target-patch)
2429 "Move the patches in PATCHSYMS to below TARGET-PATCH.
2430 If TARGET-PATCH is :bottom or :top, move the patches to the
2431 bottom or top of the stack, respectively.
2432
2433 Interactively, move the marked patches to where the point is."
2434 (interactive (list stgit-marked-patches
2435 (stgit-move-patches-target)))
2436 (stgit-assert-mode)
2437 (unless patchsyms
2438 (error "Need at least one patch to move"))
2439
2440 (unless target-patch
2441 (error "Point not at a patch"))
2442
2443 ;; need to have patchsyms sorted by position in the stack
2444 (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
2445 (stgit-capture-output nil
2446 (if (eq target-patch :top)
2447 (apply 'stgit-run "float" "--" sorted-patchsyms)
2448 (apply 'stgit-run
2449 "sink"
2450 (append (unless (eq target-patch :bottom)
2451 (list "--to" target-patch))
2452 '("--")
2453 sorted-patchsyms)))))
2454 (stgit-reload))
2455
2456 (defun stgit-squash (patchsyms)
2457 "Squash the patches in PATCHSYMS.
2458 Interactively, squash the marked patches.
2459
2460 Unless there are any conflicts, the patches will be merged into
2461 one patch, which will occupy the same spot in the series as the
2462 deepest patch had before the squash."
2463 (interactive (list stgit-marked-patches))
2464 (stgit-assert-mode)
2465 (when (< (length patchsyms) 2)
2466 (error "Need at least two patches to squash"))
2467 (let ((stgit-buffer (current-buffer))
2468 (edit-buf (get-buffer-create "*StGit edit*"))
2469 (dir default-directory)
2470 (sorted-patchsyms (stgit-sort-patches patchsyms)))
2471 (log-edit 'stgit-confirm-squash t nil edit-buf)
2472 (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms)
2473 (setq default-directory dir)
2474 (let ((result (let ((standard-output edit-buf))
2475 (save-excursion
2476 (apply 'stgit-run-silent "squash"
2477 "--save-template=-" "--" sorted-patchsyms)))))
2478
2479 ;; stg squash may have reordered the patches or caused conflicts
2480 (with-current-buffer stgit-buffer
2481 (stgit-reload))
2482
2483 (unless (eq 0 result)
2484 (fundamental-mode)
2485 (rename-buffer "*StGit error*")
2486 (resize-temp-buffer-window)
2487 (switch-to-buffer-other-window stgit-buffer)
2488 (error "stg squash failed")))))
2489
2490 (defun stgit-confirm-squash ()
2491 (interactive)
2492 (let ((file (make-temp-file "stgit-edit-")))
2493 (write-region (point-min) (point-max) file)
2494 (stgit-capture-output nil
2495 (apply 'stgit-run "squash" "-f" file "--" stgit-patchsyms))
2496 (with-current-buffer log-edit-parent-buffer
2497 (stgit-clear-marks)
2498 ;; Go to first marked patch and stay there
2499 (goto-char (point-min))
2500 (re-search-forward (concat "^[>+-]\\*") nil t)
2501 (move-to-column goal-column)
2502 (let ((pos (point)))
2503 (stgit-reload)
2504 (goto-char pos)))))
2505
2506 (defun stgit-help ()
2507 "Display help for the StGit mode."
2508 (interactive)
2509 (describe-function 'stgit-mode))
2510
2511 (defun stgit-execute-process-sentinel (process sentinel)
2512 (let (old-sentinel stgit-buf)
2513 (with-current-buffer (process-buffer process)
2514 (setq old-sentinel old-process-sentinel
2515 stgit-buf stgit-buffer))
2516 (and (memq (process-status process) '(exit signal))
2517 (buffer-live-p stgit-buf)
2518 (with-current-buffer stgit-buf
2519 (stgit-reload)))
2520 (funcall old-sentinel process sentinel)))
2521
2522 (defun stgit-execute-process-filter (process output)
2523 (with-current-buffer (process-buffer process)
2524 (let* ((old-point (point))
2525 (pmark (process-mark process))
2526 (insert-at (marker-position pmark))
2527 (at-pmark (= insert-at old-point)))
2528 (goto-char insert-at)
2529 (insert-before-markers output)
2530 (comint-carriage-motion insert-at (point))
2531 (set-marker pmark (point))
2532 (unless at-pmark
2533 (goto-char old-point)))))
2534
2535 (defun stgit-execute (&optional git-mode)
2536 "Prompt for an stg command to execute in a shell.
2537
2538 The names of any marked patches or the patch at point are
2539 inserted in the command to be executed.
2540
2541 With a prefix argument, or if GIT-MODE is non-nil, insert SHA1
2542 sums of the marked patches instead, and prompt for a git command.
2543
2544 If the command ends in an ampersand, run it asynchronously.
2545
2546 When the command has finished, reload the stgit buffer."
2547 (interactive "P")
2548 (stgit-assert-mode)
2549 (let* ((patches (stgit-sort-patches
2550 (stgit-patches-marked-or-at-point nil 'allow-committed)))
2551 (patch-names (mapcar 'symbol-name patches))
2552 (hyphens (find-if (lambda (s) (string-match "^-" s)) patch-names))
2553 (defaultcmd (if patches
2554 (concat (if git-mode "git" "stg") " "
2555 (and hyphens "-- ")
2556 (mapconcat (if git-mode 'stgit-id 'identity)
2557 patch-names " "))
2558 "stg "))
2559 (cmd (read-from-minibuffer "Shell command: " (cons defaultcmd 5)
2560 nil nil 'shell-command-history))
2561 (async (string-match "&[ \t]*\\'" cmd))
2562 (buffer (get-buffer-create
2563 (if async
2564 "*Async Shell Command*"
2565 "*Shell Command Output*"))))
2566 ;; cannot use minibuffer as stgit-reload would overwrite it; if we
2567 ;; show the buffer, shell-command will not use the minibuffer
2568 (display-buffer buffer)
2569 (shell-command cmd)
2570 (if async
2571 (let ((old-buffer (current-buffer)))
2572 (with-current-buffer buffer
2573 (let ((process (get-buffer-process buffer)))
2574 (set (make-local-variable 'old-process-sentinel)
2575 (process-sentinel process))
2576 (set (make-local-variable 'stgit-buffer)
2577 old-buffer)
2578 (set-process-filter process 'stgit-execute-process-filter)
2579 (set-process-sentinel process 'stgit-execute-process-sentinel))))
2580 (with-current-buffer buffer
2581 (comint-carriage-motion (point-min) (point-max)))
2582 (shrink-window-if-larger-than-buffer (get-buffer-window buffer))
2583 (stgit-reload))))
2584
2585 (defun stgit-undo-or-redo (redo hard)
2586 "Run stg undo or, if REDO is non-nil, stg redo.
2587
2588 If HARD is non-nil, use the --hard flag."
2589 (stgit-assert-mode)
2590 (let ((cmd (if redo "redo" "undo")))
2591 (stgit-capture-output nil
2592 (if arg
2593 (when (or (and (stgit-index-empty-p)
2594 (stgit-work-tree-empty-p))
2595 (y-or-n-p (format "Hard %s may overwrite index/work tree changes. Continue? "
2596 cmd)))
2597 (stgit-run cmd "--hard"))
2598 (stgit-run cmd))))
2599 (stgit-reload))
2600
2601 (defun stgit-undo (&optional arg)
2602 "Run stg undo.
2603 With prefix argument, run it with the --hard flag.
2604
2605 See also `stgit-redo'."
2606 (interactive "P")
2607 (stgit-undo-or-redo nil arg))
2608
2609 (defun stgit-redo (&optional arg)
2610 "Run stg redo.
2611 With prefix argument, run it with the --hard flag.
2612
2613 See also `stgit-undo'."
2614 (interactive "P")
2615 (stgit-undo-or-redo t arg))
2616
2617 (defun stgit-refresh (&optional arg)
2618 "Run stg refresh.
2619 If the index contains any changes, only refresh from index.
2620
2621 With prefix argument, refresh the marked patch or the patch under point."
2622 (interactive "P")
2623 (stgit-assert-mode)
2624 (let ((patchargs (if arg
2625 (let ((patches (stgit-patches-marked-or-at-point t t)))
2626 (when (> (length patches) 1)
2627 (error "Too many patches marked"))
2628 (cons "-p" patches))
2629 nil)))
2630 (unless (stgit-index-empty-p)
2631 (setq patchargs (cons "--index" patchargs)))
2632 (stgit-capture-output nil
2633 (apply 'stgit-run "refresh" patchargs))
2634 (stgit-refresh-git-status))
2635 (stgit-reload))
2636
2637 (defvar stgit-show-worktree nil
2638 "If nil, inhibit showing work tree and index in the stgit buffer.
2639
2640 See also `stgit-show-worktree-mode'.")
2641
2642 (defvar stgit-show-ignored nil
2643 "If nil, inhibit showing files ignored by git.")
2644
2645 (defvar stgit-show-unknown nil
2646 "If nil, inhibit showing files not registered with git.")
2647
2648 (defvar stgit-show-patch-names t
2649 "If nil, inhibit showing patch names.")
2650
2651 (defvar stgit-show-committed nil
2652 "If nil, inhibit showing recent commits.")
2653
2654 (defvar stgit-show-svn nil
2655 "If nil, inhibit showing git svn information.")
2656
2657 (defvar stgit-committed-count nil
2658 "The number of recent commits to show.")
2659
2660 (defmacro stgit-define-toggle-view (sym desc help)
2661 (declare (indent 1))
2662 (let* ((name (symbol-name sym))
2663 (fun (intern (concat "stgit-toggle-" name)))
2664 (flag (intern (concat "stgit-show-" name))))
2665 ;; make help-follow find the correct function
2666 `(put (quote ,fun) 'definition-name 'stgit-define-toggle-view)
2667 `(defun ,fun (&optional arg)
2668 ,help
2669 (interactive "P")
2670 (stgit-assert-mode)
2671 (setq ,flag (if arg
2672 (> (prefix-numeric-value arg) 0)
2673 (not ,flag)))
2674 (stgit-reload (format "%s %s" (if ,flag "Showing" "Hiding") ,desc)))))
2675
2676 (stgit-define-toggle-view worktree
2677 "work tree and index"
2678 "Toggle the visibility of the work tree.
2679 With ARG, show the work tree if ARG is positive.
2680
2681 Its initial setting is controlled by `stgit-default-show-worktree'.
2682
2683 `stgit-show-worktree-mode' controls where on screen the index and
2684 work tree will show up.")
2685
2686 (stgit-define-toggle-view ignored
2687 "ignored files"
2688 "Toggle the visibility of files ignored by git in the work
2689 tree. With ARG, show these files if ARG is positive.
2690
2691 Its initial setting is controlled by `stgit-default-show-ignored'.
2692
2693 Use \\[stgit-toggle-worktree] to show the work tree.")
2694
2695 (stgit-define-toggle-view unknown
2696 "unknown files"
2697 "Toggle the visibility of files not registered with git in the
2698 work tree. With ARG, show these files if ARG is positive.
2699
2700 Its initial setting is controlled by `stgit-default-show-unknown'.
2701
2702 Use \\[stgit-toggle-worktree] to show the work tree.")
2703
2704 (stgit-define-toggle-view patch-names
2705 "patch names"
2706 "Toggle the visibility of patch names. With ARG, show patch names
2707 if ARG is positive.
2708
2709 The initial setting is controlled by `stgit-default-show-patch-names'.")
2710
2711 (stgit-define-toggle-view svn
2712 "subversion revisions"
2713 "Toggle showing subversion information from git svn. With ARG,
2714 show svn information if ARG is positive.
2715
2716 The initial setting is controlled by `stgit-default-show-svn'.")
2717
2718 (defun stgit-toggle-committed (&optional arg)
2719 "Toggle the visibility of historical git commits.
2720 With ARG, set the number of commits to show to ARG, and disable
2721 them if ARG is zero.
2722
2723 The initial setting is controlled by `stgit-default-show-committed'."
2724 (interactive "P")
2725 (stgit-assert-mode)
2726 (if (null arg)
2727 (setq stgit-show-committed (not stgit-show-committed))
2728 (let ((n (prefix-numeric-value arg)))
2729 (setq stgit-show-committed (> n 0))
2730 (setq stgit-committed-count n)))
2731 (stgit-reload (format "%s historical commits"
2732 (if (and stgit-show-committed
2733 (> stgit-committed-count 0))
2734 "Showing"
2735 "Hiding"))))
2736
2737 (provide 'stgit)