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