From 767f648d299f2b4f43470b17671138dd10a515c6 Mon Sep 17 00:00:00 2001 From: vindarel Date: Wed, 3 Jan 2024 21:58:30 +0100 Subject: [PATCH 1/2] legit/porcelain: signal a lem:editor-error > ERROR is treated as an editor bug when the command loop catches it. and editor-error is more friendly. --- extensions/legit/porcelain.lisp | 40 ++++++++++++++++++++------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/extensions/legit/porcelain.lisp b/extensions/legit/porcelain.lisp index 9e5d4ec29..e2a1bc957 100644 --- a/extensions/legit/porcelain.lisp +++ b/extensions/legit/porcelain.lisp @@ -167,6 +167,14 @@ Mercurial: ;;; Getting changes. ;;; +(defun %editor-error (message &rest args) + "Signal a lem:editor-error condition if the :lem package exists, otherwise signal a simple error. + This helps avoiding a tight dependency on Lem in the porcelain package." + (let ((msg (apply #'format nil message args))) + (if (find-package :lem) + (uiop:symbol-call :lem :editor-error msg) + (error msg)))) + (defun git-porcelain () "Return the git status: for each file in the project, the `git status --porcelain` command allows to learn about the file state: modified, deleted, ignored… " @@ -182,7 +190,7 @@ allows to learn about the file state: modified, deleted, ignored… " (run-fossil "changes") (cond ((not (zerop code)) - (error (str:join #\newline (list out error)))) + (%editor-error (str:join #\newline (list out error)))) (t (values out error))))) @@ -194,7 +202,7 @@ allows to learn about the file state: modified, deleted, ignored… " (:git (git-porcelain)) (:fossil (fossil-porcelain)) (:hg (hg-porcelain)) - (t (error "VCS not supported: ~a" *vcs*)))) + (t (%editor-error "VCS not supported: ~a" *vcs*)))) (defun git-components() "Return 3 values: @@ -295,7 +303,7 @@ allows to learn about the file state: modified, deleted, ignored… " (:git (git-components)) (:fossil (fossil-components)) (:hg (hg-components)) - (t (error "VCS not supported: ~a" *vcs*)))) + (t (%editor-error "VCS not supported: ~a" *vcs*)))) ;;; @@ -378,7 +386,7 @@ allows to learn about the file state: modified, deleted, ignored… " collect (subseq branch 2 (length branch)))) (defun fossil-branches (&key &allow-other-keys) - (error "not implemented")) + (%editor-error "not implemented")) (defun git-current-branch () (let ((branches (git-list-branches :sort-by "-creatordate"))) @@ -516,8 +524,8 @@ summary: test (case *vcs* (:git (git-unstage file)) (:hg (hg-unstage file)) - (:fossil (error "unstage not implemented for Fossil.")) - (t (error "VCS not supported: ~a" *vcs*)))) + (:fossil (%editor-error "unstage not implemented for Fossil.")) + (t (%editor-error "VCS not supported: ~a" *vcs*)))) (defun git-unstage (file) "Unstage changes to a file." @@ -534,7 +542,7 @@ M src/ext/porcelain.lisp (defun hg-unstage (file) (declare (ignorable file)) ;; no index like git, we'd need to exclude files from the commit with -X ? - (error "no unstage support for Mercurial")) + (%editor-error "no unstage support for Mercurial")) (defvar *verbose* nil) @@ -581,7 +589,7 @@ M src/ext/porcelain.lisp diff: string." (case *vcs* (:fossil (fossil-apply-patch diff :reverse reverse)) - (:hg (error "applying patch not yet implemented for Mercurial")) + (:hg (%editor-error "applying patch not yet implemented for Mercurial")) (t (git-apply-patch diff :reverse reverse)))) (defun checkout (branch) @@ -596,7 +604,7 @@ M src/ext/porcelain.lisp (defun push (&rest args) (when args - (error "Our git push command doesn't accept args. Did you mean cl:push ?!!")) + (%editor-error "Our git push command doesn't accept args. Did you mean cl:push ?!!")) (run-git (list "push"))) ;; @@ -643,7 +651,7 @@ M src/ext/porcelain.lisp :error-output :string :ignore-error-status t) #-unix - (error "lem/legit: our rebase script is only for Unix platforms currently. We need to run a shell script and trap a signal.") + (%editor-error "lem/legit: our rebase script is only for Unix platforms currently. We need to run a shell script and trap a signal.") (setf *rebase-script-path* script-path)))) (defvar *rebase-pid* nil @@ -670,9 +678,9 @@ M src/ext/porcelain.lisp (defun rebase-interactively (&key from) (case *vcs* (:git (git-rebase-interactively :from from)) - (:hg (error "Interactive rebase not implemented for Mercurial")) - (:fossil (error "No interactive rebase for Fossil.")) - (t (error "Interactive rebase not available for this VCS: ~a" *vcs*)))) + (:hg (%editor-error "Interactive rebase not implemented for Mercurial")) + (:fossil (%editor-error "No interactive rebase for Fossil.")) + (t (%editor-error "Interactive rebase not available for this VCS: ~a" *vcs*)))) (defun git-rebase-interactively (&key from) "Start a rebase session. @@ -687,7 +695,7 @@ M src/ext/porcelain.lisp ;; .git/rebase-merge/git-rebase-merge-todo ;; Beware of C-c ~ lol^^ (when (uiop:directory-exists-p ".git/rebase-merge/") - (error "It seems that there is already a rebase-merge directory, + (%editor-error "It seems that there is already a rebase-merge directory, and I wonder if you are in the middle of another rebase. If that is the case, please try git rebase (--continue | --abort | --skip) @@ -728,7 +736,7 @@ I am stopping in case you still have something valuable there.")) (values (format nil "rebase started") nil 0)) - (error "git rebase process didn't start properly. Aborting."))) + (%editor-error "git rebase process didn't start properly. Aborting."))) (setf (uiop:getenv "EDITOR") editor)))) (defun rebase-continue () @@ -751,4 +759,4 @@ I am stopping in case you still have something valuable there.")) "" 0)) (t - (error "No git rebase in process? PID not found.")))) + (%editor-error "No git rebase in process? PID not found.")))) From 7e9a8e152f6b6fee2537aa7b798a2371582e9a15 Mon Sep 17 00:00:00 2001 From: vindarel Date: Wed, 3 Jan 2024 22:26:43 +0100 Subject: [PATCH 2/2] legit/porcelain: avoid coupling to Lem when calling asdf:find-system --- extensions/legit/porcelain.lisp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extensions/legit/porcelain.lisp b/extensions/legit/porcelain.lisp index e2a1bc957..28a8e7e76 100644 --- a/extensions/legit/porcelain.lisp +++ b/extensions/legit/porcelain.lisp @@ -622,9 +622,10 @@ M src/ext/porcelain.lisp ;; Save our script as a string at compile time. (defparameter *rebase-script-content* - (str:from-file - (asdf:system-relative-pathname (asdf:find-system "lem") - "scripts/dumbrebaseeditor.sh")) + (when (find-package :lem) + (str:from-file + (asdf:system-relative-pathname (uiop:symbol-call :asdf :find-system "lem") + "scripts/dumbrebaseeditor.sh"))) "Our dumb editor shell script, saved as a string at compile time. We then save it to the user's ~/.lem/legit/rebaseetidor.sh at first use.")