X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/e558a4abe4756f98845f1b8443b8730f816bd4e3..6c82670d2b729cf1b491241044d9bab58b572597:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index c8d9368..44a3f51 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -68,6 +68,8 @@ Argument DIR is the repository path." "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)) @@ -82,7 +84,6 @@ Returns nil if there was no output." (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." @@ -418,7 +419,7 @@ find copied files." (error "File does not exist")) (find-file filename)))) -(defun stgit-toggle-patch-file-list (curpath) +(defun stgit-select-patch (curpath) (let ((inhibit-read-only t)) (if (memq curpatch stgit-expanded-patches) (save-excursion @@ -433,7 +434,7 @@ find copied files." (interactive) (let ((curpatch (stgit-patch-at-point))) (if curpatch - (stgit-toggle-patch-file-list curpatch) + (stgit-select-patch curpatch) (stgit-select-file)))) @@ -463,19 +464,23 @@ 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" + (cond ((get-text-property (point) 'stgit-file-patchsym) 4) + ((get-text-property (point) 'stgit-patchsym) 2) + (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" @@ -517,10 +522,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) @@ -528,6 +535,7 @@ find copied files." ("r" . stgit-refresh) ("\C-c\C-r" . stgit-rename) ("e" . stgit-edit) + ("M" . stgit-move-patches) ("S" . stgit-squash) ("N" . stgit-new) ("R" . stgit-repair) @@ -586,14 +594,10 @@ Commands: "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." +If CAUSE-ERROR is not nil, signal an error if none found." (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")))) @@ -785,7 +789,7 @@ With numeric prefix argument, pop that many patches." ;; just one file (stgit-run-git "diff" (concat id "^") id "--" (cdr patched-file))))) - (stgit-run "show" "-O" "--patch-with-stat" patchsym)) + (stgit-run "show" "-O" "--patch-with-stat" "-O" "-M" patchsym)) (with-current-buffer standard-output (goto-char (point-min)) (diff-mode))))) @@ -877,19 +881,101 @@ the work tree and index." (apply 'stgit-run "delete" args)) (stgit-reload))))) +(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." +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 squash")) - (let ((edit-buf (get-buffer-create "*StGit edit*")) - (dir default-directory)) + (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) patchsyms) + (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms) (setq default-directory dir) - (let ((standard-output edit-buf)) - (apply 'stgit-run-silent "squash" "--save-template=-" patchsyms)))) + (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)