legit: drop stash at point

extensions/legit/legit.lisp

@@ -27,7 +27,7 @@ Done:
 - basic Fossil support (current branch, add change, commit)
 - basic Mercurial support
 - show the commits log, with pagination
-- view stashes, stash push, stash pop
+- view stashes, stash push, pop and drop stash at point
 
 Ongoing:
 
@@ -185,12 +185,22 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
       (cond
         ((and (numberp stash)
               (not (minusp stash)))
-         ;; (message (format nil "let's unstash n° ~s" stash))
          (lem/porcelain:stash-pop vcs :position stash)
          )
         (t
          (message (format nil "=== this stash reference is not valid: ~s" stash)))))))
 
+(defun make-stash-drop-function (stash)
+  (lambda ()
+    (with-current-project (vcs)
+      (cond
+        ((and (numberp stash)
+              (not (minusp stash)))
+         (when (prompt-for-y-or-n-p "Drop stash? "))
+             (lem/porcelain:stash-drop vcs :position stash))
+        (t
+         (message (format nil "=== this stash reference is not valid: ~s" stash)))))))
+
 (defun make-diff-function (file &key cached type)
   (lambda ()
     (with-current-project (vcs)
@@ -548,7 +558,8 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
                                                         ;; Have a side effect,
                                                         ;; don't try to open a file.
                                                         (values))
-                                 :stage-function (make-stash-pop-function position))
+                                 :stage-function (make-stash-pop-function position)
+                                 :discard-file-function (make-stash-drop-function position))
                         (insert-string point line
                                        :attribute 'filename-attribute :read-only t)))))
 
@@ -838,7 +849,7 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
     (format s "(P)push      -> (p) to remote branch~&")
     (format s "(r)ebase     -> (i)nteractively from commit at point, (a)bort~&")
     (format s "(z) stashes  -> (z) stash changes (p)op latest stash~&")
-    (format s "             -> also use (s) on a stash.~&")
+    (format s "             -> also use (s) and (k) on a stash.~&")
     (format s "(g) -> refresh~&")
     (format s "~%")
     (format s "Navigate: n and p, C-n and C-p, M-n and M-p.~&")

extensions/legit/porcelain-git.lisp

@@ -454,6 +454,15 @@ I am stopping in case you still have something valuable there."))
                  (format nil "stash@{~a}" position) ;; position alone works too.
                  )))
 
+(defmethod stash-drop ((vcs vcs-git) &key position)
+  "drop this stash."
+  (when (not (and (numberp position)
+                  (not (minusp position))))
+    (porcelain-error "Bad stash index: ~a. We expect a non-negative number." position))
+  (run-git (list "stash"
+                 "drop"
+                 (format nil "stash@{~a}" position))))
+
 (defmethod stash-list ((vcs vcs-git))
   ;; each line is like
   ;; stash@{7}: On main: notes: legit vim interference

extensions/legit/porcelain.lisp

@@ -37,7 +37,8 @@
    :*commits-log-page-size*
    :commit-count
    :*nb-latest-commits*
-   :vcs-project)
+   :vcs-project
+   :stash-drop)
   (:documentation "Functions to run VCS operations: get the list of changes, of untracked files, commit, push… Git support is the main goal, a simple layer is used with other VCS systems (Fossil, Mercurial).
 
 On interactive commands, Legit will check what VCS is in use in the current project.
@@ -277,6 +278,12 @@ M	src/ext/porcelain.lisp
     (porcelain-error "lem/porcelain:stash-pop not implemented for vcs ~a" (vcs-name vcs)))
   (:documentation "Pop saved stashes. Defaults to the latest stash."))
 
+(defgeneric stash-drop (vcs &key position)
+  (:method (vcs &key position)
+    (declare (ignorable position))
+    (porcelain-error "lem/porcelain:stash-drop not implemented for vcs ~a" (vcs-name vcs)))
+  (:documentation "drop this stash."))
+
 (defgeneric stash-list (vcs)
   (:method (vcs)
     (declare (ignorable position))