From 5782c55e52899513f4244ec9a6ba191b3679a5ee Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 19 Apr 2022 22:27:03 -0500 Subject: Enhance :straight setup form :straight now takes care of :straight-when, :also-straight, and possibly others, later. --- init.el | 99 +++++++++++++++++++++--------------------- lisp/+setup.el | 133 ++++++++++++++++++++++++++++++++++++--------------------- 2 files changed, 136 insertions(+), 96 deletions(-) diff --git a/init.el b/init.el index ddef209..c1a1cd2 100644 --- a/init.el +++ b/init.el @@ -255,7 +255,7 @@ (setup dired (:also-load dired-x +dired) - (:also-straight dired+) + (:straight dired+) (:option dired-recursive-copies 'always dired-recursive-deletes 'always dired-create-destination-dirs 'always @@ -543,8 +543,8 @@ :build (:not autoloads) :files (:defaults "lisp/*.el" - ("etc/styles/" "etc/styles/*"))) - (org-contrib + ("etc/styles/" "etc/styles/*")))) + (:straight (org-contrib :type git :host nil :repo "https://git.sr.ht/~bzg/org-contrib")) ;; DO NOT load system-installed org !!! @@ -860,7 +860,7 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers." (:with-mode adaptive-wrap-prefix-mode (:hook-into visual-column-mode))) -(setup (:straight-when affe +(setup (:straight affe (or (executable-find "rg") (and (executable-find "find") (executable-find "grep")))) @@ -905,9 +905,9 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers." (setf (alist-get ?. avy-dispatch-alist) #'avy-action-embark))) (setup (:straight bbdb) + (:straight bbdb-vcard) (:require bbdb-autoloads bbdb) - (:also-straight bbdb-vcard) (bbdb-initialize 'gnus 'message)) (setup (:straight (bongo :type git @@ -1289,7 +1289,8 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers." (setf (alist-get 'consult-notmuch vertico-multiform-commands) '(buffer) (alist-get 'consult-notmuch-tree vertico-multiform-commands) '(buffer)))) -(setup (:straight corfu) (:quit "Turns out, I actually like minibuffer completion better.") +(setup (:straight corfu + :quit "Turns out, I actually like minibuffer completion better.") (+with-ensure-after-init (corfu-global-mode +1))) @@ -1366,7 +1367,7 @@ See also `crux-reopen-as-root-mode'." (setup (:straight dumb-jump) (add-hook 'xref-backend-functions #'dumb-jump-xref-activate)) -(setup (:straight-when ebuku +(setup (:straight ebuku (executable-find "buku")) (:option ebuku-display-on-startup 'recent ebuku-recent-count 100)) @@ -1490,12 +1491,13 @@ See also `crux-reopen-as-root-mode'." (setup (:straight eshell-syntax-highlighting) (:hook-into eshell-mode)) -;; (setup (:straight eshell-vterm) -;; (:load-after eshell) -;; (defalias 'eshell/v 'eshell-exec-visual) -;; (eshell-vterm-mode +1)) +(setup (:straight eshell-vterm + :quit) + (:load-after eshell) + (defalias 'eshell/v 'eshell-exec-visual) + (eshell-vterm-mode +1)) -(setup (:straight-when exec-path-from-shell +(setup (:straight exec-path-from-shell (eq system-type 'gnu/linux)) (require 'exec-path-from-shell) (dolist (var '("SSH_AUTH_SOCK" @@ -1544,8 +1546,8 @@ See also `crux-reopen-as-root-mode'." (with-eval-after-load 'vertico-multiform (setf (alist-get 'flyspell vertico-multiform-categories) nil))) -(setup (:straight-when (forge - :host github :repo "magit/forge") +(setup (:straight (forge + :host github :repo "magit/forge") (eq system-type 'gnu/linux)) (require 'forge) (add-to-list 'forge-alist @@ -1570,10 +1572,10 @@ See also `crux-reopen-as-root-mode'." :files ("elisp/*.el" "doc/*" "geiser-pkg.el") :pre-build ("make" "-Cdoc" "geiser.info") :host gitlab - :repo "emacs-geiser/geiser") - geiser-chicken - macrostep-geiser - scheme-complete) + :repo "emacs-geiser/geiser")) + (:straight geiser-chicken) + (:straight macrostep-geiser) + (:straight scheme-complete) (:require +chicken) (setf (alist-get "\\.scm\\'" auto-mode-alist nil nil #'string=) 'scheme-mode)) @@ -1582,7 +1584,8 @@ See also `crux-reopen-as-root-mode'." :host github :repo "magit/git-modes")) (:require git-modes)) -(setup (:straight god-mode) (:quit "I could never get the hang of this.") +(setup (:straight god-mode + :quit "I could never get the hang of this.") (setq god-mode-enable-function-key-translation nil) (:require god-mode +god-mode) @@ -1631,6 +1634,9 @@ See also `crux-reopen-as-root-mode'." (paredit-forward-delete arg)))) (global-hungry-delete-mode +1)) +(setup (:straight i3wm-config-mode + (executable-find "i3"))) + (setup (:straight info+) (:load-after info) (:option Info-fontify-isolated-quote-flag nil @@ -1693,7 +1699,7 @@ See also `crux-reopen-as-root-mode'." :host github :repo "duckwork/keepassxc-shim.el")) (keepassxc-shim-activate)) -(setup (:straight-when keychain-environment +(setup (:straight keychain-environment (executable-find "keychain")) (keychain-refresh-environment)) @@ -1782,7 +1788,8 @@ See also `crux-reopen-as-root-mode'." #'hl-line-mode #'lin-mode)) -(setup (:straight md4rd) (:quit "Janky a.f.") +(setup (:straight md4rd + :quit) ;; `md4rd' is ... a bit janky, tbh. But I'm including this here so I have it. ;; TODO: enable opening Reddit links in md4rd (:also-load _md4rd) @@ -1873,7 +1880,8 @@ See also `crux-reopen-as-root-mode'." (:when-loaded (notmuch-bookmarks-mode +1))) -(setup (:straight notmuch-labeler) (:quit "This is buggy") +(setup (:straight notmuch-labeler + :quit "Buggy") (:load-after notmuch)) (setup (:straight ol-notmuch)) @@ -1969,17 +1977,13 @@ See also `crux-reopen-as-root-mode'." lisp-interaction-mode scheme-mode)) -(setup (:straight pdf-tools) +(setup (:straight pdf-tools + (or (executable-find "gcc") + (executable-find "g++"))) + (setf (alist-get "\\.pdf\\'" auto-mode-alist nil nil #'equal) + #'pdf-view-mode) (pdf-tools-install)) -;; (setup (:straight-when pdf-tools -;; ;; Ensure we can build `pdf-tools' -;; (or (executable-find "gcc") -;; (executable-find "g++"))) -;; (setf (alist-get "\\.pdf\\'" auto-mode-alist nil nil #'equal) -;; #'pdf-view-mode) -;; (pdf-tools-install t)) - (setup (:straight (plancat :host github :repo "duckwork/plancat.el" @@ -2078,7 +2082,7 @@ See also `crux-reopen-as-root-mode'." (alert-add-rule :category "slack" :style 'ignore))) -(setup (:straight-when sly +(setup (:straight sly (defvar +lisp-bin (executable-find "sbcl"))) (:also-load sly-autoloads +sly) @@ -2120,7 +2124,7 @@ See also `crux-reopen-as-root-mode'." (auto-save-visited-mode -1) (super-save-mode +1)) -(setup (:straight-when systemd +(setup (:straight systemd (executable-find "systemd")) (:option systemd-man-function 'woman)) @@ -2189,10 +2193,8 @@ See also `crux-reopen-as-root-mode'." (setup (:straight unfill)) -(setup (:straight valign) - (:hook-into org-mode)) - -(setup (:straight valign) (:quit "Doesn't work with narrowed tables.") +(setup (:straight valign + :quit "Doesn't work with narrowed tables.") (:option valign-fancy-bar t) (:hook-into org-mode markdown-mode)) @@ -2246,21 +2248,22 @@ See also `crux-reopen-as-root-mode'." (setup (:straight vlf) (:require vlf-setup)) +(setup (:straight vterm + (and module-file-suffix + (executable-find "cmake")) + :quit) + (:also-load +vterm) + (:option vterm-always-compile-module t + vterm-buffer-name-string "vterm: %s" + vterm-max-scrollback 100000 ; max allowed by vterm-module.h + ) + (advice-add 'counsel-yank-pop-action :around + #'+vterm-counsel-yank-pop-action)) + (setup (:straight (vundo :host github :repo "casouri/vundo"))) -;; (setup (:straight-when vterm -;; (and module-file-suffix -;; (executable-find "cmake"))) -;; (:also-load +vterm) -;; (:option vterm-always-compile-module t -;; vterm-buffer-name-string "vterm: %s" -;; vterm-max-scrollback 100000 ; max allowed by vterm-module.h -;; ) -;; (advice-add 'counsel-yank-pop-action :around -;; #'+vterm-counsel-yank-pop-action)) - (setup (:straight web-mode) (setf (alist-get (rx "." (or "htm" "html" "phtml" "tpl.php" "asp" "gsp" "jsp" "ascx" "aspx" diff --git a/lisp/+setup.el b/lisp/+setup.el index 7c658b6..975bcde 100644 --- a/lisp/+setup.el +++ b/lisp/+setup.el @@ -23,6 +23,7 @@ (require 'el-patch) (require 'setup) (require 'straight) +(require 'cl-lib) (defun +setup-warn (message &rest args) "Warn the user that something bad happened in `setup'." @@ -66,57 +67,93 @@ If PATH does not exist, abort the evaluation." ;;; Straight.el (with-eval-after-load 'straight - (setup-define :also-straight - (lambda (recipe) `(setup (:straight ,recipe))) - :documentation - "Install RECIPE with `straight-use-package', after loading FEATURE." - :repeatable t - :after-loaded t) - - (defun +setup-straight-shorthand (sexp) - "Shorthand for `:straight' and other local macros." - (let ((recipe (cadr sexp))) - (or (car-safe recipe) recipe))) + (defun setup--straight-handle-arg (arg var) + (cond + ((and (boundp var) (symbol-value var)) t) + ((keywordp arg) (set var t)) + ((functionp arg) (set var nil) (funcall arg)) + ((listp arg) (set var nil) (eval arg :lexical)))) (setup-define :straight - (lambda (recipe) - `(unless (ignore-errors (straight-use-package ',recipe) t) - (+setup-warn ":straight error: %S" ',recipe) - ,(setup-quit))) - :documentation - "Install RECIPE with `straight-use-package'. -This macro can be used as HEAD, and will replace itself with the -first RECIPE's package." - :repeatable t - :shorthand #'+setup-straight-shorthand) - - (setup-define :straight-after - (lambda (recipe feature) - `(with-eval-after-load ,feature - (setup (:straight ,recipe)))) - :indent 1 - :documentation - "Install RECIPE with `straight-use-package', after FEATURE. -This macro can be used as HEAD, and will replace itself with the -first RECIPE's package." - :shorthand #'+setup-straight-shorthand) - - (setup-define :straight-when - (lambda (recipe condition) - `(if ,condition - (unless (ignore-errors (straight-use-package ',recipe) t) - (+setup-warn ":straight error: %S" ',recipe) - ,(setup-quit)) - (message "Setup: :straight-when returned nil %S" ',recipe) - ,(setup-quit))) - :documentation - "Install RECIPE with `straight-use-package' when CONDITION is met. -If CONDITION is false, or if `straight-use-package' fails, stop -evaluating the body. This macro can be used as HEAD, and will -replace itself with the RECIPE's package." - :repeatable 2 + (lambda (recipe &rest predicates) + (let* ((skp (make-symbol "straight-keyword-p")) + (straight-use-p + (cl-every (lambda (f) (setup--straight-handle-arg f skp)) + predicates)) + (form `(unless (and ,straight-use-p + (condition-case e + (straight-use-package ',recipe) + (error + (+setup-warn ":straight error: %S" + ',recipe) + ,(setup-quit)) + (:success t))) +(defun setup--straight-handle-arg (arg var) + (cond + ((and (boundp var) (symbol-value var)) t) + ((keywordp arg) (set var t)) + ((functionp arg) (set var nil) (funcall arg)) + ((listp arg) (set var nil) (eval arg :lexical)))) + +(setup-define :straight + (lambda (recipe &rest predicates) + (let* ((skp (make-symbol "straight-keyword-p")) + (straight-use-p + (cl-every (lambda (f) (setup--straight-handle-arg f skp)) + predicates)) + (form `(unless (and ,straight-use-p + (condition-case e + (straight-use-package ',recipe) + (error + (+setup-warn ":straight error: %S" + ',recipe) + ,(setup-quit)) + (:success t))) + ,(setup-quit)))) + ;; Keyword arguments --- :quit is special and should short-circuit + (if (memq :quit predicates) + (setq form `,(setup-quit)) + ;; Otherwise, handle the rest of them ... + (when-let ((after (cadr (memq :after predicates)))) + (setq form `(with-eval-after-load ,(if (eq after t) + (setup-get 'feature) + after) + ,form)))) + ;; Finally ... + form)) + :documentation "Install RECIPE with `straight-use-package'. +If PREDICATES are given, only install RECIPE if all of them return non-nil. +The following keyword arguments are also recognized: +- :quit --- immediately stop evaluating. Good for commenting. +- :after FEATURE --- only install RECIPE after FEATURE is loaded. + If FEATURE is t, install RECIPE after the current feature." + :repeatable nil + :indent 1 + :shorthand (lambda (sexp) + (let ((recipe (cadr sexp))) + (or (car-safe recipe) recipe)))) ,(setup-quit)))) + ;; Keyword arguments --- :quit is special and should short-circuit + (if (memq :quit predicates) + (setq form `,(setup-quit)) + ;; Otherwise, handle the rest of them ... + (when-let ((after (cadr (memq :after predicates)))) + (setq form `(with-eval-after-load ,(if (eq after t) + (setup-get 'feature) + after) + ,form)))) + ;; Finally ... + form)) + :documentation "Install RECIPE with `straight-use-package'. +If PREDICATES are given, only install RECIPE if all of them return non-nil. +The following keyword arguments are also recognized: +- :quit --- immediately stop evaluating. Good for commenting. +- :after FEATURE --- only install RECIPE after FEATURE is loaded. + If FEATURE is t, install RECIPE after the current feature." + :repeatable nil :indent 1 - :shorthand #'+setup-straight-shorthand)) + :shorthand (lambda (sexp) + (let ((recipe (cadr sexp))) + (or (car-safe recipe) recipe))))) ;;; Redefines of `setup' forms -- cgit 1.4.1-21-gabe81