stgit.el: Optionally allow duplicates when sorting patches

[stgit] / contrib / stgit.el

diff --git a/contrib/stgit.el b/contrib/stgit.el
index 3dd1989..61fca79 100644 (file)
--- a/contrib/stgit.el
+++ b/contrib/stgit.el
@@ -262,6 +262,13 @@ directory DIR or `default-directory'"
       (:work "Work Tree")
       (t (symbol-name name)))))
 
       (:work "Work Tree")
       (t (symbol-name name)))))
 

+(defun stgit-insert-without-trailing-whitespace (text)
+  "Insert TEXT in buffer using `insert', without trailing whitespace.
+A newline is appended."
+  (unless (string-match "\\(.*?\\) *$" text)
+    (error))
+  (insert (match-string 1 text) ?\n))
+

 (defun stgit-patch-pp (patch)
   (let* ((status (stgit-patch->status patch))
          (start (point))
 (defun stgit-patch-pp (patch)
   (let* ((status (stgit-patch->status patch))
          (start (point))


@@ -284,11 +291,14 @@ directory DIR or `default-directory'"
                 ?e (if (stgit-patch->empty patch) "(empty) " "")
                 ?d (propertize (or (stgit-patch->desc patch) "")
                                'face 'stgit-description-face)
                 ?e (if (stgit-patch->empty patch) "(empty) " "")
                 ?d (propertize (or (stgit-patch->desc patch) "")
                                'face 'stgit-description-face)

-                ?D (propertize (or (stgit-patch->desc patch)
-                                   (stgit-patch-display-name patch))
-                               'face face))))
-
-    (insert (format-spec fmt spec) "\n")
+                ?D (propertize (let ((desc (stgit-patch->desc patch)))
+                                 (if (zerop (length desc))
+                                   (stgit-patch-display-name patch)
+                                   desc))
+                               'face face)))
+         (text (format-spec fmt spec)))
+
+    (stgit-insert-without-trailing-whitespace text)

     (put-text-property start (point) 'entry-type 'patch)
     (when (memq name stgit-expanded-patches)
       (stgit-insert-patch-files patch))
     (put-text-property start (point) 'entry-type 'patch)
     (when (memq name stgit-expanded-patches)
       (stgit-insert-patch-files patch))


@@ -651,7 +661,8 @@ Cf. `stgit-file-type-change-string'."
                                (stgit-file->old-perm file)
                                (stgit-file->new-perm file))
                               'face 'stgit-description-face))))
                                (stgit-file->old-perm file)
                                (stgit-file->new-perm file))
                               'face 'stgit-description-face))))

-    (insert (format-spec stgit-file-line-format spec) "\n")
+    (stgit-insert-without-trailing-whitespace
+     (format-spec stgit-file-line-format spec))

     (add-text-properties start (point)
                          (list 'entry-type 'file
                                'file-data file))))
     (add-text-properties start (point)
                          (list 'entry-type 'file
                                'file-data file))))


@@ -1608,23 +1619,32 @@ tree, or a single change in either."
 
     (stgit-reload)))
 
 
     (stgit-reload)))
 

+(defun stgit-push-or-pop-patches (do-push npatches)
+  "Push (if DO-PUSH is not nil) or pop (if DO-PUSH is nil)
+NPATCHES patches, or all patches if NPATCHES is t."
+  (stgit-assert-mode)
+  (stgit-capture-output nil
+    (apply 'stgit-run
+           (if do-push "push" "pop")
+           (if (eq npatches t)
+               '("--all")
+             (list "-n" npatches))))
+  (stgit-reload)
+  (stgit-refresh-git-status))
+

 (defun stgit-push-next (npatches)
   "Push the first unapplied patch.
 With numeric prefix argument, push that many patches."
   (interactive "p")
 (defun stgit-push-next (npatches)
   "Push the first unapplied patch.
 With numeric prefix argument, push that many patches."
   (interactive "p")

-  (stgit-assert-mode)
-  (stgit-capture-output nil (stgit-run "push" "-n" npatches))
-  (stgit-reload)
-  (stgit-refresh-git-status))
+  (stgit-push-or-pop-patches t npatches))

 
 (defun stgit-pop-next (npatches)
   "Pop the topmost applied patch.
 
 (defun stgit-pop-next (npatches)
   "Pop the topmost applied patch.

-With numeric prefix argument, pop that many patches."
+With numeric prefix argument, pop that many patches.
+
+If NPATCHES is t, pop all patches."

   (interactive "p")
   (interactive "p")

-  (stgit-assert-mode)
-  (stgit-capture-output nil (stgit-run "pop" "-n" npatches))
-  (stgit-reload)
-  (stgit-refresh-git-status))
+  (stgit-push-or-pop-patches nil npatches))

 
 (defun stgit-applied-patches (&optional only-patches)
   "Return a list of the applied patches.
 
 (defun stgit-applied-patches (&optional only-patches)
   "Return a list of the applied patches.


@@ -1659,16 +1679,33 @@ If ONLY-PATCHES is not nil, exclude index and work tree."
              (stgit-sort-patches (if unapplied unapplied patchsyms)))))
   (stgit-reload))
 
              (stgit-sort-patches (if unapplied unapplied patchsyms)))))
   (stgit-reload))
 

