;; To start: `M-x stgit'
(require 'git nil t)
+(require 'cl)
(defun stgit (dir)
"Manage StGit patches for the tree in DIR."
buf))
(defmacro stgit-capture-output (name &rest body)
- "Capture StGit output and show it in a window at the end."
+ "Capture StGit output and, if there was any output, show it in a window
+at the end.
+Returns nil if there was no output."
+ (declare (debug ([&or stringp null] body))
+ (indent 1))
`(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
(stgit-dir default-directory)
(inhibit-read-only t))
(setq buffer-read-only t)
(if (< (point-min) (point-max))
(display-buffer output-buf t)))))
-(put 'stgit-capture-output 'lisp-indent-function 1)
(defun stgit-make-run-args (args)
"Return a copy of ARGS with its elements converted to strings."
(line-start (point))
status
change
- properties)
+ (properties '(entry-type file)))
(insert " ")
(if copy-or-rename
(let ((cr-score (match-string 5 result))
(cr-to-file (match-string 7 result)))
(setq status (stgit-file-status-code copy-or-rename
cr-score)
- properties (list 'stgit-old-file cr-from-file
- 'stgit-new-file cr-to-file)
+ properties (list* 'stgit-old-file cr-from-file
+ 'stgit-new-file cr-to-file
+ properties)
change (concat
cr-from-file
(propertize " -> "
'face 'stgit-description-face)
cr-to-file)))
(setq status (stgit-file-status-code (match-string 8 result))
- properties (list 'stgit-file (match-string 9 result))
+ properties (list* 'stgit-file (match-string 9 result)
+ properties)
change (match-string 9 result)))
(let ((mode-change (stgit-file-mode-change-string old-perm
(insert " <no files>\n"))
(put-text-property start (point) 'stgit-file-patchsym patchsym))))
+(defun stgit-collapse-patch (patchsym)
+ "Collapse the patch with name PATCHSYM after the line at point."
+ (save-excursion
+ (forward-line)
+ (let ((start (point)))
+ (while (eq (get-text-property (point) 'stgit-file-patchsym) patchsym)
+ (forward-line))
+ (delete-region start (point)))))
+
(defun stgit-rescan ()
"Rescan the status buffer."
(save-excursion
(save-excursion
(replace-match "*" nil nil nil 3))
(setq marked (cons patchsym marked)))
- (put-text-property (match-beginning 0) (match-end 0)
- 'stgit-patchsym patchsym)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'stgit-patchsym patchsym
+ 'entry-type 'patch))
(when (memq patchsym stgit-expanded-patches)
(stgit-expand-patch patchsym))
(when (equal "0" empty)
(propertize "no patches in series"
'face 'stgit-description-face))))))
+(defun stgit-select-file ()
+ (let ((patched-file (stgit-patched-file-at-point)))
+ (unless patched-file
+ (error "No patch or file on the current line"))
+ (let ((filename (expand-file-name (cdr patched-file))))
+ (unless (file-exists-p filename)
+ (error "File does not exist"))
+ (find-file filename))))
+
+(defun stgit-select-patch ()
+ (let ((inhibit-read-only t)
+ (curpatch (stgit-patch-at-point)))
+ (if (memq curpatch stgit-expanded-patches)
+ (save-excursion
+ (setq stgit-expanded-patches (delq curpatch stgit-expanded-patches))
+ (stgit-collapse-patch curpatch))
+ (progn
+ (setq stgit-expanded-patches (cons curpatch stgit-expanded-patches))
+ (stgit-expand-patch curpatch)))))
+
(defun stgit-select ()
"Expand or collapse the current entry"
(interactive)
- (let ((curpatch (stgit-patch-at-point)))
- (if (not curpatch)
- (let ((patched-file (stgit-patched-file-at-point)))
- (unless patched-file
- (error "No patch or file on the current line"))
- (let ((filename (expand-file-name (cdr patched-file))))
- (unless (file-exists-p filename)
- (error "File does not exist"))
- (find-file filename)))
- (setq stgit-expanded-patches
- (if (memq curpatch stgit-expanded-patches)
- (delq curpatch stgit-expanded-patches)
- (cons curpatch stgit-expanded-patches)))
- (stgit-reload))))
+ (case (get-text-property (point) 'entry-type)
+ ('patch
+ (stgit-select-patch))
+ ('file
+ (stgit-select-file))
+ (t
+ (error "No patch or file on line"))))
(defun stgit-find-file-other-window ()
"Open file at point in other window"
(pop-to-buffer nil)
(git-status dir))))
-(defun stgit-next-line (&optional arg try-vscroll)
+(defun stgit-goal-column ()
+ "Return goal column for the current line"
+ (case (get-text-property (point) 'entry-type)
+ ('patch 2)
+ ('file 4)
+ (t 0)))
+
+(defun stgit-next-line (&optional arg)
"Move cursor vertically down ARG lines"
- (interactive "p\np")
- (next-line arg try-vscroll)
- (when (looking-at " \\S-")
- (forward-char 2)))
+ (interactive "p")
+ (next-line arg)
+ (move-to-column (stgit-goal-column)))
-(defun stgit-previous-line (&optional arg try-vscroll)
+(defun stgit-previous-line (&optional arg)
"Move cursor vertically up ARG lines"
- (interactive "p\np")
- (previous-line arg try-vscroll)
- (when (looking-at " \\S-")
- (forward-char 2)))
+ (interactive "p")
+ (previous-line arg)
+ (move-to-column (stgit-goal-column)))
(defun stgit-next-patch (&optional arg)
"Move cursor down ARG patches"
("u" . stgit-unmark-down)
("?" . stgit-help)
("h" . stgit-help)
- ("p" . stgit-previous-line)
- ("n" . stgit-next-line)
- ("\C-p" . stgit-previous-patch)
- ("\C-n" . stgit-next-patch)
+ ("\C-p" . stgit-previous-line)
+ ("\C-n" . stgit-next-line)
+ ([up] . stgit-previous-line)
+ ([down] . stgit-next-line)
+ ("p" . stgit-previous-patch)
+ ("n" . stgit-next-patch)
("\M-{" . stgit-previous-patch)
("\M-}" . stgit-next-patch)
("s" . stgit-git-status)
("r" . stgit-refresh)
("\C-c\C-r" . stgit-rename)
("e" . stgit-edit)
- ("c" . stgit-coalesce)
+ ("M" . stgit-move-patches)
+ ("S" . stgit-squash)
("N" . stgit-new)
("R" . stgit-repair)
("C" . stgit-commit)
("D" . stgit-delete)
([(control ?/)] . stgit-undo)
("\C-_" . stgit-undo)
- ("q" . stgit-quit))))
+ ("B" . stgit-branch)
+ ("q" . stgit-quit))))
(defun stgit-mode ()
"Major mode for interacting with StGit.
(defun stgit-add-mark (patchsym)
"Mark the patch PATCHSYM."
- (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
+ (setq stgit-marked-patches (cons patchsym stgit-marked-patches))
+ (save-excursion
+ (when (stgit-goto-patch patchsym)
+ (move-to-column 1)
+ (let ((inhibit-read-only t))
+ (insert-and-inherit ?*)
+ (delete-char 1)))))
(defun stgit-remove-mark (patchsym)
"Unmark the patch PATCHSYM."
- (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))
+ (setq stgit-marked-patches (delq patchsym stgit-marked-patches))
+ (save-excursion
+ (when (stgit-goto-patch patchsym)
+ (move-to-column 1)
+ (let ((inhibit-read-only t))
+ (insert-and-inherit ? )
+ (delete-char 1)))))
(defun stgit-clear-marks ()
"Unmark all patches."
(setq stgit-marked-patches '()))
-(defun stgit-patch-at-point (&optional cause-error allow-file)
+(defun stgit-patch-at-point (&optional cause-error)
"Return the patch name on the current line as a symbol.
-If CAUSE-ERROR is not nil, signal an error if none found.
-If ALLOW-FILE is not nil, also handle when point is on a file of
-a patch."
- (or (get-text-property (point) 'stgit-patchsym)
- (and allow-file
- (get-text-property (point) 'stgit-file-patchsym))
- (when cause-error
- (error "No patch on this line"))))
+If CAUSE-ERROR is not nil, signal an error if none found."
+ (case (get-text-property (point) 'entry-type)
+ ('patch (get-text-property (point) 'stgit-patchsym))
+ (t (if cause-error
+ (error "No patch on this line")
+ nil))))
(defun stgit-patched-file-at-point (&optional both-files)
"Returns a cons of the patchsym and file name at point. For
"Mark the patch under point."
(interactive)
(let ((patch (stgit-patch-at-point t)))
- (stgit-add-mark patch)
- (stgit-reload))
+ (stgit-add-mark patch))
(stgit-next-patch))
(defun stgit-unmark-up ()
"Remove mark from the patch on the previous line."
(interactive)
(stgit-previous-patch)
- (stgit-remove-mark (stgit-patch-at-point t))
- (stgit-reload))
+ (stgit-remove-mark (stgit-patch-at-point t)))
(defun stgit-unmark-down ()
"Remove mark from the patch on the current line."
(interactive)
(stgit-remove-mark (stgit-patch-at-point t))
- (stgit-reload)
(stgit-next-patch))
(defun stgit-rename (name)
(stgit-run "repair"))
(stgit-reload))
-(defun stgit-commit ()
- "Run stg commit."
- (interactive)
- (stgit-capture-output nil (stgit-run "commit"))
+(defun stgit-available-branches ()
+ "Returns a list of the available stg branches"
+ (let ((output (with-output-to-string
+ (stgit-run "branch" "--list")))
+ (start 0)
+ result)
+ (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start)
+ (setq result (cons (match-string 1 output) result))
+ (setq start (match-end 0)))
+ result))
+
+(defun stgit-branch (branch)
+ "Switch to branch BRANCH."
+ (interactive (list (completing-read "Switch to branch: "
+ (stgit-available-branches))))
+ (stgit-capture-output nil (stgit-run "branch" "--" branch))
+ (stgit-reload))
+
+(defun stgit-commit (count)
+ "Run stg commit on COUNT commits.
+Interactively, the prefix argument is used as COUNT."
+ (interactive "p")
+ (stgit-capture-output nil (stgit-run "commit" "-n" count))
(stgit-reload))
-(defun stgit-uncommit (arg)
- "Run stg uncommit. Numeric arg determines number of patches to uncommit."
+(defun stgit-uncommit (count)
+ "Run stg uncommit on COUNT commits.
+Interactively, the prefix argument is used as COUNT."
(interactive "p")
- (stgit-capture-output nil (stgit-run "uncommit" "-n" arg))
+ (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
(stgit-reload))
(defun stgit-push-next (npatches)
(stgit-reload)))
(defun stgit-id (patchsym)
- "Return the git commit id for PATCHSYM."
- (let ((result (with-output-to-string
- (stgit-run-silent "id" patchsym))))
- (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
- (error "Cannot find commit id for %s" patchsym))
- (match-string 1 result)))
+ "Return the git commit id for PATCHSYM.
+If PATCHSYM is a keyword, returns PATCHSYM unmodified."
+ (if (keywordp patchsym)
+ patchsym
+ (let ((result (with-output-to-string
+ (stgit-run-silent "id" patchsym))))
+ (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
+ (error "Cannot find commit id for %s" patchsym))
+ (match-string 1 result))))
(defun stgit-show ()
"Show the patch on the current line."
(interactive)
(stgit-capture-output "*StGit patch*"
- (let ((patchsym (stgit-patch-at-point)))
- (if (not patchsym)
- (let ((patched-file (stgit-patched-file-at-point t)))
- (unless patched-file
- (error "No patch or file at point"))
- (let ((id (stgit-id (car patched-file))))
- (if (consp (cdr patched-file))
- ;; two files (copy or rename)
- (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
- (cadr patched-file) (cddr patched-file))
- ;; just one file
- (stgit-run-git "diff" (concat id "^") id "--"
- (cdr patched-file)))))
- (stgit-run "show" "-O" "--patch-with-stat" patchsym))
- (with-current-buffer standard-output
- (goto-char (point-min))
- (diff-mode)))))
+ (case (get-text-property (point) 'entry-type)
+ ('file
+ (let ((patchsym (stgit-patch-at-point))
+ (patched-file (stgit-patched-file-at-point t)))
+ (let ((id (stgit-id (car patched-file))))
+ (if (consp (cdr patched-file))
+ ;; two files (copy or rename)
+ (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
+ (cadr patched-file) (cddr patched-file))
+ ;; just one file
+ (stgit-run-git "diff" (concat id "^") id "--"
+ (cdr patched-file))))))
+ ('patch
+ (stgit-run "show" "-O" "--patch-with-stat" "-O" "-M" (stgit-patch-at-point)))
+ (t
+ (error "No patch or file at point")))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (diff-mode))))
(defun stgit-edit ()
"Edit the patch on the current line."
(substring patch 0 20))
(t patch))))
-(defun stgit-delete (patchsyms)
+(defun stgit-delete (patchsyms &optional spill-p)
"Delete the patches in PATCHSYMS.
-Interactively, delete the marked patches, or the patch at point."
- (interactive (list (stgit-patches-marked-or-at-point)))
+Interactively, delete the marked patches, or the patch at point.
+
+With a prefix argument, or SPILL-P, spill the patch contents to
+the work tree and index."
+ (interactive (list (stgit-patches-marked-or-at-point)
+ current-prefix-arg))
+ (unless patchsyms
+ (error "No patches to delete"))
(let ((npatches (length patchsyms)))
- (if (zerop npatches)
- (error "No patches to delete")
- (when (yes-or-no-p (format "Really delete %d patch%s? "
- npatches
- (if (= 1 npatches) "" "es")))
+ (when (yes-or-no-p (format "Really delete %d patch%s%s? "
+ npatches
+ (if (= 1 npatches) "" "es")
+ (if spill-p
+ " (spilling contents to index)"
+ "")))
+ (let ((args (if spill-p
+ (cons "--spill" patchsyms)
+ patchsyms)))
(stgit-capture-output nil
- (apply 'stgit-run "delete" patchsyms))
+ (apply 'stgit-run "delete" args))
(stgit-reload)))))
-(defun stgit-coalesce (patchsyms)
- "Coalesce the patches in PATCHSYMS.
-Interactively, coalesce the marked patches."
+(defun stgit-move-patches-target ()
+ "Return the patchsym indicating a target patch for
+`stgit-move-patches'.
+
+This is either the patch at point, or one of :top and :bottom, if
+the point is after or before the applied patches."
+
+ (let ((patchsym (stgit-patch-at-point)))
+ (cond (patchsym patchsym)
+ ((save-excursion (re-search-backward "^>" nil t)) :top)
+ (t :bottom))))
+
+(defun stgit-sort-patches (patchsyms)
+ "Returns the list of patches in PATCHSYMS sorted according to
+their position in the patch series, bottommost first.
+
+PATCHSYMS may not contain duplicate entries."
+ (let (sorted-patchsyms
+ (series (with-output-to-string
+ (with-current-buffer standard-output
+ (stgit-run-silent "series" "--noprefix"))))
+ start)
+ (while (string-match "^\\(.+\\)" series start)
+ (let ((patchsym (intern (match-string 1 series))))
+ (when (memq patchsym patchsyms)
+ (setq sorted-patchsyms (cons patchsym sorted-patchsyms))))
+ (setq start (match-end 0)))
+ (setq sorted-patchsyms (nreverse sorted-patchsyms))
+
+ (unless (= (length patchsyms) (length sorted-patchsyms))
+ (error "Internal error"))
+
+ sorted-patchsyms))
+
+(defun stgit-move-patches (patchsyms target-patch)
+ "Move the patches in PATCHSYMS to below TARGET-PATCH.
+If TARGET-PATCH is :bottom or :top, move the patches to the
+bottom or top of the stack, respectively.
+
+Interactively, move the marked patches to where the point is."
+ (interactive (list stgit-marked-patches
+ (stgit-move-patches-target)))
+ (unless patchsyms
+ (error "Need at least one patch to move"))
+
+ (unless target-patch
+ (error "Point not at a patch"))
+
+ (if (eq target-patch :top)
+ (stgit-capture-output nil
+ (apply 'stgit-run "float" patchsyms))
+
+ ;; need to have patchsyms sorted by position in the stack
+ (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
+ (while sorted-patchsyms
+ (setq sorted-patchsyms
+ (and (stgit-capture-output nil
+ (if (eq target-patch :bottom)
+ (stgit-run "sink" "--" (car sorted-patchsyms))
+ (stgit-run "sink" "--to" target-patch "--"
+ (car sorted-patchsyms))))
+ (cdr sorted-patchsyms))))))
+ (stgit-reload))
+
+(defun stgit-squash (patchsyms)
+ "Squash the patches in PATCHSYMS.
+Interactively, squash the marked patches.
+
+Unless there are any conflicts, the patches will be merged into
+one patch, which will occupy the same spot in the series as the
+deepest patch had before the squash."
(interactive (list stgit-marked-patches))
(when (< (length patchsyms) 2)
- (error "Need at least two patches to coalesce"))
- (let ((edit-buf (get-buffer-create "*StGit edit*"))
- (dir default-directory))
- (log-edit 'stgit-confirm-coalesce t nil edit-buf)
- (set (make-local-variable 'stgit-patchsyms) patchsyms)
+ (error "Need at least two patches to squash"))
+ (let ((stgit-buffer (current-buffer))
+ (edit-buf (get-buffer-create "*StGit edit*"))
+ (dir default-directory)
+ (sorted-patchsyms (stgit-sort-patches patchsyms)))
+ (log-edit 'stgit-confirm-squash t nil edit-buf)
+ (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms)
(setq default-directory dir)
- (let ((standard-output edit-buf))
- (apply 'stgit-run-silent "coalesce" "--save-template=-" patchsyms))))
-
-(defun stgit-confirm-coalesce ()
+ (let ((result (let ((standard-output edit-buf))
+ (apply 'stgit-run-silent "squash"
+ "--save-template=-" sorted-patchsyms))))
+
+ ;; stg squash may have reordered the patches or caused conflicts
+ (with-current-buffer stgit-buffer
+ (stgit-reload))
+
+ (unless (eq 0 result)
+ (fundamental-mode)
+ (rename-buffer "*StGit error*")
+ (resize-temp-buffer-window)
+ (switch-to-buffer-other-window stgit-buffer)
+ (error "stg squash failed")))))
+
+(defun stgit-confirm-squash ()
(interactive)
(let ((file (make-temp-file "stgit-edit-")))
(write-region (point-min) (point-max) file)
(stgit-capture-output nil
- (apply 'stgit-run "coalesce" "-f" file stgit-patchsyms))
+ (apply 'stgit-run "squash" "-f" file stgit-patchsyms))
(with-current-buffer log-edit-parent-buffer
(stgit-clear-marks)
;; Go to first marked patch and stay there
~mdw / stgit / blobdiff