Enhance :straight setup form

:straight now takes care of :straight-when, :also-straight, and possibly others,
later.

2 files changed, 136 insertions, 96 deletions

@@ -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"
@@ -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