+(defun stgit-goto-target ()
+  "Return the goto target a point; either a patchsym, :top,
+or :bottom."
+  (let ((patchsym (stgit-patch-name-at-point)))
+    (cond ((memq patchsym '(:work :index)) nil)
+          (patchsym)
+          ((not (next-single-property-change (point) 'patch-data))
+           :top)
+          ((not (previous-single-property-change (point) 'patch-data))
+           :bottom))))
+

 (defun stgit-goto ()
   "Go to the patch on the current line.
 
 (defun stgit-goto ()
   "Go to the patch on the current line.
 

-Pops or pushes patches to make this patch topmost."
+Push or pop patches to make this patch topmost. Push or pop all
+patches if used on a line after or before all patches."

   (interactive)
   (stgit-assert-mode)
   (interactive)
   (stgit-assert-mode)

-  (let ((patchsym (stgit-patch-name-at-point t)))
-    (stgit-capture-output nil
-      (stgit-run "goto" patchsym))
-    (stgit-reload)))
+  (let ((patchsym (stgit-goto-target)))
+    (unless patchsym
+      (error "No patch to go to on this line"))
+    (case patchsym
+      (:top    (stgit-push-or-pop-patches t t))
+      (:bottom (stgit-push-or-pop-patches nil t))
+      (t (stgit-capture-output nil
+           (stgit-run "goto" patchsym))
+         (stgit-reload)))))

 
 (defun stgit-id (patchsym)
   "Return the git commit id for PATCHSYM.
 
 (defun stgit-id (patchsym)
   "Return the git commit id for PATCHSYM.


@@ -1681,16 +1718,17 @@ If PATCHSYM is a keyword, returns PATCHSYM unmodified."
        (error "Cannot find commit id for %s" patchsym))
       (match-string 1 result))))
 
        (error "Cannot find commit id for %s" patchsym))
       (match-string 1 result))))
 

+(defun stgit-whitespace-diff-arg (arg)
+  (when (numberp arg)
+    (cond ((> arg 4) "--ignore-all-space")
+          ((> arg 1) "--ignore-space-change"))))
+

 (defun stgit-show-patch (unmerged-stage ignore-whitespace)
   "Show the patch on the current line.
 
 UNMERGED-STAGE is the argument to `git-diff' that that selects
 which stage to diff against in the case of unmerged files."
 (defun stgit-show-patch (unmerged-stage ignore-whitespace)
   "Show the patch on the current line.
 
 UNMERGED-STAGE is the argument to `git-diff' that that selects
 which stage to diff against in the case of unmerged files."

-  (let ((space-arg (when (numberp ignore-whitespace)
-                     (cond ((> ignore-whitespace 4)
-                            "--ignore-all-space")
-                           ((> ignore-whitespace 1)
-                            "--ignore-space-change"))))
+  (let ((space-arg (stgit-whitespace-diff-arg ignore-whitespace))

         (patch-name (stgit-patch-name-at-point t)))
     (stgit-capture-output "*StGit patch*"
       (case (get-text-property (point) 'entry-type)
         (patch-name (stgit-patch-name-at-point t)))
     (stgit-capture-output "*StGit patch*"
       (case (get-text-property (point) 'entry-type)


@@ -1984,11 +2022,12 @@ patches."
                 (t (setq result :bottom)))))
       result)))
 
                 (t (setq result :bottom)))))
       result)))
 

-(defun stgit-sort-patches (patchsyms)
+(defun stgit-sort-patches (patchsyms &optional allow-duplicates)

   "Returns the list of patches in PATCHSYMS sorted according to
 their position in the patch series, bottommost first.
 
   "Returns the list of patches in PATCHSYMS sorted according to
 their position in the patch series, bottommost first.
 

-PATCHSYMS must not contain duplicate entries."
+PATCHSYMS must not contain duplicate entries, unless
+ALLOW-DUPLICATES is not nil."

   (let (sorted-patchsyms
         (series (with-output-to-string
                   (with-current-buffer standard-output
   (let (sorted-patchsyms
         (series (with-output-to-string
                   (with-current-buffer standard-output


@@ -2001,8 +2040,9 @@ PATCHSYMS must not contain duplicate entries."
       (setq start (match-end 0)))
     (setq sorted-patchsyms (nreverse sorted-patchsyms))
 
       (setq start (match-end 0)))
     (setq sorted-patchsyms (nreverse sorted-patchsyms))
 

-    (unless (= (length patchsyms) (length sorted-patchsyms))
-      (error "Internal error"))
+    (unless allow-duplicates
+      (unless (= (length patchsyms) (length sorted-patchsyms))
+        (error "Internal error")))

 
     sorted-patchsyms))
 
 
     sorted-patchsyms))