Refactor bin/doom

So innocuous CLI command return values don't break the post-script
written to /tmp/doom.sh.
This commit is contained in:
Henrik Lissner 2021-05-17 22:29:50 -04:00
parent b237de5619
commit 1e9870e13a
3 changed files with 138 additions and 111 deletions

155
bin/doom
View file

@ -23,6 +23,54 @@
(expand-file-name (expand-file-name
"../" (file-name-directory (file-truename load-file-name))))) "../" (file-name-directory (file-truename load-file-name)))))
;;
;;; Sanity checks
(when (version< emacs-version "26.3")
(error
(concat "Detected Emacs " emacs-version " (at " (car command-line-args) ").\n\n"
"Doom only supports Emacs 26.3 and newer. 27.1 is highly recommended. A guide\n"
"to install a newer version of Emacs can be found at:\n\n "
(format "https://doomemacs.org/docs/getting_started.org#%s"
(cond ((eq system-type 'darwin) "on-macos")
((memq system-type '(cygwin windows-nt ms-dos)) "on-windows")
("on-linux")))
"Aborting...")))
(unless (file-readable-p (expand-file-name "core/core.el" user-emacs-directory))
(error
(concat
"Couldn't find or read '"
(abbreviate-file-name
(expand-file-name "core/core.el" user-emacs-directory))
"'.\n\n"
"Are you sure Doom Emacs is correctly installed?\n\n"
(when (file-symlink-p load-file-name)
(concat "This error can occur if you've symlinked the 'doom' script, which Doom does not\n"
"support. Consider symlinking its parent directory instead or explicitly set the\n"
"EMACSDIR environment variable, e.g.\n\n "
(if (string-match-p "/fish$" (getenv "SHELL"))
"env EMACSDIR=~/.emacs.d doom"
"EMACSDIR=~/.emacs.d doom sync"))
"\n\n")
"Aborting...")))
(when (equal (user-real-uid) 0)
;; If ~/.emacs.d is owned by root, assume the user genuinely wants root to be
;; their primary user.
(unless (= 0 (file-attribute-user-id (file-attributes user-emacs-directory)))
(error
(concat
"Do not run this script as root. It will cause file permissions errors later.\n\n"
"To carry on anyway, change the owner of your Emacs config to root:\n\n"
" chown root:root -R " (abbreviate-file-name user-emacs-directory) "\n\n"
"Aborting..."))))
;;
;;; Let 'er rip!
;; HACK Load `cl' and site files manually to prevent polluting logs and stdout ;; HACK Load `cl' and site files manually to prevent polluting logs and stdout
;; with deprecation and/or file load messages. ;; with deprecation and/or file load messages.
(let ((inhibit-message t)) (let ((inhibit-message t))
@ -43,69 +91,48 @@
(setq tail (cdr tail))) (setq tail (cdr tail)))
(load site-run-file t (not verbose))))) (load site-run-file t (not verbose)))))
;; Load the heart of the beast and its CLI processing library
(load (expand-file-name "core/core.el" user-emacs-directory) nil t)
(require 'core-cli)
(kill-emacs (kill-emacs
(pcase ;; Process the arguments passed to this script. `doom-cli-execute' should
(catch 'exit ;; return one of two things: a cons cell whose CAR is t, and CDR is the
;; Catch some potential issues early ;; command's return value OR one of: a keyword, command string, or command
;; list.
(pcase (apply #'doom-cli-execute :doom (cdr (member "--" argv)))
;; If a CLI command returns an integer, treat it as an exit code.
((and (app car-safe `t) code)
(if (integerp (cdr code))
(cdr code)))
;; CLI commands can do (throw 'exit SHELL-COMMAND) to run something after
;; this session ends. e.g.
;;
;; (throw 'exit "$@") or (throw 'exit :restart)
;; This reruns the current command with the same arguments.
;; (throw 'exit "$@ -h -c")
;; This reruns the current command with two new switches.
;; (throw 'exit "emacs -nw FILE")
;; Opens Emacs on FILE
;; (throw 'exit t) or (throw 'exit nil)
;; A safe way to simply abort back to the shell with exit code 0
;; (throw 'exit 42)
;; Abort to shell with an explicit exit code (as a more abrupt
;; alternative to having the CLI command return 42).
;;
;; How this works: the command is written to a temporary shell script which
;; is executed after this session ends (see the shebang lines of this file).
;; It's done this way because Emacs' batch library lacks an implementation of
;; the exec system call.
(command
(cond (cond
((version< emacs-version "26.3") ((integerp command)
(princ (concat "Detected Emacs " emacs-version " (at " (car command-line-args) ").\n\n"))
(princ "Doom only supports Emacs 26.3 and newer. 27.1 is highly recommended. A guide\n")
(princ "to install a newer version of Emacs can be found at:\n\n ")
(princ (format "https://doomemacs.org/docs/getting_started.org#%s"
(cond ((eq system-type 'darwin) "on-macos")
((memq system-type '(cygwin windows-nt ms-dos)) "on-windows")
("on-linux"))))
(princ "Aborting...")
1)
((not (file-readable-p (expand-file-name "core/core.el" user-emacs-directory)))
(princ (concat "Couldn't find or read '"
(abbreviate-file-name
(expand-file-name "core/core.el" user-emacs-directory))
"'.\n\n"))
(princ "Are you sure Doom Emacs is correctly installed?\n\n")
(when (file-symlink-p load-file-name)
(princ "This error can occur if you've symlinked the 'doom' script, which Doom does not\n")
(princ "support. Consider symlinking its parent directory instead or explicitly set the\n")
(princ "EMACSDIR environment variable, e.g.\n\n ")
(princ (if (string-match-p "/fish$" (getenv "SHELL"))
"env EMACSDIR=~/.emacs.d doom"
"EMACSDIR=~/.emacs.d doom sync"))
(princ "\n\n")
(princ "Aborting..."))
2)
((and (equal (user-real-uid) 0)
(/= 0 (file-attribute-user-id (file-attributes user-emacs-directory))))
(princ "Do not run this script as root. It will cause file permissions errors later.\n\n")
(princ "To carry on anyway, change the owner of your Emacs config to root:\n\n")
(princ (concat " chown root:root -R " (abbreviate-file-name user-emacs-directory) "\n\n"))
(princ "Aborting...")
3)
;; Load the heart of the beast and its CLI processing library
((load (expand-file-name "core/core.el" user-emacs-directory) nil t)
(require 'core-cli)
;; Process the arguments passed to this script. `doom-cli-execute'
;; should return a boolean, integer (error code) or throw an 'exit
;; event, which is handled specially.
(apply #'doom-cli-execute :doom (cdr (member "--" argv))))))
;; Any non-zero integer is treated as an explicit exit code.
((and (pred integerp) code)
code)
;; If, instead, we were given a string or list of strings, copy these as
;; shell script commands to a temporary script file which this script will
;; execute after this session finishes. Also accepts special keywords, like
;; `:restart', to rerun the current command with the same arguments.
((and (or (pred consp)
(pred stringp)
(pred keywordp))
command) command)
(let ((script (expand-file-name "doom.sh" temporary-file-directory)) ((booleanp command)
0)
((let ((script (expand-file-name "doom.sh" temporary-file-directory))
(coding-system-for-write 'utf-8-unix) (coding-system-for-write 'utf-8-unix)
(coding-system-for-read 'utf-8-unix)) (coding-system-for-read 'utf-8-unix))
(with-temp-file script (with-temp-file script
@ -132,11 +159,9 @@
(shell-quote-argument (match-string 2 env))))) (shell-quote-argument (match-string 2 env)))))
(format "PATH=\"%s%s$PATH\" \\\n" (concat doom-emacs-dir "bin/") path-separator) (format "PATH=\"%s%s$PATH\" \\\n" (concat doom-emacs-dir "bin/") path-separator)
"_postscript $@\n")) "_postscript $@\n"))
(set-file-modes script #o600)) (set-file-modes script #o600))))
;; Error code 128 is special: it means run the post-script after this ;; Error code 128 is special: it means run the post-script after this
;; session ends. ;; session ends.
128) 128)
))
;; Anything else (e.g. booleans) is treated as a successful run. Yes, a `nil'
;; indicates a successful run too!
(_ 0)))

View file

@ -108,7 +108,7 @@ Accepts 'ansi and 'text-properties. nil means don't render colors.")
(unless (string-empty-p output) (unless (string-empty-p output)
(princ output) (princ output)
(terpri) (terpri)
t)) output))
;;;###autoload ;;;###autoload
(defun doom--output-indent (width text &optional prefix) (defun doom--output-indent (width text &optional prefix)

View file

@ -127,11 +127,12 @@ Environment variables:
(when command (when command
(push command args)) (push command args))
(setq command "help")) (setq command "help"))
(if (null command) (cons
t (if (null command)
(doom-cli-execute "help") (doom-cli-execute "help")
(let ((start-time (current-time))) (let ((start-time (current-time)))
(run-hooks 'doom-cli-pre-hook) (run-hooks 'doom-cli-pre-hook)
(when (apply #'doom-cli-execute command args) (when-let (result (apply #'doom-cli-execute command args))
(run-hooks 'doom-cli-post-hook) (run-hooks 'doom-cli-post-hook)
(print! (success "Finished in %s") (print! (success "Finished in %s")
(let* ((duration (float-time (time-subtract (current-time) before-init-time))) (let* ((duration (float-time (time-subtract (current-time) before-init-time)))
@ -143,7 +144,8 @@ Environment variables:
nil (list (unless (zerop hours) (format "%dh" hours)) nil (list (unless (zerop hours) (format "%dh" hours))
(unless (zerop minutes) (format "%dm" minutes)) (unless (zerop minutes) (format "%dm" minutes))
(format (if (> duration 60) "%ds" "%.4fs") (format (if (> duration 60) "%ds" "%.4fs")
seconds))))))))))) seconds))))))
result))))))
;; TODO Not implemented yet ;; TODO Not implemented yet
(doom-cli-command-not-found-error (doom-cli-command-not-found-error
(print! (error "Command 'doom %s' not recognized") (string-join (cdr e) " ")) (print! (error "Command 'doom %s' not recognized") (string-join (cdr e) " "))