X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/5f1b00134eecb000fad349603ce0796ff6061abb..50d88c672d3a540330450fcc8cc87ccc7d44c829:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index b2ef43c..09f3a3c 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -10,6 +10,7 @@ ;; To start: `M-x stgit' (require 'git nil t) +(require 'cl) (defun stgit (dir) "Manage StGit patches for the tree in DIR." @@ -65,7 +66,11 @@ Argument DIR is the repository path." 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)) @@ -80,7 +85,6 @@ Argument DIR is the repository path." (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." @@ -124,7 +128,7 @@ Argument DIR is the repository path." (erase-buffer) (insert "Branch: ") (stgit-run-silent "branch") - (stgit-run-silent "series" "--description") + (stgit-run-silent "series" "--description" "--empty") (stgit-rescan) (if curpatch (stgit-goto-patch curpatch) @@ -314,7 +318,7 @@ find copied files." (line-start (point)) status change - properties) + (properties '(entry-type file))) (insert " ") (if copy-or-rename (let ((cr-score (match-string 5 result)) @@ -322,15 +326,17 @@ find copied files." (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 @@ -350,57 +356,94 @@ find copied files." (insert " \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 - (let ((marked ())) + (let ((marked ()) + found-any) (goto-char (point-min)) (while (not (eobp)) (cond ((looking-at "Branch: \\(.*\\)") (put-text-property (match-beginning 1) (match-end 1) 'face 'bold)) - ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)") - (let ((state (match-string 1)) - (patchsym (intern (match-string 3)))) + ((looking-at "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)") + (setq found-any t) + (let ((empty (match-string 1)) + (state (match-string 2)) + (patchsym (intern (match-string 4)))) (put-text-property - (match-beginning 3) (match-end 3) 'face + (match-beginning 4) (match-end 4) 'face (cond ((string= state ">") 'stgit-top-patch-face) ((string= state "+") 'stgit-applied-patch-face) ((string= state "-") 'stgit-unapplied-patch-face))) - (put-text-property (match-beginning 4) (match-end 4) + (put-text-property (match-beginning 5) (match-end 5) 'face 'stgit-description-face) (when (memq patchsym stgit-marked-patches) - (replace-match "*" nil nil nil 2) + (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) + (save-excursion + (goto-char (match-beginning 5)) + (insert "(empty) "))) + (delete-char 1) )) ((or (looking-at "stg series: Branch \".*\" not initialised") (looking-at "stg series: .*: branch not initialized")) + (setq found-any t) (forward-line 1) (insert "Run M-x stgit-init to initialise"))) (forward-line 1)) - (setq stgit-marked-patches (nreverse marked))))) + (setq stgit-marked-patches (nreverse marked)) + (unless found-any + (insert "\n " + (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" @@ -428,19 +471,24 @@ find copied files." (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" @@ -482,10 +530,12 @@ find copied files." ("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) @@ -493,7 +543,8 @@ find copied files." ("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) @@ -508,7 +559,8 @@ find copied files." ("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. @@ -528,26 +580,36 @@ Commands: (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 @@ -602,22 +664,19 @@ If that patch cannot be found, return nil." "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) @@ -644,16 +703,36 @@ If that patch cannot be found, return nil." (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) @@ -696,34 +775,39 @@ With numeric prefix argument, pop that many patches." (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" 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." @@ -788,40 +872,132 @@ end of the patch." (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