X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/e7231e4f2ac4b73b6ae14762cf82a24aaa12d8f8..6c82670d2b729cf1b491241044d9bab58b572597:/contrib/stgit.el

diff --git a/contrib/stgit.el b/contrib/stgit.el
index 372014f..44a3f51 100644
--- a/contrib/stgit.el
+++ b/contrib/stgit.el
@@ -65,7 +65,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 +84,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."
@@ -350,6 +353,15 @@ find copied files."
         (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
@@ -398,23 +410,33 @@ find copied files."
 		(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 (curpath)
+  (let ((inhibit-read-only t))
+    (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))))
+    (if curpatch
+        (stgit-select-patch curpatch)
+      (stgit-select-file))))
+
 
 (defun stgit-find-file-other-window ()
   "Open file at point in other window"
@@ -442,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"
@@ -496,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)
@@ -507,7 +535,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)
@@ -522,7 +551,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.
@@ -542,24 +572,32 @@ 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."
+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"))))
 
@@ -616,22 +654,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)
@@ -658,16 +693,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)
@@ -734,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)))))
@@ -802,40 +857,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)))
-    (when (yes-or-no-p (format "Really delete %d patch%s? "
+    (when (yes-or-no-p (format "Really delete %d patch%s%s? "
 			       npatches
-			       (if (= 1 npatches) "" "es")))
+			       (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" 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 "delete" patchsyms))
-      (stgit-reload))))
+        (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-coalesce (patchsyms)
-  "Coalesce the patches in PATCHSYMS.
-Interactively, coalesce the marked patches."
+(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