6 files changed, 511 insertions, 95 deletions

@@ -26,3 +26,4 @@ lisp/*-autoloads.el
 
 # put random stuff in here
 scratch.el
+jabber-avatar-cache/
\ No newline at end of file
@@ -68,9 +68,29 @@
     "M-o" #'other-window|switch-buffer
     "C-M-;" #'+lisp-comment-or-uncomment-sexp
     "C-x 5 z" #'suspend-frame
-    "M-@" #'dictionary-search)
+    "M-@" #'dictionary-search
+    "C-x f" #'find-file)
   (define-key* text-mode-map
-    "C-M-k" #'kill-paragraph)
+    "C-M-k" #'kill-paragraph
+    "C-o" (defun open-paragraph (&optional arg)
+            "Open a paragraph after paragraph at point.
+A paragraph is defined as continguous non-empty lines of text
+surrounded by empty lines, so opening a paragraph means to make
+three blank lines, then place the point on the second one.
+
+Called with prefix ARG, open a paragraph before point."
+            ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down.
+            (interactive "*P")
+            ;; Go to next blank line.  This /isn't/ `end-of-paragraph-text' because
+            ;; that's weird with org, and I'm guessing other modes too.
+            (unless (looking-at "^$") (forward-line (if arg -1 +1)))
+            (while (and (not (looking-at "^$"))
+                        (= 0 (forward-line (if arg -1 +1)))))
+            (newline)
+            (when arg (newline) (forward-line -2))
+            (delete-blank-lines)
+            (newline 2)
+            (previous-line)))
   ;; Hooks
   (add-hook 'after-save-hook
             #'executable-make-buffer-file-executable-if-script-p)
@@ -86,8 +106,7 @@
     "Don't close quits on `keyboard-escape-quit'."
     (let ((buffer-quit-function #'ignore))
       (apply fn r)))
-  ;; Themes
-  (load-theme 'modus-operandi)
+  ;; Faces
   (set-face-attribute 'default nil :family "Comic Code" :height 100)
   (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold)
   (set-face-attribute 'variable-pitch nil :family "Comic Code")
@@ -104,6 +123,22 @@
   (eval-after init
     (+custom-load-some-customizations :noerror)))
 
+(yoke modus-themes
+  (setf modus-themes-bold-constructs t
+        modus-themes-italic-constructs t
+        modus-themes-headings '((1 monochrome bold italic)
+                                (2 monochrome bold)
+                                (3 monochrom italic)
+                                (t monochrome)))
+  (cond ((require 'dawn nil :noerrer)
+         (add-hook* '+custom-after-load-hook
+           (defun dawn@custom ()
+             (load-theme 'modus-operandi :noconfirm :noenable)
+             (load-theme 'modus-vivendi :noconfirm :noenable)
+             (dawn-schedule #'modus-themes-load-operandi
+                            #'modus-themes-load-vivendi))))
+        (:else (load-theme 'modus-operandi))))
+
 (yoke time
   (setf display-time-mail-function
         (defun +notmuch-new-mail-p ()
@@ -115,6 +150,8 @@
                      :count))
         display-time-use-mail-icon t
         read-mail-command #'+notmuch-goto
+        display-time-format " %a %-e, %H:%M"
+        ;; `display-time-format' makes these unnecessary, but I'll keep em
         display-time-24hr-format t
         display-time-day-and-date t
         display-time-default-load-average nil)
@@ -229,7 +266,8 @@
   (setq-local-hook dired-mode-hook
     truncate-lines t)
   (define-key* (current-global-map)
-    "C-x C-j" #'dired-jump)
+    "C-x C-j" #'dired-jump
+    [remap list-directory] #'dired)
   (eval-after dired
     (define-key* dired-mode-map
       "<backspace>" #'dired-up-directory
@@ -262,7 +300,7 @@
   (advice-add #'register-preview :override #'consult-register-window)
   (define-key* (current-global-map)
     ;; Etc
-    "C-x m" #'consult-mode-command
+    "M-S-x" #'consult-mode-command
     ;; C-c bindings (mode-specific-map)
     "C-c h" #'consult-history
     "C-c b" #'consult-bookmark
@@ -351,25 +389,17 @@
   (marginalia-mode))
 
 (yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep")
-  (require 'wgrep))
-
-;; (yoke (slime "https://github.com/slime/slime")
-;;   ;; r7rs-swank
-;;   (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank")))
-;;     (cond
-;;      ((executable-find "chibi-scheme")
-;;       (defun chibi-scheme-start-swank (file encoding)
-;;         (format "%S\n\n" `(start-swank ,file)))
-;;       (setq slime-lisp-implementations
-;;             (cons `(chibi-scheme
-;;                     ("chibi-scheme" ,(format "-A%s" r7rsloc)
-;;                      "-m" "(chibi-swank)")
-;;                     :init chibi-scheme-start-swank)
-;;                   (bound-and-true-p slime-lisp-implementations)))
-;;       ;; (add-hook* 'scheme-mode-hook #'slime-mode)
-;;       (setf slime-completion-at-point-functions
-;;             (delq 'slime-c-p-c-completion-at-point
-;;                   slime-completion-at-point-functions))))))
+  (require 'wgrep)
+  (define-key* grep-mode-map
+    "C-x C-q" #'wgrep-change-to-wgrep-mode))
+
+(yoke (slime "https://github.com/slime/slime")
+  :when (executable-find "sbcl")
+  (setf inferior-lisp-program (executable-find "sbcl"))
+  (eval-after slime
+    (setf slime-completion-at-point-functions
+          (delq 'slime-c-p-c-completion-at-point
+                slime-completion-at-point-functions))))
 
 (yoke (puni "https://github.com/amaikinono/puni")
   (define-key* puni-mode-map
@@ -537,7 +567,21 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
       "RET" #'+org-return-dwim
       "S-<return>" #'+org-table-copy-down|+org-return
       "C-c C-o" #'+org-open-at-point-dwim)
-    (org-clock-persistence-insinuate)))
+    (org-clock-persistence-insinuate))
+  (eval-after ol                        ; org-link
+    (defmacro define-org-link-type (type args &rest body)
+      "Define an org link TYPE with ARGS that does something.
+  If BODY is blank, message the user about the link."
+      (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body)))
+      (let ((fn (intern (format "org-%s-open" type)))
+            (body (or body `((message ,(format "%s: %%S" type) ,(car args)))))
+            (type-string (format "%s" type)))
+        `(prog1
+             (defun ,fn ,args
+               ,@body)
+           (org-link-set-parameters ,type-string :follow #',fn))))
+    (define-org-link-type sms (number _))
+    (define-org-link-type tel (number _))))
 
 (yoke org-agenda nil
       (setq org-agenda-skip-deadline-if-done t
@@ -556,7 +600,18 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
             org-agenda-include-deadlines t
             org-deadline-warning-days 0
             org-agenda-show-future-repeats 'next
-            org-agenda-window-setup 'current-window)
+            org-agenda-window-setup 'current-window
+            org-agenda-file-skip-regexp "sync-conflict")
+      (defcustom org-agenda-file-skip-regexp nil
+        "Files matching this regexp are removed from `org-agenda-files'."
+        :group 'org-agenda)
+      (define-advice org-agenda-files (:filter-return (files) skip-regexp)
+        (when org-agenda-file-skip-regexp
+          (setq files (seq-remove (lambda (file)
+                                    (string-match-p org-agenda-file-skip-regexp
+                                                    file))
+                                  files)))
+        files)
       (setq-local-hook org-agenda-mode-hook
         truncate-lines t
         electric-pair-pairs (append electric-pair-pairs
@@ -574,17 +629,17 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
         '+org-capture))
 
 (yoke ox                                ; org-export
-      (eval-after org (require 'ox))
-      (eval-after ox
-        (require* '+ox '(ox-md nil t))
-        (+org-export-pre-hooks-insinuate))
-      (setq org-export-coding-system 'utf-8-unix
-            org-export-headline-levels 8
-            org-export-with-drawers nil
-            org-export-with-section-numbers nil
-            org-export-with-smart-quotes t
-            org-export-with-sub-superscripts t
-            org-export-with-toc nil))
+  (eval-after org (require 'ox))
+  (eval-after ox
+    (require* '+ox '(ox-md nil t))
+    (+org-export-pre-hooks-insinuate))
+  (setq org-export-coding-system 'utf-8-unix
+        org-export-headline-levels 8
+        org-export-with-drawers nil
+        org-export-with-section-numbers nil
+        org-export-with-smart-quotes t
+        org-export-with-sub-superscripts t
+        org-export-with-toc nil))
 
 (yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el")
   (setq electric-cursor-alist '((overwrite-mode . hbar)
@@ -683,6 +738,7 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
       "@" #'dictionary-search)))
 
 (yoke (anzu "https://github.com/emacsorphanage/anzu")
+  (require 'anzu)
   (global-anzu-mode)
   (define-key* (current-global-map)
     [remap query-replace] #'anzu-query-replace-regexp
@@ -693,9 +749,11 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
   (defun anzu-qr@window (fn &rest r)
     "ADVICE to query-replace from the beginning of the window."
     (let ((scroll-margin 0))
-      (save-excursion
-        (goto-char (window-start))
-        (apply fn r))))
+      (cond ((region-active-p)
+             (apply fn r))
+            (:else (save-excursion
+                     (goto-char (window-start))
+                     (apply fn r))))))
   (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window)
   (advice-add 'anzu-query-replace :around #'anzu-qr@window))
 
@@ -704,6 +762,10 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
 
 (yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0")
   (setf 0x0-default-server 'ttm)
+  (define-advice 0x0-shorten-uri (:around (fn server uri) use-0x0)
+    (interactive (list (cdr (assq 'envs 0x0-servers))
+                       (read-string "URI: ")))
+    (funcall fn server uri))
   (eval-after embark
     (define-key* embark-region-map
       "U" #'0x0-dwim)))
@@ -759,8 +821,24 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
   :when (executable-find "keychain")
   (keychain-refresh-environment))
 
+(yoke (exec-path-from-shell "https://github.com/purcell/exec-path-from-shell")
+  :when (eq system-type 'gnu/linux)
+  (require 'exec-path-from-shell)
+  (dolist (var '("SSH_AUTH_SOCK"
+                 "SSH_AGENT_PID"
+                 "GPG_AGENT_INFO"
+                 "LANG"
+                 "LC_CTYPE"
+                 "XDG_CONFIG_HOME"
+                 "XDG_CONFIG_DIRS"
+                 "XDG_DATA_HOME"
+                 "XDG_DATA_DIRS"
+                 "XDG_CACHE_HOME"))
+    (add-to-list 'exec-path-from-shell-variables var))
+  (exec-path-from-shell-initialize))
+
 (yoke (sophomore "https://codeberg.org/acdw/sophomore.el")
-  (sophomore-enable #'narrow-to-region)
+  (sophomore-enable-all)
   (sophomore-disable #'view-hello-file
                      #'describe-gnu-project)
   (sophomore-disable-with 'confirm #'save-buffers-kill-terminal))
@@ -844,12 +922,20 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
         message-sendmail-envelope-from 'header
         message-envelope-from 'header)
   ;; Extras
+  (define-advice mm-save-part-to-file (:before (_handle file) create-directory)
+    (let ((directory (file-name-directory file)))
+      (when (yes-or-no-p (format "Directory %s doesn't exist.  Create?" directory))
+        (make-directory directory :parents))))
   (eval-after notmuch
     (require '+notmuch)
     (load notmuch-init-file :noerror)
     (add-hook 'message-setup-hook #'+message-signature-setup)
     (add-hook 'message-send-hook #'+send-mail-dispatch)
     (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags)
+    (advice-add 'notmuch-bury-or-kill-this-buffer :after
+                (defun +display-time@notmuch (&rest _)
+                  ;; (display-time-event-handler)
+                  (display-time-update)))
     (setf notmuch-saved-searches (list
                                   (list :name "inbox+unread"
                                         :query (+notmuch-query-concat
@@ -906,6 +992,152 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
             (sesman "https://github.com/vspinu/sesman"))
   :when (executable-find "clojure"))
 
+(yoke (web-mode "https://github.com/fxbois/web-mode")
+  (setf (alist-get (rx "." (or "htm" "html" "phtml" "tpl.php"
+                               "asp" "gsp" "jsp" "ascx" "aspx"
+                               "erb" "mustache" "djhtml")
+                       eos)
+                   auto-mode-alist nil nil #'string=)
+        'web-mode))
+
+(yoke (chicken-geiser "https://gitlab.com/emacs-geiser/chicken")
+  :depends ((geiser "https://gitlab.com/emacs-geiser/geiser"
+                    :load "elisp"))
+  :when (executable-find "csi")
+  :pre ((autoload 'geiser-activate-implementation "geiser-impl"))
+  (autoload 'geiser "geiser" nil :interactive)
+  (add-hook 'scheme-mode-hook 'geiser-mode))
+
+(yoke (zoom-frm "https://github.com/emacsmirror/zoom-frm")
+  :depends ((frame-cmds "https://github.com/emacsmirror/frame-cmds")
+            (frame-fns "https://github.com/emacsmirror/frame-fns"))
+  (define-key* (current-global-map)
+    "M-+" #'zoom-frm-in
+    "M-_" #'zoom-frm-out))
+
+(yoke (jabber "https://codeberg.org/acdw/emacs-jabber")
+  :depends ((srv "https://github.com/legoscia/srv.el")
+            (fsm "https://elpa.gnu.org/packages/fsm-0.2.1.el" :type 'http))
+  (setf jabber-account-list '(("acdw@hmm.st"))
+        jabber-auto-reconnect t
+        jabber-chat-buffer-format "xmpp:%n"
+        jabber-browse-buffer-format "xmpp-browse:%n"
+        jabber-groupchat-buffer-format "xmpp-muc:%n"
+        jabber-muc-private-buffer-format "xmpp-muc-private:%n"
+        jabber-groupchat-prompt-format "%>10n │ "
+        jabber-chat-local-prompt-format "%>10n │ "
+        jabber-chat-system-prompt-format " * * * * * *"
+        jabber-chat-foreign-prompt-format "%>10n │ "
+        jabber-muc-private-foreign-prompt-format "%g/%n "
+        jabber-last-read-marker  "----------------------------------------"
+        jabber-muc-header-line-format '("" jabber-muc-topic)
+        jabber-muc-decorate-presence-patterns
+        '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
+          ("." . jabber-muc-presence-dim))
+        jabber-activity-make-strings
+        #'jabber-activity-make-strings-shorten
+        ;; (defun +jabber-activity-make-strings (jids)
+        ;;   (mapcar (lambda (jid)
+        ;;             (cons jid
+        ;;                   (let ((s (jabber-activity-make-string-default jid)))
+        ;;                     (cond
+        ;;                      ((string-match-p "%" s)
+        ;;                       (replace-regexp-in-string "%.*" "" s))
+        ;;                      (:else s)))))
+        ;;           jids))
+        jabber-rare-time-format " - - - - - - %H:00 %F")
+  (defun +electric-pair-disable-local-mode ()
+    (electric-pair-local-mode -1))
+  (add-hook* '(jabber-chat-mode-hook
+               jabber-browse-mode-hook
+               jabber-roster-mode-hook
+               jabber-console-mode-hook)
+    #'visual-fill-column-mode
+    #'+electric-pair-disable-local-mode)
+  (defun +jabber-fix-keybinds-dammit ()
+    "Jabber autoloads keybinds which is really annoying."
+    (define-key* (current-global-map)
+      "C-x C-j" #'dired-jump
+      "C-c j" jabber-global-keymap
+      "C-c C-SPC" #'jabber-activity-switch-to))
+  (eval-after init (+jabber-fix-keybinds-dammit))
+  (eval-after jabber
+    (require 'jabber-httpupload nil :noerror)
+    (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
+    (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
+    (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
+    (add-hook 'jabber-alert-muc-hooks
+              (defun jabber@highlight-acdw (&optional _nick _group buf _text _title)
+                (when buf
+                  (with-current-buffer buf
+                    (let ((regexp (rx word-boundary
+                                      "acdw" ; maybe get from the config?
+                                      word-boundary)))
+                      (hi-lock-unface-buffer regexp)
+                      (highlight-regexp regexp 'hi-blue))))))
+    (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)
+    (+jabber-fix-keybinds-dammit))
+  ;; (add-hook* 'jabber-activity-mode-hook
+  ;;   (defun +jabber-activity-mode@move-to-end-of-mode-line ()
+  ;;     (setf global-mode-string
+  ;;           (append (delete '(t jabber-activity-mode-string)
+  ;;                           global-mode-string)
+  ;;                   '((t jabber-activity-mode-string))))))
+  (setq-local-hook jabber-chat-mode-hook
+    wrap-prefix (format "%10s   " " ")
+    mode-line-buffer-identification
+    (pcase (buffer-name)
+      ((rx "%")                           ; biboumi irc channel
+       ;; xmpp-muc:#scheme%irc.libera.chat@irc.hmm.st
+       (propertized-buffer-identification
+        (replace-regexp-in-string "xmpp-muc:\\([^%]*\\)%\\([^@]*\\)@.*"
+                                  "\\1@\\2"
+                                  (buffer-name))))
+      (_                                  ; xmpp channel
+       (propertized-buffer-identification "%12b"))))
+  (defun jabber-chat@after-modus-themes-load ()
+    (modus-themes-with-colors
+      (custom-set-faces
+       `(jabber-chat-prompt-foreign ((t :foreground unspecified
+                                        :inherit modus-themes-bold))
+                                    :now)
+       `(jabber-chat-prompt-local ((t :foreground unspecified
+                                      :inherit modus-themes-bold))
+                                  :now)
+       `(jabber-chat-prompt-system ((t :foreground unspecified
+                                       :inherit modus-themes-bold))
+                                   :now)
+       `(jabber-activity-face ((t :slant italic)))
+       `(jabber-activity-personal-face ((t :slant italic :weight bold)))
+       `(jabber-rare-time-face ((t :inherit font-lock-comment-face)))))
+    (setq jabber-muc-nick-value
+          (pcase (frame--current-backround-mode (selected-frame))
+            ('light 0.5)
+            ('dark 1.0))))
+  (eval-after modus-themes
+    (add-hook 'modus-themes-after-load-theme-hook
+              #'jabber-chat@after-modus-themes-load))
+  (when (or (custom-theme-enabled-p 'modus-operandi)
+            (custom-theme-enabled-p 'modus-vivendi))
+    (jabber-chat@after-modus-themes-load))
+  (eval-after (consult jabber)
+    ;; Jabber.el chat buffers source for `consult-buffer'
+    (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)
+    ;; Also hide xmpp buffers from regular buffer list
+    (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal)))
+
 (yoke (link-hint "https://github.com/noctuid/link-hint.el/")
   :depends ((avy "https://github.com/abo-abo/avy"))
   (require '+link-hint)
@@ -921,6 +1153,21 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
     "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link
     "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome))
 
+(yoke (elpher "git://thelambdalab.xyz/elpher.git")
+  (eval-after elpher
+    (define-key* elpher-mode-map
+      "l" #'elpher-back)))
+
+(yoke (epithet "https://github.com/oantolin/epithet")
+  (add-hook* '(Info-selection-hook
+               help-mode-hook
+               occur-mode-hook
+               shell-mode-hook)
+    #'epithet-rename-buffer)
+  (cond ((boundp 'eww-auto-rename-buffer)
+         (setf eww-auto-rename-buffer 'title))
+        (:else (add-hook 'eww-after-render-hook #'epithet-rename-buffer))))
+
 (yoke browse-url
   (require '+browse-url)
   (setf browse-url-browser-function #'eww-browse-url
@@ -994,3 +1241,19 @@ CAPES defaults to `+capes'.  CAPF will be made un-exclusive."
   (define-key* eww-mode-map
     "&" #'+eww-browse-with-external-browser))
 
+(yoke tab-bar
+  (setf tab-bar-show t
+        global-mode-string
+        '((jabber-activity-mode jabber-activity-mode-string)
+          " ⋅"
+          display-time-string
+          "|"))
+  (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
+  (add-to-list 'tab-bar-format 'tab-bar-format-global :append)
+  (tab-bar-mode))
+
+(yoke (pdf-tools "https://github.com/vedang/pdf-tools"
+                 :load "lisp")
+  :depends ((tablist "https://github.com/politza/tablist/"))
+  :when (executable-find "epdfinfo")    ; installed from Debian repos
+  (pdf-tools-install))
@@ -108,12 +108,10 @@ Do this only if the buffer is not visiting a file."
  regexp-search-ring-max 200
  save-interprogram-paste-before-kill t
  save-some-buffers-default-predicate #'+save-some-buffers-p
- scroll-conservatively 101
- scroll-down-aggressively 0.01
- scroll-margin 2
+ scroll-conservatively 25
+ scroll-margin 0
  scroll-preserve-screen-position 1
  scroll-step 1
- scroll-up-aggressively 0.01
  search-ring-max 200
  search-ring-max 200
  sentence-end-double-space t
@@ -1,7 +1,5 @@
 ;;; acdw.el -- bits and bobs  -*- lexical-binding: t; -*-
 ;; by C. Duckworth <acdw@acdw.net>
-(provide 'acdw)
-
 (require 'cl-lib)
 
 ;;; Define both a directory and a function expanding to a file in that directory
@@ -30,7 +28,6 @@ the filesystem, unless INHIBIT-MKDIR is non-nil."
 
 ;;; Evaluating things after other things
 
-
 (defun eval-after-init (fn)
   "Evaluate FN after inititation, or now if Emacs is initialized.
 FN is called with no arguments."
@@ -78,12 +75,12 @@ Convenience wrapper around `define-key'."
 (unless (fboundp 'ensure-list)
   ;; Just in case we're using an old version of Emacs.
   (defun ensure-list (object)
-  "Return OBJECT as a list.
+    "Return OBJECT as a list.
 If OBJECT is already a list, return OBJECT itself.  If it's
 not a list, return a one-element list containing OBJECT."
-  (if (listp object)
-      object
-    (list object))))
+    (if (listp object)
+        object
+      (list object))))
 
 (defun add-to-list* (lists &rest things)
   "Add THINGS to LISTS.
@@ -130,8 +127,8 @@ without any separator."
 Each feature of FEATURES can also be a list of the arguments to
 pass to `require', which see."
   (condition-case e
-    (dolist (feature features)
-      (apply #'require (ensure-list feature)))
+      (dolist (feature features)
+        (apply #'require (ensure-list feature)))
     (:success (mapcar (lambda (f) (car (ensure-list f))) features))
     (t (signal (car e) (cdr e)))))
 
@@ -153,22 +150,33 @@ pass to `require', which see."
          (add-hook 'before-save-hook #',internal-name nil :local))
        (add-hook ',hook #',external-name))))
 
-(defmacro setq-local-hook (hook &rest args)
-  "Run `setq-local' on ARGS when running HOOK."
+(defmacro setq-local-hook (hooks &rest args)
+  "Run `setq-local' on ARGS when running HOOKs."
+  ;; FIXME: this is pretty messy, i think...
+  ;; The settings should be stored in an alist so that they can be deduplicated
   (declare (indent 1))
-  (let ((fn (intern (format "%s-setq-local" hook))))
-    (when (and (fboundp fn)
-               (functionp fn))
-      (setf args (append (function-get fn 'setq-local-hook-settings) args)))
-    (unless (and (< 0 (length args))
-                 (zerop (mod (length args) 2)))
-      (user-error "Wrong number of arguments: %S" (length args)))
-    `(progn
-       (defun ,fn ()
-         ,(format "Set local variables after `%s'." hook)
-         (setq-local ,@args))
-       (function-put ',fn 'setq-local-hook-settings ',args)
-       (add-hook ',hook #',fn))))
+  `(progn
+     ,@(cl-loop for hook in (ensure-list hooks)
+                collect
+                (let ((fn (intern (format "%s-setq-local" hook))))
+                  (when (and (fboundp fn)
+                             (functionp fn))
+                    (setf args (append (function-get fn 'setq-local-hook-settings) args)))
+                  (unless (and (< 0 (length args))
+                               (zerop (mod (length args) 2)))
+                    (user-error "Wrong number of arguments: %S" (length args)))
+                  `(progn
+                     (defun ,fn ()
+                       ,(format "Set local variables after `%s'." hook)
+                       (setq-local ,@args))
+                     (function-put ',fn 'setq-local-hook-settings ',args)
+                     (dolist (buf (buffer-list))
+                       (with-current-buffer buf
+                         (when (derived-mode-p
+                                ',(intern (replace-regexp-in-string
+                                           "-hook" "" (format "%s" hook))))
+                           (,fn))))
+                     (add-hook ',hook #',fn))))))
 
 (defmacro with-message (message &rest body)
   "Execute BODY, with MESSAGE.
@@ -182,6 +190,13 @@ If body executes without errors, MESSAGE...Done will be displayed."
          (:success (message "%s...done" ,msg))
          (t (signal (car e) (cdr e)))))))
 
+(defmacro either (&rest clauses)
+  "Return the first of CLAUSES that returns non-nil."
+  (let* ((this (gensym "either")))
+    (unless (null clauses)
+      `(let* ((,this ,(car clauses)))
+         (if ,this ,this (either ,@(cdr clauses)))))))
+
 ;; https://emacs.stackexchange.com/a/39324/37239
 ;; XXX: This shit don't work rn
 (defun ignore-invisible-overlays (fn)
@@ -189,13 +204,13 @@ If body executes without errors, MESSAGE...Done will be displayed."
 FN should return a point."
   (let ((overlay nil)
         (point nil))
-   (setq point (and (funcall fn) (point)))
-   (setq overlay (car (overlays-at (point))))
-   (while (and overlay (member 'invisible (overlay-properties overlay)))
-     (goto-char (overlay-end overlay))
-     (setq point (and (funcall fn) (point)))
-     (setq overlay (car (overlays-at (point)))))
-   point))
+    (setq point (and (funcall fn) (point)))
+    (setq overlay (car (overlays-at (point))))
+    (while (and overlay (member 'invisible (overlay-properties overlay)))
+      (goto-char (overlay-end overlay))
+      (setq point (and (funcall fn) (point)))
+      (setq overlay (car (overlays-at (point)))))
+    point))
 
 ;;; Extras
 ;; Trying to avoid a whole install of crux ...
@@ -217,3 +232,6 @@ When called with prefix ARG, unconditionally switch buffer."
   (if (or arg (one-window-p))
       (switch-to-buffer (other-buffer) nil t)
     (other-window 1)))
+
+(provide 'acdw)
+;;; acdw.el ends here
@@ -0,0 +1,84 @@
+;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; There is also circadian.el, but it doesn't quite work for me.
+;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
+;; somewhere else (which I've forgotten) and my own brain :)
+
+;;; Code:
+
+(require 'calendar)
+(require 'cl-lib)
+(require 'solar)
+
+(defvar dawn--dawn-timer nil
+  "Timer for dawn-command.")
+
+(defvar dawn--dusk-timer nil
+  "Timer for dusk-command.")
+
+(defvar dawn--reset-timer nil
+  "Timer to reset dawn at midnight.")
+
+(defun dawn-encode-time (f)
+  "Encode fractional time F."
+  (let ((hhmm (cl-floor f))
+        (date (cdddr (decode-time))))
+    (encode-time
+     (append (list 0
+                   (round (* 60 (cadr hhmm)))
+                   (car hhmm)
+                   )
+             date))))
+
+(defun dawn-midnight ()
+  "Return the time of the /next/ midnight."
+  (let ((date (cdddr (decode-time))))
+    (encode-time
+     (append (list 0 0 0 (1+ (car date))) (cdr date)))))
+
+(defun dawn-sunrise ()
+  "Return the time of today's sunrise."
+  (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
+
+(defun dawn-sunset ()
+  "Return the time of today's sunset."
+  (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
+
+(defun dawn-schedule (dawn-command dusk-command)
+  "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
+RESET is an argument for internal use."
+  (when (or (null calendar-longitude)
+            (null calendar-latitude))
+    (user-error "`dawn' won't work without setting %s!"
+                (cond ((and (null calendar-longitude)
+                            (null calendar-latitude))
+                       "`calendar-longitude' and `calendar-latitude'")
+                      ((null calendar-longitude)
+                       "`calendar-longitude'")
+                      ((null calendar-latitude)
+                       "`calendar-latitude'"))))
+  (let ((dawn (dawn-sunrise))
+        (dusk (dawn-sunset)))
+    (cond
+     ((time-less-p nil dawn)
+      ;; If it isn't dawn yet, it's still dark.  Run DUSK-COMMAND and schedule
+      ;; DAWN-COMMAND and DUSK-COMMAND for later.
+      (funcall dusk-command)
+      (run-at-time dawn nil dawn-command)
+      (run-at-time dusk nil dusk-command))
+     ((time-less-p nil dusk)
+      ;; If it isn't dusk yet, it's still light.  Run DAWN-COMMAND and schedule
+      ;; DUSK-COMMAND.
+      (funcall dawn-command)
+      (run-at-time dusk nil dusk-command))
+     (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
+      (funcall dusk-command)))
+    ;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
+    ;(unless reset)
+    (run-at-time (dawn-midnight) nil
+                 #'dawn-schedule dawn-command dusk-command)))
+
+(provide 'dawn)
+;;; dawn.el ends here
@@ -64,8 +64,8 @@ Execute BODY afterward.
          (url (cond ((consp package) (cdr package))
                     (:else nil)))
          (pname (intern (format "yoke:%s" pkg)))
-         (dirvar (gensym "yoke-dir-"))
-         ;; Keyword args
+         (dirvar '$yoke-dir)
+         ;; Keyword args --- TODO: Naming could probably be better.
          (after (plist-get body :after))
          (depends (plist-get body :depends))
          (whenp (plist-member body :when))
@@ -77,6 +77,7 @@ Execute BODY afterward.
          (autoload (cond ((plist-member body :autoload)
                           (plist-get body :autoload))
                          (:else t)))
+         (pre (plist-get body :pre))
          ;; Body
          (body (cl-loop for (this next) on body by #'cddr
                         unless (keywordp this)
@@ -102,12 +103,17 @@ Execute BODY afterward.
                  `((when ,unless (cl-return-from ,pname
                                    (format "%s (abort) :unless %S"
                                            ',pname ',unless))))))
+             ;; Evaluate `:pre' forms
+             ,@pre
              ;; Get prerequisite packages
              ,@(cl-loop
                 for (pkg* . yoke-get-args) in depends
                 collect `(or
-                          (let ((dir (yoke-get ,@yoke-get-args
-                                               :dir ,(format "%s" pkg*))))
+                          (let* ((pkg-spec (yoke-get ,@yoke-get-args
+                                                     :dir ,(format "%s" pkg*)))
+                                 (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load)
+                                                            "")
+                                                        (car pkg-spec))))
                             (and dir
                                  ,@(if autoload
                                        `((yoke-generate-autoloads ',pkg* dir))
@@ -118,13 +124,16 @@ Execute BODY afterward.
                                     ',pkg*))))
              ;; Download the package, generate autoloads
              ,@(when url
-                 `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg))))
+                 `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg)))
+                          (,dirvar  (expand-file-name (or (plist-get (cdr pkg-spec) :load)
+                                                            "")
+                                                        (car pkg-spec))))
                      ,@(when autoload
                          `((yoke-generate-autoloads ',pkg ,dirvar)))
                      (add-to-list 'yoke-dirs ,dirvar nil #'string=))))
              ;; Evaluate the body, optionally after the features in `:after'
              ,@(cond (after
-                      `((eval-after ,after ,@body)))
+                      `((yoke-eval-after ,after ,@body)))
                      (:else body)))
          (:success ',package)
          (t (message "%s: %s (%s)" ',pname (car err) (cdr err))
@@ -144,7 +153,7 @@ ARGS is a plist with the following possible keys:
                     download URL."
   (let* ((dir (plist-get args :dir))
          (load (plist-get args :load))
-         (type (plist-get args :type))
+         (type (or (plist-get args :type)))
          (path (cond
                 ((eq type 'http) (yoke-get-http url dir))
                 ((or (eq type 'git)
@@ -159,7 +168,7 @@ ARGS is a plist with the following possible keys:
     (cond
      ((file-exists-p path)
       (add-to-list 'load-path (expand-file-name (or load "") path))
-      path)
+      (cons path args))
      (:else (error "Directory \"%s\" doesn't exist." path)
             nil))))
 
@@ -178,7 +187,18 @@ If DIR isn't given, it's guessed from the final component of the
 URL's path and placed under `yoke-dir'."
   (let* ((dir (yoke-get--guess-directory url dir))
          (basename (file-name-nondirectory url))
-         (filename (expand-file-name basename dir)))
+         ;; XXX: Is this the best idea?? PROBABLY NOT!!!  Ideally I'd have
+         ;; a parameter (either dynamic var or passed in) that would give the
+         ;; name of the downloaded file.  But that would take a bit of
+         ;; re-engineering, I think.  So for now, it stays thus.
+         (filename (expand-file-name
+                    (replace-regexp-in-string
+                     (rx "-" (+ digit)             ; major version
+                         (+ (group "." (+ digit))) ; following version numbers
+                         (group "." (+ (not space)))) ; extension
+                     "\\2"
+                     basename)
+                    dir)))
     (cond ((file-exists-p filename)
            dir)
           (:else
@@ -187,6 +207,8 @@ URL's path and placed under `yoke-dir'."
                                   (url-retrieve-synchronously url))
              (condition-case e
                  (progn
+                   (goto-char (point-min))
+                   (delete-region (point) (+ 1 (re-search-forward "^$")))
                    (make-directory dir :parents)
                    (write-file filename 1)
                    (message "Downloading %s... Done" url))
@@ -264,7 +286,7 @@ BODY after Emacs is finished initializing."
            (rest (cdr features)))
       (cond ((eq this 'init)
              `(yoke--eval-after-init
-               (lambda () (eval-after ,rest ,@body))))
+               (lambda () (yoke-eval-after ,rest ,@body))))
             (:else
              `(with-eval-after-load ',this
                 (yoke-eval-after ,rest ,@body)))))))
@@ -277,21 +299,51 @@ BODY after Emacs is finished initializing."
   (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
         (list (rx (: "(yoke" (+ space) (? "(")
                      (group (+ (not (or "(" " " "\t" "\n"))))
-                     (+ space)
-                     (group (+ (not space)))))
+                     (* any)))
               1)))
 
-(defun yoke-compile ()
+;;; Package maintenance
+
+(defvar yoke--all "*all*"
+  "Value that `yoke--prompt-for-package' uses for all packages.")
+
+(defun yoke--choose-packages (prompt &optional onep)
+  "Choose from all of yoke's installed packages."
+  (funcall (if onep #'completing-read #'completing-read-multiple)
+           prompt
+           (cons yoke--all yoke-dirs)
+           nil :require-match nil nil
+           (unless onep yoke--all)))
+
+(defun yoke--choices (&optional selections)
+  "Either the SELECTIONS given, or all of `yoke-dirs'.
+If `yoke--all' is part of SELECTIONS, or if it's not given,
+return the full list of `yoke-dirs'."
+  (cond ((or (null selections)
+             (member yoke--all selections))
+         yoke-dirs)
+        (:else selections)))
+
+(defun yoke-compile (&rest packages)
   "Compile all elisp files in `yoke-dirs'."
-  (interactive)
-  (dolist (dir yoke-dirs)
+  (interactive (yoke--choose-packages "Compile packages: "))
+  (dolist (dir (yoke--choices packages))
     (byte-recompile-directory dir 0)))
 
+(defun yoke-update-autoloads (&rest packages)
+  "Update the autoloads in PACKAGES' directories."
+  (interactive (yoke--choose-packages "Generate autoloads for packages: "))
+  (dolist (dir (yoke--choices packages))
+    (message "Generating autoloads for %s..." dir)
+    (yoke-generate-autoloads (file-name-nondirectory dir) dir)
+    (message "Generating autoloads for %s... Done" dir)))
+
 (defun yoke-remove (dir)
+  "Remove DIR from `yoke-dir'."
   (interactive
-   (completing-read "Remove: " yoke-dirs
-                    nil :require-match))
-  (delete-file dir :trash))
+   (list (completing-read "Remove: " yoke-dirs
+                          nil :require-match)))
+  (delete-directory dir :recursive :trash))
 
 (provide 'yoke)
 ;;; yoke.el ends here