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

4 files changed, 97 insertions, 46 deletions

@@ -51,10 +51,10 @@
         (height . 30)
         (left-fringe . 8)               ; Width of fringes
         (right-fringe . 8)              ; (8 is default)
-        (font . ,(pcase acdw/system
-                   (:home "DejaVu Sans Mono 10")
-                   (:work "Consolas 10")
-                   (:other "monospace 10"))))
+        (font . ,(acdw/system
+                  (:home "DejaVu Sans Mono 10")
+                  (:work "Consolas 10")
+                  (:other "monospace 10"))))
       frame-inhibit-implied-resize t    ; Don't resize randomly
       frame-resize-pixelwise t          ; Resize by pixels, not chars
       inhibit-x-resources t             ; Don't load ~/.Xresources
@@ -76,15 +76,15 @@
               (defun acdw/first-frame-setup ()
                 ;; fonts
                 (require 'acdw-fonts)
-                (setq acdw-fonts/monospace (pcase acdw/system
-                                             (:home "DejaVu Sans Mono")
-                                             (:work "Consolas")
-                                             (:other "monospace"))
+                (setq acdw-fonts/monospace (acdw/system
+                                            (:home "DejaVu Sans Mono")
+                                            (:work "Consolas")
+                                            (:other "monospace"))
                       acdw-fonts/monospace-size 10
-                      acdw-fonts/variable (pcase acdw/system
-                                            (:home "DejaVu Sans")
-                                            (:work "Calibri")
-                                            (:other "sans-serif"))
+                      acdw-fonts/variable (acdw/system
+                                           (:home "DejaVu Sans")
+                                           (:work "Calibri")
+                                           (:other "sans-serif"))
                       acdw-fonts/variable-size 12)
                 (acdw-fonts/set)
                 (acdw-fonts/setup-emoji-fonts "Segoe UI Emoji"
@@ -1,4 +1,3 @@
-nnimap+fastmail.com:INBOX
 nntp+news.gwene.org:gwene.blog.botanistinthek
 nntp+news.gwene.org:gwene.ca.muto
 nntp+news.gwene.org:gwene.casa.m455
@@ -66,7 +66,7 @@
 ;; Flash the mode line
 (defun flash-mode-line ()
   "Flash the modeline as a bell."
-  (when (eq acdw/system :home)
+  (when (acdw/system :home)
     (beep))
   (invert-face 'mode-line)
   (run-with-timer 0.1 nil #'invert-face 'mode-line))
@@ -103,7 +103,7 @@
                   'browse-url-default-browser)
                 browse-url-new-window-flag t
                 browse-url-firefox-new-window-is-tab t)
-  (when (eq acdw/system :work)
+  (when (acdw/system :work)
     (add-to-list 'exec-path "C:/Program Files/Mozilla Firefox")))
 
 (setup buffers
@@ -162,14 +162,14 @@
   
   (:global "C-x C-j" dired-jump)
 
-  (pcase acdw/system
-    (:work (:straight w32-browser)
-           (autoload 'dired-w32-browser "w32-browser")
-           (:bind "RET" dired-w32-browser))
-    (:home (:straight dired-open)
-           (require 'dired-open)
-           (:bind "RET" dired-find-alternate-file)
-           (:option (prepend dired-open-functions) #'dired-open-xdg)))
+  (acdw/system
+   (:work (:straight w32-browser)
+          (autoload 'dired-w32-browser "w32-browser")
+          (:bind "RET" dired-w32-browser))
+   (:home (:straight dired-open)
+          (require 'dired-open)
+          (:bind "RET" dired-find-alternate-file)
+          (:option (prepend dired-open-functions) #'dired-open-xdg)))
   
   (:when-loaded
    (:straight dired-subtree)
@@ -251,11 +251,11 @@
   (set-terminal-coding-system 'utf-8-unix)
   (set-keyboard-coding-system 'utf-8-unix)
 
-  (pcase acdw/system
-    (:work (set-clipboard-coding-system 'utf-16-le)
-           (set-selection-coding-system 'utf-16-le))
-    (_ (set-selection-coding-system 'utf-8)
-       (set-clipboard-coding-system 'utf-8))))
+  (acdw/system
+   (:work (set-clipboard-coding-system 'utf-16-le)
+          (set-selection-coding-system 'utf-16-le))
+   (_ (set-selection-coding-system 'utf-8)
+      (set-clipboard-coding-system 'utf-8))))
 
 (setup eshell
   (:option eshell-directory-name (acdw/dir "eshell/" t)
@@ -450,26 +450,58 @@
   (:option recentf-save-file (acdw/dir "recentf.el")
            recentf-max-menu-items 100
            recentf-max-saved-items nil
-           recentf-auto-cleanup 60
+           recentf-auto-cleanup 'mode
            (append recentf-exclude) (acdw/dir))
+
+  ;; Magic advice to rename entries in recentf when moving files in
+  ;; dired.
+  (defun rjs/recentf-rename-notify (oldname newname &rest args)
+    (if (file-directory-p newname)
+        (rjs/recentf-rename-directory oldname newname)
+      (rjs/recentf-rename-file oldname newname)))
+
+  (defun rjs/recentf-rename-file (oldname newname)
+    (setq recentf-list
+          (mapcar (lambda (name)
+                    (if (string-equal name oldname)
+                        newname
+                      oldname))
+                  recentf-list)))
+
+  (defun rjs/recentf-rename-directory (oldname newname)
+    ;; oldname, newname and all entries of recentf-list should already
+    ;; be absolute and normalised so I think this can just test whether
+    ;; oldname is a prefix of the element.
+    (setq recentf-list
+          (mapcar (lambda (name)
+                    (if (string-prefix-p oldname name)
+                        (concat newname (substring name (length oldname)))
+                      name))
+                  recentf-list)))
+
+  (advice-add 'dired-rename-file :after #'rjs/recentf-rename-notify)
+  
   (recentf-mode +1))
 
 (setup (:require savehist)
   (:option history-length t
            history-delete-duplicates t
-           savehist-autosave-interval 6
+           savehist-autosave-interval 60
            savehist-file (acdw/dir "savehist.el"))
 
-  (dolist (var '(kill-ring
+  (dolist (var '(extended-command-history
+                 global-mark-ring
+                 kill-ring
+                 regexp-search-ring
                  search-ring
-                 regexp-search-ring))
+                 mark-ring))
     (:option (append savehist-additional-variables) var))
   
   (savehist-mode +1))
 
 (setup saveplace
   (:option save-place-file (acdw/dir "places.el")
-           save-place-forget-unreadable-files (eq acdw/system :home))
+           save-place-forget-unreadable-files (acdw/system :home))
   
   (save-place-mode +1))
 
@@ -595,7 +627,9 @@
            find-function-C-source-directory (acdw/find-emacs-source))
 
   (:global "M-=" count-words
-           "C-w" kill-region-or-backward-word)
+           "C-w" kill-region-or-backward-word
+           "<help> h" nil ; HELLO takes a long time to load on Windows
+           )
 
   ;; Remap C-h to DEL -- <f1> can be the "help" key
   (define-key key-translation-map [?\C-h] [?\C-?])
@@ -617,7 +651,8 @@
 
   ;; Use a dumb formatter on modes that `apheleia' doesn't work for.
   (hook-defun dumb-auto-format before-save-hook
-    (setq stupid-modes '(makefile-mode))    
+    (setq stupid-modes '(makefile-mode
+                         org-mode))    
     ;; If there's no apheleia formatter for the mode, just indent the buffer.
     (unless (or (apply #'derived-mode-p stupid-modes)
                 (and (fboundp 'apheleia--get-formatter-command)
@@ -985,7 +1020,7 @@ if ripgrep is installed, otherwise `consult-grep'."
   (:option undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
                                                 "/git-rebase-todo\\'")
            undo-fu-session-directory (acdw/dir "undo/" t)
-           undo-fu-session-compression (eq acdw/system :home))
+           undo-fu-session-compression (acdw/system :home))
   
   (global-undo-fu-session-mode +1))
 
@@ -1059,7 +1094,7 @@ call `zzz-to-char'."
 ;;; System-dependent
 
 ;;;; Home
-(when (eq acdw/system :home)
+(when (acdw/system :home)
 
   (setup (:straight pkgbuild-mode))
   
@@ -21,12 +21,29 @@
 
 ;;; Variables
 
-(defconst acdw/system (pcase system-type
-                        ('gnu/linux :home)
-                        ((or 'msdos 'windows-nt) :work)
-                        (_ :other))
+(defconst acdw/system
+  (pcase system-type
+    ('gnu/linux :home)
+    ((or 'msdos 'windows-nt) :work)
+    (_ :other))
   "Which computer system is currently being used.")
 
+(defmacro acdw/system (&rest arg)
+  "Convenience macro for interfacing with `acdw/system'.
+
+When called without arguments, it returns `acdw/system'.
+When called with one argument, it returns (eq acdw/system ARG).
+When called with multiple arguments, it returns `pcase' over each argument."
+  (cond
+   ((not arg) acdw/system)
+   ((not (cdr arg))
+    `(when (eq acdw/system ,(car arg))
+       ,(car arg)))
+   ((cdr arg)
+    `(pcase acdw/system
+       ,@arg))
+   (t (error "Wrong argument type: %s" (type-of arg)))))
+
 
 ;;; Utility functions
 ;; I don't prefix these because ... reasons.  Honestly I probably should prefix
@@ -162,11 +179,11 @@ if MAKE-DIRECTORY is non-nil."
 
 (defun acdw/find-emacs-source ()
   "Find where Emacs keeps its source tree."
-  (pcase acdw/system
-    (:work (expand-file-name
-            (concat "~/src/emacs-" emacs-version "/src")))
-    (:home (expand-file-name "~/src/pkg/emacs/src/emacs-git/src"))
-    (:other nil)))
+  (acdw/system
+   (:work (expand-file-name
+           (concat "~/src/emacs-" emacs-version "/src")))
+   (:home (expand-file-name "~/src/pkg/emacs/src/emacs-git/src"))
+   (:other nil)))
 
 (defun acdw/gc-disable ()
   "Functionally disable the Garbage collector."