Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

legit/porcelain: signal a lem:editor-error #1227

Closed
wants to merge 2 commits into from
Closed

legit/porcelain: signal a lem:editor-error #1227

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
767f648
legit/porcelain: signal a lem:editor-error
vindarel Jan 3, 2024
7e9a8e1
legit/porcelain: avoid coupling to Lem when calling asdf:find-system
vindarel Jan 3, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
47 changes: 28 additions & 19 deletions extensions/legit/porcelain.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

uiop:symbol-call only fools the compiler and actually makes it dependent on lem.
Besides, this kind of pattern is troublesome when refactoring and should be avoided if possible.

I have a suggestion, how about the following?

  • define porcelain condition
  (define-condition porcelain-error (error) ...)
  • Call that porcelain-error on this line.
(error 'porcelain-error ...)
  • Each define-command handles porcelain-error, converts it to editor-error, and lifts it up.
(define-command legit-... (...) (...)
  (with-porcelain-error () ...))

or

(defclass legit-advice () ())

(defmethod execute (mode (command legit-advice) argument)
  (with-porcelain-error () (call-next-method)))

(define-command (legit-... :advice-classes legit-advice) () ())
  ...)

(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… "
Expand All @@ -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)))))

Expand All @@ -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:
Expand Down Expand Up @@ -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*))))


;;;
Expand Down Expand Up @@ -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")))
Expand Down Expand Up @@ -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."
Expand All @@ -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)

Expand Down Expand Up @@ -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)
Expand All @@ -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")))

;;
Expand All @@ -614,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.")

Expand All @@ -643,7 +652,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
Expand All @@ -670,9 +679,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.
Expand All @@ -687,7 +696,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)
Expand Down Expand Up @@ -728,7 +737,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 ()
Expand All @@ -751,4 +760,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."))))