4 files changed, 260 insertions, 21 deletions

@@ -560,12 +560,23 @@ N spaces."
   :hook
   (embark-collect-mode . consult-preview-at-point-mode))
 
+(use-package undo-fu
+  :ensure t
+  :init
+  (setq undo-limit 67108864)            ; 64mb.
+  (setq undo-strong-limit 100663296)    ; 96mb.
+  (setq undo-outer-limit 1006632960)    ; 960mb.
+  :bind (("C-/" . undo-fu-only-undo)
+         ("C-?" . undo-fu-only-redo)))
+
 (use-package undo-fu-session
   :ensure t
   :config
-  (setq undo-fu-session-incompatible-files
-        '("/COMMIT_EDITMSG\\'"
-          "/git-rebase-todo\\'"))
+  (setopt undo-fu-session-compression (cond
+                                       ((executable-find "gunzip") 'gz)
+                                       ((executable-find "bzip2") 'bz2))
+          undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
+                                               "/git-rebase-todo\\'"))
   (global-undo-fu-session-mode))
 
 (use-package crux
@@ -1,6 +1,17 @@
 ;;; init.el --- An Emacs of one's own -*- lexical-binding: t -*-
+
+;; Author: Case Duckworth <acdw@acdw.net>, with inspo from many others
+;; Homepage: https://git.acdw.net/emacs
+;; Config-Requires: ((emacs "29.0"))
 ;; Bankruptcy: 9.4
 
+;; This configuration is Free Software.  Everyone is permitted to do whatever
+;; they want with it, without limitation.  This software comes without any
+;; warranty whatsoever, but with two pieces of advice:
+;;
+;; - Don't hurt others.
+;; - Make good choices.
+
 ;;; Code:
 
 (load (locate-user-emacs-file "basics")) ; super basic stuff
@@ -106,6 +117,14 @@
   :config
   (fringe-mode '(nil . 0)))
 
+(use-package ispell
+  :config
+  (setopt ispell-program-name (choose-executable "ispell" "aspell"))
+  (add-hook 'before-save-hook
+            #'+ispell-move-buffer-words-to-dir-locals-hook)
+  (put 'ispell-buffer-session-localwords 'safe-local-variable
+       '+ispell-safe-local-p))
+
 (use-package flyspell
   :hook org-mode-hook)
 
@@ -164,6 +183,8 @@
 (use-package time
   :config
   (setopt display-time-format " %H:%M"
+          display-time-interval 60
+          display-time-use-mail-icon t
           display-time-mail-function
           (defun +notmuch-new-mail-p ()
             (plist-get (cl-find "inbox+unread"
@@ -173,8 +194,24 @@
                                 :test #'equal)
                        :count))
           display-time-default-load-average nil)
+  (with-eval-after-load 'notmuch
+    (add-hook 'notmuch-after-tag-hook #'display-time-update))
   (display-time-mode))
 
+(use-package tab-bar
+  :config
+  (setopt tab-bar-show t
+          tab-bar-close-button-show t)
+  ;; (add-to-list 'tab-bar-format 'tab-bar-format-menu-bar)
+  (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
+  (add-to-list 'tab-bar-format 'tab-bar-format-global :append)
+  (when (daemonp)
+    (add-hook 'server-after-make-frame-hook
+              (defun after-frame@tab-bar ()
+                (tab-bar-mode)
+                (remove-hook 'server-after-make-frame-hook
+                             #'after-frame@tab-bar)))))
+
 
 ;;; Applications
 
@@ -265,7 +302,9 @@ With prefix ARG, toggle the value of
 
 (use-package filldent
   :load-path "~/src/emacs/filldent/"
-  :bind ("M-q" . filldent-dwim))
+  :bind ("M-q" . filldent-dwim)
+  :config
+  (setopt filldent-fill-modes '(web-mode)))
 
 (use-package frowny
   :load-path "~/src/emacs/frowny/"
@@ -338,8 +377,30 @@ With prefix ARG, toggle the value of
                                     word-boundary)))
                     (hi-lock-unface-buffer regexp)
                     (highlight-regexp regexp 'font-lock-warning-face))))))
+  (add-hook 'jabber-chat-mode-hook
+            (defun jabber-chat@leave-when-kill ()
+              (add-hook 'kill-buffer-hook
+                        (defun @jabber-leave@kill ()
+                          (apply #'jabber-muc-leave (jabber-muc-argument-list)))
+                        nil :local)))
   (when (fboundp 'jabber-chat-update-focus)
-    (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)))
+    (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))
+  (with-eval-after-load 'consult
+    (defvar jabber-chat-buffer-source
+      `( :name "Jabber"
+         :hidden nil
+         :narrow ?j
+         :category buffer
+         :state ,#'consult--buffer-state
+         :items ,(lambda ()
+                   (mapcar #'buffer-name
+                           (seq-filter (lambda (buf)
+                                         (with-current-buffer buf
+                                           (eq major-mode 'jabber-chat-mode)))
+                                       (buffer-list))))))
+    (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append)
+    (consult-customize
+     consult-buffer :preview-key (kbd "M-."))))
 
 (use-package keepassxc-shim
   :load-path "~/src/emacs/keepassxc-shim/"
@@ -349,6 +410,14 @@ With prefix ARG, toggle the value of
 
 ;;; External packages
 
+(use-package async
+  :ensure t
+  :config
+  ;; https://github.com/jwiegley/emacs-async/issues/64
+  ;; (setopt message-send-mail-function #'async-smtpmail-send-it)
+  (dired-async-mode)
+  (async-bytecomp-package-mode))
+
 (use-package trashed
   :ensure t)
 
@@ -367,11 +436,45 @@ With prefix ARG, toggle the value of
   :config (minions-mode))
 
 (use-package visual-fill-column
+  :preface
+  (defcustom visual-fill-column-widen-amount 4
+    "Amount to widen `fill-column' by in `visual-fill-column-mode'."
+    :type 'natnum
+    :group 'visual-fill-column)
+  (defun visual-fill-column--widen/narrow-handle-arg (cols)
+    (cond
+     ((null cols) visual-fill-column-widen-amount)
+     ((listp cols) (* visual-fill-column-widen-amount
+                      (1+ (/ (car cols) 4))))
+     ((eq '- cols) (- visual-fill-column-widen-amount))
+     (:else cols)))
+  (defun visual-fill-column-widen (&optional cols)
+    "Widen `fill-column' by COLS, and re-display.
+If COLS is missing or nil, widen by
+`visual-fill-column-widen-amount'.  When called with a plain
+\\[universal-argument], multiply that amount by 1 + the amount of
+\\[universal-argument]s.  If called with a numerical prefix
+argument, widen by that number of columns."
+    (interactive "P")
+    (let ((cols (visual-fill-column--widen/narrow-handle-arg cols)))
+      (cl-incf fill-column cols)
+      (visual-fill-column-adjust)
+      (message "Fill-column: %s" fill-column)))
+  (defun visual-fill-column-narrow (&optional cols)
+    "Narrow `fill-column' by COLS, then redisplay.
+The prefix argument is as in `visual-fill-column-widen' but negated."
+    (interactive "P")
+    (let ((cols (visual-fill-column--widen/narrow-handle-arg cols)))
+      (cl-decf fill-column cols)
+      (visual-fill-column-adjust)
+      (message "Fill-column: %s" fill-column)))
   :ensure t
   :init
   (setopt visual-fill-column-center-text t
           visual-fill-column-extra-text-width '(3 . 3))
   :config
+  (keymap-set visual-fill-column-mode-map "C-x C->" #'visual-fill-column-widen)
+  (keymap-set visual-fill-column-mode-map "C-x C-<" #'visual-fill-column-narrow)
   (add-hook 'visual-fill-column-mode-hook #'visual-line-mode)
   (add-hook 'eww-mode-hook #'visual-fill-column-mode)
   (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust))
@@ -726,15 +829,5 @@ With PREFIX, prompt to change the current dictionary."
 (use-package php-mode
   :ensure t)
 
-(use-package tab-bar
-  :config
-  (setopt tab-bar-show t)
-  (add-to-list 'tab-bar-format 'tab-bar-format-menu-bar)
-  (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
-  (add-to-list 'tab-bar-format 'tab-bar-format-global :append)
-  (with-eval-after-load 'notmuch
-
-    ;; (remove-hook 'notmuch-after-tag-hook #'tab-bar-make-keymap-1)
-    (define-advice notmuch-update-tags (:after (&rest _) update-tab-bar)
-      (tab-bar--update-tab-bar-lines)))
-  (tab-bar-mode))
+(use-package rec-mode
+  :ensure t)
@@ -74,6 +74,7 @@ for a free-form search.  With any other PREFIX argument, open
                                                 (mapcar (lambda (elt)
                                                           (plist-get elt :name))
                                                         notmuch-saved-searches))
+                               notmuch-saved-searches
                                :key (lambda (elt) (plist-get elt :name))
                                :test #'equal)
                       :query)))
@@ -127,6 +128,22 @@ the saved search as well."
                    (equal (plist-get a :name)
                           (plist-get b :name))))))
 
+(defun notmuch-async-poll ()
+  "Run `notmuch-poll' in an async process."
+  (interactive)
+  (if (require 'async nil t)
+      (progn
+        (message "Polling mail async...")
+        (async-start
+         (lambda ()
+           (push "~/usr/share/emacs/site-lisp/" load-path)
+           (require 'notmuch-lib)
+           (notmuch-poll))
+         (lambda (result)
+           (message "%s" result))))
+    (user-error "Feature `async' not found!")))
+
+
 ;;; Packages
 
 (use-package bbdb
@@ -174,7 +191,9 @@ the saved search as well."
           mail-specify-envelope-from t
           message-sendmail-envelope-from 'header
           message-envelope-from 'header
-          notmuch-saved-searches nil)
+          notmuch-saved-searches nil
+          notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option
+          )
   ;; Key bindings
   (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
   (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
@@ -205,6 +224,9 @@ the saved search as well."
   (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
   (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode)
 
+  (define-advice notmuch-bury-or-kill-this-buffer (:after (&rest _) poll-async)
+    (notmuch-async-poll))
+
   (define-advice notmuch-address-selection-function
       (:override (prompt collection _) no-initial-input)
     "Call `completing-read' with `notmuch-address-history'.
@@ -2,6 +2,9 @@
 
 ;;; Code:
 
+(require 'cl-lib)
+(require 'seq)
+
 (defmacro defdir (name directory &optional docstring makedir)
   "Define a variable and a function NAME expanding to DIRECTORY.
 DOCSTRING is applied to the variable; its default is DIRECTORY's
@@ -22,9 +25,9 @@ be created."
            (make-directory (file-name-directory file-name) :parents))
          file-name))
      ,(if makedir
-          `(make-directory ,directory :parents)
-        `(unless (file-exists-p ,directory)
-           (warn "Directory `%s' doesn't exist." ,directory)))))
+          `(make-directory ,directory :parents)
+        `(unless (file-exists-p ,directory)
+           (warn "Directory `%s' doesn't exist." ,directory)))))
 
 (defun choose-executable (&rest programs)
   "Return the first of PROGRAMS that exists in the system's $PATH.
@@ -85,6 +88,17 @@ If `:separator' is the first of STRINGS, the next string will be
 used as a separator."
   (++concat #'format strings))
 
+(defun list-append-removing-duplicates (&rest lists)
+  "Append LISTS, removing duplicates from the result.
+Any keyword arguments to `cl-remove-duplicates' should come
+before the LISTS."
+  (let (cl-remove-duplicates-args)
+    (while (keywordp (car lists))
+      (push (pop lists) cl-remove-duplicates-args)
+      (push (pop lists) cl-remove-duplicates-args))
+    (apply #'cl-remove-duplicates (apply #'append lists)
+           (nreverse cl-remove-duplicates-args))))
+
 (defun mapc-buffers (func &optional predicate)
   "Map FUNC over buffers matching PREDICATE.
 Both FUNC and PREDICATE will be executed with no arguments and in
@@ -125,6 +139,83 @@ each buffer."
          (progress-reporter-done ,prog)))))
 
 
+
+;;; Ispell in .dir-locals
+
+;; Let Emacs know a list of strings is safe
+(defun +ispell-safe-local-p (list)
+  (and (listp list)
+       (seq-every-p #'stringp list)))
+
+;; Can I instruct ispell to insert LocalWords in a different file?
+;; https://emacs.stackexchange.com/q/31396/2264
+
+;; How can I move all my file-local LocalWords to .dir-locals.el?
+;; https://emacs.stackexchange.com/q/31419
+
+;; Adapted from ispell.el:ispell-buffer-local-words
+(defun +ispell-buffer-local-words-list ()
+  (let (words)
+    (or ispell-buffer-local-name
+        (setf ispell-buffer-local-name (buffer-name)))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward ispell-words-keyword nil t)
+        (let ((end (point-at-eol))
+              (ispell-casechars (ispell-get-casechars))
+              string)
+          (while (re-search-forward " *\\([^ ]+\\)" end t)
+            (setf string (match-string-no-properties 1))
+            (if (and (< 1 (length string))
+                     (equal 0 (string-match ispell-casechars string)))
+                (push string words))))))
+    words))
+
+;;;###autoload
+(defun +ispell-move-buffer-words-to-dir-locals (&optional arg)
+  "Move the current buffer-local words to .dir-locals.el.
+This function prompts the user to save .dir-locals.el, unless
+prefix ARG is non-nil; then it just saves them."
+  (interactive "P")
+  (unless (buffer-file-name)
+    (user-error "Buffer not attached to file"))
+  (hack-dir-local-variables)
+  (let ((print-level nil)
+        (print-length nil))
+    (when-let ((new-words (cl-remove-if
+                           (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
+                                        ; where this came from
+                           (list-append-removing-duplicates
+                            :test #'string=
+                            ispell-buffer-session-localwords
+                            (alist-get 'ispell-buffer-session-localwords
+                                       dir-local-variables-alist)
+                            (alist-get 'ispell-buffer-session-localwords
+                                       file-local-variables-alist)
+                            (+ispell-buffer-local-words-list)))))
+      (save-excursion
+        (add-dir-local-variable
+         major-mode
+         'ispell-buffer-session-localwords
+         (setf ispell-buffer-session-localwords
+               new-words))
+        (when (or arg
+                  (y-or-n-p "Save .dir-locals.el?"))
+          (save-buffer))
+        (bury-buffer))
+      (or ispell-buffer-local-name
+          (setf ispell-buffer-local-name (buffer-name)))
+      (save-excursion
+        (goto-char (point-min))
+        (while (search-forward ispell-words-keyword nil t)
+          (delete-region (point-at-bol) (1+ (point-at-eol))))))))
+
+;;;###autoload
+(defun +ispell-move-buffer-words-to-dir-locals-hook ()
+  "Convenience function for binding to a hook."
+  (+ispell-move-buffer-words-to-dir-locals t))
+
+
 ;;; Comment-or-uncomment-sexp
 ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
 
@@ -214,5 +305,27 @@ With a prefix argument N, (un)comment that many sexps."
     (dotimes (_ (or n 1))
       (+lisp-comment-sexp--raw))))
 
+
+;;; Random shit
+
+(defun insert-iso-date (&optional arg)
+  "Insert current date formatted ISO-8601 style.
+When called with \\[universal-argument] \\[insert-iso-date],
+include the time.  When called with \\[universal-argument]
+\\[universal-argument] \\[insert-iso-date], prompt the user for the
+`format-time-string' format to use."
+  (interactive "P")
+  (insert (format-time-string (pcase arg
+                                ('nil "%F")
+                                ('(4) "%FT%T%z")
+                                (_ (read-string "Time format: "))))))
+
+(defun unfill-paragraph ()
+  "Unfill the current paragraph."
+  (interactive)
+  (let ((fill-column most-positive-fixnum)
+        (fill-paragraph-function nil))
+    (fill-paragraph)))
+
 (provide 'acdw)
 ;;; acdw.el ends here