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