Merge pull request #1538 from vindarel/legit-closify-remove-global-vcs

Legit closify remove global vcs

extensions/legit/README.md

@@ -16,23 +16,10 @@ at your own risk.
 
 However it should run a few operations smoothly.
 
-
-## Load
-
-`legit` is built into Lem but it isn't loaded by default. To load it, open a Lisp REPL (`M-x start-lisp-repl`) or evaluate Lisp code (`M-:`) and type:
-
-    (ql:quickload "lem/legit")
-
-Now you can start it with `C-x g` or `M-x legit-status`.
-
-![](lem-status.png)
-
-## Help
-
-Press `?` or `C-x ?` to call `legit-help`.
-
 ## M-x legit-status
 
+Bound to `C-x g` by default.
+
 The status windows show us, on the left:
 
 - the current branch (or "trunk")
@@ -46,6 +33,12 @@ and the window on the right shows us the file diffs or the commits' content.
 
 Refresh the status content with `g`.
 
+![](lem-status.png)
+
+## Help
+
+Press `?` or `C-x ?` to call `legit-help`.
+
 ## Navigation
 
 We can navigate inside legit windows with `n`, `p`, `M-n` and `M-p` (go to next/previous section).
@@ -182,41 +175,25 @@ Same with `*fossil-base-args*` and `*hg-base-arglist*`.
 - `*branch-sort-by*`: when listing branches, sort by this field name. Prefix with "-" to sort in descending order. Defaults to "-creatordate", to list the latest used branches first.
 - `*file-diff-args*`: defaults to `(list "diff" "--no-color")`. Arguments to display the file diffs. Will be surrounded by the git binary and the file path. For staged files, --cached is added by the command.
 
-If a project is managed by more than one VCS, `legit` takes the first VCS defined in `*vcs-existence-order*`:
+If a project is managed by more than one VCS, `legit` takes the first VCS defined in `lem/legit:*vcs-existence-order*`. You can change it like so:
 
 ~~~lisp
