Clean up emacs stuff

2 files changed, 279 insertions, 83 deletions

@@ -13,6 +13,8 @@
 
 ;; (load-theme 'modus-operandi :no-confirm)
 
+;;; Custom functions
+
 (define-advice startup-echo-area-message (:override ())
   (if (get-buffer "*Warnings*")
       ";_;"
@@ -61,8 +63,11 @@ If already so, run FUNC immediately."
   (set-face-attribute 'variable-pitch nil
                       :family (first-found-font "Public Sans")
                       :height 1.0)
+  (set-face-attribute 'fixed-pitch nil
+                      :family (first-found-font "Recursive Mono Linear Static"))
   (set-face-attribute 'fixed-pitch-serif nil
-                      :inherit 'default)
+                      :family (first-found-font "Go Mono"
+                                                "DejaVu Sans Mono"))
 
   ;; Emojis
   (cl-loop with ffl = (font-family-list)
@@ -100,62 +105,6 @@ If already so, run FUNC immediately."
            if (member font ffl)
            do (set-fontset-font t charset font)))
 
-(defun cancel-colors ()
-  (mapatoms
-   (lambda (atom)
-     (when (facep atom)
-       (set-face-attribute atom nil
-                           :foreground 'unspecified
-                           :background 'unspecified
-                           :weight 'unspecified
-                           :slant 'unspecified
-                           :underline 'unspecified
-                           :overline 'unspecified
-                           :strike-through 'unspecified
-                           :box 'unspecified
-                           :inverse-video nil
-                           :stipple nil
-                           :extend nil)))))
-
-(defun set-faces (faces)
-  (dolist (face faces)
-    (apply #'set-face-attribute (car face) nil (cdr face))))
-
-(font-lock-mode -1)
-(cancel-colors)
-(run-after-frame-init
- (defun uncancel-colors ()
-   (set-faces `((font-lock-comment-face :italic t)
-                (font-lock-comment-delimiter-face :italic t)
-                (font-lock-doc-face :italic t)
-                (font-lock-keyword-face :bold t)
-                (bold :bold t) (italic :italic t) (underline :underline t)
-                (mode-line-active :box t :background "light goldenrod")
-                (mode-line-inactive :box "pale goldenrod"
-                                    :background "pale goldenrod")
-                (link :foreground "navy" :underline t)
-                (completions-annotations :inherit 'italic)
-                (highlight :background "wheat")
-                (match :background "wheat")
-                (isearch :background "sea green" :foreground "white")
-                (isearch-fail :background "tomato")
-                (lazy-highlight :background "dark sea green")
-                (region :background "papaya whip")
-                (query-replace :background "wheat")
-                (shadow :foreground "orchid")
-                (show-paren-match :background "goldenrod")
-                (success :foreground "sea green" :italic t)
-                (warning :foreground "brown" :italic t)
-                (error :foreground "red" :italic t)
-                (trailing-whitespace :background "tomato")
-                (vertical-border :foreground "gray")
-                (completions-highlight :background "wheat")))))
-
-(defun recancel-colors ()
-  (interactive)
-  (cancel-colors)
-  (uncancel-colors))
-
 (defmacro inhibit-messages (&rest body)
   "Inhibit all messages in BODY."
   (declare (indent defun))
@@ -216,8 +165,20 @@ With ARG, edit in other window."
   (unless (package-installed-p pkg)
     (package-install pkg)))
 
+(defun minibuffer-delete-directory ()
+  (interactive)
+  (let ((here (point))
+        (meta (completion-metadata
+               "" minibuffer-completion-table
+               minibuffer-completion-predicate)))
+    (if (eq (completion-metadata-get meta 'category) 'file)
+        (when (search-backward "/" (minibuffer-prompt-end) t)
+          (delete-region (point) here))
+      (backward-kill-word 1))))
+
 ;;; Basic settings
 
+(recancel-colors)
 (tooltip-mode -1)
 
 ;; Dialogs
@@ -238,6 +199,7 @@ With ARG, edit in other window."
 
 ;; Whitespace
 (setopt whitespace-style '(face trailing tabs tab-mark))
+(setopt whitespace-global-modes '(not rcirc-mode))
 (global-whitespace-mode)
 (add-hook 'before-save-hook #'delete-trailing-whitespace-except-current-line)
 (set-face-attribute 'whitespace-tab nil :background nil :foreground "#888")
@@ -265,6 +227,7 @@ With ARG, edit in other window."
 
 (keymap-set minibuffer-local-map "C-p" #'minibuffer-previous-completion)
 (keymap-set minibuffer-local-map "C-n" #'minibuffer-next-completion)
+(keymap-set minibuffer-local-map "M-DEL" #'minibuffer-delete-directory)
 
 (setopt enable-recursive-minibuffers t)
 (setopt minibuffer-default-prompt-format " [%s]")
@@ -319,6 +282,10 @@ With ARG, edit in other window."
 (package-ensure 'marginalia)
 (marginalia-mode)
 
+;;; Frames / Windows
+
+(winner-mode)
+
 ;;; Files
 
 (setopt auto-revert-verbose nil)
@@ -334,13 +301,17 @@ With ARG, edit in other window."
 (setopt auto-save-no-message t)
 (setopt auto-save-interval 2)
 (setopt auto-save-timeout 2)
-(setopt auto-save-visited-interval 2)
+(setopt auto-save-visited-interval 5)
 (setopt remote-file-name-inhibit-auto-save t)
 (setopt remote-file-name-inhibit-auto-save-visited t)
 (add-to-list 'auto-save-file-name-transforms
              `(".*" ,(locate-user-emacs-file "auto-save/") t))
 (auto-save-visited-mode)
 
+(add-function :after after-focus-change-function
+              (defun focus-out-save ()
+                (save-some-buffers t)))
+
 (setopt backup-by-copying t)
 (setopt version-control t)
 (setopt kept-new-versions 3)
@@ -370,8 +341,15 @@ With ARG, edit in other window."
 
 ;;; Buffers
 
+;; Unique names
 (setopt uniquify-buffer-name-style 'forward)
 
+;; Persistent undo
+(package-ensure 'undo-fu-session)
+(setopt undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
+                                             "/git-rebase-todo\\'"))
+(undo-fu-session-global-mode)
+
 ;; Encodings
 (set-language-environment "UTF-8")
 (setopt buffer-file-coding-system 'utf-8-unix)
@@ -397,7 +375,6 @@ With ARG, edit in other window."
 (setopt isearch-lazy-count t)
 (setopt isearch-regexp-lax-whitespace t)
 (setopt isearch-wrap-pause 'no)
-(setopt search-default-mode t)
 (setopt search-whitespace-regexp ".*?") ; swiper-style
 (setopt search-ring-max 256)
 (setopt regexp-search-ring-max 256)
@@ -416,6 +393,11 @@ With ARG, edit in other window."
     (keymap-set isearch-mb-minibuffer-map "M-s l" #'consult-line)))
 (isearch-mb-mode)
 
+;; Default to regexen
+(setopt search-default-mode t)          ; Isearch
+(keymap-global-set "M-%" #'query-replace-regexp)
+(keymap-global-set "C-M-%" #'query-replace)
+
 ;;; Keybinds
 
 (keymap-global-set "C-x C-c" #'save-buffers-kill-terminal)
@@ -432,7 +414,7 @@ With ARG, edit in other window."
 (keymap-global-set "C-c p" #'find-user-private-file)
 (keymap-global-set "C-c s" #'eshell)
 
-(keymap-global-set "C-c t"
+(keymap-global-set "C-c d"
                    (defun insert-current-iso8601 ()
                      (interactive)
                      (insert (format-time-string "%FT%TZ" (current-time) t))))
@@ -441,7 +423,20 @@ With ARG, edit in other window."
                    (defun indent-buffer ()
                      (interactive)
                      (save-mark-and-excursion
-                       (indent-region (point-min) (point-max)))))
+                       (indent-region (point-min) (point-max))
+                       (if (apply #'derived-mode-p space-indent-modes)
+                           (untabify (point-min) (point-max))
+                         (tabify (point-min) (point-max))))))
+
+(keymap-global-set "C-c t"
+                   (define-keymap
+                     :prefix 'toggle-map
+                     "e" #'toggle-debug-on-error
+                     "q" #'toggle-debug-on-quit
+                     "c" #'column-number-mode
+                     "l" #'line-number-mode
+                     "L" #'display-line-numbers-mode
+                     "t" #'truncate-lines-local-mode))
 
 ;; Un-keybinds
 (keymap-global-unset "C-<wheel-down>" t)
@@ -456,6 +451,7 @@ With ARG, edit in other window."
 ;;; Writing
 
 (add-hook 'text-mode-hook #'visual-line-mode)
+(add-hook 'text-mode-hook #'auto-fill-mode)
 
 ;;; Hungry delete
 ;; I was using the hungry-delete package, but it turns out I can get *most* of
@@ -576,19 +572,28 @@ With ARG, edit in other window."
 (setopt compilation-always-kill t)
 (setopt compilation-ask-about-save nil)
 
+;;; Languages
+
+(package-ensure 'gemtext-mode)
+
 ;;; Miscellaneous settings
 
 (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p)
 (add-hook 'prog-mode-hook #'auto-fill-mode)
-(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode)
 (add-hook 'prog-mode-hook #'electric-pair-local-mode)
+(global-display-fill-column-indicator-mode)
 (delete-selection-mode)
 (global-so-long-mode)
+(global-goto-address-mode)
+(context-menu-mode)
+(setopt scroll-conservatively 101)
 (setopt display-fill-column-indicator-character ?·)
 (setopt disabled-command-function nil)
 (setopt electric-pair-skip-whitespace 'chomp)
 (setopt fill-column 80)
 (setopt recenter-positions '(top middle bottom))
+(setopt eval-expression-print-level nil)
+(setopt eval-expression-print-length nil)
 (setopt show-paren-delay 0.01)
 (setopt show-paren-style 'parenthesis)
 (setopt show-paren-when-point-in-periphery t)
@@ -612,31 +617,45 @@ With ARG, edit in other window."
   (call-interactively #'rcirc))
 
 (add-hook 'rcirc-mode-hook
-          (defun @rcirc-mode ()
-            (whitespace-mode -1)))
-
-(add-hook 'rcirc-mode-hook #'rcirc-track-minor-mode)
-(add-hook 'rcirc-mode-hook #'rcirc-omit-mode)
-(add-hook 'rcirc-mode-hook #'visual-line-mode)
-(add-hook 'rcirc-mode-hook
-          (lambda () (whitespace-mode -1)))
+          (defun @rcirc ()
+            (rcirc-track-minor-mode)
+            (rcirc-omit-mode)
+            (visual-line-mode)
+            (setq default-directory (expand-file-name "~"))))
 
 ;;; Eshell
 
+(setopt eshell-banner-message
+        (format "%s\n\n" (mapconcat #'identity
+                                    (process-lines "fortune" "-s")
+                                    "\n")))
 (setopt eshell-prompt-function
         (defun @eshell-prompt ()
-          (concat "* " (abbreviate-file-name (eshell/pwd))
-                  (if (zerop (user-uid)) " # " " $ "))))
+          (let ((rootp (zerop (user-uid))))
+            (propertize
+             (concat "( "
+                    (abbreviate-file-name (eshell/pwd))
+                    (if rootp ":root" "")
+                    " ) ")
+             'face 'bold))))
+(setopt eshell-prompt-regexp "^(.*) ")
 
 ;;; Browsing
 
 ;; Dired (files)
+(setopt dired-dwim-target t)
+(setopt dired-listing-switches "-AlF")
+(setopt dired-ls-F-marks-symlinks t)
+(setopt dired-recursive-copies 'always)
+(setopt dired-recursive-deletes 'always)
+(setopt dired-auto-revert-buffer t)
+(setopt dired-hide-details-hide-symlink-targets nil)
 (with-eval-after-load 'dired
-  (setopt dired-dwim-target t)
-  (setopt dired-listing-switches "-alF")
-  (setopt dired-ls-F-marks-symlinks t)
-  (keymap-set dired-mode-map "C-j" #'dired-up-directory)
-  (add-hook 'dired-mode-hook #'hl-line-mode))
+  (require 'dired-x)
+  (add-hook 'dired-mode-hook #'dired-hide-details-mode)
+  (add-hook 'dired-mode-hook #'hl-line-mode)
+  (add-hook 'dired-mode-hook #'truncate-lines-local-mode)
+  (keymap-set dired-mode-map "C-j" #'dired-up-directory))
 
 ;; Elpher (gemini/gopher)
 (package-ensure 'elpher)
@@ -5,17 +5,194 @@
 (setopt frame-resize-pixelwise t)
 (setopt window-resize-pixelwise t)
 (setopt default-frame-alist
-        '((background-color . "alice blue")
-          (font . "Recursive Mono Casual Static 10")
-          (menu-bar-lines . 0)
+        '((menu-bar-lines . 0)
           (tool-bar-lines . 0)
           (vertical-scroll-bars)
           (horizontal-scroll-bars)))
 
+(defvar *fonts*
+  '((default
+     :family ("Recursive Mono Casual Static" "DejaVu Sans Mono")
+     :height 100)
+    (variable-pitch
+     :family ("Public Sans" "DejaVu Sans")
+     :height 1.0)
+    (fixed-pitch
+     :family ("Recursive Mono Linear Static" "DejaVu Sans Mono"))
+    (fixed-pitch-serif
+     :family ("Recursive Mono Linear Static" "DejaVu Sans Mono"))))
+
 (require 'package)
 (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t)
 (package-initialize)
 
-(setopt inhibit-startup-screen t)
-(setopt initial-buffer-choice #'eshell)
-(setopt initial-scratch-message nil)
+;;; Custom functions
+
+(defun pulse@eval (start end &rest _)
+  "ADVICE: makes `pulse-momentary-highlight-region' accept other arities."
+  (pulse-momentary-highlight-region start end))
+
+(defun create-missing-directories ()
+  "Automatically create missing directories."
+  (let ((target-dir (file-name-directory buffer-file-name)))
+    (unless (file-exists-p target-dir)
+      (make-directory target-dir :parents))))
+
+(defun delete-trailing-whitespace-except-current-line ()
+  "Delete all trailing whitespace except current line."
+  (save-excursion
+    (delete-trailing-whitespace (point-min)
+                                (line-beginning-position))
+    (delete-trailing-whitespace (line-end-position)
+                                (point-max))))
+
+(defun run-after-frame-init (func)
+  "Run FUNC after the first frame is initialized.
+If already so, run FUNC immediately."
+  (cond
+   ((daemonp)
+    (add-hook 'server-after-make-frame-hook func)
+    (advice-add func :after (lambda ()
+                              (remove-hook 'server-after-make-frame-hook
+                                           func)
+                              (advice-remove func
+                                             'after-frame-init-removing-advice))
+
+
+                '((name . after-frame-init-removing-advice))))
+   ((not after-init-time)
+    (add-hook 'after-init-hook func))
+   (:else (funcall func))))
+
+(defun first-found-font (&rest cands)
+  "Return the first font of CANDS that is installed, or nil."
+  (cl-loop with ffl = (font-family-list)
+           for font in cands
+           if (member font ffl)
+           return font))
+
+(defun setup-faces ()
+  "Setup Emacs faces."
+  ;; Default faces
+  (cl-loop for (face . spec) in *fonts*
+           do (set-face-attribute face nil
+                                  :family (apply #'first-found-font
+                                                 (plist-get spec :family))
+                                  :height (or (plist-get spec :height)
+                                              'unspecified)))
+  ;; Specialized fonts
+  (cl-loop with ffl = (font-family-alist)
+           for (charset . font)
+           in '((latin . "Noto Sans")
+                (han . "Noto Sans CJK SC Regular")
+                (kana . "Noto Sans CJK JP Regular")
+                (hangul . "Noto Sans CJK KR Regular")
+                (cjk-misc . "Noto Sans CJK KR Regular")
+                (khmer . "Noto Sans Khmer")
+                (lao . "Noto Sans Lao")
+                (burmese . "Noto Sans Myanmar")
+                (thai . "Noto Sans Thai")
+                (ethiopic . "Noto Sans Ethiopic")
+                (hebrew . "Noto Sans Hebrew")
+                (arabic . "Noto Sans Arabic")
+                (gujarati . "Noto Sans Gujarati")
+                (devanagari . "Noto Sans Devanagari")
+                (kannada . "Noto Sans Kannada")
+                (malayalam . "Noto Sans Malayalam")
+                (oriya . "Noto Sans Oriya")
+                (sinhala . "Noto Sans Sinhala")
+                (tamil . "Noto Sans Tamil")
+                (telugu . "Noto Sans Telugu")
+                (tibetan . "Noto Sans Tibetan")
+                ;; emojis
+                (symbol . "Noto Emoji")
+                (symbol . "Noto Color Emoji")
+                (symbol . "Segoe UI Emoji")
+                (symbol . "Apple Color Emoji")
+                (symbol . "FreeSans")
+                (symbol . "FreeMono")
+                (symbol . "FreeSerif")
+                (symbol . "Unifont")
+                (symbol . "Symbola"))
+           if (member font ffl)
+           do (set-fontset-font t charset font)))
+
+(defmacro inhibit-messages (&rest body)
+  "Inhibit all messages in BODY."
+  (declare (indent defun))
+  `(cl-letf (((symbol-function 'message) #'ignore))
+     ,@body))
+
+(defun kill-buffer-dwim (&optional buffer-or-name)
+  "Kill BUFFER-OR-NAME or the current buffer."
+  (interactive "P")
+  (cond
+   ((bufferp buffer-or-name)
+    (kill-buffer buffer-or-name))
+   ((null buffer-or-name)
+    (kill-current-buffer))
+   (:else
+    (kill-buffer (read-buffer "Kill: " nil :require-match)))))
+
+(defun other-window-dwim (&optional arg)
+  "Switch to another window/buffer.
+Calls `other-window', which see, unless
+- the current window is alone on its frame
+- `other-window-dwim' is called with \\[universal-argument]
+In these cases, switch to the last-used buffer."
+  (interactive "P")
+  (if (or arg (one-window-p))
+      (switch-to-buffer (other-buffer) nil t)
+    (other-window 1)))
+
+(defun delete-window-dwim ()
+  "Delete the current window or bury its buffer.
+If the current window is alone in its frame, bury the buffer
+instead."
+  (interactive)
+  (unless (ignore-errors (delete-window) t)
+    (bury-buffer)))
+
+(defun cycle-spacing* (&optional n)
+  "Negate N argument on `cycle-spacing'."
+  (interactive "*p")
+  (cycle-spacing (- n)))
+
+(defmacro find-user-file (name &optional file-name)
+  "Template macro to generate user file finding functions."
+  (declare (indent 1))
+  (let ((file-name (or file-name (intern (format "user-%s-file" name))))
+        (func-name (intern (format "find-user-%s-file" name))))
+    `(defun ,func-name (&optional arg)
+       ,(format "Edit `%s' in the current window.
+With ARG, edit in the other window." file-name)
+       (interactive "P")
+       (funcall (if arg #'find-file-other-window #'find-file)
+                ,file-name))))
+
+(defun indent-buffer+ ()
+  "Indent the current buffer and (un)`tabify'.
+Whether it tabifies or untabifies depends on `space-indent-modes'."
+  (interactive)
+  (save-mark-and-excursion
+    (indent-region (point-min) (point-max))
+    (if (apply #'derived-mode-p space-indent-modes)
+        (untabify (point-min) (point-max))
+      (tabify (point-min) (point-max)))))
+
+(defun package-ensure (pkg)
+  "Install PKG if it's not already installed."
+  (unless (package-installed-p pkg)
+    (package-install pkg)))
+
+(defun minibuffer-delete-directory ()
+  "Delete the last directory in a file-completing minibuffer."
+  (interactive)
+  (let ((here (point))
+        (meta (completion-metadata
+               "" minibuffer-completion-table
+               minibuffer-completion-predicate)))
+    (if (eq (completion-metadata-get meta 'category) 'file)
+        (when (search-backward "/" (minibuffer-prompt-end) t)
+          (delete-region (point) here))
+      (backward-kill-word 1))))