Merge pull request #1622 from vindarel/vindarel/legit-stash

vindarel/legit stash: push, pop, list, show, drop

extensions/legit/legit-common.lisp

@@ -5,6 +5,7 @@
   (:export :legit-status
            :*prompt-for-commit-abort-p*
            :*ignore-all-space*
+           :*show-stashes*
            :*vcs-existence-order*
 	   :*peek-legit-keymap*
            :peek-legit-discard-file

extensions/legit/legit.lisp

@@ -27,6 +27,7 @@ Done:
 - basic Fossil support (current branch, add change, commit)
 - basic Mercurial support
 - show the commits log, with pagination
+- view stashes, stash push, pop and drop stash at point
 
 Ongoing:
 
@@ -44,6 +45,9 @@ Ongoing:
 
 Currently Git-only. Concretely, this calls Git with the -w option.")
 
+(defvar *show-stashes* t "List stashes on the Legit status buffer.")
+
+
 ;; Supercharge patch-mode with our keys.
 (define-major-mode legit-diff-mode lem-patch-mode:patch-mode
     (:name "legit-diff"
@@ -103,6 +107,10 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
 (define-key *peek-legit-keymap* "r c" 'rebase-continue)
 (define-key *peek-legit-keymap* "r s" 'rebase-skip)
 
+;; Stashes
+(define-key *peek-legit-keymap* "z z" 'legit-stash-push)
+(define-key *peek-legit-keymap* "z p" 'legit-stash-pop)
+
 ;; redraw everything:
 (define-key *peek-legit-keymap* "g" 'legit-status)
 
@@ -161,6 +169,38 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
     (setf (buffer-read-only-p buffer) t)
     (move-to-line (buffer-point buffer) 1)))
 
+(defun make-stash-show-function (stash)
+  (lambda ()
+    (with-current-project (vcs)
+      (cond
+        ((and (numberp stash)
+              (not (minusp stash)))
+         (show-diff (lem/porcelain:stash-show vcs :position stash)))
+        (t
+         (show-diff (format nil "=== this stash reference is not valid: ~s" stash)))))))
+
+(defun make-stash-pop-function (stash)
+  (lambda ()
+    (with-current-project (vcs)
+      (cond
+        ((and (numberp stash)
+              (not (minusp 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)
@@ -466,7 +506,7 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
 
 
 (define-command legit-status () ()
-  "Show changes, untracked files and latest commits in an interactive window."
+  "Show changes, untracked files, stashes and latest commits in an interactive window."
   (with-current-project (vcs)
     (multiple-value-bind (untracked-files unstaged-files staged-files)
         (lem/porcelain:components vcs)
@@ -503,6 +543,26 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
                         (insert-string point file :attribute 'filename-attribute :read-only t)))
             (collector-insert "<none>"))
 
+
+        ;; Stashes.
+        (collector-insert "")
+        (let ((stashes (lem/porcelain:stash-list vcs)))
+          (collector-insert (format nil "Stashes (~a)" (length stashes)) :header t)
+          (when *show-stashes*
+            (loop :for line :in stashes
+                  :for position := 0 :then (incf position)
+                  :do (with-appending-source
+                          (point :move-function (make-stash-show-function position)
+                                 :visit-file-function (lambda ()
+                                                        (message "Apply this stash with (s)")
+                                                        ;; Have a side effect,
+                                                        ;; don't try to open a file.
+                                                        (values))
+                                 :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)))))
+
         ;; Unstaged changes
         (collector-insert "")
         (collector-insert (format nil "Unstaged changes (~a):" (length unstaged-files)) :header t)
@@ -640,7 +700,9 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
 (define-command legit-push () ()
   "Push changes to the current remote."
   (with-current-project (vcs)
-    (run-function (lambda () (lem/porcelain:push vcs)))))
+    (run-function (lambda ()
+                    (lem/porcelain:push-default vcs))
+                  :message "Done")))
 
 (define-command legit-rebase-interactive () ()
   "Rebase interactively, from the commit the point is on.
@@ -748,6 +810,21 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
                                 commits-per-page)))
       (display-commits-log vcs last-page-offset))))
 
+(define-command legit-stash-push () ()
+  "Ask for a message and stash the current changes."
+  (with-current-project (vcs)
+    (let ((message (prompt-for-string "Stash message: ")))
+      (lem/porcelain::stash-push vcs :message message)
+      (legit-status))))
+
+(define-command legit-stash-pop () ()
+  "Pop the latest staged changes"
+  (with-current-project (vcs)
+    (let ((confirm (prompt-for-y-or-n-p "Pop the latest stash to the current branch? ")))
+      (when confirm
+        (lem/porcelain::stash-pop vcs)
+        (legit-status)))))
+
 (define-command legit-quit () ()
   "Quit"
   (%legit-quit)
@@ -762,15 +839,19 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
     (format s "~%")
     (format s "Commands:~&")
     (format s "(s)tage and (u)nstage a file. Inside a diff, (s)tage or (u)nstage a hunk.~&")
-    (format s "(k) discard changes.~&")
+    (format s "  pop the stash at point.~&")
+    (format s "(k) discard changes, drop the stash at point.~&")
     (format s "(c)ommit~&")
     (format s "(b)ranches-> checkout another (b)ranch.~&")
     (format s "          -> (c)reate.~&")
     (format s "(l)og-> (l) commits log~&")
-    (format s "     -> (F) first page of the commits history~&")
+    (format s "     -> (F) first page of the commits history.~&")
+    (format s "     Navigate commit pages with (b) and (f).~&")
     (format s "(F)etch, pull-> (p) from remote branch~&")
     (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) 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.~&")
@@ -781,6 +862,7 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
     (format s "~%")
     (format s "You can customize:~&")
     (format s "~%")
+    (format s "lem/legit:*show-stashes* : set to nil to not see the list of stashes in the status buffer~&")
     (format s "lem/porcelain:*nb-latest-commits* which defaults to 10~&")
     (format s "(and more)~&")
     ))

extensions/legit/peek-legit.lisp

@@ -290,7 +290,22 @@ Notes:
                                              stage-function
                                              unstage-function
                                              discard-file-function) &body body)
-  "Macro to use inside `with-collecting-sources' to print stuff."
+  "Macro to use inside `with-collecting-sources' to print stuff.
+
+  Save the lambda functions :move-function etc to their corresponding string properties.
+
+  A keybinding is associated to these functions.
+  They will dig up the lambda functions associated with these markers and run them.
+
+  Devel note 2024: the key arguments move-function, visit-file-function etc
+  are now badly named. They should represent a function tied to an action:
+  - what to do when the point moves on this line (this is currently move-function to show diffs)
+  - what to do on Enter (this is currently visit-file-function)
+  - what to do on the `s` keybinding (currently stage-function)
+  etc
+
+  Not everything represented on legit status represents a file.
+  We now use :visit-file-function and :stage-function to have actions on stashes."
   `(call-with-appending-source (lambda (,point) ,@body)
                                ,move-function
                                ,visit-file-function
@@ -352,6 +367,16 @@ Notes:
 
 
 (define-command peek-legit-select () ()
+  "Run the action stored in the :visit-file-function marker. Bound to Enter.
+
+  By default, this function works on files:
+  - execute the lambda function from the marker,
+  - expect its return value is a file name
+  - and visit the file, in the context of the current VCS.
+
+  It is possible to run actions not tied to files, for example do
+  something when pressing Enter on a line representing a commit stash.
+  The lambda function needs to return nil or (values)."
   (alexandria:when-let ((path (get-matched-file)))
     (%legit-quit)
     (with-current-project (vcs)
@@ -378,6 +403,7 @@ Notes:
   (previous-move-point (current-point)))
 
 (define-command peek-legit-stage-file () ()
+  "Get the lambda function associated with the :stage-function marker, call it, ignore side effects and refresh legit status."
   (alexandria:when-let* ((stage (get-stage-function (buffer-point (window-buffer *peek-window*))))
                          (point (funcall stage)))
     ;; Update the buffer, to see that a staged file goes to the staged section.
@@ -386,6 +412,7 @@ Notes:
     point))
 
 (define-command peek-legit-unstage-file () ()
+  "Get the lambda function associated with the :unstage-function marker, call it, ignore side effects and refresh legit status."
   (alexandria:when-let* ((unstage (get-unstage-function (buffer-point (window-buffer *peek-window*))))
                          (point (funcall unstage)))
     ;; Update the buffer, to see that a staged file goes to the staged section.

extensions/legit/porcelain-git.lisp

@@ -2,8 +2,6 @@
   (:use :cl
     ;; let's import all the classes and methods defined in the main porcelain:
     :lem/porcelain)
-  ;; beware, we still shadow cl:push to have a "push" method:
-  (:shadow :push)
   (:import-from :trivial-types
                 :proper-list)
   (:export :git-project-p)
@@ -166,7 +164,7 @@ allows to learn about the file state: modified, deleted, ignored… "
   ;; xxx: recurse submodules, etc.
   (run-git (list "pull")))
 
-(defmethod push ((vcs vcs-git))
+(defmethod push-default ((vcs vcs-git))
   (run-git (list "push")))
 
 (defmethod current-branch ((vcs vcs-git))
@@ -437,3 +435,44 @@ I am stopping in case you still have something valuable there."))
      (run-git (list "rebase" "--skip")))
     (t
      (porcelain-error  "No git rebase in process? PID not found."))))
+
+(defmethod stash-push ((vcs vcs-git) &key message)
+  "Stash the current changes. Ask for a stash message."
+  (if message
+      (run-git (list "stash" "push" "-m" message))
+      (run-git (list "stash" "push"))))
+
+(defmethod stash-pop ((vcs vcs-git) &key (position 0))
+  "Pop the latest stashed changes."
+  (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"
+                 "pop"
+                 (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
+  ;; just display them.
+  (str:lines
+   (run-git (list "stash" "list"))))
+
+(defmethod stash-show ((vcs vcs-git) &key position)
+  (if (and (numberp position)
+           (not (minusp position)))
+      (run-git (list "stash"
+                     "show"
+                     "-p" ;; view as patch = view diff
+                     (princ-to-string position)))
+      (format nil "Invalid stash reference: ~s. We expect a positive number." position)))

extensions/legit/porcelain.lisp

@@ -1,8 +1,6 @@
 
 (uiop:define-package :lem/porcelain
   (:use :cl)
-  ;; beware, we shadow cl:push to have a "push" method:
-  (:shadow :push)
   (:import-from :trivial-types
                 :proper-list)
   (:export
@@ -19,7 +17,7 @@
    :file-diff
    :latest-commits
    :pull
-   :push
+   :push-default
    :rebase-abort
    :rebase-continue
    :rebase-interactively
@@ -28,12 +26,17 @@
    :show-commit-diff
    :stage
    :unstage
+   :stash-list
+   :stash-pop
+   :stash-push
+   :stash-show
    :*diff-context-lines*
    :commits-log
    :*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.
@@ -232,10 +235,10 @@ M	src/ext/porcelain.lisp
   (:method (vcs)
     (porcelain-error "lem/porcelain:pull not implemented for vcs ~a" (vcs-name vcs))))
 
-(defgeneric push (vcs)
-  (:documentation "Pushes to remotes")
+(defgeneric push-default (vcs)
+  (:documentation "Pushes to default remote.")
   (:method (vcs)
-    (porcelain-error "lem/porcelain:push not implemented for vcs ~a" (vcs-name vcs))))
+    (porcelain-error "lem/porcelain:push-default not implemented for vcs ~a" (vcs-name vcs))))
 
 ;; Interactive rebase
 (defgeneric rebase-interactively (vcs &key from)
@@ -257,3 +260,35 @@ M	src/ext/porcelain.lisp
 (defgeneric rebase-skip (vcs)
   (:method (vcs)
     (porcelain-error "lem/porcelain:rebase-skip not implemented for vcs ~a" (vcs-name vcs))))
+
+;;;
+;;; Stash.
+;;;
+(defgeneric stash-push (vcs &key message)
+  (:method (vcs &key message)
+    (declare (ignorable message))
+    (porcelain-error "lem/porcelain:stash not implemented for vcs ~a" (vcs-name vcs)))
+  (:documentation "Stash the current changes. Ask for a stash message."))
+
+(defgeneric stash-pop (vcs &key position)
+  (:method (vcs &key position)
+    (declare (ignorable position))
+    (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)
+    (values))
+  (:documentation "List stashes"))
+
+(defgeneric stash-show (vcs &key position)
+  (:method (vcs &key position)
+    (declare (ignorable position))
+    (porcelain-error "lem/porcelain:stash-show not implement for vcs ~a" (vcs-name vcs)))
+  (:documentation "Show this stash, as a diff. Return text."))

src/echo.lisp

@@ -1,6 +1,6 @@
 (in-package :lem-core)
 
-(defparameter *message-timeout* 1)
+(defparameter *message-timeout* 2)
 
 (defgeneric show-message (string &key timeout style &allow-other-keys))
 (defgeneric clear-message ())