-(defvar *vcs-existence-order*
-  '(
-    git-project-p
-    fossil-project-p
-    hg-project-p
-    ))
+(setf lem/legit:*vcs-existence-order* '(:git :fossil :hg))
 ~~~
 
-where these symbols are functions with no arguments that return two values: a truthy value if the current project is considered a Git/Fossil/Mercurial project, and a keyword representing the VCS: `:git`, `:fossil`, `:hg`.
-
-For example:
-
-~~~lisp
-(defun hg-project-p ()
-  "Return t if we find a .hg/ directory in the current directory (which should be the project root. Use `lem/porcelain:with-current-project`)."
-  (values (uiop:directory-exists-p ".hg")
-          :hg))
-~~~
-
-
-Variables and parameters in the `lem/legit` package. They might not be exported.
-
-- `*legit-verbose*`: If non nil, print some logs on standard output (terminal) and create the hunk patch file on disk at (lem-home)/lem-hunk-latest.patch.
+You could also use a function to decide of your own order. It would
+take no arguments and it must return one value: an instance of the VCS
+object, such as `lem/porcelain/git::vcs-git`, if the current project is considered a
+Git/Fossil/Mercurial project, and nil otherwise.
 
-=> to help debugging
+Variables and parameters for customization are defined in the `lem/legit` package. They might not be exported.
 
 see sources in `/extensions/legit/`
 
 
 ## Implementation details
 
-Repository data is retrieved with calls to the VCS binary. We have a POC to read some data directly from the Git objects (and improve efficiency).
+Repository data is retrieved with calls to the VCS binary, but currently only 2 or 3 calls are made for a legit status window, so it works fine with big repositories. We have a POC to read some data directly from the Git objects (and improve efficiency).
 
 The interactive rebase currently uses a Unix-only shell script.
 

extensions/legit/legit-commit.lisp

@@ -92,9 +92,9 @@ two
       ((str:blankp cleaned-message)
        (message "No commit message, do nothing."))
       (t
-       (with-current-project ()
+       (with-current-project (vcs)
          (run-function (lambda ()
-                         (lem/porcelain::commit cleaned-message))
+                         (lem/porcelain::commit vcs cleaned-message))
                        :message "commited")
          (kill-buffer "*legit-commit*")
          ;; come back on the status on  the left:

extensions/legit/legit-common.lisp

@@ -1,10 +1,11 @@
 
 (defpackage :lem/legit
   (:use :cl
-   :lem)
+        :lem)
   (:export :legit-status
            :*prompt-for-commit-abort-p*
-           :*ignore-all-space*)
+           :*ignore-all-space*
+           :*vcs-existence-order*)
   (:documentation "Display version control data of the current project in an interactive two-panes window.
 
   This package in particular defines the right window of the legit interface and the user-level commands.
@@ -13,10 +14,39 @@
 
 (in-package :lem/legit)
 
+(defvar *default-vcs-existence-order*
+  (list :git :fossil :hg))
+
+(defparameter *vcs-existence-order* *default-vcs-existence-order*
+  "The order in which to detect the VCS of the current project.
+
+  List of keywords. Choices are: :git, :fossil and :hg.")
+
+(defvar *vcs-keyword-function-mapping*
+  (list :git #'lem/porcelain/git:git-project-p
+        :fossil #'lem/porcelain/fossil:fossil-project-p
+        :hg #'lem/porcelain/hg:hg-project-p
+        :mercurial #'lem/porcelain/hg:hg-project-p)
+  "A keyword to function mapping to help users configure their *vcs-existence-order*.")
+
+(defun vcs-project-p (&optional (vcs-order *vcs-existence-order*))
+  "When this project is under a known version control system, returns a VCS object for the project.
+   Otherwise, returns nil."
+  ;; This doesn't return the 2 values :(
+  ;; (or (fossil-project-p)
+  ;;     (git-project-p))
+  (loop for choice in vcs-order
+        for fn = (if (keywordp choice)
+                     (getf *vcs-keyword-function-mapping* choice)
+                     choice)
+        for vcs = (funcall fn)
+        if vcs
+          return vcs))
+
 (defun call-with-porcelain-error (function)
   (handler-bind ((lem/porcelain:porcelain-error
                    (lambda (c)
-                     (lem:editor-error (slot-value c 'lem/porcelain::message)))))
+                     (lem:editor-error (slot-value c 'lem/porcelain:message)))))
     (funcall function)))
 
 (defmacro with-porcelain-error (&body body)
@@ -28,17 +58,14 @@
   (with-porcelain-error ()
     (let ((root (lem-core/commands/project:find-root (lem:buffer-directory))))
       (uiop:with-current-directory (root)
-        (multiple-value-bind (root vcs)
-            (lem/porcelain:vcs-project-p)
-          (if root
-              (let ((lem/porcelain:*vcs* vcs))
-                (progn
-                  (funcall function)))
+        (let ((vcs (vcs-project-p *vcs-existence-order*)))
+          (if vcs
+              (funcall function vcs)
               (lem:message "Not inside a version-controlled project?")))))))
 
-(defmacro with-current-project (&body body)
+(defmacro with-current-project ((vcs-bind) &body body)
   "Execute body with the current working directory changed to the project's root,
-  find and set the VCS system for this operation.
+  find and `vcs-bind` as the VCS
 
   If no Git directory (or other supported VCS system) are found, message the user."
-  `(call-with-current-project (lambda () ,@body)))
+  `(call-with-current-project (lambda (,vcs-bind) ,@body)))

extensions/legit/legit-rebase.lisp

@@ -72,21 +72,21 @@ and
 (define-key *legit-rebase-mode-keymap* "C-x ?" 'rebase-help)
 
 (define-command rebase-abort () ()
-  (with-current-project ()
-    (run-function #'lem/porcelain:rebase-abort)
+  (with-current-project (vcs)
+    (run-function (lambda () (lem/porcelain:rebase-abort vcs)))
     (when (get-buffer "git-rebase-todo")
       (kill-buffer "git-rebase-todo"))
     (message "rebase aborted.")))
 
 (define-command rebase-continue () ()
-  (with-current-project ()
-    (run-function #'lem/porcelain:rebase-continue)
+  (with-current-project (vcs)
+    (run-function (lambda () (lem/porcelain:rebase-continue vcs)))
     (when (get-buffer "git-rebase-todo")
       (kill-buffer "git-rebase-todo"))))
 
 (define-command rebase-skip () ()
-  (with-current-project ()
-    (run-function #'lem/porcelain:rebase-skip)
+  (with-current-project (vcs)
+    (run-function (lambda () (lem/porcelain:rebase-skip vcs)))
     (when (get-buffer "git-rebase-todo")
       (kill-buffer "git-rebase-todo"))))