Merge pull request #1267 from vindarel/main

legit: discard changes to unstaged file

extensions/legit/legit.lisp

@@ -21,11 +21,13 @@ Done:
 - view changes diff
 - stage, unstage files
 - inside the diff, stage, unstage hunks
+- discard an unstaged file
 - commit (only a one-line message for now)
 - push, pull the remote branch
 - branch checkout, branch create&checkout
 - view commit at point
 - basic Fossil support (current branch, add change, commit)
+- basic Mercurial support
 - redact a proper commit text in its own buffer, not only a one liner.
 
 TODO:
@@ -39,11 +41,11 @@ Ongoing:
 Nice to have/todo next:
 
 - view log
-- other VCS support
 
 Next:
 
 - stage only selected region (more precise than hunks)
+- unstage/stage/discard multiple files
 - stashes
 - many, many more commands, settings and switches
 - mouse context menus
@@ -199,13 +201,25 @@ Next:
 
 ;; unstage
 (defun make-unstage-function (file &key already-unstaged)
-  (with-current-project ()
-    (if already-unstaged
-        (lambda ()
-          (message "Already unstaged"))
-        (lambda ()
-          (lem/porcelain:unstage file)
-          t))))
+  (lambda ()
+    (with-current-project ()
+      (if already-unstaged
+          (message "Already unstaged")
+          (lem/porcelain:unstage file)))))
+
+;; discard an unstaged change.
+(defun make-discard-file-function (file &key is-staged)
+  "Discard changes to an unstaged file.
+
+  If is-staged is not nil, then message the user that this file must be unstaged."
+  (lambda ()
+    (cond
+      (is-staged
+       (message "Unstage the file first"))
+      (t
+       (with-current-project ()
+         (when (prompt-for-y-or-n-p  (format nil "Discard unstaged changes in ~a?" file))
+           (lem/porcelain:discard-file file)))))))
 
 
 ;;;
@@ -440,7 +454,8 @@ Next:
                           (point :move-function (make-diff-function file)
                                  :visit-file-function (make-visit-file-function file)
                                  :stage-function (make-stage-function file)
-                                 :unstage-function (make-unstage-function file :already-unstaged t))
+                                 :unstage-function (make-unstage-function file :already-unstaged t)
+                                 :discard-file-function (make-discard-file-function file))
 
                         (insert-string point file :attribute 'lem/peek-legit:filename-attribute :read-only t)
                         ))
@@ -457,7 +472,8 @@ Next:
                           (point :move-function (make-diff-function file :cached t)
                                  :visit-file-function (make-visit-file-function file)
                                  :stage-function (make-stage-function file)
-                                 :unstage-function (make-unstage-function file))
+                                 :unstage-function (make-unstage-function file)
+                                 :discard-file-function (make-discard-file-function file :is-staged t))
 
                         (insert-string point file :attribute 'lem/peek-legit:filename-attribute :read-only t)))
             (lem/peek-legit:collector-insert "<none>"))
@@ -590,6 +606,7 @@ Next:
     (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 "(c)ommit~&")
     (format s "(b)ranches-> checkout another (b)ranch.~&")
     (format s "          -> (c)reate.~&")

extensions/legit/peek-legit.lisp

@@ -43,6 +43,7 @@ Notes:
 ;; Some are defined on legit.lisp for this keymap too.
 (define-key *peek-legit-keymap* "s" 'peek-legit-stage-file)
 (define-key *peek-legit-keymap* "u" 'peek-legit-unstage-file)
+(define-key *peek-legit-keymap* "k" 'peek-legit-discard-file)
 
 ;; quit
 (define-key *peek-legit-keymap* "Return" 'peek-legit-select)
@@ -127,6 +128,12 @@ Notes:
     (put-text-property start end :unstage-marker t))
   (put-text-property start end :unstage-function function))
 
+(defun set-discard-file-function (start end function)
+  (with-point ((end start))
+    (character-offset end 1)
+    (put-text-property start end :discard-file-marker t))
+  (put-text-property start end :discard-file-function function))
+
 (defun get-move-function (point)
   (with-point ((point point))
     (line-start point)
@@ -147,6 +154,11 @@ Notes:
     (line-start point)
     (text-property-at point :unstage-function)))
 
+(defun get-discard-file-function (point)
+  (with-point ((point point))
+    (line-start point)
+    (text-property-at point :discard-file-function)))
+
 (defun start-move-point (point)
   (buffer-start point)
   (unless (text-property-at point :move-marker)
@@ -248,7 +260,8 @@ Notes:
                                    move-function
                                    visit-file-function
                                    stage-function
-                                   unstage-function)
+                                   unstage-function
+                                   discard-file-function)
   (let ((point (buffer-point (collector-buffer *collector*))))
     (with-point ((start point))
       (funcall insert-function point)
@@ -257,18 +270,21 @@ Notes:
       (set-move-function start point move-function)
       (set-visit-file-function start point visit-file-function)
       (set-stage-function start point stage-function)
-      (set-unstage-function start point unstage-function))
+      (set-unstage-function start point unstage-function)
+      (set-discard-file-function start point discard-file-function))
     (incf (collector-count *collector*))))
 
 (defmacro with-appending-source ((point &key move-function
                                              visit-file-function
                                              stage-function
-                                             unstage-function) &body body)
+                                             unstage-function
+                                             discard-file-function) &body body)
   `(call-with-appending-source (lambda (,point) ,@body)
                                ,move-function
                                ,visit-file-function
                                ,stage-function
-                               ,unstage-function))
+                               ,unstage-function
+                               ,discard-file-function))
 
 (defun collector-insert (s &key (newline t) header)
   (let ((point (buffer-point (collector-buffer *collector*))))
@@ -355,6 +371,14 @@ Notes:
                          (point (funcall unstage)))
     ;; Update the buffer, to see that a staged file goes to the staged section.
     ;; This calls git again and refreshes everything.
+    (uiop:symbol-call :lem/legit :legit-status)
+                        point))
+(define-command peek-legit-discard-file () ()
+  "Discard the changes in this file. The file should not be stage."
+  (alexandria:when-let* ((fn (get-discard-file-function (buffer-point (window-buffer *peek-window*))))
+                         (point (funcall fn)))
+    ;; Update the buffer.
+    ;; This calls git again and refreshes everything.
     (uiop:symbol-call :lem/legit :legit-status)
     point))
 

extensions/legit/porcelain.lisp

@@ -14,6 +14,7 @@
    :commit
    :components
    :current-branch
+   :discard-file
    :file-diff
    :latest-commits
    :pull
@@ -554,6 +555,19 @@ M	src/ext/porcelain.lisp
   ;; no index like git, we'd need to exclude files from the commit with -X ?
   (porcelain-error "no unstage support for Mercurial"))
 
+;; discard changes.
+(defun git-discard-file (file)
+  "Discard all the changes to this file.
+
+  This currently means: checkout this file."
+  (run-git (list "checkout" file)))
+
+(defun discard-file (file)
+  (case *vcs*
+    (:git (git-discard-file file))
+    (t
+     (porcelain-error "discard-file is not implemented for this VCS: ~a" *vcs*))))
+
 (defvar *verbose* nil)
 
 (defun git-apply-patch (diff &key reverse)