2 files changed, 180 insertions, 144 deletions

@@ -15,6 +15,7 @@
 ;; - Make good choices.
 
 ;;; Code:
+
 (let ((early-features `((early-init . ,(locate-user-emacs-file "early-init"))
                         acdw private +key)))
   (dolist (feature early-features)
@@ -63,10 +64,16 @@
 
 (setup (:require auth-source)
   (:option auth-sources (list 'default
+                              "secrets:passwords"
                               (private/ "authinfo")))
   (:with-mode authinfo-mode
     (:local-set truncate-lines t)))
 
+(setup (:require autoinsert)
+  (setf (alist-get "\\.scm" auto-insert-alist nil nil #'equal)
+        '(insert "#!/bin/sh\n#| -*- scheme -*-\nexec csi -s $0 \"$@\"\n|#\n"))
+  (auto-insert-mode +1))
+
 (setup (:require cus-edit)
   ;; I don't use Custom to actually /make/ any customizations, but it's handy to
   ;; (A) see what options are available and (B) persist some changes across
@@ -193,6 +200,10 @@
                    args)))
     (cons (+browse-url-secondary-browser-regexps-combine) ; non-text websites
           browse-url-secondary-browser-function)
+    (cons "xkcd\\.com"
+          (if (fboundp 'xkcd-get)
+              #'+xkcd-get-from-url
+            +browse-url-browser-function))
     (cons "."                           ; everything else
           +browse-url-browser-function)))
   ;; Transform URLs before passing to `browse-url'
@@ -254,6 +265,8 @@
          #'dired-hide-details-mode
          #'hl-line-mode)
   (:+key "C-x C-j" #'dired-jump)
+  (dolist (refresh-after-func '(dired-do-flagged-delete))
+    (advice-add refresh-after-func :after #'revert-buffer))
   (with-eval-after-load 'dired
     (cl-case system-type
       ((windows-nt ms-dos)
@@ -552,7 +565,7 @@
                  org-agenda-templates))
     (add-to-list '+custom-variable-allowlist var))
   (with-eval-after-load 'org
-   (add-to-list 'org-agenda-files (sync/ "org/" t)))
+    (add-to-list 'org-agenda-files (sync/ "org/" t)))
   (:+leader "a" #'org-agenda "C-a" #'org-agenda)
   (:hook #'hl-line-mode)
   (add-hook 'org-agenda-after-show-hook 'org-narrow-to-subtree))
@@ -657,57 +670,26 @@
                                             'display t
                                             'close-tab t)
            tab-bar-new-button (propertize "+ " 'display t))
+  ;; I need to set these here so that they take effect /before/ `display-time-mode'
+  (:option display-time-format "%H:%M"
+           display-time-mail-file :disable
+           display-time-load-average-threshold 50)
+  (:option tab-bar-format '(+tab-bar-format-menu-bar
+                            tab-bar-format-history
+                            tab-bar-format-tabs
+                            tab-bar-separator
+                            tab-bar-format-add-tab
+                            tab-bar-format-align-right
+                            ;;+tab-bar-misc-info
+                            tab-bar-separator
+                            +tab-bar-tracking-mode
+                            +tab-bar-date))
   (tab-bar-mode +1)
-  (if (version< emacs-version "28.0")
-      (+tab-bar-misc-info-mode +1)
-    (:option tab-bar-format '(+tab-bar-format-menu-bar
-                              tab-bar-format-history
-                              tab-bar-format-tabs
-                              tab-bar-separator
-                              tab-bar-format-add-tab
-                              tab-bar-format-align-right
-                              +tab-bar-misc-info
-                              tab-bar-separator
-                              ))))
+  (display-time-mode +1))
 
 (setup text
   (:hook #'turn-on-auto-fill))
 
-(setup time
-  ;; TODO: +display-time-mode with MOAR customizations
-  (:option display-time-default-load-average nil
-           display-time-mail-file :disable)
-  (:require discord +tab-bar)           ; Require instead of eval after load
-  (:option display-time-string-forms
-           '((propertize (format-time-string "%H:%M %a %e" now)
-                         'face '+tab-bar-extra
-                         'help-echo (discord-date-string))
-             load
-             (if mail
-                 (concat " "
-                         (propertize
-                          display-time-mail-string
-                          'display `(when (and display-time-use-mail-icon
-                                               (display-graphic-p))
-                                      ,@display-time-mail-icon
-                                      ,@(when (and
-                                               display-time-mail-face
-                                               (memq
-                                                (plist-get
-                                                 (cdr display-time-mail-icon)
-                                                 :type)
-                                                '(pbm xbm)))
-                                          (let ((bg (face-attribute
-                                                     display-time-mail-face
-                                                     :background)))
-                                            (when (stringp bg)
-                                              (list :background bg)))))
-                          'face display-time-mail-face))
-               "")
-             " "))
-
-  (display-time-mode +1))
-
 (setup tramp
   (el-patch-feature tramp)
   (with-eval-after-load 'tramp
@@ -717,8 +699,8 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
       (with-current-buffer buffer
         (el-patch-wrap 2
           (save-restriction
-           (widen)
-           (string-equal (buffer-substring 1 10) ";; Emacs:")))))))
+            (widen)
+            (string-equal (buffer-substring 1 10) ";; Emacs:")))))))
 
 (setup (:straight 0x0)
   (:option 0x0-default-server 'ttm)
@@ -743,6 +725,19 @@ 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
+         (or (executable-find "rg")
+             (and (executable-find "find")
+                  (executable-find "grep"))))
+  (:load-after consult orderless vertico)
+  (setq affe-regexp-compiler (defun affe-orderless-regexp-compiler (input _type)
+                               (setq input (orderless-pattern-compiler input))
+                               (cons input (lambda (str) (orderless--highlight input str)))))
+  (with-eval-after-load 'affe
+    (setf (alist-get 'affe-grep vertico-multiform-commands) '(buffer)
+          (alist-get 'affe-find vertico-multiform-commands) nil)
+    (:global "M-s g" #'affe-grep)))
+
 (setup (:straight alert)
   (:option alert-default-style 'libnotify))
 
@@ -755,15 +750,6 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
     [remap isearch-query-replace] #'anzu-isearch-query-replace
     [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace-regexp))
 
-(setup (:straight-when (apheleia
-                        :host github :repo "raxod502/apheleia")
-         (eq system-type 'gnu/linux))
-  (:require apheleia
-            +apheleia)
-  ;; (setf (alist-get 'prettier apheleia-formatters)
-  ;;       '("npx" "prettier" "--stdin-filepath" filepath))
-  (apheleia-global-mode +1))
-
 (setup (:straight avy)
   (:require avy +avy)
   (:option avy-background t
@@ -927,7 +913,7 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
                (with-temp-buffer
                  (insert string)
                  (0x0-upload-text (0x0--choose-server)))
-                (current-kill 0)))
+               (current-kill 0)))
     (add-to-list '+pulse-location-commands #'lui-track-jump-to-indicator)
     (:face lui-track-bar ((t (:height 10
                                       :underline (:color foreground-color
@@ -1037,17 +1023,16 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
   (with-eval-after-load 'org-mode
     (define-key org-mode-map "M-g o" 'consult-org-heading))
   (advice-add 'consult-yank-pop :after '+yank@indent)
-  (with-eval-after-load 'consult
+  (:when-loaded
     (:option consult-narrow-key "<"
              consult-project-root-function '+consult-project-root)
-    (consult-customize
-     consult-theme
-     :preview-key '(:debounce 0.2 any)
-     consult-ripgrep consult-git-grep consult-grep
-     consult-bookmark consult-recent-file consult-xref
-     consult--source-file consult--source-project-file
-     consult--source-bookmark
-     :preview-key (kbd "M-."))
+    (consult-customize consult-theme
+                       :preview-key '(:debounce 0.2 any))
+    (consult-customize consult-ripgrep consult-git-grep consult-grep
+                       consult-bookmark consult-recent-file consult-xref
+                       consult--source-file consult--source-project-file
+                       consult--source-bookmark consult-buffer
+                       :preview-key (kbd "M-,"))
     (consult-history-to-modes ((minibuffer-local-map . nil)
                                (shell-mode-map . shell-mode-hook)
                                (term-mode-map . term-mode-hook)
@@ -1055,7 +1040,24 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
                                (comint-mode-map . comint-mode-hook)
                                (sly-mrepl-mode-map . sly-mrepl-hook)))
     (with-eval-after-load 'orderless
-      (:option consult--regexp-compiler #'consult--orderless-regexp-compiler))))
+      (:option consult--regexp-compiler #'consult--orderless-regexp-compiler))
+    (with-eval-after-load 'vertico-multiform
+      (setf (alist-get 'consult-buffer vertico-multiform-commands) '(flat))
+      (dolist (buf-cmd '(consult-find
+                         consult-yank-pop
+                         consult-locate
+                         consult-grep
+                         consult-git-grep
+                         consult-ripgrep
+                         consult-line
+                         consult-line-multi
+                         consult-multi-occur
+                         consult-keep-lines
+                         consult-focus-lines
+                         consult-imenu
+                         consult-imenu-multi
+                         consult-outline))
+        (setf (alist-get buf-cmd vertico-multiform-commands) '(buffer))))))
 
 (setup (:straight consult-dir)
   (:+key "C-x C-d" #'consult-dir)
@@ -1063,6 +1065,16 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
     (:bind "C-x C-d" #'consult-dir
            "C-x C-j" #'consult-dir-jump-file)))
 
+(setup (:straight crossword)
+  ;; This isn't the perfect Emacs crossword puzzle, but it's the only one I
+  ;; know.
+  (:hook #'turn-off-+key-mode)
+  (:option crossword-save-path (sync/ "emacs/crosswords/" t)
+           crossword-empty-position-char "=")
+  (:face crossword-grid-face ((t :inherit 'font-lock-string-face))
+         crossword-current-face ((t :inherit 'highlight))
+         crossword-other-dir-face ((t :inherit 'font-lock-keyword-face))))
+
 (setup (:straight crux)
   ;; yes it's silly I have an addon to this addon.
   (:require crux +crux)
@@ -1113,6 +1125,14 @@ See also `crux-reopen-as-root-mode'."
   (:option ebuku-display-on-startup 'recent
            ebuku-recent-count 100))
 
+(setup (:straight edit-server)
+  (:option edit-server-url-major-mode-alist `(("github\\.com" . ,(if (fboundp 'gfm-mode)
+                                                                     #'gfm-mode
+                                                                   #'markdown-mode))))
+  (add-hook 'edit-server-done-hook (lambda () (unfill-region (point-min) (point-max))))
+  (+with-ensure-after-init
+    (edit-server-start)))
+
 (setup (:straight electric-cursor)
   (:option electric-cursor-alist '((overwrite-mode . hbar)
                                    (god-local-mode . box)
@@ -1147,14 +1167,13 @@ See also `crux-reopen-as-root-mode'."
     (advice-add #'elfeed :before #'elfeed-db-load))
   (:with-mode elfeed-show-mode
     (:bind "SPC" #'+elfeed-scroll-up-command
-           "S-SPC" #'+elfeed-scroll-down-command
+           "S-SPC"  #'+elfeed-scroll-down-command
            "&" #'+elfeed-show-browse-generic
            "RET" #'shr-browse-url)
     (:hook #'reading-mode)
     (:option +elfeed--update-repeat (* 60 60) ; 1 hour
              +elfeed--update-first-time 60)
-    ;; (+elfeed-update-async-mode +1)
-    ))
+    (+elfeed-update-async-mode +1)))
 
 (setup (:straight elfeed-org)
   (:also-load +org-capture)
@@ -1273,7 +1292,7 @@ See also `crux-reopen-as-root-mode'."
   (:bind-into flyspell
     "C-;" #'flyspell-correct-wrapper
     "<f7>" #'+flyspell-correct-buffer)
-  (+with-ensure-after-init              ; vertico-multiform
+  (with-eval-after-load 'vertico-multiform
     (setf (alist-get 'flyspell vertico-multiform-categories) nil)))
 
 (setup (:straight-when (forge
@@ -1296,32 +1315,12 @@ See also `crux-reopen-as-root-mode'."
   (:option gcmh-idle-delay 'auto)
   (gcmh-mode +1))
 
-(setup (:straight-when (geiser
-                        :host gitlab :repo "acdw/geiser"
-                        :files (:defaults "doc/*")
-                        ;; XXX: This seems to trigger a build on every start of Emacs....
-                        :pre-build ("make" "-Cdoc" "geiser.info"))
-         (progn
-           (defvar +schemes
-             (let (schemes)
-               (dolist (scheme '(("scheme" . geiser-chez) ; chez
-                                 ("petite" . geiser-chez) ; petite
-                                 ("csi" . geiser-chicken) ; chicken
-                                 ("gsi" . geiser-gambit)
-                                 ("gosh" . geiser-gauche)
-                                 ("guile" . geiser-guile)
-                                 ("kawa" . geiser-kawa)
-                                 ("mit-scheme" . geiser-mit)
-                                 ("racket" . geiser-racket)
-                                 ("stklos" . geiser-stklos)))
-                 (when-let (binary (executable-find (car scheme)))
-                   (push binary schemes)
-                   ;; and install the proper helper package
-                   (straight-use-package (cdr scheme))))
-               (nreverse schemes)))
-           +schemes))
-  (:file-match (rx ".rkt" eos)
-               (rx ".scm" eos)))
+(setup (:straight geiser
+                  geiser-chicken
+                  macrostep-geiser
+                  scheme-complete)
+  (setf (alist-get "\\.scm\\'" auto-mode-alist nil nil #'string=)
+        'scheme-mode))
 
 (setup (:straight (git-modes
                    :host github :repo "magit/git-modes"))
@@ -1337,12 +1336,16 @@ See also `crux-reopen-as-root-mode'."
 ;;            "a" nil)))
 
 (setup (:straight helpful)
-  (run-with-idle-timer 0.5 nil
-                       'require 'helpful)
   (:+key "<f1> f" #'helpful-callable
          "<f1> v" #'helpful-variable
          "<f1> k" #'helpful-key
-         "<f1> ." #'helpful-at-point))
+         "<f1> ." #'helpful-at-point)
+  (with-eval-after-load 'vertico-multiform
+    (dolist (cmd '(describe-symbol     ; describe-* included here for completeness
+                   describe-function describe-variable
+                   helpful-function helpful-macro helpful-callable
+                   helpful-variable))
+      (setf (alist-get cmd vertico-multiform-commands) nil))))
 
 (setup (:straight (hippie-completing-read
                    :host github
@@ -1376,7 +1379,8 @@ See also `crux-reopen-as-root-mode'."
   ;; This complicatedness is an attempt to make it easier to add and
   ;; subtract `isearch-mb' bindings using the suggestions in the
   ;; project's README.
-  (with-eval-after-load 'isearch-mb
+  (:load-after consult anzu)
+  (:when-loaded
     (dolist (spec '((isearch-mb--with-buffer
                      ("M-e" .  consult-isearch)
                      ("C-o" . loccur-isearch))
@@ -1444,21 +1448,36 @@ See also `crux-reopen-as-root-mode'."
 
 (setup (:straight link-hint)
   (:require +link-hint)
-  (+link-hint-setup-open-secondary)
+  (+link-hint-open-secondary-setup)
   (:option link-hint-avy-style 'at-full)
   (:+key "M-l" +link-hint-map)
   (:with-map +link-hint-map
     (:bind "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link
-           "M-m" #'link-hint-open-multiple-links
-           "m" #'link-hint-open-multiple-links
+           "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary
+           "M-m" #'link-hint-open-multiple-links "m" #'link-hint-open-multiple-links
            "M-c" #'link-hint-copy-link "c" #'link-hint-copy-link)))
 
 (setup (:straight (machine
                    :host github :repo "duckwork/machine.el"))
-  (:option machine-default-font "DejaVu Sans Mono"
-           machine-variable-pitch-font "DejaVu Sans")
   (+with-ensure-after-init              ; So that they override anything here.
-   (machine-settings-load)))
+    ;; Emoji fonts
+    (let ((ffl (font-family-list))
+          (emoji-fonts '("Noto Color Emoji"
+                         "Noto Emoji"
+                         "Segoe UI Emoji"
+                         "Apple Color Emoji"
+                         "FreeSans"
+                         "FreeMono"
+                         "FreeSerif"
+                         "Unifont"
+                         "Symbola"))
+          found)
+      (dolist (font emoji-fonts)
+        (when (member font ffl)
+          (push font found)
+          (set-fontset-font t 'symbol (font-spec :family font) nil :append)))
+      (nreverse found))
+    (machine-settings-load)))
 
 (setup (:straight macrostep)
   (:require macrostep)
@@ -1485,7 +1504,11 @@ See also `crux-reopen-as-root-mode'."
 (setup (:straight mastodon)
   (:option mastodon-instance-url "https://tiny.tilde.website"
            mastodon-client--token-file (.etc "mastodon.plstore")
-           mastodon-auth-source-file (car auth-sources)
+           mastodon-auth-source-file (seq-some (lambda (i)
+                                                 (when (and (stringp i)
+                                                            (file-exists-p i))
+                                                   i))
+                                               auth-sources)
            mastodon-tl--enable-proportional-fonts t
            mastodon-tl--show-avatars t)
   (:hook #'mastodon-async-mode
@@ -1508,6 +1531,7 @@ See also `crux-reopen-as-root-mode'."
                    :host github :repo "purcell/mode-line-bell"
                    :fork (:host github :repo "duckwork/mode-line-bell"
                                 :branch "remap-face")))
+  ;; This is still, annoyingly, not quite working right.
   (:face mode-line-bell ((t (:inherit mode-line-highlight))))
   (:option mode-line-bell-flash-time 0.1)
   (mode-line-bell-mode +1))
@@ -1536,7 +1560,8 @@ See also `crux-reopen-as-root-mode'."
   (:require +mwim)
   (:option +mwim-passthrough-modes '(comint-mode
                                      eshell-mode
-                                     vterm-mode))
+                                     vterm-mode
+                                     crossword-mode))
   (:+key "C-a" #'+mwim-beginning-maybe
          "C-e" #'+mwim-end-maybe))
 
@@ -1626,6 +1651,19 @@ See also `crux-reopen-as-root-mode'."
                    :repo "duckwork/plancat.el"))
   (:option plancat-user "acdw"))
 
+(setup (:straight pocket-reader)
+  (:option pocket-reader-open-url-default-function #'browse-url)
+  (dolist (mode '((eww-mode-map . eww)
+                  (w3m-mode-map . w3m)
+                  (elfeed-search-mode-map . elfeed-search)
+                  (elfeed-show-mode-map . elfeed-show)))
+    (with-eval-after-load (cdr mode)
+      (define-key (symbol-value (car mode)) "\"" #'pocket-reader-add-link))
+    (with-eval-after-load '+link-hint
+      (+link-hint-pocket-add-setup)
+      (define-key +link-hint-map "M-\"" #'+link-hint-pocket-add)
+      (define-key +link-hint-map "\"" #'+link-hint-pocket-add))))
+
 (setup (:straight (shell-command+
                    :host nil
                    :repo "https://git.sr.ht/~pkal/shell-command-plus"))
@@ -1777,6 +1815,8 @@ See also `crux-reopen-as-root-mode'."
            undo-fu-session-compression (executable-find "gzip"))
   (global-undo-fu-session-mode +1))
 
+(setup (:straight unfill))
+
 ;; (setup (:straight valign)
 ;;   (:option valign-fancy-bar t)
 ;;   (:hook-into org-mode
@@ -1803,39 +1843,15 @@ See also `crux-reopen-as-root-mode'."
               vertico-quick)
   (vertico-mouse-mode +1)
   (vertico-multiform-mode +1)
-  (:option vertico-multiform-commands '((execute-extended-command flat)
-                                        (helpful-function)
-                                        (helpful-macro)
-                                        (helpful-callable)
-                                        (helpful-variable)
-                                        (describe-symbol)
-                                        (completion-at-point flat)
-                                        (indent-for-tab-command flat)
-                                        (consult-buffer flat)
-                                        (insert-char)
-                                        (flyspell-correct-wrapper)
-                                        (+flyspell-correct-buffer)
-                                        (flyspell-correct-move))
-           ;; This is applied /after/ the above, so default is at the end of
-           ;; this alist.
-           vertico-multiform-categories '((file buffer grid)
-                                          (bookmark)
-                                          (flyspell)
-                                          (t flat)))
-  (dolist (buf-cmd '(consult-find
-                     consult-yank-pop
-                     consult-locate
-                     consult-grep
-                     consult-git-grep
-                     consult-ripgrep
-                     consult-line
-                     consult-line-multi
-                     consult-multi-occur
-                     consult-keep-lines
-                     consult-focus-lines
-                     consult-imenu
-                     consult-outline))
-    (setf (alist-get buf-cmd vertico-multiform-commands) '(buffer)))
+  ;; I `setf' these so they don't override the other setfs elsewhere in init.el.
+  (setf (alist-get 'execute-extended-command vertico-multiform-commands) '(flat))
+  (setf (alist-get 'completion-at-point vertico-multiform-commands) '(flat))
+  (setf (alist-get 'indent-for-tab-command vertico-multiform-commands) '(flat))
+  (setf (alist-get 'insert-char vertico-multiform-commands) nil)
+  (setf (alist-get 'file vertico-multiform-categories) '(buffer))
+  (setf (alist-get 'bookmark vertico-multiform-categories) nil)
+  ;; Default.  Needs to be `add-to-list' so that it appears at the end.
+  (add-to-list 'vertico-multiform-categories '(t flat) :append)
   (:with-map vertico-map
     (:bind "RET" #'vertico-directory-enter
            "DEL" #'vertico-directory-delete-char
@@ -1894,6 +1910,10 @@ See also `crux-reopen-as-root-mode'."
   (:hook-into org-mode
               latex-mode))
 
+(setup (:straight xkcd)
+  (:also-load +xkcd)
+  (:hook #'visual-fill-column-mode))
+
 (setup (:straight yasnippet)
   (:option yas-snippet-dirs (list
                              (expand-file-name "snippets" user-emacs-directory)
@@ -0,0 +1,16 @@
+;;; +xkcd.el -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'xkcd)
+
+(defun +xkcd-get-from-url (url &rest _)
+  "Open XKCD from URL."
+  (if (string-match "xkcd\\.com/\\([0-9]+\\)" url)
+      (xkcd-get (string-to-number (match-string 1 url)))
+    (funcall +browse-url-browser-function url)))
+
+(provide '+xkcd)
+;;; +xkcd.el ends here