5 files changed, 201 insertions, 79 deletions

@@ -149,7 +149,7 @@
 (setup (:require user-save)
   (add-hook 'user-save-before-save-hook #'+clean-empty-lines)
   (add-hook 'user-save-before-save-hook (defun user-save@save-some-buffers ()
-                              (save-some-buffers t t)))
+                                          (save-some-buffers t t)))
   (user-save-global-mode +1))
 
 (setup (:require winner)
@@ -520,18 +520,18 @@
            )
   (with-eval-after-load 'transient
     (transient-define-prefix net-utils ()
-                             "Networking utilities"
-                             ["Actions"
-                              ("p" "Ping" ping)
-                              ("i" "Ifconfig" ifconfig)
-                              ("w" "Iwconfig" iwconfig)
-                              ("n" "Netstat" netstat)
-                              ("a" "Arp" arp)
-                              ("r" "Route" route)
-                              ("h" "Nslookup host" nslookup-host)
-                              ("d" "Dig" dig)
-                              ("s" "Smb Client" smbclient)
-                              ("t" "Traceroute" traceroute)])
+      "Networking utilities"
+      ["Actions"
+       ("p" "Ping" ping)
+       ("i" "Ifconfig" ifconfig)
+       ("w" "Iwconfig" iwconfig)
+       ("n" "Netstat" netstat)
+       ("a" "Arp" arp)
+       ("r" "Route" route)
+       ("h" "Nslookup host" nslookup-host)
+       ("d" "Dig" dig)
+       ("s" "Smb Client" smbclient)
+       ("t" "Traceroute" traceroute)])
     (:+key "C-z M-n" #'net-utils)))
 
 (setup notmuch
@@ -544,13 +544,20 @@
            notmuch-address-save-filename (notmuch/ "addresses" t)
            notmuch-address-use-company (featurep 'company)
            notmuch-search-oldest-first nil
-           notmuch-archive-tags '("-inbox" "-unread"))
+           notmuch-archive-tags '("-inbox" "-unread")
+           notmuch-draft-tags '("+draft" "-inbox" "-unread"))
   ;; Reading mail
   (:option notmuch-show-indent-content nil)
   (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode)
+  (:with-mode notmuch-search-mode
+    (:bind "RET" #'notmuch-search-show-thread
+           "M-RET" #'notmuch-tree-from-search-thread
+           "!" #'+notmuch-search-mark-spam))
+  (:with-mode notmuch-tree-mode
+    (:bind "!" #'+notmuch-tree-mark-spam-then-next))
   ;; Composing mail
   (:option message-kill-buffer-on-exit t
-           message-auto-save-directory "~/var/mail/drafts")
+           message-auto-save-directory nil)
   ;; Sending mail
   (:option send-mail-function #'sendmail-send-it
            mail-specify-envelope-from t
@@ -568,38 +575,47 @@
                                                    "tag:inbox"
                                                    "tag:unread"
                                                    "NOT tag:Spam")
-                                           :key "i")
+                                           :key "m"
+                                           :search-type 'tree)
                                      (list :name "inbox"
                                            :query (+notmuch-query-concat
                                                    "tag:inbox"
                                                    "NOT tag:Spam")
-                                           :key "I")
+                                           :key "i"
+                                           :search-type 'tree)
                                      (list :name "lists+unread"
                                            :query (+notmuch-query-concat
                                                    "tag:/List/"
                                                    "tag:unread")
-                                           :key "l")
+                                           :key "l"
+                                           :search-type 'tree)
                                      (list :name "lists"
                                            :query "tag:/List/"
-                                           :key "L")
+                                           :key "L"
+                                           :search-type 'tree)
                                      (list :name "unread"
                                            :query (+notmuch-query-concat
                                                    "tag:unread"
                                                    "NOT tag:Spam")
-                                           :key "u")
+                                           :key "u"
+                                           :search-type 'tree)
                                      (list :name "flagged"
                                            :query "tag:flagged"
-                                           :key "f")
+                                           :key "f"
+                                           :search-type 'tree)
                                      (list :name "sent"
                                            :query "tag:sent"
-                                           :key "t")
+                                           :key "t"
+                                           :search-type 'tree)
                                      (list :name "drafts"
                                            :query "tag:draft"
-                                           :key "d")
+                                           :key "d"
+                                           :search-type 'tree)
                                      (list :name "all mail"
                                            :query "*"
-                                           :key "a"))))
-  (:+leader "m" #'+notmuch-goto "C-m" #'+notmuch-goto
+                                           :key "a"
+                                           :search-type 'tree))))
+  (:+leader "m" #'notmuch-mua-new-mail "C-m" #'notmuch-jump-search
             "n" #'notmuch "C-n" #'notmuch)
   ;; For `focus'
   (put 'notmuch-message 'bounds-of-thing-at-point 'notmuch-show-message-extent))
@@ -671,10 +687,11 @@
            org-startup-truncated nil
            org-startup-with-inline-images t
            org-tags-column -77 ;; (- (- fill-column 1 (length org-ellipsis)))
-           org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
-                                         "|" "DONE(d!)" "ASSIGNED(a!)")
-                               (sequence "|" "CANCELED(k@)")
-                               (sequence "MEETING(m)"))
+           org-todo-keywords
+           '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
+                       "|" "DONE(d!)" "ASSIGNED(a@/!)")
+             (sequence "|" "CANCELED(k@)")
+             (sequence "MEETING(m)"))
            org-use-speed-commands t
            org-emphasis-alist '(("*" org-bold)
                                 ("/" org-italic)
@@ -921,8 +938,8 @@
   (:option shell-command-prompt-show-cwd t)
   (:local-set +modeline-position-function
               (lambda () (string-replace (getenv "HOME")
-                                         "~"
-                                         default-directory)))
+                                    "~"
+                                    default-directory)))
   (:hook #'form-feed-mode))
 
 (setup shr
@@ -1062,7 +1079,8 @@
   (:bind-into isearch
     "M-j" #'avy-isearch)
   (setf (alist-get ?. avy-dispatch-alist) #'avy-action-embark)
-  (+avy-buffer-face-mode +1))
+  ;; (+avy-buffer-face-mode +1)
+  )
 
 (setup (:straight bbdb)
   (:straight bbdb-vcard)
@@ -1070,7 +1088,9 @@
             (defun +bbdb-load ()
               (:require bbdb-autoloads
                         bbdb)
-              (bbdb-initialize 'gnus 'message))))
+              (bbdb-initialize 'gnus 'message)
+              (bbdb-insinuate-message)
+              (setq bbdb-complete-mail-allow-cycling t))))
 
 (setup (:straight (bongo :type git
                          :flavor melpa
@@ -1165,8 +1185,8 @@
                     '(t))))))
 
 (setup (:straight circe)
-  ;; (:require _circe
-  ;;           +circe)
+  (:require _circe
+            +circe)
   ;; (:also-load circe-chanop)
   ;; (+ensure-after-init (lambda () (defalias 'irc '+irc "Start IRC.")))
 
@@ -1499,6 +1519,11 @@
 (setup (:straight dired-open)
   (:load-after dired))
 
+(setup (:straight dired-rsync)
+  (:load-after dired)
+  (:bind-into dired-mode
+    "r" #'dired-rsync))
+
 (setup (:straight dired-subtree)
   (:load-after dired)
   (:bind-into dired
@@ -1702,6 +1727,12 @@
   (:+key "C-=" #'er/expand-region
          "C--" #'+er/contract-or-negative-argument))
 
+(setup (:straight fennel-mode)
+  (with-eval-after-load 'apheleia
+    (when-let ((fnlfmt (executable-find "fnlfmt")))
+      (setf (alist-get 'fnlfmt apheleia-formatters) (list fnlfmt 'filepath))
+      (setf (alist-get 'fennel-mode apheleia-mode-alist) 'fnlfmt))))
+
 (setup (:straight (filldent :host nil
                             :repo "https://codeberg.org/acdw/filldent.el"))
   (:+key "M-q" #'filldent-unfill-toggle))
@@ -1769,6 +1800,10 @@
   (setf (alist-get "\\.scm\\'" auto-insert-alist nil nil #'equal)
         '(insert "#!/bin/sh\n#| -*- scheme -*-\nexec csi -s $0 \"$@\"\n|#\n")))
 
+(setup (:straight (ghelp :repo "https://github.com/casouri/ghelp"))
+  ;;; XXX: set this up!
+  (:require))
+
 (setup (:straight (git-modes :host github :repo "magit/git-modes"))
   (:require git-modes))
 
@@ -1801,7 +1836,10 @@
   (:option hungry-delete-chars-to-skip " \t"
            hungry-delete-join-reluctantly nil)
   (+with-ensure-after-init
-    (add-to-list 'hungry-delete-except-modes 'eshell-mode))
+    (dolist (m '(eshell-mode
+                 nim-mode
+                 python-mode))
+      (add-to-list 'hungry-delete-except-modes m)))
   (:bind-into paredit
     ;; I define these functions here because they really require both packages
     ;; to make any sense.  So, would I put them in `+hungry-delete' or
@@ -1907,15 +1945,16 @@
                                             ('dark 1.0)))
               (+mapc-some-buffers #'+jabber-colors-update
                                   (lambda () (derived-mode-p 'jabber-chat-mode
-                                                             'jabber-roster-mode
-                                                             'jabber-activity-mode
-                                                             'jabber-browse-mode)))))
+                                                        'jabber-roster-mode
+                                                        'jabber-activity-mode
+                                                        'jabber-browse-mode)))))
   (dolist (mode '(jabber-chat-mode
                   jabber-browse-mode
                   jabber-roster-mode
                   jabber-console-mode))
     (let ((hook (intern (format "%s-hook" mode))))
       (add-hook hook #'visual-fill-column-mode)
+      (add-hook hook (defun +electric-pair-disable-local-mode () (electric-pair-local-mode -1)))
       ;; (add-hook hook (lambda () (setq-local wrap-prefix "        ")))
       ))
   (with-eval-after-load 'tracking
@@ -1927,7 +1966,8 @@
                                                 "🤔 ")))
                 file-percentage-mode nil
                 ;; wrap-prefix (make-string +jabber-ws-prefix ?\ )
-                comment-start nil))
+                comment-start nil)
+    (:bind "C-c C-t" #'jabber-muc-set-topic))
   (:+leader "C-j" jabber-global-keymap)
   (advice-add 'jabber-activity-add :after #'+jabber-tracking-add)
   (advice-add 'jabber-activity-add-muc :after #'+jabber-tracking-add-muc)
@@ -1955,7 +1995,8 @@
   (:require +link-hint)
   (+link-hint-open-secondary-setup)
   (+link-hint-open-chrome-setup)
-  (:option link-hint-avy-style 'at-full)
+  (:option link-hint-avy-style 'at-full
+           link-hint-avy-all-windows t)
   (:+key "M-l" +link-hint-map)
   (:with-map +link-hint-map
     (:bind "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link
@@ -2006,7 +2047,7 @@
     (:hook #'visual-fill-column-mode))
   (with-eval-after-load 'apheleia
     (when-let ((mdfmt-exe (executable-find "markdownfmt")))
-      (setf (alist-get 'markdownfmt apheleia-formatters) mdfmt-exe)
+      (setf (alist-get 'markdownfmt apheleia-formatters) (list mdfmt-exe))
       (setf (alist-get 'markdown-mode apheleia-mode-alist) 'markdownfmt)
       (setf (alist-get 'gfm-mode apheleia-mode-alist) 'markdownfmt))))
 
@@ -2077,8 +2118,9 @@
                    ((,class :inherit modus-themes-bold
                             :foreground unspecified)))
                  `(font-lock-comment-face
-                   ((,class :inherit variable-pitch
-                            :slant italic
+                   ((,class :inherit default
+                            :slant normal
+                            :height 1.0
                             :foreground ,fg-comment-yellow)))
                  `(font-lock-comment-delimiter-face
                    ((,class :inherit fixed-pitch
@@ -2265,7 +2307,9 @@
                   lisp-mode-hook
                   scheme-mode-hook
                   geiser-mode-hook
-                  geiser-repl-mode-hook))
+                  geiser-repl-mode-hook
+                  fennel-mode-hook
+                  fennel-repl-mode-hook))
     (add-hook hook #'enable-paredit-mode))
   (:also-load eldoc)
   (eldoc-add-command #'paredit-backward-delete #'paredit-close-round))
@@ -2357,6 +2401,8 @@
                   (+modeline-concat
                    '(+modeline-track
                      simple-modeline-segment-misc-info))))
+              (lambda () (when (featurep 'dired-rsync)
+                      dired-rsync-modeline-status))
               ,(+modeline-concat
                 '(+modeline-god-mode
                   +modeline-kmacro-indicator
@@ -2392,7 +2438,10 @@
   (:also-load sly-autoloads
               +sly)
   (:option inferior-lisp-program +lisp-bin
-           sly-kill-without-query-p t)
+           sly-kill-without-query-p t
+           sly-command-switch-to-existing-lisp t)
+  (:with-mode lisp-mode
+    (:bind "C-c C-z" #'sly-mrepl))
   (:with-feature sly-mrepl
     (dolist (key '("RET" "<return>"))
       (:bind key #'sly-mrepl-return-at-end))
@@ -2607,6 +2656,9 @@
 
 (setup (:straight xr))
 
+(setup (:straight yaml-mode)
+  (:file-match (rx "." (or "yml" "yaml") eos)))
+
 (setup (:straight yaoddmuse))
 
 (setup (:straight yasnippet)
@@ -89,14 +89,15 @@ and appended with `truncate-string-ellipsis'."
 
 (defun +modeline-buffer-name (&optional spacer)         ; gonsie
   "Display the buffer name."
-  (let ((bufname (string-trim (string-replace "%" "" (buffer-name)))))
+  (let ((bufname (string-trim (string-replace "%" "%%%%" (buffer-name)))))
     (+modeline-spacer nil spacer
       (if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
           (funcall +modeline-buffer-position)
         (propertize (cond
                      ((ignore-errors
-                        (and (> +modeline-buffer-name-max-length 0)
-                             (< +modeline-buffer-name-max-length 1)))
+                        (and
+                         (> +modeline-buffer-name-max-length 0)
+                         (< +modeline-buffer-name-max-length 1)))
                       (truncate-string-to-width bufname
                                                 (* (window-total-width)
                                                    +modeline-buffer-name-max-length)
@@ -149,14 +150,14 @@ in the cdr will be applied to the major-mode in the mode line."
     (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
      (format-mode-line mode-name)
      'face (when (actually-selected-window-p)
-               ;; XXX: This is probably really inefficient.  I need to
-               ;; simply detect which mode it's in when I change major
-               ;; modes (`change-major-mode-hook') and change the face
-               ;; there, probably.
-               ;; (catch :done (dolist (cel +modeline-major-mode-faces)
-               ;;                (when (derived-mode-p (car cel))
-               ;;                  (throw :done (cdr cel))))
-               ;;        (alist-get t +modeline-major-mode-faces))
+             ;; XXX: This is probably really inefficient.  I need to
+             ;; simply detect which mode it's in when I change major
+             ;; modes (`change-major-mode-hook') and change the face
+             ;; there, probably.
+             ;; (catch :done (dolist (cel +modeline-major-mode-faces)
+             ;;                (when (derived-mode-p (car cel))
+             ;;                  (throw :done (cdr cel))))
+             ;;        (alist-get t +modeline-major-mode-faces))
              '+modeline-major-mode-face)
      'keymap (let ((map (make-sparse-keymap)))
                (bindings--define-key map [mode-line down-mouse-1]
@@ -302,13 +303,13 @@ The order of elements matters: whichever one matches first is applied."
   (when file-percentage-mode
     (+modeline-spacer nil spacer
       (let ((perc (format-mode-line '(-2 "%p"))))
-       (pcase perc
-         ("To" "/\\")
-         ("Bo" "\\/")
-         ("Al" "[]")
-         (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|"))
-                  (perc (string-to-number perc)))
-              (aref vec (floor (/ perc 17))))))))))
+        (pcase perc
+          ("To" "/\\")
+          ("Bo" "\\/")
+          ("Al" "[]")
+          (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|"))
+                   (perc (string-to-number perc)))
+               (aref vec (floor (/ perc 17))))))))))
 
 (defun +modeline-file-percentage-icon (&optional spacer)
   "Display the position in the current file as an icon."
@@ -379,8 +380,8 @@ to a function in the current buffer, call that function instead."
   "Display the version control branch of the current buffer in the modeline."
   ;; from https://www.gonsie.com/blorg/modeline.html, from Doom
   (when-let ((backend (vc-backend buffer-file-name)))
-      (+modeline-spacer nil spacer
-        (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))))
+    (+modeline-spacer nil spacer
+      (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))))
 
 (defun +modeline-track (&optional spacer)
   "Display `tracking-mode' information."
@@ -58,5 +58,40 @@ for search."
                     nil)
      'notmuch-address-history)))
 
+(defcustom +notmuch-spam-tags '("+spam" "+Spam")
+  "A list of tag changes to apply when marking a thread as spam."
+  :type '(repeat string))
+
+(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end)
+  "Mark the current message as spam and move to the next."
+  (interactive "P")
+  (+notmuch-tree-mark-spam ham)
+  (notmuch-tree-next-matching-message))
+
+(defun +notmuch-tree-mark-spam (&optional ham)
+  "Mark the current message as spam.
+That is, apply the tag changes in `+notmuch-spam-tags' to it.  If
+an optional prefix HAM argument is given, the message will be
+marked as not-spam (\"ham\"), i.e., the tag changes in
+`+notmuch-spam-tags' will be reversed."
+  (interactive "P")
+  (when +notmuch-spam-tags
+    (notmuch-tree-tag
+     (notmuch-tag-change-list +notmuch-spam-tags ham))))
+
+(defun +notmuch-search-mark-spam (&optional ham beg end)
+  "Mark the current thread or region as spam.
+This adds the tags in `+notmuch-spam-tags' to the message.  With
+an optional HAM prefix argument, mark the messages as
+not-spam (\"ham\").
+
+This function advances the next thread when finished."
+  (interactive (cons current-prefix-arg (notmuch-interactive-region)))
+  (when +notmuch-spam-tags
+    (notmuch-search-tag
+     (notmuch-tag-change-list +notmuch-spam-tags ham) beg end))
+  (when (eq beg end)
+    (notmuch-search-next-thread)))
+
 (provide '+notmuch)
 ;;; +notmuch.el ends here
@@ -32,6 +32,19 @@
   "Hide the `tracking-mode' information when clocked in."
   :type 'boolean)
 
+(defun format-mode-line-unescaping (construct)
+  "Return a mode-line construct as a string, but unescape `%'s."
+  (format-mode-line
+   (cond ((listp construct)
+          (cl-loop for item in construct
+                   collect (cond ((stringp item)
+                                  (string-replace "%" "%%" item))
+                                 ((and (listp item) (eq :propertize (car item)))
+                                  (format-mode-line-unescaping item))
+                                 (t item))))
+         ((stringp construct) (string-replace "%" "%%" construct))
+         (t construct))))
+
 (defun +tab-bar-tracking-mode ()
   "Display `tracking-mode-line-buffers' in the tab-bar."
   ;; TODO: write something to convert a mode-line construct to a tab-bar
@@ -45,7 +58,7 @@
                          as item = (nth i tracking-mode-line-buffers)
                          collect (append (list (intern (format "tracking-mode-line-%s" i))
                                                'menu-item
-                                                (string-trim (format-mode-line item)))
+                                                (string-trim (format-mode-line-unescaping item)))
                                          (if-let ((keymap (plist-get item 'keymap)))
                                              (list (alist-get 'down-mouse-1 (cdadr keymap)))
                                            (list #'ignore))
@@ -7,18 +7,37 @@
 (require 'acdw)
 (require 'machine)
 
+(defcustom +bob-face-plist
+  '( :dejavu ("DejaVu Sans Mono" "DejaVu Sans")
+     :iosevka ("Iosevka Comfy Wide" "Iosevka Comfy Duo")
+     :plex ("IBM Plex Mono" "IBM Plex Serif")
+     :go/djv ("Go Mono" "DejaVu Sans")
+     :tt (("TT2020Base" 120) "TT2020 Base Style E") ; no italic
+     :courier ("Courier Prime Code" "Courier Prime")
+     :gaegu (("Gaegu" 140) "Gaegu")     ; no italic
+     :comic (("Comic Code" 100) "Comic Code")
+     :go/comic (("Go Mono" 100) ("Comic Code" 100))
+     )
+  "A plist of possible font combinations.")
+
+(defcustom +bob-face-pair :comic ;; (+bob-set-faces)
+  "The index of `+bob-face-pairs' to use.")
+
 (defun +bob-set-faces (&rest _)
-  (let (;;(base-face "IBM Plex Mono")
-        ;; (var-face "IBM Plex Sans")
-        ;; (base-face "Iosevka Comfy Wide")
-        ;; (var-face "Iosevka Comfy Duo")
-        (base-face "DejaVu Sans Mono")
-        (var-face "DejaVu Sans")
-        (base-size 100)
-        (var-size 1.0)
-        (italic-face nil)
-        ;; (bold-face nil)
-        (mono-face nil))
+  (let* ((face-pair (plist-get +bob-face-plist +bob-face-pair))
+         (base-face (if (stringp (car face-pair))
+                        (car face-pair)
+                      (caar face-pair)))
+         (var-face (if (stringp (cadr face-pair))
+                       (cadr face-pair)
+                     (caadr face-pair)))
+         (base-size (or (ignore-errors (cadar face-pair))
+                        100))
+         (var-size (or (ignore-errors (cadadr face-pair))
+                       1.0))
+         (italic-face nil)
+         ;; (bold-face nil)
+         (mono-face nil))
     (+set-faces
      `((default
          :family ,base-face
@@ -33,7 +52,9 @@
                     :height 1.0)
        (variable-pitch
         :family ,(or var-face base-face)
-        :height ,var-size)
+        :height ,var-size
+        ;; :weight medium
+        )
        ;; (org-italic
        ;;  :family ,(or var-face base-face)
        ;;  :slant italic)