Merge branch 'main' of tildegit.org:acdw/emacs

2 files changed, 150 insertions, 115 deletions

@@ -117,7 +117,8 @@
            pulse-delay 0.5
            pulse-iterations 1)
   (dolist (command '(+ace-window-or-switch-buffer
-                     pop-mark pop-global-mark))
+                     pop-mark pop-global-mark
+                     Info-history-back Info-history-forward))
     (add-to-list '+pulse-location-commands command))
   (+ensure-after-init #'+pulse-location-mode))
 
@@ -264,7 +265,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
@@ -554,14 +555,13 @@
               :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 !!!
-  (setq load-path (cl-remove-if (lambda (path)
-                                  (string-match-p "lisp/org\\'" path))
-                                load-path))
+  (setq load-path
+        (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) load-path))
   (:also-load +org)
   (:option org-adapt-indentation nil
            org-auto-align-tags t
@@ -671,13 +671,13 @@
      ;; `compose-region' returns t.
      ("^[ \t]*\\([-]\\) "
       (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "–") 'fixed-pitch)
-         'fixed-pitch t))
+       'fixed-pitch t))
      ("^[ \t]*\\([+]\\) "
       (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "¬") 'fixed-pitch)
-         'fixed-pitch t))
+       'fixed-pitch t))
      ("^[ \t]+\\([*]\\) "
       (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "→") 'fixed-pitch)
-         'fixed-pitch t))
+       'fixed-pitch t))
      ;; Fancy numbered lists (well, monospaced)
      ("^[ \t]*\\(\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\) " 0 'fixed-pitch t)
      ;; Make leading org-heading stars fixed-pitch
@@ -773,12 +773,6 @@
         :unnarrowed t))
   (+org-capture-sort))
 
-(setup org-contacts (:quit)
-  (:require)
-  (:also-straight org-vcard)                 ; for importing Vcard files
-  (:option org-contacts-matcher "contact")    ; Contacts are tagged "contact"
-  )
-
 (setup org-export
   (:also-load ox-md)
   (:option org-export-coding-system 'utf-8-unix
@@ -902,7 +896,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"))))
@@ -947,9 +941,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
@@ -1331,7 +1325,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)))
 
@@ -1408,7 +1403,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))
@@ -1532,12 +1527,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"
@@ -1601,7 +1597,7 @@ See also `crux-reopen-as-root-mode'."
         'notmuch-message)
   (:hook-into notmuch-show-mode))
 
-(setup (:straight-when (forge
+(setup (:straight (forge
                         :host github :repo "magit/forge")
          (eq system-type 'gnu/linux))
   (require 'forge)
@@ -1627,10 +1623,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)
@@ -1641,7 +1637,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)
@@ -1690,8 +1687,15 @@ 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))
+  (:load-after info)
+  (:option Info-fontify-isolated-quote-flag nil
+           Info-fontify-quotations nil
+           Info-saved-history-file (.etc "info-history"))
+  (add-hook 'Info-mode-hook #'Info-variable-pitch-text-mode))
 
 (setup (:straight isearch-mb)
   ;; This complicatedness is an attempt to make it easier to add and
@@ -1748,7 +1752,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))
 
@@ -1759,11 +1763,7 @@ See also `crux-reopen-as-root-mode'."
           '(buffer grid (vertico-sort-function . vertico-sort-length-alpha)))))
 
 (setup (:straight (lin :host gitlab :repo "protesilaos/lin"))
-  (require 'lin)
-  (+with-ensure-after-init
-    (dolist (hook lin-foreign-hooks)
-      (add-hook hook #'hl-line-mode)
-      (add-hook hook #'lin-mode))))
+  (lin-global-mode +1))
 
 (setup (:straight link-hint)
   (:require +link-hint)
@@ -1841,7 +1841,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)
@@ -1939,7 +1940,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))
@@ -1980,9 +1982,7 @@ See also `crux-reopen-as-root-mode'."
   (:also-load +org-drawer-list))
 
 (setup (:straight org-mime)
-  (:option org-mime-export-ascii 'utf-8))
-
-(setup (:straight org-mime)
+  (:option org-mime-export-ascii 'utf-8)
   (add-hook 'message-mode-hook
             (defun org-mime-setup@message-mode ()
               (local-set-key (kbd "C-c M-o") 'org-mime-htmlize)))
@@ -2053,17 +2053,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"
@@ -2157,7 +2153,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)
@@ -2199,7 +2195,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))
 
@@ -2266,9 +2262,10 @@ See also `crux-reopen-as-root-mode'."
   (:require)
   (:hook-into text-mode prog-mode))
 
-(setup (:straight unfill)) ;; XXX: Is this necessary with changes to filldent?
+(setup (:straight unfill))
 
-(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))
@@ -2322,21 +2319,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