diff options
-rw-r--r-- | early-init.el | 121 | ||||
-rw-r--r-- | init.el | 2336 | ||||
-rw-r--r-- | lisp/+browse-url.el | 189 | ||||
-rw-r--r-- | lisp/+cape.el | 25 | ||||
-rw-r--r-- | lisp/+custom.el | 52 | ||||
-rw-r--r-- | lisp/+emacs.el | 422 | ||||
-rw-r--r-- | lisp/+emms.el | 38 | ||||
-rw-r--r-- | lisp/+hungry-delete.el | 53 | ||||
-rw-r--r-- | lisp/+isearch.el | 24 | ||||
-rw-r--r-- | lisp/+notmuch.el | 52 | ||||
-rw-r--r-- | lisp/+org-capture.el | 197 | ||||
-rw-r--r-- | lisp/+org.el | 268 | ||||
-rw-r--r-- | lisp/+ox.el | 29 | ||||
-rw-r--r-- | lisp/+paredit.el | 26 | ||||
-rw-r--r-- | lisp/+tempo.el | 45 | ||||
-rw-r--r-- | lisp/+titlecase.el | 6 | ||||
-rw-r--r-- | lisp/+window.el | 130 | ||||
-rw-r--r-- | lisp/acdw-defaults.el | 292 | ||||
-rw-r--r-- | lisp/acdw-funs.el | 262 | ||||
-rw-r--r-- | lisp/acdw-macs.el | 293 | ||||
-rw-r--r-- | lisp/acdw.el | 345 | ||||
-rw-r--r-- | lisp/browse-url-transform.el | 45 | ||||
-rw-r--r-- | lisp/dawn.el | 109 | ||||
-rw-r--r-- | lisp/def.el | 142 | ||||
-rw-r--r-- | lisp/graveyard.el | 50 | ||||
-rw-r--r-- | lisp/init-org.el | 144 | ||||
-rw-r--r-- | lisp/org-word-count.el | 297 | ||||
-rw-r--r-- | lisp/pita.el | 69 | ||||
-rw-r--r-- | lisp/private.el | 23 | ||||
-rw-r--r-- | lisp/scule.el | 61 | ||||
-rw-r--r-- | lisp/upload-junk.el | 47 | ||||
-rw-r--r-- | lisp/yoke.el | 664 |
32 files changed, 3083 insertions, 3773 deletions
diff --git a/early-init.el b/early-init.el index 8004342..b841ea5 100644 --- a/early-init.el +++ b/early-init.el | |||
@@ -1,98 +1,95 @@ | |||
1 | ;;; early-init.el --- Emacs early init -*- lexical-binding: t; -*- | 1 | ;;; early-init.el --- Emacs early init -*- lexical-binding: t -*- |
2 | |||
2 | ;; by C. Duckworth <acdw@acdw.net> | 3 | ;; by C. Duckworth <acdw@acdw.net> |
3 | ;; Bankruptcy: 9 | ||
4 | 4 | ||
5 | ;;; Speed up init | 5 | ;; Bankruptcy: 9.3 |
6 | |||
7 | ;;; Debugging --- delete this when done bankrupting | ||
8 | (setf debug-on-error t | ||
9 | use-package-verbose t) | ||
10 | |||
11 | ;;; Speedy startup | ||
6 | 12 | ||
7 | ;; Restore things after init | ||
8 | (defvar +emacs--startup-restore-alist nil | 13 | (defvar +emacs--startup-restore-alist nil |
9 | "Variables and values to restore after init.") | 14 | "Variables to restore after startup.") |
10 | 15 | ||
11 | (add-hook 'emacs-startup-hook | 16 | (defun +emacs-startup@restore-variables () |
12 | (defun emacs-startup@restore-values () | 17 | "Restore variables set temporarily during startup." |
13 | "Restore values set during init. | 18 | (dolist (v +emacs--startup-restore-alist) |
14 | This applies values in `+emacs--startup-restore-alist'." | 19 | (set-default (car v) (cdr v)))) |
15 | (dolist (a +emacs--startup-restore-alist) | 20 | (add-hook 'after-init-hook #'+emacs-startup@restore-variables) |
16 | (set (car a) (cdr a))))) | ||
17 | 21 | ||
18 | (defun +set-during-startup (variable value &optional restore) | 22 | (defun +set-during-startup (variable value &optional restore) |
19 | "Set VARIABLE to VALUE during startup, but restore to RESTORE. | 23 | "Set VARIABLE to VALUE during startup. |
20 | If RESTORE is nil or not passed, save the original value and | 24 | If RESTORE is non-nil, restore the variable's value to it. |
21 | restore that." | 25 | Otherwise, save its original value and restore to that." |
22 | (unless after-init-time | 26 | (unless after-init-time |
23 | (setf (alist-get variable +emacs--startup-restore-alist) | 27 | (setf (alist-get variable +emacs--startup-restore-alist) |
24 | (or restore (symbol-value variable))) | 28 | (or restore (symbol-value variable))) |
25 | (set-default variable value))) | 29 | (set-default variable value))) |
26 | 30 | ||
27 | ;; Garbage collection | ||
28 | (+set-during-startup 'gc-cons-threshold most-positive-fixnum) | 31 | (+set-during-startup 'gc-cons-threshold most-positive-fixnum) |
29 | 32 | ||
30 | (add-hook 'minibuffer-setup-hook (defun garbage-collect@minibuffer-enter () | 33 | ;;; Distraction-free startup |
31 | (setf gc-cons-threshold most-positive-fixnum))) | ||
32 | (add-hook 'minibuffer-exit-hook (defun garbage-collect@minibuffer-exit () | ||
33 | (setf gc-cons-threshold 800000))) | ||
34 | 34 | ||
35 | ;; Don't prematurely re-display | ||
36 | (unless debug-on-error | 35 | (unless debug-on-error |
37 | (+set-during-startup 'inhibit-redisplay t) | 36 | (+set-during-startup 'inhibit-redisplay t) |
38 | (+set-during-startup 'inhibit-message t)) | 37 | (+set-during-startup 'inhibit-message t)) |
39 | 38 | ||
40 | ;; Debug during init | 39 | (setf warning-minimum-level :emergency) |
41 | (unless (eq debug-on-error 'startup) | 40 | (add-hook 'emacs-startup-hook |
42 | (+set-during-startup 'debug-on-error 'init)) | 41 | (defun +message-about-warnings () |
43 | 42 | (when-let ((warnings (get-buffer "*Warnings*"))) | |
44 | ;;; Default frame settings | 43 | (message "%s. %s." "There were init-time warnings" |
44 | "See the `*Warnings*' buffer.")))) | ||
45 | 45 | ||
46 | (setf default-frame-alist '((tool-bar-lines . 0) | 46 | (setf default-frame-alist '((tool-bar-lines . 0) |
47 | (menu-bar-lines . 0) | 47 | (menu-bar-lines . 0) |
48 | (vertical-scroll-bars) | 48 | (vertical-scroll-bars . nil) |
49 | (horizontal-scroll-bars)) | 49 | (horizontal-scroll-bars . nil)) |
50 | frame-inhibit-implied-resize t | 50 | frame-inhibit-implied-resize t |
51 | frame-resize-pixelwise t | 51 | frame-resize-pixelwise t |
52 | window-resize-pixelwise t | 52 | window-resize-pixelwise t |
53 | inhibit-x-resources t | 53 | inhibit-x-resources t |
54 | indicate-empty-lines nil | 54 | indicate-empty-lines nil |
55 | indicate-buffer-boundaries nil | 55 | indicate-buffer-boundaries nil) |
56 | ;; '((top . right) | 56 | |
57 | ;; (bottom . right)) | 57 | ;;; Packages |
58 | ) | ||
59 | 58 | ||
60 | ;;; Set up extra load paths and functionality | 59 | (require 'package) |
61 | 60 | ||
62 | (push (expand-file-name (locate-user-emacs-file "lisp")) load-path) | 61 | (dolist (archive |
63 | (require 'acdw) | 62 | '(("gnu-devel" . "https://elpa.gnu.org/devel/") |
63 | ("nongnu-devel" . "https://elpa.gnu.org/nongnu-devel/") | ||
64 | ("melpa" . "https://melpa.org/packages/"))) | ||
65 | (add-to-list 'package-archives archive :append)) | ||
64 | 66 | ||
65 | (+define-dir .etc (locate-user-emacs-file "etc") | 67 | (setf package-archive-priorities |
66 | "Directory for all of Emacs's various files. | 68 | '(("gnu-devel" . 2) |
67 | See `no-littering' for examples.") | 69 | ("nongnu-devel" . 1) |
70 | ("melpa" . 0) | ||
71 | ("gnu" . 0) | ||
72 | ("nongnu" . 0))) | ||
68 | 73 | ||
69 | (+define-dir sync/ (expand-file-name "~/Sync") | 74 | (package-initialize) |
70 | "My Syncthing directory.") | ||
71 | 75 | ||
72 | (+define-dir private/ (sync/ "emacs/private")) | 76 | (unless package-archive-contents |
73 | (add-to-list 'load-path private/) | 77 | (package-refresh-contents)) |
74 | 78 | ||
75 | ;;; Packages | 79 | ;; https://melpa.org/packages/archive-contents |
76 | 80 | ||
77 | (setf package-enable-at-startup nil | 81 | ;;; Use-package |
78 | package-quickstart nil) | ||
79 | 82 | ||
80 | (require 'yoke) | 83 | (setf use-package-enable-imenu-support t |
81 | (add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate) | 84 | use-package-hook-name-suffix nil) |
82 | 85 | ||
83 | (yoke (compat "https://git.sr.ht/~pkal/compat")) | 86 | (require 'use-package) |
84 | 87 | ||
85 | (yoke (no-littering "https://github.com/emacscollective/no-littering") | 88 | (setf use-package-compute-statistics debug-on-error) |
86 | (setf no-littering-etc-directory .etc | ||
87 | no-littering-var-directory .etc | ||
88 | custom-file (.etc "custom.el")) | ||
89 | (require 'no-littering) | ||
90 | (when (boundp 'native-comp-eln-load-path) | ||
91 | (setcar native-comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) | ||
92 | (when (boundp 'comp-eln-load-path) | ||
93 | (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) | ||
94 | (when (fboundp 'startup-redirect-eln-cache) | ||
95 | (startup-redirect-eln-cache (convert-standard-filename (.etc "eln-cache/"))))) | ||
96 | 89 | ||
97 | (provide 'early-init) | 90 | (use-package use-package-vc |
98 | ;;; early-init.el ends here | 91 | :load-path "~/src/emacs/use-package-vc.el" |
92 | :config | ||
93 | (define-advice package-vc-install (:around (orig &rest args) wtf) | ||
94 | (let ((package-archives nil)) | ||
95 | (apply orig args)))) | ||
diff --git a/init.el b/init.el index ffe7f81..3fcf374 100644 --- a/init.el +++ b/init.el | |||
@@ -1,1228 +1,977 @@ | |||
1 | ;;; emacs init --- an init for emacs -*- lexical-binding: t; -*- | 1 | ;;; init.el --- a config of one's own -*- lexical-binding: t; -*- |
2 | ;; by C. Duckworth <acdw@acdw.net> | 2 | ;; by C. Duckworth <acdw@acdw.net> |
3 | ;; URL: https://git.acdw.net/emacs | 3 | ;; Bankruptcy: 9.3 |
4 | ;; Bankruptcy: 9 | 4 | |
5 | ;; | 5 | ;;; Code: |
6 | ;; Everyone is permitted to do whatever they like with this software | 6 | |
7 | ;; without limitation. This software comes without any warranty | 7 | ;;; Remove when done bankrupting |
8 | ;; whatsoever, but with two pieces of advice: | 8 | |
9 | ;; - Be kind to yourself. | 9 | (defkeys t "C-x C-c" #'restart-emacs) |
10 | ;; - Make good choices. | 10 | |
11 | 11 | ;;; My extras | |
12 | (yoke +emacs | 12 | |
13 | (require* '+emacs '+window '+lisp) | 13 | (push (expand-file-name (locate-user-emacs-file "lisp")) load-path) |
14 | ;; Settings | 14 | (require 'acdw) ; Omnibus fun stuff |
15 | (setc truncate-string-ellipsis "…" | 15 | |
16 | ring-bell-function #'ignore | 16 | ;;; Basic defaults |
17 | read-file-name-completion-ignore-case t | 17 | |
18 | comment-auto-fill-only-comments t | 18 | (use-package no-littering |
19 | password-cache t | 19 | :ensure t |
20 | password-cache-expiry (* 60 60) | 20 | :demand t |
21 | switch-to-buffer-in-dedicated-window 'pop | 21 | :custom |
22 | switch-to-buffer-obey-display-actions t | 22 | (no-littering-etc-directory etc/) |
23 | initial-buffer-choice (defun +initial-buffer-choose () | 23 | (no-littering-var-directory var/) |
24 | (cond | 24 | (custom-file (etc/ "custom.el")) |
25 | ((equal (get-buffer "*Messages*") | 25 | (auto-save-file-name-transforms `(("." ,(var/ "auto-save/") t))) |
26 | (other-buffer)) | 26 | (auto-save-list-file-prefix (var/ "auto-save/.saves-" t)) |
27 | (get-buffer "*scratch*")) | 27 | (backup-directory-alist `(("." . ,(var/ "backup/" t))))) |
28 | (:else (other-buffer))))) | 28 | |
29 | ;; "Safe" variables | 29 | (use-package custom-allowed |
30 | (dolist (var+pred | 30 | :load-path "~/src/emacs/custom-allowed/" |
31 | '((browse-url-browser-function | 31 | :custom |
32 | ;; All types defined by custom are safe. | 32 | (custom-file (private/ "custom.el")) |
33 | . (lambda (f) | 33 | :config |
34 | ;; Whooooo boy | 34 | (dolist (var '(safe-local-variable-values |
35 | (memq f (mapcar (lambda (i) | 35 | warning-suppress-types |
36 | (plist-get (cdr i) :value)) | 36 | ispell-buffer-session-localwords |
37 | (seq-filter | 37 | calendar-latitude |
38 | (lambda (i) | 38 | calendar-longitude |
39 | (eq (car i) 'function-item)) | 39 | user-full-name |
40 | (cdr (get 'browse-url-browser-function | 40 | user-mail-address)) |
41 | 'custom-type))))))))) | 41 | (add-to-list 'custom-allowed-variables var)) |
42 | (put (car var+pred) 'safe-local-variable (cdr var+pred))) | 42 | :hook |
43 | ;; Keys | 43 | (after-init-hook . custom-allowed-load-custom-file)) |
44 | (defkeys t | 44 | |
45 | "C-x C-k" #'kill-current-buffer | 45 | (use-package modus-themes |
46 | "C-/" #'undo-only | 46 | :load-path "~/usr/share/emacs/30.0.50/etc/themes/" |
47 | "C-?" #'undo-redo | 47 | :custom |
48 | "C-x C-c" (defun delete-frame-or-quit (arg) | 48 | (modus-themes-bold-constructs t) |
49 | (interactive "P") | 49 | (modus-themes-italic-constructs t) |
50 | (cond (arg (delete-frame nil :force)) | 50 | (modus-themes-variable-pitch-ui nil)) |
51 | ((= 1 (length (frame-list))) | 51 | |
52 | (and (yes-or-no-p "Kill emacs? ") | 52 | (use-package dawn |
53 | (save-buffers-kill-emacs t))) | 53 | :load-path "~/src/emacs/dawn/" |
54 | (:else (delete-frame)))) | 54 | :after modus-themes |
55 | "C-x r q" (defun really-quit-emacs (arg) | 55 | :config |
56 | (interactive "P") | 56 | (load-theme 'modus-operandi :noconfirm :noenable) |
57 | (cond (arg (save-buffers-kill-emacs t)) | 57 | (load-theme 'modus-vivendi :noconfirm :noenable) |
58 | (:else (save-buffers-kill-terminal t)))) | 58 | (defhook custom-allowed-after-load-hook |
59 | "M-SPC" #'+cycle-spacing | 59 | (dawn-schedule-themes 'modus-operandi |
60 | ;; "M-/" #'hippie-expand ; `hippie-completing-read' | 60 | 'modus-vivendi) |
61 | "M-=" #'count-words | 61 | (set-face-attribute 'default nil |
62 | "C-x C-b" #'ibuffer | 62 | :family "IBM Plex Mono" |
63 | "C-x 4 n" #'clone-buffer | 63 | :height 100) |
64 | "S-<down-mouse-1>" #'mouse-set-mark | 64 | (set-face-attribute 'variable-pitch nil |
65 | "C-x 0" #'+delete-window-or-bury-buffer | 65 | :family "Georgia" |
66 | ;; "M-j" nil ; `avy' | 66 | :height 1.2))) |
67 | "<Scroll_Lock>" nil | 67 | |
68 | "C-z" nil | 68 | (use-package midnight |
69 | "M-o" #'other-window|switch-buffer | 69 | :config |
70 | "C-M-;" #'+lisp-comment-or-uncomment-sexp | 70 | (add-hook 'midnight-mode-hook #'recentf-cleanup) |
71 | "C-x 5 z" #'suspend-frame | 71 | (midnight-mode)) |
72 | "C-x f" #'find-file | 72 | |
73 | "C-c t" (defmap toggle-map | 73 | (use-package sophomore |
74 | "A map for toggling various settings." | 74 | :load-path "~/src/emacs/sophomore/" |
75 | "d" (defmap toggle-debug-map | 75 | :config |
76 | "Easily toggle debug flavors." | 76 | (sophomore-enable-all) |
77 | "e" #'toggle-debug-on-error | 77 | (sophomore-disable 'view-hello-file |
78 | "q" #'toggle-debug-on-quit) | 78 | 'describe-gnu-project |
79 | "w" #'toggle-word-wrap | 79 | 'suspend-frame) |
80 | "t" #'toggle-truncate-lines | 80 | (sophomore-mode)) |
81 | "c" #'column-number-mode | 81 | |
82 | "l" #'line-number-mode | 82 | ;;; Completions |
83 | "v" (defmap toggle-view-map | 83 | |
84 | "Easily toggle UI elements' views." | 84 | (use-package vertico |
85 | "c" #'display-fill-column-indicator-mode | 85 | :ensure t |
86 | "l" #'display-line-numbers-mode | 86 | :custom |
87 | "m" #'menu-bar-mode | 87 | (resize-mini-windows 'grow-only) |
88 | "t" #'tool-bar-mode | 88 | (vertico-cycle t) |
89 | "s" #'scroll-bar-mode))) | 89 | :init |
90 | (defkeys text-mode-map | 90 | (use-package vertico-directory |
91 | "C-M-k" #'kill-paragraph | 91 | :after vertico |
92 | "C-o" (defun open-paragraph (&optional arg) | 92 | :config |
93 | "Open a paragraph after paragraph at point. | 93 | (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) |
94 | A paragraph is defined as continguous non-empty lines of text | 94 | (vertico-mode)) |
95 | surrounded by empty lines, so opening a paragraph means to make | 95 | |
96 | three blank lines, then place the point on the second one. | 96 | (use-package marginalia |
97 | 97 | :ensure t | |
98 | Called with prefix ARG, open a paragraph before point." | 98 | :demand t |
99 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | 99 | :config |
100 | (interactive "*P") | 100 | (add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode) |
101 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | 101 | (marginalia-mode)) |
102 | ;; that's weird with org, and I'm guessing other modes too. | ||
103 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
104 | (while (and (not (looking-at "^$")) | ||
105 | (= 0 (forward-line (if arg -1 +1))))) | ||
106 | (newline) | ||
107 | (when arg (newline) (forward-line -2)) | ||
108 | (delete-blank-lines) | ||
109 | (newline 2) | ||
110 | (previous-line))) | ||
111 | ;; Hooks | ||
112 | (add-hook 'after-save-hook | ||
113 | #'executable-make-buffer-file-executable-if-script-p) | ||
114 | (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) | ||
115 | (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) | ||
116 | (add-hook 'text-mode-hook #'abbrev-mode) | ||
117 | (add-hook 'find-file-hook #'+vc-off-when-remote) | ||
118 | (add-hook 'prog-mode-hook #'auto-fill-mode) | ||
119 | ;; Advice | ||
120 | (add-function :after after-focus-change-function | ||
121 | #'+save-some-buffers-debounce) | ||
122 | (define-advice keyboard-escape-quit (:around (fn &rest r) keep-window-open) | ||
123 | "Don't close quits on `keyboard-escape-quit'." | ||
124 | (let ((buffer-quit-function #'ignore)) | ||
125 | (apply fn r))) | ||
126 | ;; Faces | ||
127 | (set-face-attribute 'default nil :family "Comic Code" :height 100) | ||
128 | (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold) | ||
129 | (set-face-attribute 'variable-pitch nil :family "Comic Code") | ||
130 | ;; Modes | ||
131 | (winner-mode)) | ||
132 | |||
133 | (yoke custom ; This is `cus-edit' but meh | ||
134 | (require '+custom) | ||
135 | (setf custom-file (private/ "custom.el")) | ||
136 | (add-to-list* '+custom-allowed-variables | ||
137 | 'safe-local-variable-values | ||
138 | 'warning-suppress-types | ||
139 | 'ispell-buffer-session-localwords) | ||
140 | (eval-after init | ||
141 | (+custom-load-some-customizations :noerror))) | ||
142 | |||
143 | ;; (yoke modus-themes | ||
144 | ;; (setc modus-themes-bold-constructs t | ||
145 | ;; modus-themes-italic-constructs t | ||
146 | ;; modus-themes-headings '((1 monochrome bold italic) | ||
147 | ;; (2 monochrome bold) | ||
148 | ;; (3 monochrom italic) | ||
149 | ;; (t monochrome))) | ||
150 | ;; (defhook modus-themes-after-load-theme-hook | ||
151 | ;; :name modus-monochrome | ||
152 | ;; (modus-themes-with-colors | ||
153 | ;; (cl-loop for x being the symbols | ||
154 | ;; if (string-match-p "\\`font-lock-.*-face\\'" | ||
155 | ;; (symbol-name x)) | ||
156 | ;; do | ||
157 | ;; (custom-set-faces | ||
158 | ;; `(,x ((,class :foreground | ||
159 | ;; ,(cond | ||
160 | ;; ((memq x '(font-lock-string-face | ||
161 | ;; font-lock-doc-face | ||
162 | ;; font-lock-doc-markup-face)) | ||
163 | ;; fg-special-warm) | ||
164 | ;; ((memq x '(font-lock-warning-face)) | ||
165 | ;; fg-lang-warning) | ||
166 | ;; ((memq x '(font-lock-comment-face)) | ||
167 | ;; fg-alt) | ||
168 | ;; (:else 'unspecified)) | ||
169 | ;; :background unspecified | ||
170 | ;; :weight | ||
171 | ;; ,(cond | ||
172 | ;; ((memq x '(font-lock-keyword-face)) | ||
173 | ;; 'bold) | ||
174 | ;; (:else 'normal)) | ||
175 | ;; :slant | ||
176 | ;; ,(cond | ||
177 | ;; ((memq x '(font-lock-doc-face | ||
178 | ;; font-lock-comment-face)) | ||
179 | ;; 'italic) | ||
180 | ;; (:else 'normal)) | ||
181 | ;; :underline | ||
182 | ;; ,(cond | ||
183 | ;; ((memq x '(font-lock-warning-face)) | ||
184 | ;; t) | ||
185 | ;; (:else nil))))))))) | ||
186 | ;; (when (or (custom-theme-enabled-p 'modus-operandi) | ||
187 | ;; (custom-theme-enabled-p 'modus-vivendi)) | ||
188 | ;; (modus-monochrome)) | ||
189 | ;; (cond ((require 'dawn nil :noerrer) | ||
190 | ;; (defhook +custom-after-load-hook | ||
191 | ;; :name dawn@custom | ||
192 | ;; (load-theme 'modus-operandi :noconfirm :noenable) | ||
193 | ;; (load-theme 'modus-vivendi :noconfirm :noenable) | ||
194 | ;; (dawn-schedule #'modus-themes-load-operandi | ||
195 | ;; #'modus-themes-load-vivendi))) | ||
196 | ;; (:else (modus-themes-load-operandi)))) | ||
197 | |||
198 | (yoke time | ||
199 | (setc display-time-mail-function | ||
200 | (defun +notmuch-new-mail-p () | ||
201 | (plist-get (cl-find "inbox+unread" | ||
202 | (ignore-errors | ||
203 | (notmuch-hello-query-counts notmuch-saved-searches)) | ||
204 | :key (lambda (l) (plist-get l :name)) | ||
205 | :test #'equal) | ||
206 | :count)) | ||
207 | display-time-use-mail-icon nil | ||
208 | display-time-mail-string (format "⋅ Mail (%s)" (+notmuch-new-mail-p)) | ||
209 | read-mail-command #'+notmuch-goto | ||
210 | display-time-format " %a %-e, %H:%M" | ||
211 | ;; `display-time-format' makes these unnecessary, but I'll keep em | ||
212 | display-time-24hr-format t | ||
213 | display-time-day-and-date t | ||
214 | display-time-default-load-average nil) | ||
215 | (define-advice display-time-update (:after (&rest _) update-mail-count) | ||
216 | (setq display-time-mail-string (format "⋅ Mail (%s)" (+notmuch-new-mail-p)))) | ||
217 | (display-time-mode)) | ||
218 | |||
219 | (yoke pita | ||
220 | (require 'pita) | ||
221 | (advice-add 'indent-region :before #'with-region-or-buffer)) | ||
222 | |||
223 | (yoke (undo-fu-session "https://codeberg.org/ideasman42/emacs-undo-fu-session") | ||
224 | (setc undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" | ||
225 | "/git-rebase-todo\\'") | ||
226 | undo-fu-session-directory (.etc "undo/" t) | ||
227 | undo-fu-session-compression (cond | ||
228 | ((executable-find "gzip") 'gz) | ||
229 | ((executable-find "bzip2") 'bz2) | ||
230 | ((executable-find "xz") 'xz) | ||
231 | (t nil))) | ||
232 | (global-undo-fu-session-mode)) | ||
233 | |||
234 | (yoke whitespace | ||
235 | (setc whitespace-line-column nil | ||
236 | whitespace-style '( face trailing | ||
237 | tabs tab-mark | ||
238 | indentation | ||
239 | space-after-tab space-before-tab)) | ||
240 | (defhook (text-mode-hook prog-mode-hook read-only-mode-hook) | ||
241 | :name +whitespace-mode-for-writable-buffers | ||
242 | :doc "Turn on `whitespace-mode' if the buffer is writable, off otherwise." | ||
243 | (whitespace-mode (if buffer-read-only -1 t))) | ||
244 | (defhook before-save-hook #'whitespace-cleanup) | ||
245 | (define-advice whitespace-cleanup (:around (fn &rest r) preserve-point) | ||
246 | (let ((col (current-column))) | ||
247 | (apply fn r) | ||
248 | (move-to-column col t) | ||
249 | (set-buffer-modified-p nil)))) | ||
250 | |||
251 | (yoke elisp-mode | ||
252 | (setc eval-expression-print-length nil ; remove ellipses from `eval-expression' | ||
253 | eval-expression-print-level nil) | ||
254 | (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map) | ||
255 | "C-c C-c" #'eval-defun | ||
256 | "C-c C-k" (defun +elisp-eval-region-or-buffer () | ||
257 | (interactive) | ||
258 | (cond | ||
259 | ((region-active-p) | ||
260 | (eval-region (region-beginning) (region-end)) | ||
261 | (message "Region evaluated.")) | ||
262 | (t | ||
263 | (eval-buffer) | ||
264 | (message "Buffer %s evaluated." (buffer-name))))) | ||
265 | "C-c C-z" #'ielm) | ||
266 | (define-advice eval-region (:around (fn beg end &rest args) pulse) | ||
267 | (apply fn beg end args) | ||
268 | (pulse-momentary-highlight-region beg end))) | ||
269 | |||
270 | (yoke isearch | ||
271 | (defkeys t | ||
272 | "C-s" #'isearch-forward-regexp | ||
273 | "C-r" #'isearch-backward-regexp | ||
274 | "C-M-s" #'isearch-forward | ||
275 | "C-M-r" #'isearch-backward)) | ||
276 | 102 | ||
277 | (yoke ispell | 103 | (use-package orderless |
278 | (require* '+ispell 'ispell) | 104 | :ensure t |
279 | (add-hook 'before-save-hook | 105 | :custom |
280 | #'+ispell-move-buffer-words-to-dir-locals-hook) | 106 | (completion-styles '(orderless basic)) |
281 | (setc ispell-program-name (or (executable-find "ispell") | 107 | (completion-category-overrides |
282 | (executable-find "aspell"))) | 108 | '((file (styles basic partial-completion))))) |
283 | (put 'ispell-buffer-session-localwords | 109 | |
284 | 'safe-local-variable #'+ispell-safe-local-p)) | 110 | (use-package consult |
285 | 111 | :ensure t | |
286 | 112 | :custom | |
287 | (yoke mouse | 113 | (register-preview-delay 0.01) |
288 | ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html | 114 | (register-preview-function #'consult-register-format) |
289 | ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 | 115 | (xref-show-xrefs-function #'consult-xref) |
290 | (when (fboundp 'context-menu-mode) | 116 | (tab-always-indent 'complete) |
291 | (setc context-menu-functions '(context-menu-ffap | 117 | (completion-in-region-function #'consult-completion-in-region) |
292 | context-menu-region | 118 | (consult-narrow-key "<") |
293 | context-menu-undo | 119 | (consult--regexp-compiler #'consult--default-regexp-compiler) |
294 | ;; context-menu-dictionary | 120 | :config |
295 | )) | ||
296 | (context-menu-mode +1)) | ||
297 | (dolist (click '(;; Fix scrolling in the margin | ||
298 | wheel-down double-wheel-down triple-wheel-down | ||
299 | wheel-up double-wheel-up triple-wheel-up)) | ||
300 | (global-set-key (vector 'right-margin click) 'mwheel-scroll) | ||
301 | (global-set-key (vector 'left-margin click) 'mwheel-scroll))) | ||
302 | |||
303 | (yoke dired | ||
304 | (require 'dired-x) | ||
305 | (setc dired-recursive-copies 'always | ||
306 | dired-recursive-deletes 'always | ||
307 | dired-create-destination-dirs 'always | ||
308 | dired-do-revert-buffer t | ||
309 | dired-hide-details-hide-symlink-targets nil | ||
310 | dired-isearch-filenames 'dwim | ||
311 | delete-by-moving-to-trash t | ||
312 | dired-auto-revert-buffer t | ||
313 | dired-listing-switches "-AlF" | ||
314 | ls-lisp-dirs-first t | ||
315 | dired-ls-F-marks-symlinks t | ||
316 | dired-clean-confirm-killing-deleted-buffers nil | ||
317 | dired-no-confirm '(byte-compile | ||
318 | load chgrp chmod chown | ||
319 | copy move hardlink symlink | ||
320 | shell touch) | ||
321 | dired-dwim-target t) | ||
322 | (setq-local-hook dired-mode-hook | ||
323 | truncate-lines t) | ||
324 | (defkeys t | ||
325 | "C-x C-j" #'dired-jump | ||
326 | [remap list-directory] #'dired) | ||
327 | (defkeys ((dired-mode-map :after dired)) | ||
328 | "<backspace>" #'dired-up-directory | ||
329 | "C-j" #'dired-up-directory) | ||
330 | (defhook dired-mode-hook | ||
331 | #'dired-hide-details-mode | ||
332 | #'hl-line-mode)) | ||
333 | |||
334 | (yoke (dired-hacks "https://github.com/Fuco1/dired-hacks") | ||
335 | (defkeys dired-mode-map | ||
336 | "TAB" #'dired-subtree-sycle | ||
337 | "i" #'dired-subtree-toggle) | ||
338 | (defhook 'dired-mode-hook | ||
339 | #'dired-collapse-mode)) | ||
340 | |||
341 | (yoke auth-source | ||
342 | (setc auth-sources `(default "secrets:passwords")) | ||
343 | (setq-local-hook authinfo-mode-hook | ||
344 | truncate-lines t)) | ||
345 | |||
346 | (yoke (consult "https://github.com/minad/consult") | ||
347 | (require 'consult) | ||
348 | (setf register-preview-delay 0 | ||
349 | register-preview-function #'consult-register-format | ||
350 | xref-show-xrefs-function #'consult-xref | ||
351 | tab-always-indent 'complete | ||
352 | completion-in-region-function #'consult-completion-in-region | ||
353 | consult-narrow-key "<" | ||
354 | consult--regexp-compiler #'consult--default-regexp-compiler) | ||
355 | (advice-add #'register-preview :override #'consult-register-window) | 121 | (advice-add #'register-preview :override #'consult-register-window) |
356 | (define-key* (current-global-map) | 122 | (define-advice completing-read-multiple (:filter-args (args) indicator) |
357 | ;; Etc | 123 | (cons (format "[CRM%s] %s" |
358 | "M-S-x" #'consult-mode-command | 124 | (replace-regexp-in-string |
359 | ;; C-c bindings (mode-specific-map) | 125 | "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" |
360 | "C-c h" #'consult-history | 126 | crm-separator) |
361 | "C-c b" #'consult-bookmark | 127 | (car args)) |
362 | "C-c k" #'consult-kmacro | 128 | (cdr args))) |
363 | ;; C-x bindings (ctl-x-map) | 129 | :bind |
364 | "C-x M-:" #'consult-complex-command | 130 | (([remap switch-to-buffer] . consult-buffer) |
365 | "C-x b" #'consult-buffer | 131 | ([remap switch-to-buffer-other-window] . consult-buffer-other-window) |
366 | "C-x 4 b" #'consult-buffer-other-window | 132 | ([remap switch-to-buffer-other-frame] . consult-buffer-other-frame) |
367 | "C-x 5 b" #'consult-buffer-other-frame | 133 | ([remap yank-pop] . consult-yank-pop) |
368 | ;; Custom M-# bindings for fast register access | 134 | ("M-g g" . consult-goto-line) |
369 | "M-#" #'consult-register-load | 135 | ("M-g M-g" . consult-goto-line) |
370 | "M-'" #'consult-register-store | 136 | ("M-g i" . consult-imenu) |
371 | "C-M-#" #'consult-register | 137 | ("M-g M-i" . consult-imenu) |
372 | ;; Other custom bindings | 138 | ("M-s l" . consult-line) |
373 | "M-y" #'consult-yank-pop | 139 | ("M-s f" . consult-find) |
374 | ;;("<f1> a" . consult-apropos) | 140 | ("M-s M-f" . consult-find) |
375 | ;; M-g bindings (goto-map) | 141 | ("M-s g" . consult-grep) |
376 | "M-g e" #'consult-compile-error | 142 | ("M-s M-g" . consult-grep))) |
377 | "M-g f" #'consult-flymake ; or consult-flycheck | 143 | |
378 | "M-g g" #'consult-goto-line | 144 | ;;; General enhancements |
379 | "M-g M-g" #'consult-goto-line | 145 | |
380 | "M-g o" #'consult-outline ; or consult-org-heading | 146 | (use-package embark |
381 | "M-g m" #'consult-mark | 147 | :ensure t |
382 | "M-g k" #'consult-global-mark | 148 | :custom |
383 | "M-g i" #'consult-imenu | 149 | (prefix-help-command #'embark-prefix-help-command) |
384 | "M-g M-i" #'consult-imenu | 150 | :bind |
385 | "M-g I" #'consult-imenu-multi | 151 | (("C-." . embark-act) |
386 | ;; M-s bindings (search-map) | 152 | ("M-." . embark-dwim) |
387 | "M-s f" #'consult-find | 153 | ("C-h b" . embark-bindings)) |
388 | "M-s F" #'consult-locate | 154 | :custom |
389 | "M-s g" #'consult-grep | 155 | (add-to-list 'display-buffer-alist |
390 | "M-s G" #'consult-git-grep | 156 | '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" |
391 | "M-s r" #'consult-ripgrep | 157 | nil |
392 | "M-s l" #'consult-line | 158 | (window-parameters (mode-line-format . none))))) |
393 | "M-s L" #'consult-line-multi | 159 | |
394 | "M-s m" #'consult-multi-occur | 160 | (use-package embark-consult |
395 | "M-s k" #'consult-keep-lines | 161 | :ensure t |
396 | "M-s u" #'consult-focus-lines | 162 | :after (embark consult) |
397 | ;; Isearch integration | 163 | :hook (embark-collect-mode-hook . consult-preview-at-point-mode)) |
398 | "M-s e" #'consult-isearch-history) | 164 | |
399 | (eval-after isearch-mode | 165 | (use-package undo-fu-session |
400 | (define-key* isearch-mode-map | 166 | :ensure t |
401 | "M-e" #'consult-isearch-history | 167 | :custom |
402 | "M-s e" #'consult-isearch-history | 168 | (undo-fu-session-directory (etc/ "undo/" t)) |
403 | "M-s l" #'consult-line | 169 | (undo-fu-session-incompatible-files |
404 | "M-s L" #'consult-line-multi)) | 170 | '("/COMMIT_EDITMSG\\'" |
405 | (eval-after org | 171 | "/git-rebase-todo\\'")) |
406 | (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)) | 172 | (undo-fu-session-compression |
407 | (eval-after consult-imenu | 173 | (cl-loop for (exe . sym) in '(("gzip" . gz) |
408 | (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode | 174 | ("bzip2" . bz2) |
409 | consult-imenu-config) | 175 | ("xz" . xz)) |
410 | :types)) | 176 | if (executable-find exe) |
411 | '("Yoke")))) | 177 | return sym)) |
412 | 178 | :config | |
413 | (yoke (orderless "https://github.com/oantolin/orderless") | 179 | (global-undo-fu-session-mode)) |
414 | (require 'orderless) | ||
415 | (setf completion-styles '(substring orderless basic) | ||
416 | completion-category-defaults nil | ||
417 | completion-category-overrides | ||
418 | '((file (styles basic partial-completion))) | ||
419 | orderless-component-separator #'orderless-escapable-split-on-space)) | ||
420 | |||
421 | (yoke (vertico "https://github.com/minad/vertico") | ||
422 | (require 'vertico) | ||
423 | (setf resize-mini-windows 'grow-only | ||
424 | vertico-count-format nil | ||
425 | vertico-cycle t) | ||
426 | (vertico-mode) | ||
427 | (add-to-list 'load-path (expand-file-name "vertico/extensions" yoke-dir)) | ||
428 | (require 'vertico-directory) | ||
429 | (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) | ||
430 | |||
431 | (yoke (embark "https://github.com/oantolin/embark") | ||
432 | (require 'embark) | ||
433 | (setf prefix-help-command #'embark-prefix-help-command | ||
434 | embar-keymap-prompter-key ";") | ||
435 | (defkeys (t minibuffer-local-map) | ||
436 | "C-." #'embark-act | ||
437 | "M-." #'embark-dwim | ||
438 | "<f1> B" #'embark-bindings) | ||
439 | (define-key* embark-file-map | ||
440 | "l" #'vlf) | ||
441 | (eval-after (embark consult) | ||
442 | (require 'embark-consult) | ||
443 | (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))) | ||
444 | |||
445 | (yoke (marginalia "https://github.com/minad/marginalia/") | ||
446 | (marginalia-mode)) | ||
447 | 180 | ||
448 | (yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep") | 181 | (use-package ws-butler |
449 | (require 'wgrep) | 182 | :ensure t |
450 | (define-key* grep-mode-map | 183 | :custom |
451 | "C-x C-q" #'wgrep-change-to-wgrep-mode)) | 184 | (ws-butler-trim-predicate (lambda (begin end) |
185 | (not (eq 'font-lock-string-face | ||
186 | (get-text-property end 'face))))) | ||
187 | :config | ||
188 | (ws-butler-global-mode)) | ||
189 | |||
190 | (use-package minions | ||
191 | :ensure t | ||
192 | :config | ||
193 | (minions-mode)) | ||
452 | 194 | ||
453 | (yoke (slime "https://github.com/slime/slime") | 195 | (use-package mode-line-bell |
454 | :when (executable-find "sbcl") | 196 | :vc ( :url "https://github.com/duckwork/mode-line-bell" |
455 | (setc inferior-lisp-program (executable-find "sbcl")) | 197 | :rev "remap-face") |
456 | (defhook lisp-mode-hook | 198 | :custom |
457 | :name slime-mode-setup | 199 | (mode-line-bell-flash-time 0.25) |
458 | (load (expand-file-name "~/quicklisp/slime-helper.el") :noerror) | 200 | :config |
459 | (slime-mode)) | 201 | (mode-line-bell-mode)) |
460 | (eval-after slime | 202 | |
461 | (setc slime-completion-at-point-functions | 203 | (use-package electric-cursor |
462 | (delq 'slime-c-p-c-completion-at-point | 204 | :load-path "~/src/emacs/electric-cursor/" |
463 | slime-completion-at-point-functions)))) | 205 | :custom |
464 | 206 | (electric-cursor-alist '((overwrite-mode . box) | |
465 | (yoke (puni "https://github.com/amaikinono/puni") | 207 | (t . bar))) |
466 | (electric-pair-mode) | 208 | (electric-cursor-mode)) |
467 | (defkeys puni-mode-map | ||
468 | "C-)" #'puni-slurp-forward | ||
469 | "C-(" #'puni-slurp-backward | ||
470 | "C-}" #'puni-barf-forward | ||
471 | "C-{" #'puni-barf-backward | ||
472 | "M-(" (defun +puni-open-then-slurp-forward (&optional n) | ||
473 | (interactive "p") | ||
474 | (insert "()") | ||
475 | (backward-char) | ||
476 | (ignore-errors (puni-slurp-forward n)))) | ||
477 | (defhook (prog-mode-hook | ||
478 | lisp-interaction-mode-hook emacs-lisp-mode-hook | ||
479 | lisp-mode-hook scheme-mode-hook | ||
480 | ielm-mode-hook eval-expression-minibuffer-setup-hook) | ||
481 | #'puni-mode)) | ||
482 | |||
483 | (yoke (hungry-delete "https://github.com/nflath/hungry-delete") | ||
484 | (setc hungry-delete-chars-to-skip " \t" | ||
485 | hungry-delete-join-reluctantly nil) | ||
486 | (eval-after hungry-delete | ||
487 | (add-to-list* 'hungry-delete-except-modes | ||
488 | #'eshell-mode | ||
489 | #'nim-mode | ||
490 | #'python-mode)) | ||
491 | (defun +hungry-delete-or (hd-fn fn arg) | ||
492 | (funcall (if (looking-back (format "[%s]" hungry-delete-chars-to-skip) arg) | ||
493 | hd-fn | ||
494 | fn) | ||
495 | arg)) | ||
496 | (defkeys puni-mode-map | ||
497 | [remap puni-backward-delete-char] | ||
498 | (defun +puni|hungry-delete-backward (arg) | ||
499 | (interactive "p") | ||
500 | (+hungry-delete-or #'hungry-delete-backward | ||
501 | #'puni-backward-delete-char | ||
502 | arg)) | ||
503 | [remap puni-forward-delete-char] | ||
504 | (defun +puni|hungry-delete-forward (arg) | ||
505 | (interactive "p") | ||
506 | (+hungry-delete-or #'hungry-delete-forward | ||
507 | #'puni-forward-delete-char | ||
508 | arg))) | ||
509 | (global-hungry-delete-mode)) | ||
510 | 209 | ||
511 | (yoke (cape "https://github.com/minad/cape") | 210 | (use-package visual-fill-column |
512 | ;; Insinuate in a lot of modes | 211 | :ensure t |
513 | (defvar +capes '(cape-file cape-dabbrev)) | 212 | :custom |
514 | (defun +cape-insinuate (hook capf &optional capes) | 213 | (visual-fill-column-center-text t) |
515 | "Insinuate CAPES into a HOOK along with CAPF function. | 214 | :hook ((visual-fill-column-mode-hook . visual-line-mode) |
516 | CAPES defaults to `+capes'. CAPF will be made un-exclusive." | 215 | (eww-mode-hook . visual-fill-column-mode)) |
517 | (setq-local-hook hook | 216 | :config |
518 | completion-at-point-functions | 217 | (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) |
519 | (apply #'list (cape-capf-properties capf :exclusive 'no) | ||
520 | (or capes +capes)))) | ||
521 | (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point)) | ||
522 | |||
523 | (yoke (minions "https://github.com/tarsius/minions") | ||
524 | (minions-mode)) | ||
525 | 218 | ||
526 | (yoke (magit "https://github.com/magit/magit" | 219 | (use-package cape |
527 | :load "lisp") | 220 | :ensure t |
528 | :depends ((transient "https://github.com/magit/transient" | 221 | :demand t |
529 | :load "lisp") | 222 | :init |
530 | (dash "https://github.com/magnars/dash.el") | 223 | (dolist (fn '(cape-file cape-dabbrev)) |
531 | (with-editor "https://github.com/magit/with-editor" | 224 | (add-hook 'completion-at-point-functions fn 90)) |
532 | :load "lisp")) | 225 | :config |
533 | (autoload #'transient--with-suspended-override "transient") | 226 | (require '+cape) |
534 | (autoload #'magit "magit" nil :interactive) | 227 | (advice-add 'emacs-completion-at-point :around #'cape-wrap-nonexclusive) |
535 | (defkeys t | 228 | (+cape-insinuate text-mode-hook ( cape-dict cape-ispell |
536 | "C-x g" #'magit)) | 229 | cape-file cape-dabbrev))) |
230 | |||
231 | (use-package wgrep | ||
232 | :ensure t | ||
233 | :custom | ||
234 | (wgrep-enable-key (kbd "C-x C-q")) | ||
235 | :bind (:map grep-mode-map | ||
236 | ("C-x C-q" . wgrep-change-to-wgrep-mode))) | ||
237 | |||
238 | (progn | ||
239 | (use-package-statistics-gather :use-package 'mlscroll nil) | ||
240 | (use-package-ensure-elpa 'mlscroll | ||
241 | '(t) | ||
242 | 'nil) | ||
243 | (use-package-statistics-gather :preface 'mlscroll nil) | ||
244 | (eval-and-compile | ||
245 | (defhook modus-themes-after-load-theme-hook :name modus-themes-load@mlscroll | ||
246 | (mlscroll-mode -1) | ||
247 | (when | ||
248 | (or | ||
249 | (memq 'modus-vivendi custom-enabled-themes) | ||
250 | (memq 'modus-operandi custom-enabled-themes)) | ||
251 | (modus-themes-with-colors | ||
252 | (setf mlscroll-in-color fg-dim mlscroll-out-color bg-inactive))) | ||
253 | (eval-after 1 | ||
254 | (mlscroll-mode 1)))) | ||
255 | (defvar use-package--warning99 | ||
256 | (function | ||
257 | (lambda | ||
258 | (keyword err) | ||
259 | (let | ||
260 | ((msg | ||
261 | (format "%s/%s: %s" 'mlscroll keyword | ||
262 | (error-message-string err)))) | ||
263 | (display-warning 'use-package msg :error))))) | ||
264 | (condition-case-unless-debug err | ||
265 | (progn | ||
266 | (use-package-statistics-gather :init 'mlscroll nil) | ||
267 | (condition-case-unless-debug err | ||
268 | (when | ||
269 | (daemonp) | ||
270 | (add-hook 'server-after-make-frame | ||
271 | (function modus-themes-load@ml-scroll))) | ||
272 | (error | ||
273 | (funcall use-package--warning99 :init err))) | ||
274 | (run-with-idle-timer 1 nil | ||
275 | (function require) | ||
276 | 'mlscroll nil t) | ||
277 | (eval-after-load 'mlscroll | ||
278 | '(progn | ||
279 | (use-package-statistics-gather :config 'mlscroll nil) | ||
280 | (let | ||
281 | ((now | ||
282 | (current-time))) | ||
283 | (message "%s..." "Configuring package mlscroll") | ||
284 | (prog1 | ||
285 | (condition-case-unless-debug err | ||
286 | (progn | ||
287 | (modus-themes-load@mlscroll) | ||
288 | t) | ||
289 | (error | ||
290 | (funcall use-package--warning99 :config err))) | ||
291 | (let | ||
292 | ((elapsed | ||
293 | (float-time | ||
294 | (time-subtract | ||
295 | (current-time) | ||
296 | now)))) | ||
297 | (if | ||
298 | (> elapsed 0.1) | ||
299 | (message "%s...done (%.3fs)" "Configuring package mlscroll" elapsed) | ||
300 | (message "%s...done" "Configuring package mlscroll"))))) | ||
301 | (use-package-statistics-gather :config 'mlscroll t))) | ||
302 | (use-package-statistics-gather :init 'mlscroll t)) | ||
303 | (error | ||
304 | (funcall use-package--warning99 :catch err))) | ||
305 | (use-package-statistics-gather :preface 'mlscroll t) | ||
306 | (use-package-statistics-gather :use-package 'mlscroll t)) | ||
307 | |||
308 | (use-package avy | ||
309 | :ensure t | ||
310 | :demand t | ||
311 | :custom | ||
312 | (avy-background t) | ||
313 | (avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) | ||
314 | :bind (("M-j" . avy-goto-char-timer) | ||
315 | :map isearch-mode-map | ||
316 | ("M-j" . avy-isearch))) | ||
317 | |||
318 | (use-package zzz-to-char | ||
319 | :ensure t | ||
320 | :bind (("M-z" . zzz-to-char))) | ||
321 | |||
322 | ;;; Searching | ||
323 | |||
324 | (use-package isearch-mb | ||
325 | :ensure t | ||
326 | :custom | ||
327 | (isearch-lazy-count t) | ||
328 | (isearch-regexp-lax-whitespace t) | ||
329 | ;; Space matches whitespace, newlines, punctuation | ||
330 | (search-whitespace-regexp "\\W+") | ||
331 | (search-default-mode t "Search using regexp by default.") | ||
332 | ;; Space matches any sequence of characters in a line | ||
333 | ;; search-whitespace-regexp ".*?" | ||
334 | (isearch-wrap-pause 'no) | ||
335 | :config | ||
336 | (require '+isearch) | ||
337 | (advice-add 'isearch-cancel :before | ||
338 | #'+isearch-cancel@add-search-to-history) | ||
339 | (advice-add 'perform-replace :around | ||
340 | #'+perform-replace-dont-exit-on-anykey) | ||
341 | (eval-after (isearch-mb consult) | ||
342 | (add-to-list 'isearch-mb--after-exit #'consult-line) | ||
343 | (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history) | ||
344 | (defkeys isearch-mb-minibuffer-map | ||
345 | "M-s l" #'consult-line | ||
346 | "M-r" #'consult-isearch-history)) | ||
347 | (eval-after (isearch-mb anzu) | ||
348 | (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace) | ||
349 | (defkeys isearch-mb-minibuffer-map | ||
350 | "M-%" #'anzu-isearch-query-replace-regexp | ||
351 | "C-M-%" #'anzu-isearch-query-replace)) | ||
352 | (isearch-mb-mode)) | ||
537 | 353 | ||
538 | (yoke (git-modes "https://github.com/magit/git-modes") | 354 | (use-package anzu |
539 | (require 'git-modes)) | 355 | :ensure t |
356 | :bind | ||
357 | (("M-%" . anzu-query-replace-regexp) | ||
358 | ("C-M-%" . anzu-query-replace))) | ||
540 | 359 | ||
541 | (yoke (visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column") | 360 | (use-package frowny |
542 | (setc visual-fill-column-center-text t) | 361 | :load-path "~/src/emacs/frowny/" |
543 | (add-hook 'visual-fill-column-mode-hook #'visual-line-mode) | 362 | :config |
544 | (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) | 363 | (global-frowny-mode)) |
545 | 364 | ||
546 | (yoke (org "https://git.savannah.gnu.org/git/emacs/org-mode.git" | 365 | (use-package transpose-frame |
547 | :load "lisp") | 366 | :ensure t |
548 | :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib" | 367 | :bind |
549 | :load "lisp")) | 368 | (("C-x 5 t" . transpose-frame))) |
550 | ;; DON'T load system org | 369 | |
551 | (setc load-path | 370 | ;;; Text editing |
552 | (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) | 371 | |
553 | load-path)) | 372 | (use-package org |
554 | (setc org-adapt-indentation nil | 373 | :defer t |
555 | org-auto-align-tags t | 374 | :after derived |
556 | org-archive-mark-done t | 375 | :init |
557 | org-fold-catch-invisible-edits 'show-and-error | 376 | (require 'init-org) |
558 | org-clock-clocked-in-display 'mode-line | 377 | (require '_work)) |
559 | org-clock-frame-title-format (cons | 378 | |
560 | '(t org-mode-line-string) | 379 | (use-package ispell |
561 | (cons " --- " frame-title-format)) | 380 | :custom |
562 | org-clock-string-limit 7 ; just the clock bit | 381 | (ispell-program-name (choose-executable "ispell" "aspell")) |
563 | ;; org-clock-string-limit 25 ; gives enough information | 382 | :config |
564 | org-clock-persist nil | 383 | (require '+ispell) |
565 | org-confirm-babel-evaluate nil | 384 | (add-hook 'before-save-hook |
566 | org-cycle-separator-lines 0 | 385 | #'+ispell-move-buffer-words-to-dir-locals-hook) |
567 | org-directory (sync/ "org/" t) | 386 | (put 'ispell-buffer-session-localwords 'safe-local-variable |
568 | org-ellipsis (or truncate-string-ellipsis "…") | 387 | #'+ispell-safe-local-p)) |
569 | org-fontify-done-headline t | 388 | |
570 | org-fontify-quote-and-verse-blocks t | 389 | (use-package flyspell |
571 | org-fontify-whole-heading-line t | 390 | :hook org-mode-hook) |
572 | org-hide-emphasis-markers t | 391 | |
573 | org-html-coding-system 'utf-8-unix | 392 | (use-package flyspell-correct |
574 | org-image-actual-width (list (* (window-font-width) | 393 | :ensure t |
575 | (- fill-column 8))) | 394 | :after flyspell |
576 | org-imenu-depth 3 | 395 | :custom |
577 | org-indent-indentation-per-level 0 | 396 | (flyspell-correct--cr-key ";") |
578 | org-indent-mode-turns-on-hiding-stars nil | 397 | :bind |
579 | org-insert-heading-respect-content t | 398 | (:map flyspell-mode-map |
580 | org-list-demote-modify-bullet '(("-" . "+") | 399 | (("C-;" . flyspell-correct-wrapper) |
581 | ("+" . "-")) | 400 | ("<f7>" . +flyspell-correct-buffer))) |
582 | org-log-done 'time | 401 | :config |
583 | org-log-into-drawer t | 402 | (require '+flyspell-correct) |
584 | org-num-skip-commented t | 403 | (defkeys flyspell-mode-map |
585 | org-num-skip-unnumbered t | 404 | "C-," nil |
586 | org-num-skip-footnotes t | 405 | "C-." nil)) |
587 | org-outline-path-complete-in-steps nil | 406 | |
588 | org-pretty-entities t | 407 | (use-package text-mode |
589 | org-pretty-entities-include-sub-superscripts nil | 408 | :config |
590 | org-refile-targets '((nil . (:maxlevel . 2)) | 409 | (defhook text-mode-hook |
591 | (org-agenda-files . (:maxlevel . 1))) | 410 | #'abbrev-mode)) |
592 | org-refile-use-outline-path 'file | 411 | |
593 | org-special-ctrl-a/e t | 412 | (use-package filldent |
594 | org-special-ctrl-k t | 413 | :load-path "~/src/emacs/filldent/" |
595 | org-src-fontify-natively t | 414 | :bind |
596 | org-src-tab-acts-natively t | 415 | ("M-q" . filldent-dwim)) |
597 | org-src-window-setup 'current-window | 416 | |
598 | org-startup-truncated nil | 417 | (use-package scule |
599 | org-startup-with-inline-images t | 418 | :load-path "~/src/emacs/scule/" |
600 | org-tags-column -77 ;; (- (- fill-column 1 (length org-ellipsis))) | 419 | :config |
601 | org-todo-keywords | ||
602 | '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" | ||
603 | "|" "DONE(d!)" "ASSIGNED(a@/!)") | ||
604 | (sequence "|" "CANCELED(k@)") | ||
605 | (sequence "MEETING(m)")) | ||
606 | org-use-speed-commands t | ||
607 | org-emphasis-alist '(("*" org-bold) | ||
608 | ("/" org-italic) | ||
609 | ("_" org-underline) | ||
610 | ("=" org-verbatim) | ||
611 | ("~" org-code) | ||
612 | ("+" org-strikethrough))) | ||
613 | (defhook org-mode-hook | ||
614 | #'variable-pitch-mode | ||
615 | #'visual-fill-column-mode | ||
616 | #'turn-off-auto-fill | ||
617 | #'org-indent-mode | ||
618 | #'prettify-symbols-mode | ||
619 | #'abbrev-mode | ||
620 | (defhook ((before-save-hook nil :local)) | ||
621 | :name before-save@org-mode | ||
622 | (+org-hide-drawers-except-point) | ||
623 | (org-align-tags 'all))) | ||
624 | (eval-after org | ||
625 | (require '+org) | ||
626 | (org-clock-persistence-insinuate) | ||
627 | (+org-agenda-inhibit-hooks-mode) | ||
628 | (defkeys org-mode-map | ||
629 | "C-M-k" #'kill-paragraph | ||
630 | "C-M-t" #'transpose-paragraphs | ||
631 | "RET" #'+org-return-dwim | ||
632 | "S-<return>" #'+org-table-copy-down|+org-return | ||
633 | "C-c C-o" #'+org-open-at-point-dwim)) | ||
634 | (eval-after ol ; org-link | ||
635 | (defmacro define-org-link-type (type args &rest body) | ||
636 | "Define an org link TYPE with ARGS that does something. | ||
637 | If BODY is blank, message the user about the link." | ||
638 | (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) | ||
639 | (let ((fn (intern (format "org-%s-open" type))) | ||
640 | (body (or body `((message ,(format "%s: %%S" type) ,(car args))))) | ||
641 | (type-string (format "%s" type))) | ||
642 | `(prog1 | ||
643 | (defun ,fn ,args | ||
644 | ,@body) | ||
645 | (org-link-set-parameters ,type-string :follow #',fn)))) | ||
646 | (define-org-link-type sms (number _)) | ||
647 | (define-org-link-type tel (number _)))) | ||
648 | |||
649 | (yoke org-word-count ; in lisp/ | ||
650 | (eval-after org | ||
651 | (require 'org-word-count) | ||
652 | (add-hook 'org-mode-hook #'org-word-count-mode))) | ||
653 | |||
654 | (yoke org-agenda | ||
655 | (setq org-agenda-skip-deadline-if-done t | ||
656 | org-agenda-skip-scheduled-if-done t | ||
657 | org-agenda-span 10 | ||
658 | org-agenda-block-separator ?─ | ||
659 | org-agenda-time-grid | ||
660 | '((daily today require-timed) | ||
661 | (800 1000 1200 1400 1600 1800 2000) | ||
662 | " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") | ||
663 | org-agenda-current-time-string | ||
664 | "← now ─────────────────────────────────────────────────" | ||
665 | org-agenda-include-diary nil ; I use the org-diary features | ||
666 | org-agenda-todo-ignore-deadlines 'near | ||
667 | org-agenda-todo-ignore-scheduled 'future | ||
668 | org-agenda-include-deadlines t | ||
669 | org-deadline-warning-days 0 | ||
670 | org-agenda-show-future-repeats 'next | ||
671 | org-agenda-window-setup 'current-window | ||
672 | org-agenda-file-skip-regexp "sync-conflict") | ||
673 | (defcustom org-agenda-file-skip-regexp nil | ||
674 | "Files matching this regexp are removed from `org-agenda-files'." | ||
675 | :group 'org-agenda) | ||
676 | (define-advice org-agenda-files (:filter-return (files) skip-regexp) | ||
677 | (when org-agenda-file-skip-regexp | ||
678 | (setq files (seq-remove (lambda (file) | ||
679 | (string-match-p org-agenda-file-skip-regexp | ||
680 | file)) | ||
681 | files))) | ||
682 | files) | ||
683 | (setq-local-hook org-agenda-mode-hook | ||
684 | truncate-lines t) | ||
685 | (add-hook 'org-agenda-mode-hook #'hl-line-mode) | ||
686 | (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) | ||
687 | (defkeys t | 420 | (defkeys t |
688 | "C-c c" #'org-capture | 421 | "M-c" (defmap scule-map |
689 | "C-c a" #'org-agenda) | 422 | "Keymap for twiddling scules." |
690 | (eval-after org-capture | 423 | "M-u" #'scule-upcase |
691 | (require '+org-capture))) | 424 | "M-l" #'scule-downcase |
692 | 425 | "M-c" #'scule-capitalize))) | |
693 | (yoke ox ; org-export | 426 | |
694 | (eval-after org (require 'ox)) | 427 | (use-package titlecase |
695 | (eval-after ox | 428 | :load-path "~/src/emacs/titlecase.el/" |
696 | (require* '+ox '(ox-md nil t)) | 429 | :after org |
697 | (+org-export-pre-hooks-insinuate)) | 430 | :bind (:map scule-map |
698 | (setq org-export-coding-system 'utf-8-unix | 431 | ("M-t" . titlecase-dwim)) |
699 | org-export-headline-levels 8 | 432 | :config |
700 | org-export-with-drawers nil | 433 | (require '+titlecase)) |
701 | org-export-with-section-numbers nil | 434 | |
702 | org-export-with-smart-quotes t | 435 | ;;; Programming |
703 | org-export-with-sub-superscripts t | 436 | |
704 | org-export-with-toc nil)) | 437 | (use-package prog-mode |
705 | 438 | :config | |
706 | (yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el") | 439 | (defhook prog-mode-hook |
707 | (setq electric-cursor-alist '((overwrite-mode . hbar) | 440 | #'auto-fill-mode |
708 | (t . bar))) | 441 | ;; Use `indent-tabs-mode' unless one of the following modes |
709 | (electric-cursor-mode)) | 442 | (indent-tabs-mode (if (derived-mode-p 'emacs-lisp-mode |
443 | 'python-mode | ||
444 | 'haskell-mode) | ||
445 | -1 1)))) | ||
446 | |||
447 | (use-package paredit | ||
448 | :ensure t | ||
449 | :preface | ||
450 | (defun +paredit-newline () | ||
451 | (interactive) | ||
452 | (call-interactively | ||
453 | (if (derived-mode-p 'lisp-interaction-mode) | ||
454 | #'eval-print-last-sexp | ||
455 | #'paredit-newline))) | ||
456 | :hook ((emacs-lisp-mode-hook | ||
457 | eval-expression-minibuffer-setup-hook | ||
458 | ielm-mode-hook lisp-interaction-mode-hook | ||
459 | lisp-mode-hook scheme-mode-hook | ||
460 | fennel-repl-mode-hook fennel-mode-hook | ||
461 | geiser-mode-hook geiser-repl-mode-hook | ||
462 | ielm-mode-hook) | ||
463 | . enable-paredit-mode) | ||
464 | :bind | ||
465 | (("C-j" . +paredit-newline)) | ||
466 | :config | ||
467 | (defkeys paredit-mode-map | ||
468 | "RET" nil | ||
469 | "M-s" nil) | ||
470 | (require '+paredit) | ||
471 | (add-to-list 'paredit-space-for-delimiter-predicates | ||
472 | #'+paredit-space-for-delimiter) | ||
473 | (eval-after (paredit eldoc) | ||
474 | (eldoc-add-command #'paredit-backward-delete #'paredit-close-round))) | ||
475 | |||
476 | (use-package hungry-delete | ||
477 | :ensure t | ||
478 | :custom | ||
479 | (hungry-delete-chars-to-skip " \t") | ||
480 | (hungry-delete-join-reluctantly nil) | ||
481 | :config | ||
482 | (dolist (m '(eshell-mode | ||
483 | nim-mode | ||
484 | python-mode)) | ||
485 | (add-to-list 'hungry-delete-except-modes m)) | ||
486 | (require '+hungry-delete) | ||
487 | (eval-after paredit | ||
488 | (defkeys paredit-mode-map | ||
489 | [remap paredit-backward-delete] | ||
490 | (+hungry-delete-define-alternative | ||
491 | paredit-backward-delete hungry-delete-backward) | ||
492 | [remap paredit-forward-delete] | ||
493 | (+hungry-delete-define-alternative | ||
494 | paredit-forward-delete hungry-delete-forward))) | ||
495 | (global-hungry-delete-mode)) | ||
710 | 496 | ||
711 | (yoke _work | 497 | (use-package ediff |
712 | :depends ((bbdb "https://git.savannah.nongnu.org/git/bbdb.git" | 498 | :custom |
713 | :load "lisp") | 499 | (ediff-keep-variants nil) |
714 | (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) | 500 | (ediff-split-window-function #'split-window-horizontally) |
715 | (setf bbdb-complete-mail-allow-cycling t | 501 | (ediff-window-setup-function #'ediff-setup-windows-plain)) |
716 | bbdb-file (private/ "bbdb")) | ||
717 | (defhook +custom-after-load-hook | ||
718 | :name _work@after-custom | ||
719 | (require* 'private '_work) | ||
720 | (require* 'bbdb 'bbdb-message) | ||
721 | (bbdb-initialize 'gnus 'message))) | ||
722 | |||
723 | (yoke (org-taskwise "https://codeberg.org/acdw/org-taskwise.el")) | ||
724 | |||
725 | (yoke scule | ||
726 | (require 'scule) | ||
727 | (defvar scule-map (let ((map (make-sparse-keymap))) | ||
728 | (define-key map (kbd "M-u") #'scule-upcase) | ||
729 | (define-key map (kbd "M-l") #'scule-downcase) | ||
730 | (define-key map (kbd "M-c") #'scule-capitalize) | ||
731 | map) | ||
732 | "Keymap for scule twiddling.") | ||
733 | (define-key* (current-global-map) | ||
734 | "M-c" scule-map | ||
735 | "M-u" #'universal-argument) | ||
736 | (define-key universal-argument-map (kbd "M-u") #'universal-argument-more)) | ||
737 | |||
738 | (yoke (titlecase "https://codeberg.org/acdw/titlecase.el") | ||
739 | (eval-after titlecase | ||
740 | (add-to-list* 'titlecase-skip-words-regexps | ||
741 | (rx word-boundary | ||
742 | (+ (any upper digit)) | ||
743 | word-boundary))) | ||
744 | (eval-after scule | ||
745 | (define-key* scule-map | ||
746 | "M-t" #'titlecase-dwim))) | ||
747 | |||
748 | (yoke (flyspell-correct "https://github.com/duckwork/flyspell-correct") | ||
749 | (eval-after flyspell | ||
750 | (require* 'flyspell-correct | ||
751 | `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct"))) | ||
752 | (define-key* flyspell-mode-map | ||
753 | "C-;" #'flyspell-correct-wrapper | ||
754 | "<f7>" #'+flyspell-correct-buffer | ||
755 | "C-," nil | ||
756 | "C-." nil)) | ||
757 | (add-hook 'org-mode-hook #'flyspell-mode) | ||
758 | (setq flyspell-correct--cr-key ";")) | ||
759 | |||
760 | (yoke (helpful "https://github.com/Wilfred/helpful") | ||
761 | :depends ((dash "https://github.com/magnars/dash.el") | ||
762 | (f "https://github.com/rejeep/f.el") | ||
763 | (s "https://github.com/magnars/s.el") | ||
764 | (elisp-refs "https://github.com/Wilfred/elisp-refs")) | ||
765 | (defkeys t | ||
766 | "<f1> f" #'helpful-callable | ||
767 | "<f1> v" #'helpful-variable | ||
768 | "<f1> k" #'helpful-key | ||
769 | "<f1> ." #'helpful-at-point | ||
770 | "<f1> o" #'helpful-symbol) | ||
771 | (unless (featurep 'info-look) | ||
772 | (run-with-idle-timer 5 nil (lambda () | ||
773 | (require 'info-look) | ||
774 | (let ((inhibit-message t)) | ||
775 | (info-lookup-setup-mode 'symbol | ||
776 | 'emacs-lisp-mode))))) | ||
777 | (defhook window-configuration-change-hook | ||
778 | :name side-window-setup | ||
779 | (setf fit-window-to-buffer-horizontally t | ||
780 | (alist-get (rx (or "*helpful" "*Help" "*info")) | ||
781 | display-buffer-alist nil nil #'string=) | ||
782 | `(display-buffer-in-side-window | ||
783 | ,@(if (< (frame-text-width) (frame-text-height)) | ||
784 | '((side . bottom) (window-height . 24)) | ||
785 | '((side . right) (window-width . fit-window-to-buffer))))))) | ||
786 | |||
787 | (yoke (hippie-completing-read | ||
788 | "https://codeberg.org/acdw/hippie-completing-read.el") | ||
789 | (define-key* (current-global-map) | ||
790 | "M-/" #'hippie-completing-read)) | ||
791 | |||
792 | (yoke dictionary ; Comes with Emacs 29! | ||
793 | (defkeys (t (org-mode-map :after org)) | ||
794 | "C-c d" #'dictionary-search) | ||
795 | (defkeys ((embark-identifier-map :after embark)) | ||
796 | "@" #'dictionary-search) | ||
797 | (setc dictionary-server (if (or (executable-find "dictd") | ||
798 | (file-exists-p "/usr/sbin/dictd")) ; oh debian | ||
799 | "localhost" | ||
800 | "dict.org")) | ||
801 | (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=) | ||
802 | '((display-buffer-in-side-window) | ||
803 | (side . bottom) | ||
804 | (window-height . 20)))) | ||
805 | |||
806 | (yoke (anzu "https://github.com/emacsorphanage/anzu") | ||
807 | (require 'anzu) | ||
808 | (global-anzu-mode) | ||
809 | (defkeys t | ||
810 | [remap query-replace] #'anzu-query-replace-regexp | ||
811 | [remap query-replace-regexp] #'anzu-query-replace) | ||
812 | (defkeys (isearch-mode-map (isearch-mb-minibuffer-map :after isearch-mb)) | ||
813 | [remap isearch-query-replace] #'anzu-isearch-query-replace-regexp | ||
814 | [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace) | ||
815 | (defun anzu-qr@window (fn &rest r) | ||
816 | "ADVICE to query-replace from the beginning of the window." | ||
817 | (let ((scroll-margin 0)) | ||
818 | (cond ((region-active-p) | ||
819 | (apply fn r)) | ||
820 | (:else (save-excursion | ||
821 | (goto-char (window-start)) | ||
822 | (apply fn r)))))) | ||
823 | (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window) | ||
824 | (advice-add 'anzu-query-replace :around #'anzu-qr@window)) | ||
825 | |||
826 | (yoke tempo | ||
827 | (require '+tempo)) | ||
828 | |||
829 | (yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0") | ||
830 | (setf 0x0-default-server 'ttm) | ||
831 | (define-advice 0x0-shorten-uri (:around (fn server uri) use-0x0) | ||
832 | (interactive (list (cdr (assq 'envs 0x0-servers)) | ||
833 | (read-string "URI: "))) | ||
834 | (funcall fn server uri)) | ||
835 | (eval-after embark | ||
836 | (define-key* embark-region-map | ||
837 | "U" #'0x0-dwim))) | ||
838 | |||
839 | (yoke (filldent "https://codeberg.org/acdw/filldent.el") | ||
840 | (define-advice canonically-space-region (:around (orig &rest r) double-space) | ||
841 | (let ((sentence-end-double-space t)) | ||
842 | (apply orig r))) | ||
843 | (defkeys t | ||
844 | "M-q" #'filldent-unfill-toggle)) | ||
845 | |||
846 | (yoke (avy "https://github.com/abo-abo/avy") | ||
847 | (require 'avy) | ||
848 | (setf avy-background t | ||
849 | (alist-get ?. avy-dispatch-alist) | ||
850 | (defun avy-action-embark (pt) | ||
851 | (unwind-protect | ||
852 | (save-excursion | ||
853 | (goto-char pt) | ||
854 | (embark-act)) | ||
855 | (select-window | ||
856 | (cdr (ring-ref avy-ring 0)))) | ||
857 | t)) | ||
858 | (define-key* (current-global-map) | ||
859 | "M-j" #'avy-goto-char-timer) | ||
860 | (define-key* isearch-mode-map | ||
861 | "M-j" #'avy-isearch)) | ||
862 | |||
863 | (yoke (frowny "https://codeberg.org/acdw/frowny.el") | ||
864 | (setf frowny-eyes (rx (any ":=") (opt "'") (? "-"))) | ||
865 | (global-frowny-mode)) | ||
866 | 502 | ||
867 | (yoke (isearch-mb "https://github.com/astoff/isearch-mb") | 503 | ;;; Lisps |
868 | (eval-after (consult anzu) | ||
869 | (require 'isearch-mb) | ||
870 | (dolist (spec '((isearch-mb--with-buffer | ||
871 | ("M-e" . consult-isearch) | ||
872 | ("C-o" . loccur-isearch)) | ||
873 | (isearch-mb--after-exit | ||
874 | ("M-%" . anzu-isearch-query-replace) | ||
875 | ("M-s l" . consult-line)))) | ||
876 | (let ((isearch-mb-list (car spec)) | ||
877 | (isearch-mb-binds (cdr spec))) | ||
878 | (dolist (cell isearch-mb-binds) | ||
879 | (let ((key (car cell)) | ||
880 | (command (cdr cell))) | ||
881 | (when (fboundp command) | ||
882 | (add-to-list isearch-mb-list command) | ||
883 | (define-key isearch-mb-minibuffer-map (kbd key) command))))))) | ||
884 | (isearch-mb-mode)) | ||
885 | 504 | ||
886 | (yoke (keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el") | 505 | (use-package elisp-mode |
506 | :custom | ||
507 | (eval-expression-print-length nil) | ||
508 | (eval-expression-print-level nil) | ||
509 | :preface | ||
510 | (defun elisp-eval-region|eval-buffer () | ||
511 | (interactive) | ||
512 | (if (region-active-p) | ||
513 | (let ((start (region-beginning)) | ||
514 | (end (region-end))) | ||
515 | (eval-region start end) | ||
516 | (message "Region from %s to %s evaluated." | ||
517 | start end)) | ||
518 | (eval-buffer) | ||
519 | (message "Buffer `%s' evaluated." (buffer-name)))) | ||
520 | (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map) | ||
521 | "C-c C-c" #'eval-defun | ||
522 | "C-c C-k" #'elisp-eval-region|eval-buffer | ||
523 | "C-c C-z" #'ielm) | ||
524 | :config | ||
525 | (define-advice eval-region (:around (orig start end &rest args) pulse) | ||
526 | (apply orig start end args) | ||
527 | (pulse-momentary-highlight-region start end)) | ||
528 | (defhook emacs-lisp-mode-hook | ||
529 | (setq-local page-delimiter "^\\(\\|;;;+\\).*"))) | ||
530 | |||
531 | (use-package macrostep | ||
532 | :ensure t | ||
533 | :after elisp-mode | ||
534 | :bind ( :map emacs-lisp-mode-map | ||
535 | ("C-c e" . macrostep-expand) | ||
536 | :map lisp-interaction-mode-map | ||
537 | ("C-c e" . macrostep-expand))) | ||
538 | |||
539 | (use-package eros | ||
540 | :ensure t | ||
541 | :after elisp-mode | ||
542 | :custom (eros-eval-result-prefix "; ") | ||
543 | :hook emacs-lisp-mode-hook) | ||
544 | |||
545 | (use-package package-lint | ||
546 | :ensure t) | ||
547 | |||
548 | (use-package sly | ||
549 | :ensure t | ||
550 | :when (executable-find "sbcl") | ||
551 | :custom | ||
552 | (inferior-lisp-program (executable-find "sbcl")) | ||
553 | (sly-net-coding-system 'utf-8-unix) | ||
554 | :bind (:map sly-mode-map | ||
555 | (("C-c C-z" . sly-mrepl))) | ||
556 | :config | ||
557 | (sly-symbol-completion-mode -1)) | ||
558 | |||
559 | (use-package edebug | ||
560 | :preface | ||
561 | (defun turn-off-eldoc-mode () | ||
562 | (eldoc-mode -1)) | ||
563 | :config | ||
564 | (add-hook 'edebug-mode-hook #'turn-off-eldoc-mode)) | ||
565 | |||
566 | ;;; Web languages | ||
567 | |||
568 | (use-package web-mode | ||
569 | :ensure t | ||
570 | :mode ("\\.phtml\\'" | ||
571 | "\\.tpl\\.php\\'" | ||
572 | "\\.[agj]sp\\'" | ||
573 | "\\.as[cp]x\\'" | ||
574 | "\\.erb\\'" | ||
575 | "\\.mustache\\'" | ||
576 | "\\.djhtml\\'" | ||
577 | "\\.html?\\'")) | ||
578 | |||
579 | ;;; Applications | ||
580 | |||
581 | (use-package dired | ||
582 | :init (require 'dired-x) | ||
583 | :custom | ||
584 | (dired-recursive-copies 'always) | ||
585 | (dired-recursive-deletes 'always) | ||
586 | (dired-create-destination-dirs 'always) | ||
587 | (dired-do-revert-buffer t) | ||
588 | (dired-hide-details-hide-symlink-targets nil) | ||
589 | (dired-isearch-filenames 'dwim) | ||
590 | (delete-by-moving-to-trash t) | ||
591 | (dired-auto-revert-buffer t) | ||
592 | (dired-listing-switches "-AlF") | ||
593 | (ls-lisp-dirs-first t) | ||
594 | (dired-ls-F-marks-symlinks t) | ||
595 | (dired-clean-confirm-killing-deleted-buffers nil) | ||
596 | (dired-no-confirm '(byte-compile | ||
597 | load chgrp chmod chown | ||
598 | copy move hardlink symlink | ||
599 | shell touch)) | ||
600 | (dired-dwim-target t) | ||
601 | :bind | ||
602 | (("C-x C-j" . dired-jump) | ||
603 | ([remap list-directory] . dired) | ||
604 | :map dired-mode-map | ||
605 | ("C-j" . dired-up-directory) | ||
606 | ("<backspace>" . dired-up-directory)) | ||
607 | :init | ||
608 | (defhook dired-mode-hook | ||
609 | #'dired-hide-details-mode | ||
610 | #'hl-line-mode | ||
611 | #'truncate-lines-local-mode)) | ||
612 | |||
613 | (use-package dired-subtree | ||
614 | :ensure t | ||
615 | :after dired | ||
616 | :bind (:map dired-mode-map | ||
617 | (("TAB" . dired-subtree-cycle) | ||
618 | ("i" . dired-subtree-toggle)))) | ||
619 | |||
620 | (use-package dired-collapse | ||
621 | :ensure t | ||
622 | :hook dired-mode-hook) | ||
623 | |||
624 | (use-package dired-hide-dotfiles | ||
625 | :ensure t | ||
626 | :bind (:map dired-mode-map | ||
627 | ("." . dired-hide-dotfiles-mode))) | ||
628 | |||
629 | (use-package magit | ||
630 | :ensure t | ||
631 | :bind | ||
632 | ("C-x g" . magit)) | ||
633 | |||
634 | (use-package auth-source | ||
635 | :custom | ||
636 | (auth-sources '(default "secrets:passwords")) | ||
637 | :config | ||
638 | (defhook authinfo-mode-hook | ||
639 | #'truncate-lines-local-mode)) | ||
640 | |||
641 | (use-package keychain-environment | ||
642 | :ensure t | ||
643 | :when (executable-find "keychain") | ||
644 | :hook (after-init-hook . keychain-refresh-environment)) | ||
645 | |||
646 | (use-package keepassxc-shim | ||
647 | :load-path "~/src/emacs/keepassxc-shim/" | ||
648 | :config | ||
887 | (keepassxc-shim-activate)) | 649 | (keepassxc-shim-activate)) |
888 | 650 | ||
889 | (yoke (keychain-environment "https://github.com/tarsius/keychain-environment") | 651 | (use-package eat |
890 | :when (executable-find "keychain") | 652 | :ensure t |
891 | (keychain-refresh-environment)) | 653 | :commands eat-eshell-mode |
892 | 654 | :hook (eshell-load-hook . eat-eshell-mode)) | |
893 | (yoke (exec-path-from-shell "https://github.com/purcell/exec-path-from-shell") | 655 | |
894 | :when (eq system-type 'gnu/linux) | 656 | (use-package dictionary |
895 | (require 'exec-path-from-shell) | 657 | :custom |
896 | (dolist (var '("SSH_AUTH_SOCK" | 658 | (dictionary-server (if (or (executable-find "dictd") |
897 | "SSH_AGENT_PID" | 659 | (file-exists-p "/usr/sbin/dictd")) ; debian |
898 | "GPG_AGENT_INFO" | 660 | "localhost" |
899 | "LANG" | 661 | "dict.org")) |
900 | "LC_CTYPE" | 662 | :bind |
901 | "XDG_CONFIG_HOME" | 663 | (("C-c d" . dictionary-search))) |
902 | "XDG_CONFIG_DIRS" | 664 | |
903 | "XDG_DATA_HOME" | 665 | (use-package pdf-tools |
904 | "XDG_DATA_DIRS" | 666 | :ensure t |
905 | "XDG_CACHE_HOME")) | 667 | :mode ("\\.[pP][dD][fF]\\'" . pdf-view-mode) |
906 | (add-to-list 'exec-path-from-shell-variables var)) | 668 | :magic ("%PDF" . pdf-view-mode) |
907 | (exec-path-from-shell-initialize)) | 669 | :config |
908 | 670 | (pdf-tools-install)) | |
909 | (yoke (sophomore "https://codeberg.org/acdw/sophomore.el") | ||
910 | (sophomore-enable-all) | ||
911 | (sophomore-disable #'view-hello-file | ||
912 | #'describe-gnu-project) | ||
913 | (sophomore-disable-with 'confirm #'save-buffers-kill-terminal)) | ||
914 | |||
915 | (yoke (macrostep "https://github.com/joddie/macrostep") | ||
916 | (eval-after elisp-mode (require 'macrostep)) | ||
917 | (define-key* '(emacs-lisp-mode-map | ||
918 | lisp-interaction-mode-map) | ||
919 | "C-c e" #'macrostep-expand)) | ||
920 | |||
921 | (yoke (expand-region "https://github.com/magnars/expand-region.el") | ||
922 | (define-advice er/clear-history (:after (&rest _) refold-org) | ||
923 | (when (derived-mode-p 'org-mode) | ||
924 | (+org-hide-drawers-except-point) | ||
925 | (org-link-descriptive-ensure) | ||
926 | (font-lock-update))) | ||
927 | (defkeys t | ||
928 | "C-=" #'er/expand-region)) | ||
929 | 671 | ||
930 | (yoke (embrace "https://github.com/cute-jumper/embrace.el") | 672 | |
931 | :depends ((expand-region "https://github.com/magnars/expand-region.el")) | 673 | |
932 | (defkeys t | 674 | (use-package bbdb |
933 | "C-\"" #'embrace-commander) | 675 | :ensure t |
934 | (dolist (fnhook '((org-mode-hook embrace-org-mode-hook) | 676 | :custom |
935 | (ruby-mode-hook embrace-ruby-mode-hook) | 677 | (bbdb-complete-mail-allow-cycling t) |
936 | (emacs-lisp-mode-hook embrace-emacs-lisp-mode-hook) | 678 | (bbdb-file (private/ "bbdb")) |
937 | (latex-mode-hook embrace-LaTeX-mode-hook))) | 679 | :init |
938 | (apply #'add-hook fnhook)) | 680 | (defhook custom-allowed-after-load-hook |
939 | (eval-after org | 681 | :name bbdb@after-custom |
940 | (defkeys org-mode-map | 682 | (require 'bbdb) |
941 | "C-\"" #'embrace-commander) | 683 | (require 'bbdb-message) |
942 | (defmacro org-insert-or-embrace (char) | 684 | (bbdb-initialize 'message))) |
943 | "Define a function to insert CHAR, or `embrace' the region with it." | 685 | |
944 | (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char))) | 686 | (use-package bbdb-vcard |
945 | (char (cond ((characterp char) char) | 687 | :ensure t) |
946 | ((stringp char) (string-to-char char)) | 688 | |
947 | (t (user-error "Bad format for char: %S" char))))) | 689 | (use-package notmuch |
948 | `(defun ,fn-name (n) | 690 | :load-path "~/usr/share/emacs/site-lisp/" |
949 | ,(format "Insert N %ss, or surround the region with them." | 691 | :preface |
950 | (char-to-string char)) | 692 | (defdir notmuch/ (sync/ "emacs/notmuch")) |
951 | (interactive "p") | 693 | :init |
952 | (if (region-active-p) | 694 | (use-package +notmuch |
953 | (dotimes (_ n) | 695 | :after notmuch |
954 | (embrace--add-internal (region-beginning) (region-end) ,char) | 696 | :load-path "lisp/" |
955 | (forward-char 1)) | 697 | :bind (("C-c n" . +notmuch-goto) |
956 | (self-insert-command n ,char))))) | 698 | :map notmuch-search-mode-map |
957 | (define-key* org-mode-map | 699 | ("!" . +notmuch-search-mark-spam) |
958 | "*" (org-insert-or-embrace "*") | 700 | :map notmuch-tree-mode-map |
959 | "/" (org-insert-or-embrace "/") | 701 | ("!" . +notmuch-search-mark-spam-then-next) |
960 | "_" (org-insert-or-embrace "_") | 702 | ("M-<" . +notmuch-tree-beginning) |
961 | "=" (org-insert-or-embrace "=") | 703 | ("M->" . +notmuch-tree-end)) |
962 | "~" (org-insert-or-embrace "~") | 704 | :hook (message-send-hook . +send-mail-dispatch) |
963 | "+" (org-insert-or-embrace "+")))) | 705 | :config |
964 | 706 | ;; Saved searches | |
965 | (yoke (notmuch "~/usr/share/emacs/site-lisp") | 707 | (+notmuch-make-saved-search "inbox+unread" "m" 'tree "tag:inbox" "tag:unread" "NOT tag:Spam") |
966 | (eval-after bbdb | 708 | (+notmuch-make-saved-search "inbox" "i" 'tree "tag:inbox" "NOT tag:Spam") |
967 | (require* 'notmuch '+notmuch '+message)) | 709 | (+notmuch-make-saved-search "lists+unread" "l" 'tree "tag:/List/" "tag:unread") |
968 | (+define-dir notmuch/ (sync/ "emacs/notmuch") | 710 | (+notmuch-make-saved-search "lists" "L" 'tree "tag:/List/") |
969 | "Notmuch configuration and data.") | 711 | (+notmuch-make-saved-search "unread" "u" 'tree "tag:unread" "NOT tag:Spam") |
970 | (setf notmuch-init-file (notmuch/ "notmuch-init.el" t) | 712 | (+notmuch-make-saved-search "flagged" "f" 'tree "tag:flagged") |
971 | notmuch-address-save-filename (notmuch/ "addresses" t) | 713 | (+notmuch-make-saved-search "sent" "t" 'tree "tag:sent") |
972 | notmuch-address-use-company (featurep 'company) | 714 | (+notmuch-make-saved-search "drafts" "d" 'tree "tag:draft") |
973 | notmuch-search-oldest-first nil | 715 | (+notmuch-make-saved-search "all mail" "a" 'tree "*")) |
974 | notmuch-archive-tags '("-inbox" "-unread") | 716 | (use-package message |
975 | notmuch-draft-tags '("+draft" "-inbox" "-unread") | 717 | :after notmuch |
976 | mail-user-agent 'notmuch-user-agent | 718 | :hook (message-setup-hook . message-signature-setup) |
977 | bbdb-mail-user-agent 'notmuch-user-agent | 719 | :config (require '+message)) |
978 | message-mail-user-agent t) | 720 | (defhook (notmuch-show-mode-hook notmuch-message-mode-hook) |
979 | (define-key* (current-global-map) | ||
980 | "C-c m" #'notmuch-mua-new-mail | ||
981 | "C-c n" #'+notmuch-goto) | ||
982 | ;; Reading mail | ||
983 | (setf notmuch-show-indent-content nil) | ||
984 | (add-hook* '(notmuch-show-mode-hook | ||
985 | notmuch-message-mode-hook) | ||
986 | #'visual-fill-column-mode) | 721 | #'visual-fill-column-mode) |
987 | (eval-after notmuch | 722 | :custom |
988 | (define-key* notmuch-search-mode-map | 723 | (notmuch-init-file (notmuch/ "notmuch-init.el" t)) |
989 | "RET" #'notmuch-search-show-thread | 724 | (notmuch-address-save-filename (notmuch/ "addresses" t)) |
990 | "M-RET" #'notmuch-tree-from-search-thread | 725 | (notmuch-address-use-company (featurep 'company)) |
991 | "!" #'+notmuch-search-mark-spam) | 726 | (notmuch-search-oldest-first nil) |
992 | (define-key* notmuch-tree-mode-map | 727 | (notmuch-archive-tags '("-inbox" "-unread")) |
993 | "!" #'+notmuch-search-mark-spam-then-next | 728 | (notmuch-draft-tags '("+draft" "-inbox" "-unread")) |
994 | "M-<" (notmuch-tree--define-do-in-message-window | 729 | (mail-user-agent 'notmuch-user-agent) |
995 | notmuch-tree-beginning-of-message beginning-of-buffer) | 730 | (bbdb-mail-user-agent 'notmuch-user-agent) |
996 | "M->" (notmuch-tree--define-do-in-message-window | 731 | (message-mail-user-agent t) |
997 | notmuch-tree-end-of-message end-of-buffer))) | 732 | (notmuch-show-indent-content nil) |
998 | ;; Writing mail | 733 | (message-kill-buffer-on-exit t) |
999 | (setf message-kill-buffer-on-exit t | 734 | (message-auto-save-directory nil) |
1000 | message-auto-save-directory nil) | 735 | (send-mail-function #'sendmail-send-it) |
1001 | ;; Sending mail | 736 | (mail-specify-envelope-from t) |
1002 | (setf send-mail-function #'sendmail-send-it | 737 | (message-sendmail-envelope-from 'header) |
1003 | mail-specify-envelope-from t | 738 | (message-envelope-from 'header) |
1004 | message-sendmail-envelope-from 'header | 739 | (notmuch-saved-searches nil) |
1005 | message-envelope-from 'header) | 740 | :bind |
1006 | ;; Extras | 741 | (("C-c m" . notmuch-mua-new-mail) |
1007 | (define-advice mm-save-part-to-file (:before (_handle file) create-directory) | 742 | :map notmuch-search-mode-map |
1008 | (let ((directory (file-name-directory file))) | 743 | ("RET" . notmuch-search-show-thread) |
1009 | (when (yes-or-no-p (format "Directory %s doesn't exist. Create?" directory)) | 744 | ("M-RET" . notmuch-tree-from-search-thread)) |
1010 | (make-directory directory :parents)))) | 745 | :config |
1011 | (eval-after notmuch | 746 | (load notmuch-init-file :noerror) |
1012 | (require '+notmuch) | 747 | (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) |
1013 | (load notmuch-init-file :noerror) | 748 | ;; Mailing lists |
1014 | (add-hook 'message-setup-hook #'+message-signature-setup) | 749 | (add-to-list 'notmuch-message-headers "List-Post" :append) |
1015 | (add-hook 'message-send-hook #'+send-mail-dispatch) | 750 | (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) |
1016 | (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) | 751 | "Make `notmuch-mua-new-reply' list-aware." |
1017 | (advice-add 'notmuch-bury-or-kill-this-buffer :after | 752 | (let ((ml (notmuch-show-get-header :List-Post))) |
1018 | (defun +display-time@notmuch (&rest _) | 753 | (apply orig r) |
1019 | ;; (display-time-event-handler) | 754 | (when ml |
1020 | (setq display-time-mail-string | 755 | (with-buffer-modified-unmodified |
1021 | (replace-regexp-in-string "(.*)" | 756 | (message-remove-header "To") |
1022 | (format "(%s)" (+notmuch-new-mail-p)) | 757 | (message-add-header |
1023 | display-time-mail-string)) | 758 | (format "To: %s" |
1024 | (display-time-update) | 759 | (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" ml))) |
1025 | (force-mode-line-update))) | 760 | (message-goto-body)))))) |
1026 | (add-to-list 'notmuch-message-headers "List-Post" :append) | 761 | |
1027 | (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) | 762 | ;;; The INTERNET |
1028 | "Make `notmuch-mua-new-reply' list-aware." | 763 | |
1029 | (let ((ml (notmuch-show-get-header :List-Post))) | 764 | (use-package link-hint |
1030 | (apply orig r) | 765 | :ensure t |
1031 | (when ml | 766 | :demand t |
1032 | (with-buffer-modified-unmodified | 767 | :preface |
1033 | (message-remove-header "To") | 768 | (global-set-key (kbd "M-l") nil) |
1034 | (message-add-header | 769 | :custom |
1035 | (format "To: %s" | 770 | (link-hint-avy-style 'at-full) |
1036 | (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" ml))) | 771 | (link-hint-avy-all-windows t) |
1037 | (message-goto-body))))) | 772 | :config |
1038 | (setf notmuch-saved-searches (list | 773 | (require '+link-hint) |
1039 | (list :name "inbox+unread" | 774 | (+link-hint-open-secondary-setup) |
1040 | :query (+notmuch-query-concat | 775 | (+link-hint-open-chrome-setup) |
1041 | "tag:inbox" | 776 | :bind |
1042 | "tag:unread" | 777 | (("M-l M-l" . +link-hint-open-link) |
1043 | "NOT tag:Spam") | 778 | ("M-l l" . +link-hint-open-link) |
1044 | :key "m" | 779 | ("M-l M-o" . +link-hint-open-secondary) |
1045 | :search-type 'tree) | 780 | ("M-l o" . +link-hint-open-secondary) |
1046 | (list :name "inbox" | 781 | ("M-l M-m" . +link-hint-open-multiple-links) |
1047 | :query (+notmuch-query-concat | 782 | ("M-l m" . +link-hint-open-multiple-links) |
1048 | "tag:inbox" | 783 | ("M-l M-w" . link-hint-copy-link) |
1049 | "NOT tag:Spam") | 784 | ("M-l w" . link-hint-copy-link) |
1050 | :key "i" | 785 | ("M-l M-c" . +link-hint-open-chrome) |
1051 | :search-type 'tree) | 786 | ("M-l c" . +link-hint-open-chrome))) |
1052 | (list :name "lists+unread" | 787 | |
1053 | :query (+notmuch-query-concat | 788 | (use-package browse-url |
1054 | "tag:/List/" | 789 | :demand t |
1055 | "tag:unread") | 790 | :preface |
1056 | :key "l" | 791 | (require '+browse-url) |
1057 | :search-type 'tree) | 792 | :config |
1058 | (list :name "lists" | 793 | (eval-after chd |
1059 | :query "tag:/List/" | 794 | (add-to-list 'browse-url-handlers (cons chd/url-regexps |
1060 | :key "L" | 795 | #'browse-url-chrome)) |
1061 | :search-type 'tree) | 796 | (add-to-list '+browse-url-other-safe-browser-functions |
1062 | (list :name "unread" | 797 | #'chd/browse-url)) |
1063 | :query (+notmuch-query-concat | 798 | (put 'browse-url-browser-function 'safe-local-variable |
1064 | "tag:unread" | 799 | #'+browse-url-browser-function-safe-p) |
1065 | "NOT tag:Spam") | 800 | :custom |
1066 | :key "u" | 801 | (browse-url-browser-function #'eww-browse-url) |
1067 | :search-type 'tree) | 802 | (browse-url-chromium-program (choose-executable "chromium")) |
1068 | (list :name "flagged" | 803 | (browse-url-chrome-program (choose-executable "chrome" "google-chrome-stable")) |
1069 | :query "tag:flagged" | 804 | (browse-url-firefox-program (choose-executable "firefox" "firefox-esr")) |
1070 | :key "f" | 805 | (browse-url-firefox-new-window-is-tab t) |
1071 | :search-type 'tree) | 806 | (browse-url-firefox-arguments '("--new-tab")) |
1072 | (list :name "sent" | 807 | (browse-url-generic-program (or browse-url-firefox-program |
1073 | :query "tag:sent" | 808 | browse-url |
1074 | :key "t" | 809 | browse-url-chrome-program)) |
1075 | :search-type 'tree) | 810 | (browse-url-generic-args |
1076 | (list :name "drafts" | 811 | (cl-loop for prog in '(firefox chromium chrome) |
1077 | :query "tag:draft" | 812 | for progfn = (intern (format "browse-url-%s-program" |
1078 | :key "d" | 813 | prog)) |
1079 | :search-type 'tree) | 814 | for progargs = (intern (format "browse-url-%s-arguments" |
1080 | (list :name "all mail" | 815 | prog)) |
1081 | :query "*" | 816 | if (equal browse-url-generic-program |
1082 | :key "a" | 817 | (symbol-value progfn)) |
1083 | :search-type 'tree))))) | 818 | return (symbol-value progargs) |
1084 | 819 | finally return nil)) | |
1085 | (yoke (cider "https://github.com/clojure-emacs/cider") | 820 | (browse-url-handlers |
1086 | :depends ((clojure-mode "http://github.com/clojure-emacs/clojure-mode") | 821 | `(;; Videos |
1087 | (parseedn "https://github.com/clojure-emacs/parseedn/") | 822 | (,(+browse-url-matches "youtube\\.com" "youtu\\.be" |
1088 | (parseclj "https://github.com/clojure-emacs/parseclj/") ; parseedn | 823 | "invidious" "yewtu\\.be" |
1089 | (queue "https://elpa.gnu.org/packages/queue-0.2.el" :type 'http) | 824 | (rx "." (or "mp4" "gif" "mov" "MOV" "webm") |
1090 | (spinner "https://github.com/Malabarba/spinner.el") | 825 | eos)) |
1091 | (sesman "https://github.com/vspinu/sesman")) | 826 | . +browse-url-with-mpv) |
1092 | :when (executable-find "clojure")) | 827 | ;; Music |
1093 | 828 | (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com" | |
1094 | (yoke (web-mode "https://github.com/fxbois/web-mode") | 829 | (rx "." (or "ogg" "mp3" "opus" "m4a") eos)) |
1095 | (setf (alist-get (rx "." (or "htm" "html" "phtml" "tpl.php" | 830 | . +browse-url-with-mpv) |
1096 | "asp" "gsp" "jsp" "ascx" "aspx" | 831 | ;; Images |
1097 | "erb" "mustache" "djhtml") | 832 | (,(+browse-url-matches "pbs\\.twimg\\.com" |
1098 | eos) | 833 | (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") |
1099 | auto-mode-alist nil nil #'string=) | 834 | eos)) |
1100 | 'web-mode)) | 835 | . +browse-url-with-mpv-image) |
1101 | 836 | ;; Blobs (binary files) | |
1102 | (yoke (chicken-geiser "https://gitlab.com/emacs-geiser/chicken") | 837 | (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos)) |
1103 | :depends ((geiser "https://gitlab.com/emacs-geiser/geiser" | 838 | . +browse-url-download) |
1104 | :load "elisp")) | 839 | ;; External URLs --- these are URLs that don't open in EWW very well, |
1105 | :when (executable-find "csi") | 840 | ;; so I want to open them in the external browser. |
1106 | :pre ((autoload 'geiser-activate-implementation "geiser-impl")) | 841 | (+browse-url-external-url-p . ,(if (featurep 'xwidget-internal) |
1107 | (autoload 'geiser "geiser" nil :interactive) | 842 | #'xwidget-webkit-browse-url |
1108 | (add-hook 'scheme-mode-hook 'geiser-mode)) | 843 | browse-url-secondary-browser-function)))) |
1109 | 844 | (+browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org" | |
1110 | (yoke (zoom-frm "https://github.com/emacsmirror/zoom-frm") | 845 | "tildegit.org" "git.tilde.town" |
1111 | :depends ((frame-cmds "https://github.com/emacsmirror/frame-cmds") | 846 | "google.com" "imgur.com" "twitch.tv" |
1112 | (frame-fns "https://github.com/emacsmirror/frame-fns")) | 847 | "pixelfed" "instagram.com" |
1113 | (define-key* (current-global-map) | 848 | "bibliogram.art" "reddit.com" |
1114 | "M-+" #'zoom-frm-in | 849 | "teddit.net" "libreddit.de" |
1115 | "M-_" #'zoom-frm-out)) | 850 | "streamable.com" "spotify.com" |
1116 | 851 | "hetzner.cloud" "melpa.org" | |
1117 | (yoke (jabber "https://codeberg.org/acdw/emacs-jabber") | 852 | "twitter.com" ("^t\\.co$") |
1118 | :depends ((srv "https://github.com/legoscia/srv.el") | 853 | "nitter.snopyta.org" "nitter.net"))) |
1119 | (fsm "https://elpa.gnu.org/packages/fsm-0.2.1.el" :type 'http)) | 854 | |
1120 | (setf jabber-account-list '(("acdw@hmm.st")) | 855 | (use-package browse-url-transform |
1121 | jabber-auto-reconnect t | 856 | :after browse-url |
1122 | jabber-chat-buffer-format "xmpp:%n" | 857 | :load-path "~/src/emacs/browse-url-transform/" |
1123 | jabber-browse-buffer-format "xmpp-browse:%n" | 858 | :custom |
1124 | jabber-groupchat-buffer-format "xmpp-muc:%n" | 859 | (browse-url-transform-alist |
1125 | jabber-muc-private-buffer-format "xmpp-muc-private:%n" | 860 | `(;; Privacy-respecting alternatives |
1126 | jabber-groupchat-prompt-format "%>10n │ " | 861 | ("twitter\\.com" . "nitter.snopyta.org") |
1127 | jabber-chat-local-prompt-format "%>10n │ " | 862 | ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") |
1128 | jabber-chat-system-prompt-format " * * * * * *" | 863 | ("medium\\.com" . "scribe.rip") |
1129 | jabber-chat-foreign-prompt-format "%>10n │ " | 864 | (".*substack\\.com.*" . ,substack-proxy) |
1130 | jabber-muc-private-foreign-prompt-format "%g/%n " | 865 | ;; Text-mode of non-text-mode sites |
1131 | jabber-last-read-marker "----------------------------------------" | 866 | ("www\\.npr\\.org" . "text.npr.org") |
1132 | jabber-muc-header-line-format '("" jabber-muc-topic) | 867 | ;; Ask for raw versions of paste sites |
1133 | jabber-muc-decorate-presence-patterns | 868 | ("^.*dpaste\\.com.*$" . "\\&.txt") |
1134 | '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") | 869 | ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") |
1135 | ("." . jabber-muc-presence-dim)) | 870 | ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") |
1136 | jabber-activity-make-strings | 871 | ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") |
1137 | #'jabber-activity-make-strings-shorten | 872 | ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) |
1138 | ;; (defun +jabber-activity-make-strings (jids) | 873 | :config |
1139 | ;; (mapcar (lambda (jid) | 874 | (browse-url-transform-mode)) |
1140 | ;; (cons jid | 875 | |
1141 | ;; (let ((s (jabber-activity-make-string-default jid))) | 876 | (use-package eww |
1142 | ;; (cond | 877 | :custom |
1143 | ;; ((string-match-p "%" s) | 878 | (eww-use-browse-url ".") |
1144 | ;; (replace-regexp-in-string "%.*" "" s)) | 879 | :config |
1145 | ;; (:else s))))) | 880 | (defhook eww-mode-hook |
1146 | ;; jids)) | 881 | (defhook ((visual-fill-column-mode nil :local)) |
1147 | jabber-rare-time-format " - - - - - - %H:%M %F") | 882 | :name visual-fill-column@eww-mode-refresh |
883 | (eww-reload t))) | ||
884 | (defkeys eww-mode-map | ||
885 | "&" (+browse-url-switch-external-browser eww-mode | ||
886 | (plist-get eww-data :url)))) | ||
887 | |||
888 | (use-package xwidget | ||
889 | :when (featurep 'xwidget-internal) | ||
890 | :preface | ||
891 | (setenv "WEBKIT_FORCE_SANDBOX" "0") ; This is probably a bad idea | ||
892 | :custom | ||
893 | (xwidget-webkit-cookie-file (cache/ "xwidget-cookies")) | ||
894 | (xwidget-webkit-download-dir (expand-file-name "~/var/download")) | ||
895 | :config | ||
896 | (defkeys xwidget-webkit-mode-map | ||
897 | "&" (+browse-url-switch-external-browser xwidget-webkit-mode | ||
898 | (xwidget-webkit-uri (xwidget-webkit-current-session))))) | ||
899 | |||
900 | (use-package xwwp | ||
901 | :load-path "~/src/emacs/xwwp/" | ||
902 | :when (featurep 'xwidget-internal) | ||
903 | :custom | ||
904 | (xwwp-search-prefix "https://duckduckgo.com/?q=") | ||
905 | :bind (:map xwidget-webkit-mode-map | ||
906 | ("f" . xwwp-follow-link))) | ||
907 | |||
908 | (use-package jabber | ||
909 | :load-path "~/src/emacs/emacs-jabber" | ||
910 | :custom | ||
911 | (jabber-account-list '(("acdw@hmm.st"))) | ||
912 | (jabber-auto-reconnect t) | ||
913 | (jabber-chat-buffer-format "xmpp:%n") | ||
914 | (jabber-browse-buffer-format "xmpp-browse:%n") | ||
915 | (jabber-groupchat-buffer-format "xmpp-muc:%n") | ||
916 | (jabber-muc-private-buffer-format "xmpp-muc-private:%n") | ||
917 | (jabber-groupchat-prompt-format "%>10n │ ") | ||
918 | (jabber-chat-local-prompt-format "%>10n │ ") | ||
919 | (jabber-chat-system-prompt-format " * * * * * *") | ||
920 | (jabber-chat-foreign-prompt-format "%>10n │ ") | ||
921 | (jabber-muc-private-foreign-prompt-format "%g/%n ") | ||
922 | (jabber-last-read-marker "----------------------------------------") | ||
923 | (jabber-muc-header-line-format '("" jabber-muc-topic)) | ||
924 | (jabber-muc-decorate-presence-patterns | ||
925 | '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") | ||
926 | ("." . jabber-muc-presence-dim))) | ||
927 | (jabber-activity-make-strings | ||
928 | #'jabber-activity-make-strings-shorten) | ||
929 | (jabber-rare-time-format " - - - - - - %H:%M %F") | ||
930 | :custom-face | ||
931 | (jabber-chat-prompt-local ((t :inherit font-lock-keyword-face | ||
932 | :foreground unspecified))) | ||
933 | (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign | ||
934 | :foreground unspecified | ||
935 | :weight normal))) | ||
936 | (jabber-activity-personal-face ((t :inherit font-lock-warning-face | ||
937 | :foreground unspecified | ||
938 | :weight bold))) | ||
939 | (jabber-chat-prompt-foreign ((t :inherit font-lock-constant-face | ||
940 | :foreground unspecified))) | ||
941 | (jabber-chat-prompt-system ((t :inherit font-lock-doc-face | ||
942 | :foreground unspecified))) | ||
943 | (jabber-rare-time-face ((t :inherit font-lock-comment-face | ||
944 | :foreground unspecified | ||
945 | :underline nil))) | ||
946 | :init | ||
1148 | (defhook (jabber-chat-mode-hook | 947 | (defhook (jabber-chat-mode-hook |
1149 | jabber-browse-mode-hook | 948 | jabber-browse-mode-hook |
1150 | jabber-roster-mode-hook | 949 | jabber-roster-mode-hook |
1151 | jabber-console-mode-hook) | 950 | jabber-console-mode-hook) |
1152 | :name jabber-ui-setup | 951 | :name jabber-ui-setup |
952 | (visual-fill-column-mode) | ||
1153 | (electric-pair-local-mode -1) | 953 | (electric-pair-local-mode -1) |
1154 | (auto-fill-mode -1) | 954 | (auto-fill-mode -1) |
1155 | #'visual-fill-column-mode) | 955 | (setq-local wrap-prefix (format "%13s" " "))) |
1156 | (setq-local-hook jabber-chat-mode-hook | 956 | :bind-keymap ("C-c j" . jabber-global-keymap) |
1157 | wrap-prefix (format "%13s" " ")) | 957 | :bind (("C-c C-SPC" . jabber-activity-switch-to)) |
1158 | (defun +jabber-fix-keybinds-dammit () | 958 | :config |
1159 | "Jabber autoloads keybinds which is really annoying." | 959 | (global-set-key (kbd "C-x C-j") #'dired-jump) ; Extremely annoying fix |
1160 | (define-key* (current-global-map) | 960 | (require 'jabber-httpupload nil :noerror) |
1161 | "C-x C-j" #'dired-jump | 961 | (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) |
1162 | "C-c j" jabber-global-keymap | 962 | (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) |
1163 | "C-c C-SPC" #'jabber-activity-switch-to)) | 963 | (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) |
1164 | (eval-after init (+jabber-fix-keybinds-dammit)) | 964 | (add-hook 'jabber-alert-muc-hooks |
1165 | (eval-after jabber | 965 | (defun jabber@highlight-acdw (&optional _nick _group buf _text _title) |
1166 | (require 'jabber-httpupload nil :noerror) | 966 | (when buf |
1167 | (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) | 967 | (with-current-buffer buf |
1168 | (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) | 968 | (let ((regexp (rx word-boundary |
1169 | (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) | 969 | "acdw" ; maybe get from the config? |
1170 | (add-hook 'jabber-alert-muc-hooks | 970 | word-boundary))) |
1171 | (defun jabber@highlight-acdw (&optional _nick _group buf _text _title) | 971 | (hi-lock-unface-buffer regexp) |
1172 | (when buf | 972 | (highlight-regexp regexp 'hi-blue)))))) |
1173 | (with-current-buffer buf | 973 | (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus) |
1174 | (let ((regexp (rx word-boundary | 974 | (eval-after consult |
1175 | "acdw" ; maybe get from the config? | ||
1176 | word-boundary))) | ||
1177 | (hi-lock-unface-buffer regexp) | ||
1178 | (highlight-regexp regexp 'hi-blue)))))) | ||
1179 | (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus) | ||
1180 | (+jabber-fix-keybinds-dammit) | ||
1181 | (defkeys jabber-chat-mode-map | ||
1182 | "C-l" (defun +jabber-recenter-last-read () | ||
1183 | (interactive) | ||
1184 | (cond | ||
1185 | ((eq last-command '+jabber-recenter-last-read) | ||
1186 | (setq this-command #'recenter) | ||
1187 | (recenter -1)) | ||
1188 | (:else | ||
1189 | (save-excursion | ||
1190 | (condition-case e | ||
1191 | (re-search-backward jabber-last-read-marker) | ||
1192 | (search-failed nil) | ||
1193 | (:success | ||
1194 | (recenter 3))))))))) | ||
1195 | (defun jabber-chat-kill-buffers () | ||
1196 | "Kill all `jabber-chat-mode' buffers." | ||
1197 | (interactive) | ||
1198 | (mapc-buffers (lambda () (message "%S" (buffer-name))) '(jabber-chat-mode))) | ||
1199 | (defun jabber-chat@after-modus-themes-load () | ||
1200 | (modus-themes-with-colors | ||
1201 | (custom-set-faces | ||
1202 | `(jabber-chat-prompt-foreign ((t :foreground unspecified | ||
1203 | :inherit modus-themes-bold)) | ||
1204 | :now) | ||
1205 | `(jabber-chat-prompt-local ((t :foreground unspecified | ||
1206 | :inherit modus-themes-bold)) | ||
1207 | :now) | ||
1208 | `(jabber-chat-prompt-system ((t :foreground unspecified | ||
1209 | :inherit modus-themes-bold)) | ||
1210 | :now) | ||
1211 | `(jabber-activity-face ((t :slant italic))) | ||
1212 | `(jabber-activity-personal-face ((t :slant italic :weight bold))) | ||
1213 | `(jabber-rare-time-face ((t :inherit font-lock-comment-face))))) | ||
1214 | (setq jabber-muc-nick-value | ||
1215 | (pcase (frame--current-backround-mode (selected-frame)) | ||
1216 | ('light 0.5) | ||
1217 | ('dark 1.0)))) | ||
1218 | (eval-after modus-themes | ||
1219 | (add-hook 'modus-themes-after-load-theme-hook | ||
1220 | #'jabber-chat@after-modus-themes-load)) | ||
1221 | (when (or (custom-theme-enabled-p 'modus-operandi) | ||
1222 | (custom-theme-enabled-p 'modus-vivendi)) | ||
1223 | (jabber-chat@after-modus-themes-load)) | ||
1224 | (eval-after (consult jabber) | ||
1225 | ;; Jabber.el chat buffers source for `consult-buffer' | ||
1226 | (defvar jabber-chat-buffer-source | 975 | (defvar jabber-chat-buffer-source |
1227 | `( :name "Jabber" | 976 | `( :name "Jabber" |
1228 | :hidden nil | 977 | :hidden nil |
@@ -1238,190 +987,3 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1238 | (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) | 987 | (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) |
1239 | ;; Also hide xmpp buffers from regular buffer list | 988 | ;; Also hide xmpp buffers from regular buffer list |
1240 | (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal))) | 989 | (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal))) |
1241 | |||
1242 | (yoke (link-hint "https://github.com/noctuid/link-hint.el/") | ||
1243 | :depends ((avy "https://github.com/abo-abo/avy")) | ||
1244 | (require '+link-hint) | ||
1245 | (+link-hint-open-secondary-setup) | ||
1246 | (+link-hint-open-chrome-setup) | ||
1247 | (setf link-hint-avy-style 'at-full | ||
1248 | link-hint-avy-all-windows t) | ||
1249 | (global-set-key (kbd "M-l") +link-hint-map) | ||
1250 | (define-key* +link-hint-map | ||
1251 | "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link | ||
1252 | "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary | ||
1253 | "M-m" #'+link-hint-open-multiple-links "m" #'+link-hint-open-multiple-links | ||
1254 | "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link | ||
1255 | "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome)) | ||
1256 | |||
1257 | (yoke (elpher "git://thelambdalab.xyz/elpher.git") | ||
1258 | (eval-after elpher | ||
1259 | (define-key* elpher-mode-map | ||
1260 | "l" #'elpher-back))) | ||
1261 | |||
1262 | (yoke (epithet "https://github.com/oantolin/epithet") | ||
1263 | (defhook (Info-selection-hook | ||
1264 | help-mode-hook | ||
1265 | occur-mode-hook | ||
1266 | shell-mode-hook) | ||
1267 | #'epithet-rename-buffer) | ||
1268 | (cond ((boundp 'eww-auto-rename-buffer) | ||
1269 | (setc eww-auto-rename-buffer 'title)) | ||
1270 | (:else (defhook eww-after-render-hook #'epithet-rename-buffer)))) | ||
1271 | |||
1272 | (yoke browse-url | ||
1273 | (require '+browse-url) | ||
1274 | (setf browse-url-browser-function #'eww-browse-url | ||
1275 | browse-url-chrome-program (seq-some #'executable-find | ||
1276 | '("chromium" "chrome" "google-chrome-stable")) | ||
1277 | browse-url-firefox-program (seq-some #'executable-find | ||
1278 | '("firefox" "firefox-esr")) | ||
1279 | browse-url-generic-program (or browse-url-firefox-program | ||
1280 | browse-url-chrome-program) | ||
1281 | browse-url-firefox-new-window-is-tab t | ||
1282 | browse-url-firefox-arguments "-new-tab" | ||
1283 | browse-url-handlers `((video-url-p . +browse-url-with-mpv) | ||
1284 | (music-url-p . +browse-url-with-mpv) | ||
1285 | (image-url-p . +browse-image-with-mpv) | ||
1286 | (blobp . +browse-url-download) | ||
1287 | (external-url-p . ,browse-url-secondary-browser-function) | ||
1288 | ;; HERE FOR REFERENCE --- OPEN MASTO URLS SOME WAY | ||
1289 | (,(defun mastodon-url-p (url) | ||
1290 | "Try to determine whether URL is a mastodon URL." | ||
1291 | (string-match-p "/@[^/]+\\(/\\|/[[:digit:]]+\\)?$" url)) | ||
1292 | . ,browse-url-secondary-browser-function))) | ||
1293 | (+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" | ||
1294 | "--cache-pause-initial=yes") | ||
1295 | "Video URL: " | ||
1296 | :fallback browse-url-secondary-browser-function) | ||
1297 | (+browse-url-make-external-viewer-handler "mpv" '("--image-display-duration=inf") | ||
1298 | "Image URL: " | ||
1299 | :name +browse-image-with-mpv) | ||
1300 | (defun video-url-p (url) "Is URL a video?" | ||
1301 | (string-match-p (rx (or "youtube.com" "youtu.be" "invidious" "yewtu.be" | ||
1302 | (seq "." (or "mp4" "gif" "mov" "MOV" "webm") eos))) | ||
1303 | url)) | ||
1304 | (defun music-url-p (url) "Is URL music?" | ||
1305 | (string-match-p (rx "soundcloud.com" "bandcamp.com" | ||
1306 | (seq "." (or "ogg" "mp3" "opus" "m4a" "flac") eos)) | ||
1307 | url)) | ||
1308 | (defun image-url-p (url) "Is URL an image?" | ||
1309 | (string-match-p (rx | ||
1310 | (or (: "." (or "jpeg" "jpg" "png" "bmp" "webp") eos) | ||
1311 | "pbs.twimg.com")) | ||
1312 | url)) | ||
1313 | (defun external-url-p (url) "Should URL open in an external browser?" | ||
1314 | (string-match-p (rx (or "github.com" "gitlab.com" "codeberg.org" | ||
1315 | "tildegit.org" "git.tilde.town" "google.com" | ||
1316 | "imgur.com" "twitch.tv" "pixelfed" "instagram.com" | ||
1317 | "bibliogram.art" "reddit.com" "teddit.net" | ||
1318 | ;; "twitter.com" "nitter" "t.co" | ||
1319 | "streamable.com" "spotify.com" | ||
1320 | "hetzner.cloud" "melpa.org")) | ||
1321 | url)) | ||
1322 | (defun blobp (url) "Is URL some other blob that can't open in Emacs?" | ||
1323 | (string-match-p (rx (or (: (or ".tar.gz" ".pdf") | ||
1324 | eos))) | ||
1325 | url)) | ||
1326 | (eval-after chd | ||
1327 | (add-to-list 'browse-url-handlers (cons chd/url-regexps #'chd/browse-url))) | ||
1328 | (require 'browse-url-transform) | ||
1329 | (setf browse-url-transform-alist `(;; Privacy-respecting alternatives | ||
1330 | ("twitter\\.com" . "nitter.snopyta.org") | ||
1331 | ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" | ||
1332 | . "libreddit.de") | ||
1333 | ("medium\\.com" . "scribe.rip") | ||
1334 | ;; Text-mode of non-text-mode sites | ||
1335 | ("www\\.npr\\.org" . "text.npr.org") | ||
1336 | ;; Ask for raw versions of paste sites | ||
1337 | ("^.*dpaste\\.com.*$" . "\\&.txt") | ||
1338 | ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") | ||
1339 | ("\\(paste\\.debian\\.net\\)/\\(.*\\)" | ||
1340 | . "\\1/plain/\\2") | ||
1341 | ("\\(pastebin\\.com\\)/\\\(.*\\)" | ||
1342 | . "\\1/raw/\\2") | ||
1343 | ("gist\\.github\\.com/\\(.*\\)" | ||
1344 | . "gist.githubusercontent.com/\\1/raw/"))) | ||
1345 | (browse-url-transform-mode)) | ||
1346 | |||
1347 | (yoke eww | ||
1348 | (setc eww-use-browse-url ".") | ||
1349 | (eval-after eww | ||
1350 | (defhook eww-mode-hook | ||
1351 | #'visual-fill-column-mode | ||
1352 | (defhook ((visual-fill-column-mode-hook nil :local)) | ||
1353 | :name eww-mode-refresh@visual-fill-column | ||
1354 | (eww-reload t))) | ||
1355 | (defkeys eww-mode-map | ||
1356 | "&" | ||
1357 | (defun +eww-browse-with-external-browser (&optional url) | ||
1358 | "Browse URL with an external browser and close eww." | ||
1359 | (interactive nil eww-mode) | ||
1360 | (condition-case e | ||
1361 | ;; This is wrapped in a `condition-case' so that the eww window | ||
1362 | ;; won't close if there's an error calling the browser. | ||
1363 | (funcall browse-url-secondary-browser-function | ||
1364 | (or url (plist-get eww-data :url))) | ||
1365 | (:success | ||
1366 | (when (null url) ; interactive | ||
1367 | (quit-window))) | ||
1368 | (t (signal (car e) (cdr e))))))) | ||
1369 | (eval-after (eww link-hint) | ||
1370 | (defkeys eww-mode-map | ||
1371 | "f" #'+link-hint-open-link))) | ||
1372 | |||
1373 | (yoke tab-bar | ||
1374 | (setf tab-bar-show t | ||
1375 | global-mode-string | ||
1376 | '((jabber-activity-mode | ||
1377 | (:eval | ||
1378 | (let ((str (or (bound-and-true-p jabber-activity-mode-string) | ||
1379 | ""))) | ||
1380 | (concat (truncate-string-to-width str 20 nil nil t) | ||
1381 | (if (< 0 (length str)) " ⋅" ""))))) | ||
1382 | display-time-string | ||
1383 | "|")) | ||
1384 | (eval-after jabber | ||
1385 | (defhook jabber-activity-mode-hook | ||
1386 | (setf global-mode-string | ||
1387 | '((jabber-activity-mode | ||
1388 | (:eval | ||
1389 | (let ((str (or (bound-and-true-p jabber-activity-mode-string) | ||
1390 | ""))) | ||
1391 | (concat (truncate-string-to-width str 20 nil nil t) | ||
1392 | (if (< 0 (length str)) " ⋅" ""))))) | ||
1393 | display-time-string | ||
1394 | "|")))) | ||
1395 | (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) | ||
1396 | (add-to-list 'tab-bar-format 'tab-bar-format-global :append) | ||
1397 | (tab-bar-mode)) | ||
1398 | |||
1399 | (yoke (pdf-tools "https://github.com/vedang/pdf-tools" | ||
1400 | :load "lisp") | ||
1401 | :depends ((tablist "https://github.com/politza/tablist/")) | ||
1402 | :when (executable-find "epdfinfo") ; installed from Debian repos | ||
1403 | (pdf-tools-install)) | ||
1404 | |||
1405 | (yoke which-function | ||
1406 | (setf (alist-get 'which-function-mode mode-line-misc-info) | ||
1407 | '((which-func-mode ; Only display if buffer supports it | ||
1408 | (:eval (when (which-function) | ||
1409 | (list "" which-func-format " ")))))) | ||
1410 | (which-function-mode)) | ||
1411 | |||
1412 | (yoke (zzz-to-char "https://github.com/mrkkrp/zzz-to-char") | ||
1413 | :depends ((avy "https://github.com/abo-abo/avy")) | ||
1414 | (setf zzz-to-char-reach 120) | ||
1415 | (defkeys t | ||
1416 | [remap zap-to-char] | ||
1417 | (defun +zzz-to-char (&optional prefix) | ||
1418 | "Run `zzz-up-to-char', or `zzz-to-char' with PREFIX." | ||
1419 | (interactive "P") | ||
1420 | (call-interactively (cond (prefix #'zzz-to-char) | ||
1421 | (:else #'zzz-up-to-char)))))) | ||
1422 | |||
1423 | (yoke sh-mode | ||
1424 | (defhook sh-mode-hook | ||
1425 | :name turn-off-sh-electric-here-document-mode | ||
1426 | (sh-electric-here-document-mode -1))) | ||
1427 | |||
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el index 12e433c..b65b6f9 100644 --- a/lisp/+browse-url.el +++ b/lisp/+browse-url.el | |||
@@ -1,60 +1,101 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t -*- | 1 | ;;; +browse-url.el -*- lexical-binding: t; -*- |
2 | 2 | ||
3 | (require 'browse-url) | 3 | (require 'browse-url) |
4 | (require 'cl-lib) | ||
5 | (require 'seq) | ||
6 | (require 'url-util) | ||
7 | |||
8 | (defgroup +browse-url nil | ||
9 | "My `browse-url' extras." | ||
10 | :group 'browse-url) | ||
11 | |||
12 | ;;; External URL handlers | ||
4 | 13 | ||
5 | (cl-defmacro +browse-url-make-external-viewer-handler | 14 | (cl-defmacro +browse-url-make-external-viewer-handler |
6 | (viewer default-args | 15 | (viewer |
7 | &optional (prompt "URL: ") | 16 | &key |
8 | &key | 17 | args |
9 | (custom-group 'browse-url) | 18 | (prompt "URL: ") |
10 | (name (intern (format "+browse-url-with-%s" viewer))) | 19 | (program (executable-find (format "%s" viewer))) |
11 | doc vardoc | 20 | (name (intern (format "+browse-url-with-%s" viewer))) |
12 | (varname (intern (format "%s-args" name))) | 21 | doc |
13 | (fallback t)) | 22 | (var (intern (format "%s-args" name))) |
14 | "Create a `browse-url' handler function calling VIEWER on the url. | 23 | vardoc |
24 | (custom-group '+browse-url) | ||
25 | (fallback '(function browse-url-generic))) | ||
26 | "Create a `browse-url' handler function calling PROGRAM on the URL. | ||
15 | This macro also creates a `customize' setting in CUSTOM-GROUP for | 27 | This macro also creates a `customize' setting in CUSTOM-GROUP for |
16 | VIEWER's command-line arguments. DEFAULT-ARGS specifies the | 28 | PROGRAM's command-line arguments. ARGS specifies the |
17 | default arguments for that setting. | 29 | default arguments for this user option. |
30 | |||
31 | PROGRAM defaults to the result of calling `executable-find' on VIEWER. | ||
18 | 32 | ||
19 | PROMPT is shown to the user in the function's `interactive' spec, | 33 | PROMPT is shown to the user in the function's `interactive' spec, as an argument |
20 | as an argument to `browse-url-interactive-arg'. | 34 | to `browse-url-interactive-arg'. |
21 | 35 | ||
22 | The resulting function is named NAME, which defaults to | 36 | The resulting function is named NAME, which defaults to |
23 | `+browse-url-wth-VIEWER'. The custom variable is named VARNAME, | 37 | `+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults |
24 | which defaults to `NAME-args'. If DOC or VARDOC are provided, | 38 | to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of |
25 | they'll be the documentation of the function and variable | 39 | the function and variable respectively; otherwise a basic default doc-string is |
26 | respectively; otherwise, basic docstrings are used. | 40 | used. |
27 | 41 | ||
28 | Finally, if FALLBACK is non-nil (by default, it's | 42 | If FALLBACK is non-nil (the default is `browse-url-generic'), the |
29 | `browse-url-generic'), the function will call that if unable to | 43 | generated function will call FALLBACK if unable to start PROGRAM |
30 | start VIEWER." | 44 | for some reason." |
31 | (declare (indent 1)) | 45 | (declare (indent 1)) |
32 | `(progn | 46 | `(progn |
33 | (defcustom ,varname ,default-args | 47 | (defcustom ,var ,args |
34 | ,(or doc (format "Arguments to pass to %s in `%s'." viewer name)) | 48 | ,(or vardoc (format "Arguments to pass to %s in `%s'." |
49 | viewer name)) | ||
35 | :type '(repeat :tag "Command-line argument" string) | 50 | :type '(repeat :tag "Command-line argument" string) |
36 | :group ',custom-group) | 51 | :group ',custom-group) |
37 | (defun ,name (url &optional new-window) | 52 | (defun ,name (url &optional new-window) |
38 | ,(or vardoc (format "Open URL in %s." viewer)) | 53 | ,(or doc (format "Open URL in %s." viewer)) |
39 | (interactive (browse-url-interactive-arg ,prompt)) | 54 | (interactive (browse-url-interactive-arg ,prompt)) |
40 | (let* ((url (browse-url-encode-url url)) | 55 | (let* ((url (browse-url-encode-url url)) |
41 | (process-environment (browse-url-process-environment))) | 56 | (process-environment (browse-url-process-environment))) |
42 | (message ,(format "Opening %%s in %s..." viewer) url) | 57 | (message ,(format "Opening %%s in %s..." viewer) url) |
43 | (unless (ignore-errors (apply #'start-process | 58 | (unless (ignore-errors (apply #'start-process |
44 | (format "%s %s" ,viewer url) nil | 59 | (format "%s %s" ',viewer url) |
45 | ,viewer | 60 | nil |
46 | (append ,varname (list url)))) | 61 | ,program |
62 | (append ,var (list url)))) | ||
47 | ,@(cond | 63 | ,@(cond |
48 | ((eq fallback t) '((browse-url-generic url new-window))) | ||
49 | (fallback `((funcall ,fallback url new-window))) | 64 | (fallback `((funcall ,fallback url new-window))) |
50 | (:else `((message "Can't find viewer: `%s'" ,viewer) | 65 | (:else `((message "Can't find viewer: %s" ,viewer) |
51 | nil)))))))) | 66 | nil)))))))) |
52 | 67 | ||
68 | ;; Some default handlers | ||
69 | |||
70 | (+browse-url-make-external-viewer-handler mpv | ||
71 | :args '("--cache-pause-wait=15" | ||
72 | "--cache-pause-initial=yes") | ||
73 | :prompt "Video URL: ") | ||
74 | |||
75 | (+browse-url-make-external-viewer-handler mpv-image | ||
76 | :program (executable-find "mpv") | ||
77 | :args '("--image-display-duration=inf") | ||
78 | :prompt "Image URL: ") | ||
79 | |||
80 | ;;; Downloading | ||
81 | |||
53 | (defcustom +browse-url-download-open t | 82 | (defcustom +browse-url-download-open t |
54 | "Whether to open downloaded files afterward." | 83 | "Whether to open downloaded files after downloading." |
55 | :group 'browse-url | ||
56 | :type 'boolean) | 84 | :type 'boolean) |
57 | 85 | ||
86 | (defun +browse-url-download (url &rest _) | ||
87 | "Download URL to `eww-download-directory'." | ||
88 | (interactive "sDownload URL: ") | ||
89 | (let ((dir eww-download-directory)) | ||
90 | (when (functionp dir) (setq dir (funcall dir))) | ||
91 | (make-directory dir :parents) | ||
92 | (url-retrieve url | ||
93 | (lambda (s u d) | ||
94 | (let ((file (+browse-url-download-callback s u d))) | ||
95 | (when +browse-url-download-open | ||
96 | (browse-url-xdg-open file)))) | ||
97 | (list url dir)))) | ||
98 | |||
58 | (defun +browse-url-download-callback (status url dir) | 99 | (defun +browse-url-download-callback (status url dir) |
59 | ;; A slight change to `eww-download-callback' that returns the downloaded | 100 | ;; A slight change to `eww-download-callback' that returns the downloaded |
60 | ;; filename. | 101 | ;; filename. |
@@ -71,18 +112,78 @@ start VIEWER." | |||
71 | (message "Saved %s" file) | 112 | (message "Saved %s" file) |
72 | file))) | 113 | file))) |
73 | 114 | ||
74 | (defun +browse-url-download (url &rest _) | 115 | ;;; URL matcher generators |
75 | "Download URL to `eww-download-directory'." | 116 | |
76 | (interactive "sDownload URL: ") | 117 | (defun +browse-url-matches (&rest regexps) |
77 | (let ((dir eww-download-directory)) | 118 | "Return a lambda that will determine if a url matches REGEXPS. |
78 | (when (functionp dir) (setq dir (funcall dir))) | 119 | Each regexp will be tested in turn. The first one that matches |
79 | (make-directory dir :parents) | 120 | is returned by the lambda. |
80 | (url-retrieve url | 121 | |
81 | (lambda (s u d) | 122 | This is a good function to use in key positions in `browse-url-handlers'." |
82 | (let ((file (+browse-url-download-callback s u d))) | 123 | `(lambda (url &optional new-window) |
83 | (when +browse-url-download-open | 124 | (cl-loop for regexp in ',regexps |
84 | (browse-url-xdg-open file)))) | 125 | if (string-match-p regexp url) |
85 | (list url dir)))) | 126 | return regexp))) |
127 | |||
128 | ;;; External domains | ||
129 | ;; Some domains just don't open well in `eww'. The following function and user | ||
130 | ;; option define an easy way to automatically open those. | ||
131 | |||
132 | (defcustom +browse-url-external-domains nil | ||
133 | "Domains to open in `browse-url-secondary-browser-function'. | ||
134 | This is just a list of strings. They'll be regexp-escaped and | ||
135 | passed to `+browse-url-external-url-p', which is a good function | ||
136 | to put in `browse-url-handlers'. | ||
137 | |||
138 | If an item in this list is a list itself, it should contain one string, a valid | ||
139 | regexp that will not be regexp-quoted when matching against a url." | ||
140 | :type '(repeat (choice | ||
141 | (list :tag "Regexp" regexp) | ||
142 | (string :tag "Literal string")))) | ||
143 | |||
144 | (defun +browse-url-external-url-p (url) | ||
145 | "Return t if URL is a member of `+browse-url-external-domains'. | ||
146 | This function only tests URL's domain." | ||
147 | (let ((host (url-host (url-generic-parse-url url)))) | ||
148 | (cl-loop for domain in +browse-url-external-domains | ||
149 | if (string-match-p (if (stringp domain) | ||
150 | (regexp-quote domain) | ||
151 | (car domain)) | ||
152 | host) | ||
153 | return t))) | ||
154 | |||
155 | ;;; Switch to an external browser from an Emacs browser | ||
156 | |||
157 | (defmacro +browse-url-switch-external-browser (mode url-fetcher-form) | ||
158 | "Create a function for MODE to open an external browser. | ||
159 | URL-FETCHER-FORM will be used to get the URL of the current visited page." | ||
160 | (declare (indent 1)) | ||
161 | `(defun ,(intern (format "+browse-url-external-from-%s" mode)) | ||
162 | (&optional url) | ||
163 | "Browse URL with `browse-url-secondary-browser-function'. | ||
164 | This will close the current buffer." | ||
165 | (interactive nil ,mode) | ||
166 | (condition-case e | ||
167 | (funcall browse-url-secondary-browser-function | ||
168 | (or url ,url-fetcher-form)) | ||
169 | (:success (when (null url) (quit-window))) ; Interactive use | ||
170 | (t (signal (car e) (cdr e)))))) | ||
171 | |||
172 | ;;; Mark `browse-url-browser-function' as safe | ||
173 | |||
174 | (defcustom +browse-url-other-safe-browser-functions nil | ||
175 | "Other safe browser functions." | ||
176 | :type '(repeat function)) | ||
177 | |||
178 | (defun +browse-url-browser-function-safe-p (f) | ||
179 | "Return t if F is a safe browser function." | ||
180 | (memq f (append +browse-url-other-safe-browser-functions | ||
181 | (mapcar (lambda (i) | ||
182 | (plist-get (cdr i) :value)) | ||
183 | (seq-filter (lambda (i) | ||
184 | (eq (car i) 'function-item)) | ||
185 | (cdr (get 'browse-url-browser-function | ||
186 | 'custom-type))))))) | ||
86 | 187 | ||
87 | (provide '+browse-url) | 188 | (provide '+browse-url) |
88 | ;;; +browse-url.el ends here | 189 | ;;; +browse-url.el ends here |
diff --git a/lisp/+cape.el b/lisp/+cape.el new file mode 100644 index 0000000..37e88fe --- /dev/null +++ b/lisp/+cape.el | |||
@@ -0,0 +1,25 @@ | |||
1 | ;;; cape.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cape) | ||
6 | |||
7 | (defmacro +cape-insinuate (hook capes &rest capfs) | ||
8 | "Insinuate CAPES for a mode. | ||
9 | Add a function to HOOK that will add CAPES to the local | ||
10 | `completion-at-point-functions' for that mode's buffer. If CAPFS | ||
11 | are given, mark them all as non-exclusive." | ||
12 | (let ((fn (intern (format "+cape-insinuate@%s" hook)))) | ||
13 | `(prog1 | ||
14 | ,@(when capes | ||
15 | `((defun ,fn () | ||
16 | ,@(cl-loop for cape in capes | ||
17 | collect `(add-hook 'completion-at-point-functions | ||
18 | #',cape 90 :local))) | ||
19 | (add-hook ',hook #',fn))) | ||
20 | ,@(cl-loop for capf in capfs | ||
21 | collect `(advice-add ',capf :around | ||
22 | #'cape-wrap-nonexclusive))))) | ||
23 | |||
24 | (provide '+cape) | ||
25 | ;;; +cape.el ends here | ||
diff --git a/lisp/+custom.el b/lisp/+custom.el deleted file mode 100644 index ba4c55d..0000000 --- a/lisp/+custom.el +++ /dev/null | |||
@@ -1,52 +0,0 @@ | |||
1 | ;;; +custom.el -*- lexical-binding: t -*- | ||
2 | |||
3 | (require 'cl-lib) | ||
4 | (require 'seq) | ||
5 | |||
6 | (defgroup +custom nil | ||
7 | "Group for extra `customize' customizations." | ||
8 | :group 'customize) | ||
9 | |||
10 | (defcustom +custom-allowed-variables nil | ||
11 | "Variables to load during `+custom-load-some-customizations'." | ||
12 | :type '(repeat symbol)) | ||
13 | |||
14 | (defcustom +custom-allowed-faces nil | ||
15 | "Faces to load during `+custom-load-some-customziations'." | ||
16 | :type '(repeat face)) | ||
17 | |||
18 | (defun +custom--filter-list (customlist allowlist) | ||
19 | "Filter CUSTOMLIST to only include those items in ALLOWLIST. | ||
20 | Each item in ALLOWLIST will be compared using `eq' to the `car' | ||
21 | of each item in CUSTOMLIST. Items in CUSTOMLIST not included in | ||
22 | ALLOWLIST will be removed from the return value." | ||
23 | (seq-filter (lambda (el) (memq (car el) allowlist)) | ||
24 | customlist)) | ||
25 | |||
26 | (defcustom +custom-after-load-hook nil | ||
27 | "Hook run after loading the custom file." | ||
28 | :type 'hook) | ||
29 | |||
30 | (defun +custom-load-some-customizations (&optional noerror | ||
31 | nomessage | ||
32 | nosuffix | ||
33 | must-suffix) | ||
34 | "Load `custom-file', ignoring most customizations. | ||
35 | Only faces included in `+custom-allowed-faces' and variables | ||
36 | included in `+custom-allowed-variables' will be loaded. | ||
37 | |||
38 | All optional arguments---NOERROR, NOMESSAGE, NOSUFFIX, | ||
39 | MUST-SUFFIX---are passed to `load', which see." | ||
40 | (cl-letf (((symbol-function 'custom-set-faces) | ||
41 | (lambda (&rest args) | ||
42 | (apply #'custom-theme-set-faces 'user | ||
43 | (+custom--filter-list args +custom-allowed-faces)))) | ||
44 | ((symbol-function 'custom-set-variables) | ||
45 | (lambda (&rest args) | ||
46 | (apply #'custom-theme-set-variables 'user | ||
47 | (+custom--filter-list args +custom-allowed-variables))))) | ||
48 | (load custom-file noerror nomessage nosuffix must-suffix)) | ||
49 | (run-hooks '+custom-after-load-hook)) | ||
50 | |||
51 | (provide '+custom) | ||
52 | ;;; +custom.el ends here | ||
diff --git a/lisp/+emacs.el b/lisp/+emacs.el deleted file mode 100644 index 97377a3..0000000 --- a/lisp/+emacs.el +++ /dev/null | |||
@@ -1,422 +0,0 @@ | |||
1 | ;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; I find myself copy-pasting a lot of "boilerplate" type code when | ||
6 | ;; bankrupting my Emacs config and starting afresh. Instead of doing | ||
7 | ;; that, I'm putting it here, where it'll be easier to include in my | ||
8 | ;; config. | ||
9 | |||
10 | ;; Of course, some might say I could just ... stop bankrupting my | ||
11 | ;; Emacs. But like, why would I want to? | ||
12 | |||
13 | ;; Other notable packages include | ||
14 | ;; - https://git.sr.ht/~technomancy/better-defaults/ | ||
15 | ;; - https://github.com/susam/emfy | ||
16 | |||
17 | ;;; Code: | ||
18 | |||
19 | (require 'early-init (locate-user-emacs-file "early-init.el")) | ||
20 | |||
21 | (defun +set-major-mode-from-buffer-name (&optional buf) | ||
22 | "Set the major mode for BUF from the buffer's name. | ||
23 | Do this only if the buffer is not visiting a file." | ||
24 | (unless buffer-file-name | ||
25 | (let ((buffer-file-name (buffer-name buf))) | ||
26 | (set-auto-mode)))) | ||
27 | |||
28 | |||
29 | ;;; General settings | ||
30 | |||
31 | (setq-default | ||
32 | apropos-do-all t | ||
33 | async-shell-command-buffer 'new-buffer | ||
34 | async-shell-command-display-buffer nil | ||
35 | auto-hscroll-mode 'current-line | ||
36 | auto-revert-verbose t | ||
37 | auto-save-default nil | ||
38 | auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms))) | ||
39 | (".*" ,(.etc "auto-save/") t)) | ||
40 | auto-save-interval 30 | ||
41 | auto-save-list-file-prefix (.etc "auto-save/.saves-" t) | ||
42 | auto-save-timeout 30 | ||
43 | auto-save-visited-interval 5 | ||
44 | auto-window-vscroll nil | ||
45 | backup-by-copying t | ||
46 | backup-directory-alist `((".*" . ,(.etc "backup/" t))) | ||
47 | blink-cursor-blinks 1 | ||
48 | comp-deferred-compilation nil | ||
49 | completion-category-defaults nil | ||
50 | completion-category-overrides '((file (styles . (partial-completion)))) | ||
51 | completion-ignore-case t | ||
52 | completion-styles '(substring partial-completion) | ||
53 | create-lockfiles nil | ||
54 | cursor-in-non-selected-windows 'hollow | ||
55 | cursor-type 'bar | ||
56 | custom-file (.etc "custom.el") | ||
57 | delete-old-versions t | ||
58 | echo-keystrokces 0.1 | ||
59 | ediff-window-setup-function 'ediff-setup-windows-plain | ||
60 | eldoc-echo-area-use-multiline-p nil | ||
61 | eldoc-idle-delay 0.1 | ||
62 | enable-recursive-minibuffers t | ||
63 | executable-prefix-env t | ||
64 | fast-but-imprecise-scrolling t | ||
65 | file-name-shadow-properties '(invisible t intangible t) | ||
66 | fill-column 80 | ||
67 | find-file-visit-truename t | ||
68 | frame-resize-pixelwise t | ||
69 | global-auto-revert-non-file-buffers t | ||
70 | global-mark-ring-max 100 | ||
71 | hscroll-margin 1 | ||
72 | hscroll-step 1 | ||
73 | imenu-auto-rescan t | ||
74 | image-use-external-converter (or (executable-find "convert") | ||
75 | (executable-find "gm") | ||
76 | (executable-find "ffmpeg")) | ||
77 | indent-tabs-mode nil | ||
78 | inhibit-startup-screen t | ||
79 | initial-buffer-choice t | ||
80 | kept-new-versions 6 | ||
81 | kept-old-versions 2 | ||
82 | kill-do-not-save-duplicates t | ||
83 | kill-read-only-ok t | ||
84 | kill-ring-max 500 | ||
85 | kmacro-ring-max 20 | ||
86 | load-prefer-newer noninteractive | ||
87 | major-mode '+set-major-mode-from-buffer-name | ||
88 | mark-ring-max 50 | ||
89 | minibuffer-eldef-shorten-default t | ||
90 | minibuffer-prompt-properties (list 'read-only t | ||
91 | 'cursor-intangible t | ||
92 | 'face 'minibuffer-prompt) | ||
93 | mode-require-final-newline 'visit-save | ||
94 | mouse-drag-copy-region t | ||
95 | mouse-wheel-progressive-speed nil | ||
96 | mouse-yank-at-point t | ||
97 | native-comp-async-report-warnings-errors 'silent | ||
98 | native-comp-deferred-compilation nil | ||
99 | read-answer-short t | ||
100 | read-buffer-completion-ignore-case t | ||
101 | ;; read-extended-command-predicate | ||
102 | ;; (when (fboundp | ||
103 | ;; 'command-completion-default-include-p) | ||
104 | ;; 'command-completion-default-include-p) | ||
105 | read-process-output-max 1048576 ; We’re in the future man. Set that to at least a megabyte | ||
106 | recenter-positions '(top 2 middle bottom) | ||
107 | regexp-search-ring-max 100 | ||
108 | regexp-search-ring-max 200 | ||
109 | save-interprogram-paste-before-kill t | ||
110 | save-some-buffers-default-predicate #'+save-some-buffers-p | ||
111 | scroll-conservatively 25 | ||
112 | scroll-margin 0 | ||
113 | scroll-preserve-screen-position 1 | ||
114 | scroll-step 1 | ||
115 | search-ring-max 200 | ||
116 | search-ring-max 200 | ||
117 | sentence-end-double-space t | ||
118 | set-mark-command-repeat-pop t | ||
119 | show-paren-delay 0 | ||
120 | show-paren-style 'parenthesis | ||
121 | show-paren-when-point-in-periphery t | ||
122 | show-paren-when-point-inside-paren t | ||
123 | ;;show-trailing-whitespace t | ||
124 | tab-bar-show 1 | ||
125 | tab-width 8 ; so alignment expecting the default looks right | ||
126 | tramp-backup-directory-alist backup-directory-alist | ||
127 | undo-limit 100000000 ; 10 MB | ||
128 | use-dialog-box nil | ||
129 | use-file-dialog nil | ||
130 | use-short-answers t | ||
131 | vc-follow-symlinks t | ||
132 | vc-make-backup-files t | ||
133 | version-control t | ||
134 | view-read-only t | ||
135 | visible-bell nil | ||
136 | window-resize-pixelwise t | ||
137 | x-select-enable-clipboard t | ||
138 | x-select-enable-primary t | ||
139 | yank-pop-change-selection t | ||
140 | ) | ||
141 | |||
142 | ;; Programming language offsets. | ||
143 | ;; Set these after the initial block so I can use `tab-width' | ||
144 | (setq-default | ||
145 | c-basic-offset tab-width) | ||
146 | |||
147 | ;; Emacs 28 ships with an option, `use-short-answers', that makes this form | ||
148 | ;; obsolete, but I still use 27 at work. | ||
149 | (when (version< emacs-version "28") | ||
150 | (fset 'yes-or-no-p 'y-or-n-p)) | ||
151 | |||
152 | |||
153 | ;;; Encodings | ||
154 | |||
155 | ;; Allegedly, this is the only one you need... | ||
156 | (set-language-environment "UTF-8") | ||
157 | ;; But I still set all of these, for fun. | ||
158 | (setq-default locale-coding-system 'utf-8-unix | ||
159 | coding-system-for-read 'utf-8-unix | ||
160 | coding-system-for-write 'utf-8-unix | ||
161 | buffer-file-coding-system 'utf-8-unix | ||
162 | default-process-coding-system '(utf-8-unix . utf-8-unix) | ||
163 | x-select-request-type '(UTF8_STRING | ||
164 | COMPOUND_TEXT | ||
165 | TEXT | ||
166 | STRING)) | ||
167 | |||
168 | (set-charset-priority 'unicode) | ||
169 | (prefer-coding-system 'utf-8-unix) | ||
170 | (set-default-coding-systems 'utf-8-unix) | ||
171 | (set-terminal-coding-system 'utf-8-unix) | ||
172 | (set-keyboard-coding-system 'utf-8-unix) | ||
173 | |||
174 | (pcase system-type | ||
175 | ((or 'ms-dos 'windows-nt) | ||
176 | (set-clipboard-coding-system 'utf-16-le) | ||
177 | (set-selection-coding-system 'utf-16-le)) | ||
178 | (_ | ||
179 | (set-selection-coding-system 'utf-8) | ||
180 | (set-clipboard-coding-system 'utf-8))) | ||
181 | |||
182 | |||
183 | ;;; Modes | ||
184 | |||
185 | (dolist (enable-mode '(global-auto-revert-mode | ||
186 | blink-cursor-mode | ||
187 | electric-pair-mode | ||
188 | show-paren-mode | ||
189 | global-so-long-mode | ||
190 | minibuffer-depth-indicate-mode | ||
191 | file-name-shadow-mode | ||
192 | minibuffer-electric-default-mode | ||
193 | delete-selection-mode | ||
194 | auto-save-visited-mode | ||
195 | ;; column-number-mode | ||
196 | )) | ||
197 | (when (fboundp enable-mode) | ||
198 | (funcall enable-mode +1))) | ||
199 | |||
200 | (dolist (disable-mode '(tooltip-mode | ||
201 | tool-bar-mode | ||
202 | menu-bar-mode | ||
203 | scroll-bar-mode | ||
204 | horizontal-scroll-bar-mode)) | ||
205 | (when (fboundp disable-mode) | ||
206 | (funcall disable-mode -1))) | ||
207 | |||
208 | |||
209 | ;;; Hooks | ||
210 | |||
211 | (defun +auto-create-missing-dirs () | ||
212 | "Automatically create missing directories when finding a file." | ||
213 | ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ | ||
214 | (let ((target-dir (file-name-directory buffer-file-name))) | ||
215 | (unless (file-exists-p target-dir) | ||
216 | (make-directory target-dir t)))) | ||
217 | |||
218 | (defvar +save-some-buffers-debounce-time nil | ||
219 | "Last time `+save-some-buffers-debounce' was run.") | ||
220 | |||
221 | (defcustom +save-some-buffers-debounce-timeout 5 | ||
222 | "Number of seconds to wait before saving buffers again.") | ||
223 | |||
224 | (defun +save-some-buffers-debounce (&rest _) | ||
225 | "Run `save-some-buffers', but only if it's been a while." | ||
226 | (unless (and +save-some-buffers-debounce-time | ||
227 | (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time) | ||
228 | +save-some-buffers-debounce-timeout)) | ||
229 | (save-some-buffers t) | ||
230 | (setf +save-some-buffers-debounce-time (time-convert nil 'integer)))) | ||
231 | |||
232 | |||
233 | ;;; Better-default functions ... | ||
234 | |||
235 | (defun +cycle-spacing (&optional n preserve-nl-back mode) | ||
236 | "Negate N argument on `cycle-spacing'. | ||
237 | That is, with a positive N, deletes newlines as well, leaving -N | ||
238 | spaces. If N is negative, it will not delete newlines and leave | ||
239 | N spaces. See docstring of `cycle-spacing' for the meaning of | ||
240 | PRESERVE-NL-BACK and MODE." | ||
241 | (interactive "*p") | ||
242 | (cycle-spacing (- n))) | ||
243 | |||
244 | (defun +save-buffers-quit (&optional arg) | ||
245 | "Silently save each buffer, then kill the current connection. | ||
246 | If the current frame has no client, kill Emacs itself using | ||
247 | `save-buffers-kill-emacs' after confirming with the user. | ||
248 | |||
249 | With prefix ARG, silently save all file-visiting buffers, then | ||
250 | kill without asking." | ||
251 | (interactive "P") | ||
252 | (save-some-buffers t) | ||
253 | (if (and (not (frame-parameter nil 'client)) | ||
254 | (and (not arg))) | ||
255 | (when (yes-or-no-p "Sure you want to quit? ") | ||
256 | (save-buffers-kill-emacs)) | ||
257 | (delete-frame nil :force))) | ||
258 | |||
259 | (defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn) | ||
260 | "Kill active region or ARG words backward. | ||
261 | BACKWARD-KILL-WORD-FN is the function to call to kill a word | ||
262 | backward. It defaults to `backward-kill-word'." | ||
263 | (interactive "P") | ||
264 | (call-interactively (if (region-active-p) | ||
265 | #'kill-region | ||
266 | (or backward-kill-word-fn #'backward-kill-word)))) | ||
267 | |||
268 | (defun +backward-kill-word-wrapper (fn &optional arg) | ||
269 | "Kill backward using FN until the beginning of a word, smartly. | ||
270 | If point is on at the beginning of a line, kill the previous new | ||
271 | line. If the only thing before point on the current line is | ||
272 | whitespace, kill that whitespace. | ||
273 | |||
274 | With argument ARG: if ARG is a number, just call FN | ||
275 | ARG times. Otherwise, just call FN." | ||
276 | ;; I want this to be a wrapper so that I can call other word-killing functions | ||
277 | ;; with it. It's *NOT* advice because those functions probably use | ||
278 | ;; `backward-kill-word' under the hood (looking at you, paredit), so advice | ||
279 | ;; will make things weird. | ||
280 | (if (null arg) | ||
281 | (cond | ||
282 | ((looking-back "^" 1) | ||
283 | (let ((delete-active-region nil)) | ||
284 | (delete-backward-char 1))) | ||
285 | ((looking-back "^[ ]*") | ||
286 | (delete-horizontal-space :backward-only)) | ||
287 | (t (call-interactively fn))) | ||
288 | (funcall fn (if (listp arg) 1 arg)))) | ||
289 | |||
290 | (defun +backward-kill-word (&optional arg) | ||
291 | "Kill word backward using `backward-kill-word'. | ||
292 | ARG is passed to `backward-kill-word'." | ||
293 | (interactive "P") | ||
294 | (+backward-kill-word-wrapper #'backward-kill-word arg)) | ||
295 | |||
296 | ;;; ... and advice | ||
297 | |||
298 | ;; Indent the region after a yank. | ||
299 | (defun +yank@indent (&rest _) | ||
300 | "Indent the current region." | ||
301 | (indent-region (min (point) (mark)) (max (point) (mark)))) | ||
302 | ;; (advice-add #'yank :after #'+yank@indent) | ||
303 | ;; (advice-add #'yank-pop :after #'+yank@indent) | ||
304 | |||
305 | ;; https://old.reddit.com/r/emacs/comments/y92y4b/tramp_users_slowness_got_you_down_check/it3a35r/ | ||
306 | (defun +vc-off-when-remote () | ||
307 | (when (file-remote-p (buffer-file-name)) | ||
308 | (setq-local vc-handled-backends nil))) | ||
309 | |||
310 | |||
311 | ;;; Extra functions | ||
312 | |||
313 | (defun +save-some-buffers-p () | ||
314 | "Predicate for `save-some-buffers-default-predicate'. | ||
315 | It returns nil with remote files and those without attached files." | ||
316 | (and (buffer-file-name) | ||
317 | (not (file-remote-p (buffer-file-name))))) | ||
318 | |||
319 | ;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block | ||
320 | (defun +goto-matching-paren (&optional arg) | ||
321 | "Go to the matching paren, similar to vi's %." | ||
322 | (interactive "p") | ||
323 | (or arg (setf arg 1)) | ||
324 | (cond | ||
325 | ;; Check for "outside of bracket" positions | ||
326 | ((looking-at "[\[\(\{]") (forward-sexp arg)) | ||
327 | ((looking-back "[\]\)\}]" 1) (backward-sexp arg)) | ||
328 | ;; Otherwise, move from inside the bracket | ||
329 | ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg)) | ||
330 | ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg)) | ||
331 | (t (up-list arg t t)))) | ||
332 | |||
333 | (defun +delete-window-or-bury-buffer () | ||
334 | "Delete the current window, or bury the current buffer. | ||
335 | If the current window is the only window, bury the buffer." | ||
336 | (interactive) | ||
337 | (condition-case e | ||
338 | (delete-window) | ||
339 | (t (bury-buffer)))) | ||
340 | |||
341 | |||
342 | ;;; Required libraries | ||
343 | |||
344 | (when (require 'abbrev nil :noerror) | ||
345 | (setq-default abbrev-file-name (sync/ "abbrev.el") | ||
346 | save-abbrevs 'silent)) | ||
347 | |||
348 | (when (require 'autorevert nil :noerror) | ||
349 | (setq-default global-auto-revert-non-file-buffers t | ||
350 | auto-revert-verbose nil) | ||
351 | (global-auto-revert-mode +1)) | ||
352 | |||
353 | (when (require 'uniquify nil :noerror) | ||
354 | (setq-default uniquify-buffer-name-style 'forward | ||
355 | uniquify-separator path-separator | ||
356 | uniquify-after-kill-buffer-p t | ||
357 | uniquify-ignore-buffers-re "^\\*")) | ||
358 | |||
359 | (when (require 'goto-addr) | ||
360 | (if (fboundp 'global-goto-address-mode) | ||
361 | (global-goto-address-mode +1) | ||
362 | (add-hook 'after-change-major-mode-hook 'goto-address-mode))) | ||
363 | |||
364 | (when (require 'recentf nil :noerror) | ||
365 | (setq-default recentf-save-file (.etc "recentf.el") | ||
366 | recentf-max-menu-items 100 | ||
367 | recentf-max-saved-items nil | ||
368 | recentf-auto-cleanup 'mode) | ||
369 | (add-to-list 'recentf-exclude .etc) | ||
370 | (recentf-mode +1)) | ||
371 | |||
372 | (when (require 'savehist nil :noerror) | ||
373 | (setq-default history-length t | ||
374 | history-delete-duplicates t | ||
375 | history-autosave-interval 60 | ||
376 | savehist-file (.etc "savehist.el") | ||
377 | ;; Other variables --- don't truncate any of these. | ||
378 | ;; `add-to-history' uses the values of these variables unless | ||
379 | ;; they're nil, in which case it falls back to `history-length'. | ||
380 | kill-ring-max 100 | ||
381 | mark-ring-max 100 | ||
382 | global-mark-ring-max 100 | ||
383 | regexp-search-ring-max 100 | ||
384 | search-ring-max 100 | ||
385 | kmacro-ring-max 100 | ||
386 | eww-history-limit 100) | ||
387 | (dolist (var '(extended-command-history | ||
388 | global-mark-ring | ||
389 | mark-ring | ||
390 | kill-ring | ||
391 | kmacro-ring | ||
392 | regexp-search-ring | ||
393 | search-ring)) | ||
394 | (add-to-list 'savehist-additional-variables var)) | ||
395 | (savehist-mode +1)) | ||
396 | |||
397 | (when (require 'saveplace nil :noerror) | ||
398 | (setq-default save-place-file (.etc "places.el") | ||
399 | save-place-forget-unreadable-files (eq system-type 'gnu/linux)) | ||
400 | (save-place-mode +1)) | ||
401 | |||
402 | ;; (when (require 'tramp) | ||
403 | ;; ;; thanks Irreal! https://irreal.org/blog/?p=895 | ||
404 | ;; (add-to-list 'tramp-default-proxies-alist | ||
405 | ;; '(nil "\\`root\\'" "/ssh:%h:")) | ||
406 | ;; (add-to-list 'tramp-default-proxies-alist | ||
407 | ;; '((regexp-quote (system-name)) nil nil))) | ||
408 | |||
409 | |||
410 | ;;; Newer features | ||
411 | ;; These aren't in older version of Emacs, but they're so nice. | ||
412 | |||
413 | (when (fboundp 'repeat-mode) | ||
414 | (setq-default repeat-exit-key "g" | ||
415 | repeat-exit-timeout 5) | ||
416 | (repeat-mode +1)) | ||
417 | |||
418 | (when (fboundp 'pixel-scroll-precision-mode) | ||
419 | (pixel-scroll-precision-mode +1)) | ||
420 | |||
421 | (provide '+emacs) | ||
422 | ;;; +emacs.el ends here | ||
diff --git a/lisp/+emms.el b/lisp/+emms.el new file mode 100644 index 0000000..a43daea --- /dev/null +++ b/lisp/+emms.el | |||
@@ -0,0 +1,38 @@ | |||
1 | ;;; +emms.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (defun +emms-streams (&optional file) | ||
4 | "Better interface for `emms-streams'. | ||
5 | If FILE is non-nil, use it. Otherwise use `emms-streams-file'. | ||
6 | If `emms-streams-file' is nil or this function is called with | ||
7 | \\[universal-argument], prompt the user." | ||
8 | (interactive | ||
9 | (list (cond | ||
10 | ((or emms-streams-file | ||
11 | (not current-prefix-arg)) | ||
12 | emms-streams-file) | ||
13 | (:else (read-file-name "Stream file: " | ||
14 | emms-source-file-default-directory))))) | ||
15 | (when (and (not (file-exists-p emms-streams-file)) | ||
16 | (y-or-n-p "Emms' bulit-in streams file hasn't been installed yet. Install it now?")) | ||
17 | (emms-streams-install)) | ||
18 | (let ((buf (get-buffer emms-streams-buffer-name))) | ||
19 | (when (not buf) | ||
20 | (with-current-buffer (get-buffer-create emms-streams-buffer-name) | ||
21 | (setq buf (current-buffer)) | ||
22 | (emms-playlist-mode) | ||
23 | (setq emms-playlist-buffer-p t) | ||
24 | (emms-playlist-set-playlist-buffer (current-buffer)) | ||
25 | (with-current-buffer (find-file-noselect emms-streams-file) | ||
26 | (cond | ||
27 | ((emms-source-playlist-native-p) | ||
28 | (emms-add-native-playlist emms-streams-file)) | ||
29 | ((emms-source-playlist-m3u-p) | ||
30 | (emms-add-m3u-playlist emms-streams-file)) | ||
31 | ((emms-source-playlist-pls-p) | ||
32 | (emms-add-pls-playlist emms-streams-file)) | ||
33 | (:else (error "Streams file `%s' isn't in a known format." | ||
34 | emms-streams-file)))))) | ||
35 | (switch-to-buffer buf))) | ||
36 | |||
37 | (provide '+emms) | ||
38 | ;;; +emms.el ends here | ||
diff --git a/lisp/+hungry-delete.el b/lisp/+hungry-delete.el new file mode 100644 index 0000000..601aecf --- /dev/null +++ b/lisp/+hungry-delete.el | |||
@@ -0,0 +1,53 @@ | |||
1 | ;;; +hungry-delete.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'hungry-delete) | ||
8 | |||
9 | (defmacro +hungry-delete-define-alternative (func hd-func &optional direction) | ||
10 | "Define a `hungry-delete' alternative for FUNC. | ||
11 | If the adjacent characters in DIRECTION are one of | ||
12 | `hungry-delete-chars-to-skip', call HD-FUNC. Otherwise, call | ||
13 | FUNC. | ||
14 | |||
15 | If DIRECTION is a positive integer or `forward', look forward. | ||
16 | If it's negative or `backward', look backward. If it's absent, | ||
17 | this macro will try to guess based on the names of FUNC and | ||
18 | HD-FUNC. | ||
19 | |||
20 | This macro creates a function taking a prefix argument that's | ||
21 | passed to both of FUNC and HD-FUNC." | ||
22 | (let ((name (intern (format "%s|%s" func hd-func))) | ||
23 | (lookfn (cond | ||
24 | ((or (and (string-match-p "forward" (symbol-name func)) | ||
25 | (string-match-p "forward" (symbol-name hd-func)) | ||
26 | (not direction)) | ||
27 | (and (integerp direction) | ||
28 | (< 0 direction)) | ||
29 | (eq direction 'forward)) | ||
30 | 'looking-at) | ||
31 | ((or (and (string-match-p "backward" (symbol-name func)) | ||
32 | (string-match-p "backward" (symbol-name hd-func)) | ||
33 | (not direction)) | ||
34 | (and (integerp direction) | ||
35 | (> 0 direction)) | ||
36 | (eq direction 'backward)) | ||
37 | 'looking-back) | ||
38 | (:else (error "Bad direction: %S" direction)))) | ||
39 | (arg (gensym))) | ||
40 | `(defun ,name (,arg) | ||
41 | ,(concat (format "Do `%s' or `%s', depending on whitespace.\n" | ||
42 | func hd-func) | ||
43 | (format "Pass prefix argument %s to the underlying functions.\n" | ||
44 | (upcase (symbol-name arg))) | ||
45 | "This function was defined by `define-hungry-delete-alternative'.") | ||
46 | (interactive "*p") ; This is brittle | ||
47 | (if (,lookfn (format "[%s]" hungry-delete-chars-to-skip)) | ||
48 | (,hd-func (or ,arg 1)) | ||
49 | (,func ,arg))))) | ||
50 | |||
51 | (provide '+hungry-delete) | ||
52 | ;;; +hungry-delete.el ends here | ||
53 | |||
diff --git a/lisp/+isearch.el b/lisp/+isearch.el new file mode 100644 index 0000000..3516ec4 --- /dev/null +++ b/lisp/+isearch.el | |||
@@ -0,0 +1,24 @@ | |||
1 | ;;; +isearch.el --- iseach (and query-replace) extensions -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; From https://github.com/astoff/isearch-mb/wiki | ||
4 | |||
5 | (defun +isearch-cancel@add-search-to-history () | ||
6 | "Add search string to history also when canceling. | ||
7 | This should be used as `:before' advice on `isearch-cancel'." | ||
8 | (unless (string-equal "" isearch-string) | ||
9 | (isearch-update-ring isearch-string isearch-regexp))) | ||
10 | |||
11 | (defun +perform-replace-dont-exit-on-anykey (orig &rest args) | ||
12 | "Don't exit replace for anykey that's not in `query-replace-map'. | ||
13 | This should be used as `:around' advice for `perform-replace'." | ||
14 | (save-window-excursion | ||
15 | (cl-letf* ((lookup-key-orig | ||
16 | (symbol-function 'lookup-key)) | ||
17 | ((symbol-function 'lookup-key) | ||
18 | (lambda (map key &optional accept-default) | ||
19 | (or (apply lookup-key-orig map key accept-default) | ||
20 | (when (eq map query-replace-map) 'help))))) | ||
21 | (apply orig args)))) | ||
22 | |||
23 | (provide '+isearch) | ||
24 | ;;; +isearch.el ends here | ||
diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el index 74b9b77..5df6e5b 100644 --- a/lisp/+notmuch.el +++ b/lisp/+notmuch.el | |||
@@ -60,11 +60,11 @@ for search." | |||
60 | 'notmuch-address-history))) | 60 | 'notmuch-address-history))) |
61 | (:else | 61 | (:else |
62 | (defun notmuch-address-selection-function (prompt collection initial-input) | 62 | (defun notmuch-address-selection-function (prompt collection initial-input) |
63 | "Call (`completing-read' | 63 | "Call (`completing-read' |
64 | PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" | 64 | PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" |
65 | (completing-read | 65 | (completing-read |
66 | prompt collection nil nil nil | 66 | prompt collection nil nil nil |
67 | 'notmuch-address-history))))) | 67 | 'notmuch-address-history))))) |
68 | 68 | ||
69 | (defcustom +notmuch-spam-tags '("+spam" "+Spam") | 69 | (defcustom +notmuch-spam-tags '("+spam" "+Spam") |
70 | "A list of tag changes to apply when marking a thread as spam." | 70 | "A list of tag changes to apply when marking a thread as spam." |
@@ -101,5 +101,49 @@ This function advances the next thread when finished." | |||
101 | (when (eq beg end) | 101 | (when (eq beg end) |
102 | (notmuch-search-next-thread))) | 102 | (notmuch-search-next-thread))) |
103 | 103 | ||
104 | (defun +notmuch-tree-beginning (&optional arg) | ||
105 | "Move point to beginning of message or tree, depending on ARG." | ||
106 | (interactive "P") | ||
107 | (cond | ||
108 | ((and (window-live-p notmuch-tree-message-window) | ||
109 | (not arg)) | ||
110 | (with-selected-window notmuch-tree-message-window | ||
111 | (beginning-of-buffer))) | ||
112 | (:else (beginning-of-buffer)))) | ||
113 | |||
114 | (defun +notmuch-tree-end (&optional arg) | ||
115 | "Move point to end of message or tree, depending on ARG." | ||
116 | (interactive "P") | ||
117 | (cond | ||
118 | ((and (window-live-p notmuch-tree-message-window) | ||
119 | (not arg)) | ||
120 | (with-selected-window notmuch-tree-message-window | ||
121 | (end-of-buffer))) | ||
122 | (:else (end-of-buffer)))) | ||
123 | |||
124 | (defun +notmuch-make-saved-search (name key search-type &rest queries) | ||
125 | "Wrapper to ease `notmuch-saved-searches' defining. | ||
126 | NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in | ||
127 | `notmuch-saved-searches', which see. QUERIES are all concatenated together with | ||
128 | AND. If QUERIES is prepended with more keyword arguments, those are added to | ||
129 | the saved search as well." | ||
130 | (declare (indent 3)) | ||
131 | (let (extra-keywords) | ||
132 | (while (keywordp (car queries)) | ||
133 | (push (cadr queries) extra-keywords) | ||
134 | (push (car queries) extra-keywords) | ||
135 | (setf queries (cddr queries))) | ||
136 | (add-to-list 'notmuch-saved-searches | ||
137 | (append | ||
138 | (list :name name | ||
139 | :key key | ||
140 | :search-type search-type | ||
141 | :query (apply #'+notmuch-query-concat queries)) | ||
142 | (reverse extra-keywords)) | ||
143 | :append | ||
144 | (lambda (a b) | ||
145 | (equal (plist-get a :name) | ||
146 | (plist-get b :name)))))) | ||
147 | |||
104 | (provide '+notmuch) | 148 | (provide '+notmuch) |
105 | ;;; +notmuch.el ends here | 149 | ;;; +notmuch.el ends here |
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el index 06dfcfd..2f7bf6a 100644 --- a/lisp/+org-capture.el +++ b/lisp/+org-capture.el | |||
@@ -1,164 +1,49 @@ | |||
1 | ;;; +org-capture.el -*- lexical-binding: t; -*- | 1 | ;;; +org-capture.el -*- lexical-binding: t; -*- |
2 | 2 | ||
3 | ;;; Code: | 3 | ;;; Code: |
4 | 4 | ||
5 | (require 'cl-lib) | 5 | (require 'cl-lib) |
6 | (require 'acdw) | 6 | ;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll |
7 | ;; We don't require `org-capture' here because I'll have to require this library | 7 | ;; take a minute. Just let the compiler know that this variable exists. |
8 | ;; to init.el /before/ org-capture is fully needed. But I do need to declare | ||
9 | ;; `org-capture-templates'. | ||
10 | (defvar org-capture-templates nil) | 8 | (defvar org-capture-templates nil) |
11 | 9 | ||
12 | (defun +org-capture--get (key &optional list) | 10 | ;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 |
13 | "Find KEY in LIST, or return nil. | 11 | (defun +org-capture-template-define (description &rest args) |
14 | LIST defaults to `org-capture-templates'." | 12 | "Define a capture template. |
15 | (alist-get key (or list org-capture-templates) nil nil #'equal)) | 13 | Creates a list and adds it to `org-capture-templates', if it's |
16 | 14 | not already there. ARGS is a plist, which in addition to the | |
17 | ;; Set it up as a generic value. Based on the one for `alist-get'. | 15 | additional options `org-capture-templates' accepts (which see), |
18 | (gv-define-expander +org-capture--get | 16 | takes the following and puts them in the right spot: `:keys', |
19 | (lambda (do key &optional alist) | 17 | `:description', `:type', `:target', and `:template'." |
20 | (setf alist (or alist org-capture-templates)) | 18 | (declare (indent 1)) |
21 | (macroexp-let2 macroexp-copyable-p k key | 19 | (let* ((keys (plist-get args :keys)) |
22 | (gv-letplace (getter setter) alist | 20 | (type (plist-get args :type)) |
23 | (macroexp-let2 nil p `(assoc ,k ,getter 'equal) | 21 | (target (plist-get args :target)) |
24 | (funcall do `(cdr ,p) | 22 | (template (plist-get args :template)) |
25 | (lambda (v) | 23 | (template-value (append |
26 | (macroexp-let2 nil v v | 24 | (list description) |
27 | (let ((set-exp | 25 | (when (or type target template) |
28 | `(if ,p (setcdr ,p ,v) | 26 | (list (or type 'entry) target template)) |
29 | ,(funcall setter | 27 | (cl-loop for i from 0 below (length args) by 2 |
30 | `(cons (setf ,p (cons ,k ,v)) | 28 | unless (member (nth i args) |
31 | ,getter))))) | 29 | '(:keys :description :type |
32 | `(progn | 30 | :target :template)) |
33 | ,set-exp | 31 | append (list (nth i args) |
34 | ,v)))))))))) | 32 | (plist-get args (nth i |
35 | 33 | args))))))) | |
36 | (defun +org-capture-sort (&optional list) | 34 | ;; The only way I know how to do this properly (add a value to the end of |
37 | "Sort LIST by string keys. | 35 | ;; the list, if it exists; otherwise update it) is to do this weird if-setf |
38 | LIST is a symbol and defaults to `org-capture-templates'." | 36 | ;; dance. |
39 | (setf list (or list 'org-capture-templates)) | 37 | (if (seq-find (lambda (el) (equal (car el) keys)) |
40 | (set list (sort (symbol-value list) (lambda (a b) | 38 | org-capture-templates) |
41 | (string< (car a) (car b)))))) | 39 | (setf (alist-get keys org-capture-templates nil nil #'equal) |
42 | 40 | template-value) | |
43 | (defun +org-capture-sort-after-init (&optional list) | 41 | (setf org-capture-templates |
44 | "Sort LIST with `+org-capture-sort' after Emacs init." | 42 | (append org-capture-templates |
45 | (+ensure-after-init #'+org-capture-sort)) | 43 | (list (cons keys template-value))))) |
46 | 44 | ;; Regardless of what we do, return the new value of | |
47 | ;;;###autoload | 45 | ;; `org-capture-templates'. |
48 | (defun +org-capture-templates-setf (key value &optional list sort-after) | 46 | org-capture-templates)) |
49 | "Add KEY to LIST, using `setf'. | ||
50 | LIST is a symbol and defaults to `org-capture-templates' -- so | ||
51 | this function sets values on a list that's structured as such. | ||
52 | |||
53 | Thus, KEY is a string key. If it's longer than one character, | ||
54 | this function will search LIST for each successive run of | ||
55 | characters before the final, ensuring sub-lists exist of the | ||
56 | form (CHARS DESCRIPTION). | ||
57 | |||
58 | For example, if KEY is \"abc\", first a LIST item of the form (a | ||
59 | DESCRIPTION), if non-existant, will be added to the list (with a | ||
60 | default description), then an item of the | ||
61 | form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST. | ||
62 | |||
63 | VALUE is the template or group header required for | ||
64 | `org-capture-templates', which see. | ||
65 | |||
66 | SORT-AFTER, when set to t, will call | ||
67 | `+org-capture-templates-sort' after setting, to ensure org can | ||
68 | properly process the variable." | ||
69 | ;; LIST defaults to `org-capture-templates' | ||
70 | (declare (indent 2)) | ||
71 | (unless list (setf list 'org-capture-templates)) | ||
72 | ;; Ensure VALUE is a list to cons properly | ||
73 | (unless (listp value) (setf value (list value))) | ||
74 | (when (> (length key) 1) | ||
75 | ;; Check for existence of groups. | ||
76 | (let ((expected (cl-loop for i from 1 to (1- (length key)) | ||
77 | collect (substring key 0 i) into keys | ||
78 | finally return keys))) | ||
79 | (cl-loop for ek in expected | ||
80 | if (not (+org-capture--get ek (symbol-value list))) do | ||
81 | (setf (+org-capture--get ek (symbol-value list)) | ||
82 | (list (format "(Group %s)" ek)))))) | ||
83 | (prog1 ;; Set KEY to VALUE | ||
84 | (setf (+org-capture--get key (symbol-value list)) value) | ||
85 | ;; Sort after, maybe | ||
86 | (when sort-after (+org-capture-sort list)))) | ||
87 | |||
88 | (defun +org-template--ensure-path (keys &optional list) | ||
89 | "Ensure path of keys exists in `org-capture-templates'." | ||
90 | (unless list (setf list 'org-capture-templates)) | ||
91 | (when (> (length key) 1) | ||
92 | ;; Check for existence of groups. | ||
93 | (let ((expected (cl-loop for i from 1 to (1- (length key)) | ||
94 | collect (substring key 0 i) into keys | ||
95 | finally return keys))) | ||
96 | (cl-loop for ek in expected | ||
97 | if (not (+org-capture--get ek (symbol-value list))) do | ||
98 | (setf (+org-capture--get ek (symbol-value list)) | ||
99 | (list (format "(Group %s)" ek))))))) | ||
100 | |||
101 | (defcustom +org-capture-default-type 'entry | ||
102 | "Default template for `org-capture-templates'." | ||
103 | :type '(choice (const :tag "Entry" entry) | ||
104 | (const :tag "Item" item) | ||
105 | (const :tag "Check Item" checkitem) | ||
106 | (const :tag "Table Line" table-line) | ||
107 | (const :tag "Plain Text" plain))) | ||
108 | |||
109 | (defcustom +org-capture-default-target "" | ||
110 | "Default target for `org-capture-templates'." | ||
111 | ;; TODO: type | ||
112 | ) | ||
113 | |||
114 | (defcustom +org-capture-default-template nil | ||
115 | "Default template for `org-capture-templates'." | ||
116 | ;; TODO: type | ||
117 | ) | ||
118 | |||
119 | (defun +org-define-capture-templates-group (keys description) | ||
120 | "Add a group title to `org-capture-templates'." | ||
121 | (setf (+org-capture--get keys org-capture-templates) | ||
122 | (list description))) | ||
123 | |||
124 | ;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]] | ||
125 | (defun +org-define-capture-template (keys description &rest args) | ||
126 | "Define a capture template and necessary antecedents. | ||
127 | ARGS is a plist, which in addition to the additional options | ||
128 | `org-capture-templates' accepts, takes the following and places | ||
129 | them accordingly: :type, :target, and :template. Each of these | ||
130 | corresponds to the same field in `org-capture-templates's | ||
131 | docstring, which see. Likewise with KEYS and DESCRIPTION, which | ||
132 | are passed separately to the function. | ||
133 | |||
134 | This function will also create all the necessary intermediate | ||
135 | capture keys needed for `org-capture'; that is, if KEYS is | ||
136 | \"wcp\", entries for \"w\" and \"wc\" will both be ensured in | ||
137 | `org-capture-templates'." | ||
138 | (declare (indent 2)) | ||
139 | ;; Check for existence of parent groups | ||
140 | (when (> (length keys) 1) | ||
141 | (let ((expected (cl-loop for i from 1 to (1- (length keys)) | ||
142 | collect (substring 0 i) into keys | ||
143 | finally return keys))) | ||
144 | (cl-loop | ||
145 | for ek in expected | ||
146 | if (not (+org-capture--get ek org-capture-templates)) | ||
147 | do (+org-define-capture-templates-group ek (format "(Group %s)" ek))))) | ||
148 | (if (null args) | ||
149 | ;; Add the title | ||
150 | (+org-define-capture-templates-group keys description) | ||
151 | ;; Add the capture template. | ||
152 | (setf (+org-capture--get keys org-capture-templates) | ||
153 | (append (list (or (plist-get args :type) | ||
154 | +org-capture-default-type) | ||
155 | (or ( plist-get args :target) | ||
156 | +org-capture-default-target) | ||
157 | (or (plist-get args :template) | ||
158 | +org-capture-default-template)) | ||
159 | (cl-loop for (key val) on args by #'cddr | ||
160 | unless (member key '(:type :target :template)) | ||
161 | append (list key val)))))) | ||
162 | 47 | ||
163 | (provide '+org-capture) | 48 | (provide '+org-capture) |
164 | ;;; +org-capture.el ends here | 49 | ;;; +org-capture.el |
diff --git a/lisp/+org.el b/lisp/+org.el index 7698ec9..a148bd8 100644 --- a/lisp/+org.el +++ b/lisp/+org.el | |||
@@ -1,7 +1,13 @@ | |||
1 | ;;; +org.el --- -*- lexical-binding: t -*- | 1 | ;;; +org.el -*- lexical-binding: t; -*- |
2 | 2 | ||
3 | ;;; Org Return DWIM | 3 | ;;; Code: |
4 | ;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] | 4 | |
5 | (require 'cl-lib) | ||
6 | (require 'seq) | ||
7 | |||
8 | ;;; Org-return DWIM | ||
9 | ;; https://github.com/alphapapa/unpackaged.el, | ||
10 | ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ | ||
5 | 11 | ||
6 | (defun +org-element-descendant-of (type element) | 12 | (defun +org-element-descendant-of (type element) |
7 | "Return non-nil if ELEMENT is a descendant of TYPE. | 13 | "Return non-nil if ELEMENT is a descendant of TYPE. |
@@ -94,53 +100,13 @@ With PREFIX, call `org-return'." | |||
94 | (t ; Otherwise---just call `org-return'. | 100 | (t ; Otherwise---just call `org-return'. |
95 | (org-return)))) | 101 | (org-return)))) |
96 | 102 | ||
97 | (defun +org-table-copy-down|+org-return (&optional n) | 103 | (defun +org-table-copy-down|+org-return-dwim (&optional n) |
98 | "Call `org-table-copy-down' or `+org-return' depending on context." | 104 | "Call `org-table-copy-down' or `+org-return' depending on context." |
99 | (interactive "P") | 105 | (interactive "P") |
100 | (if (org-table-check-inside-data-field 'noerror) | 106 | (if (org-table-check-inside-data-field 'noerror) |
101 | (org-table-copy-down (or n 1)) | 107 | (org-table-copy-down (or n 1)) |
102 | (+org-return-dwim n))) | 108 | (+org-return-dwim n))) |
103 | 109 | ||
104 | ;;; Copy org trees as HTML | ||
105 | |||
106 | ;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. | ||
107 | (defun +org-export-clip-to-html | ||
108 | (&optional async subtreep visible-only body-only ext-plist post-process) | ||
109 | "Export region to HTML, and copy it to the clipboard. | ||
110 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, | ||
111 | and POST-PROCESS are passed to `org-export-to-file'." | ||
112 | (interactive) ; XXX: hould this be interactive? | ||
113 | (message "Exporting Org to HTML...") | ||
114 | (let ((org-tmp-file "/tmp/org.html")) | ||
115 | (org-export-to-file 'html org-tmp-file | ||
116 | async subtreep visible-only body-only ext-plist post-process) | ||
117 | (start-process "xclip" "*xclip*" | ||
118 | "xclip" "-verbose" | ||
119 | "-i" org-tmp-file | ||
120 | "-t" "text/html" | ||
121 | "-selection" "clipboard")) | ||
122 | (message "Exporting Org to HTML...done.")) | ||
123 | |||
124 | ;; Specialized functions | ||
125 | (defun +org-export-clip-subtree-to-html () | ||
126 | "Export current subtree to HTML." | ||
127 | (interactive) | ||
128 | (+org-export-clip-to-html nil :subtree)) | ||
129 | |||
130 | ;;; Unsmartify quotes and dashes and stuff. | ||
131 | |||
132 | (defun +org-unsmartify () | ||
133 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." | ||
134 | (interactive) | ||
135 | (save-excursion | ||
136 | (goto-char (point-min)) | ||
137 | (while (re-search-forward "[“”‘’–—]" nil t) | ||
138 | (let ((replace (pcase (match-string 0) | ||
139 | ((or "“" "”") "\"") | ||
140 | ((or "‘" "’") "'") | ||
141 | ("–" "--") | ||
142 | ("—" "---")))) | ||
143 | (replace-match replace nil nil))))) | ||
144 | 110 | ||
145 | ;;; A ... different ... `org-open-at-point-dwim' | 111 | ;;; A ... different ... `org-open-at-point-dwim' |
146 | ;; I honestly don't remember what the difference is between this and the | 112 | ;; I honestly don't remember what the difference is between this and the |
@@ -177,20 +143,7 @@ and POST-PROCESS are passed to `org-export-to-file'." | |||
177 | (org-up-heading-all 1)) | 143 | (org-up-heading-all 1)) |
178 | (org-open-at-point arg))))) | 144 | (org-open-at-point arg))))) |
179 | 145 | ||
180 | ;;; Skip invisible shit when moving around | ||
181 | (defun +org-ignore-invisible (fn &rest r) | ||
182 | ":around ADVICE to ignore invisible text in `org-mode' buffers." | ||
183 | ;; TODO: generalize to all modes | ||
184 | (cond ((and (derived-mode-p #'org-mode) | ||
185 | (org-invisible-p)) | ||
186 | (while (org-invisible-p) | ||
187 | (forward-char)) | ||
188 | (apply fn r)) | ||
189 | (t (apply fn r)))) | ||
190 | |||
191 | ;;; Faces | 146 | ;;; Faces |
192 | |||
193 | ;;; Better org faces | ||
194 | ;; see `org-emphasis-alist' | 147 | ;; see `org-emphasis-alist' |
195 | 148 | ||
196 | (defface org-bold '((t (:weight bold))) | 149 | (defface org-bold '((t (:weight bold))) |
@@ -205,63 +158,152 @@ and POST-PROCESS are passed to `org-export-to-file'." | |||
205 | (defface org-strikethrough '((t (:strike-through t))) | 158 | (defface org-strikethrough '((t (:strike-through t))) |
206 | "Strike-through face for `org-mode' documents.") | 159 | "Strike-through face for `org-mode' documents.") |
207 | 160 | ||
208 | ;; `org-verbatim' and `org-code' are apparently already things, so we skip them | 161 | ;;; Unsmartify |
209 | ;; here. | 162 | |
210 | 163 | (defun +org-unsmartify () | |
211 | ;;; Inhibit hooks on `org-agenda' | 164 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." |
212 | ;; It's really annoying when I call `org-agenda' and five hundred Ispell | 165 | (interactive) |
213 | ;; processes are created because I have `flyspell-mode' in the hook. This mode | 166 | (save-excursion |
214 | ;; inhibits those hooks when entering the agenda, but runs them when opening the | 167 | (goto-char (point-min)) |
215 | ;; actual buffer. | 168 | (while (re-search-forward "[“”‘’–—]" nil t) |
216 | 169 | (let ((replace (pcase (match-string 0) | |
217 | (defun +org-agenda-inhibit-hooks (fn &rest r) | 170 | ((or "“" "”") "\"") |
218 | "Advice to inhibit hooks when entering `org-agenda'." | 171 | ((or "‘" "’") "'") |
219 | (let ((org-mode-hook nil)) | 172 | ("–" "--") |
220 | (apply fn r))) | 173 | ("—" "---")))) |
221 | 174 | (replace-match replace nil nil))))) | |
222 | (defvar-local +org-hook-has-run-p nil | 175 | |
223 | "Whether `org-mode-hook' has run in the current buffer.") | 176 | ;;; Copy org trees as HTML |
224 | 177 | ;; Thanks to Oleh Krehel: | |
225 | (defun +org-agenda-switch-run-hooks (&rest _) | 178 | ;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard |
226 | "Advice to run `org-mode-hook' when entering org-mode. | 179 | |
227 | This should only fire when switching to a buffer from `org-agenda'." | 180 | (defun +org-export-clip-to-html |
228 | (unless +org-hook-has-run-p | 181 | (&optional async subtreep visible-only body-only ext-plist post-process) |
229 | (run-hooks 'org-mode-hook) | 182 | "Export region to HTML, and copy it to the clipboard. |
230 | (setq +org-hook-has-run-p t))) | 183 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, |
231 | 184 | and POST-PROCESS are passed to `org-export-to-file'." | |
232 | (define-minor-mode +org-agenda-inhibit-hooks-mode | 185 | (interactive) ; XXX: hould this be interactive? |
233 | "Inhibit `org-mode-hook' when opening `org-agenda'." | 186 | (message "Exporting Org to HTML...") |
234 | :lighter " A/h" | 187 | (let ((org-tmp-file "/tmp/org.html")) |
235 | :global t | 188 | (org-export-to-file 'html org-tmp-file |
236 | (cond (+org-agenda-inhibit-hooks-mode | 189 | async subtreep visible-only body-only ext-plist post-process) |
237 | (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) | 190 | ;; XXX: figure out which clipboard to use, or use something in Emacs |
238 | (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) | 191 | (start-process "xclip" "*xclip*" |
239 | (:else | 192 | "xclip" "-verbose" |
240 | (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) | 193 | "-i" org-tmp-file |
241 | (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) | 194 | "-t" "text/html" |
242 | 195 | "-selection" "clipboard")) | |
243 | ;;; Drawers | 196 | (message "Exporting Org to HTML...done.")) |
197 | |||
198 | ;; Specialized functions | ||
199 | (defun +org-export-clip-subtree-to-html () | ||
200 | "Export current subtree to HTML." | ||
201 | (interactive) | ||
202 | (+org-export-clip-to-html nil :subtree)) | ||
203 | |||
204 | ;;; Hide drawers on save, except the currently-expanded one | ||
205 | |||
244 | (defun +org-hide-drawers-except-point () | 206 | (defun +org-hide-drawers-except-point () |
245 | "Hide all drawers except for the one point is in." | 207 | "Hide all drawers except for the one point is in." |
246 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | 208 | ;; Most of this bit is taken from `org-fold--hide-drawers'. |
247 | (let ((pt (point)) | 209 | (let ((pt (point)) |
248 | (begin (point-min)) | 210 | (begin (point-min)) |
249 | (end (point-max))) | 211 | (end (point-max))) |
250 | (save-excursion | 212 | (save-excursion |
251 | (goto-char begin) | 213 | (goto-char begin) |
252 | (while (and (< (point) end) | 214 | (while (and (< (point) end) |
253 | (re-search-forward org-drawer-regexp end t)) | 215 | (re-search-forward org-drawer-regexp end t)) |
254 | (if (org-fold-folded-p nil 'drawer) | 216 | (if (org-fold-folded-p nil 'drawer) |
255 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | 217 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) |
256 | (let* ((drawer (org-element-at-point)) | 218 | (let* ((drawer (org-element-at-point)) |
257 | (type (org-element-type drawer)) | 219 | (type (org-element-type drawer)) |
258 | (el-begin (org-element-property :begin drawer)) | 220 | (el-begin (org-element-property :begin drawer)) |
259 | (el-end (org-element-property :end drawer))) | 221 | (el-end (org-element-property :end drawer))) |
260 | (when (memq type '(drawer property-drawer)) | 222 | (when (memq type '(drawer property-drawer)) |
261 | (org-fold-hide-drawer-toggle | 223 | (org-fold-hide-drawer-toggle |
262 | (if (< el-begin pt el-end) 'off 'on) | 224 | (if (< el-begin pt el-end) 'off 'on) |
263 | nil drawer) | 225 | nil drawer) |
264 | (goto-char el-end)))))))) | 226 | (goto-char el-end)))))))) |
227 | |||
228 | ;;; Define `ol' link types | ||
229 | |||
230 | (defmacro +org-link-define-type (type args &rest body) | ||
231 | "Define an org link TYPE. | ||
232 | A function named `+org-link-TYPE-open' will be created, with ARGS | ||
233 | as its arguments and BODY as its body. BODY can be blank, in | ||
234 | which case the user will be messaged (This is a good do-nothing | ||
235 | effect for exporting link types)." | ||
236 | (declare (indent 2) | ||
237 | (doc-string 3) | ||
238 | (debug (sexp sexp def-body))) | ||
239 | (let ((fn (intern (format "+org-link-%s-open" type))) | ||
240 | (body (or body `((message ,(format "%S: %%S" type) | ||
241 | ,(car args))))) | ||
242 | (type-string (format "%S" type))) | ||
243 | `(prog1 | ||
244 | (defun ,fn ,args ,@body) | ||
245 | (org-link-set-parameters ,type-string :follow #',fn)))) | ||
246 | |||
247 | ;;; Skip some files in `org-agenda' | ||
248 | |||
249 | (defcustom org-agenda-file-skip-regexp nil | ||
250 | "Files matching this regexp are removed from `org-agenda-files'." | ||
251 | :group 'org-agenda) | ||
252 | |||
253 | (defun org-agenda-files@skip-regexp (files) | ||
254 | "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'." | ||
255 | (when org-agenda-file-skip-regexp | ||
256 | (setq files | ||
257 | (seq-remove (lambda (file) | ||
258 | (string-match-p | ||
259 | org-agenda-file-skip-regexp file)) | ||
260 | files))) | ||
261 | files) | ||
262 | |||
263 | ;;; Prompt for stuff | ||
264 | |||
265 | (defun +org-prompt-for-property (property &optional clipboardp insert list) | ||
266 | "Prompt for PROPERTY and return a properly-formatted string. | ||
267 | Pre-fill the input with clipboard contents if they match CLIPBOARDP. If | ||
268 | CLIPBOARDP is nil or missing, don't pre-fill. | ||
269 | |||
270 | If INSERT is non-nil, insert the property into the property | ||
271 | drawer of the current org tree. | ||
272 | |||
273 | If LIST is non-nil, return the result as a list instead of a string." | ||
274 | (let* ((kill (current-kill 0)) | ||
275 | (value (read-string (concat property ": ") | ||
276 | (when (and clipboardp | ||
277 | (or (eq clipboardp t) | ||
278 | (funcall clipboardp kill))) | ||
279 | kill)))) | ||
280 | (when insert | ||
281 | (org-set-property property value)) | ||
282 | (if list | ||
283 | (list property value) | ||
284 | (format ":%s: %s" property value)))) | ||
265 | 285 | ||
286 | (defun +org-prompt-tags (&optional prompt global) | ||
287 | (let* ((buffer (org-capture-get :buffer)) | ||
288 | (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) | ||
289 | (org-last-tags-completion-table | ||
290 | (org-global-tags-completion-table | ||
291 | (if global (org-agenda-files) (list file)))) | ||
292 | (org-add-colon-after-tag-completion t) | ||
293 | (ins (mapconcat | ||
294 | #'identity | ||
295 | (let ((crm-separator "[ \t]*:[ \t]*")) | ||
296 | (completing-read-multiple | ||
297 | (or prompt "Tags: ") | ||
298 | org-last-tags-completion-table nil nil nil | ||
299 | 'org-tags-history)) | ||
300 | ":"))) | ||
301 | (when (org-string-nw-p ins) | ||
302 | (prog1 (concat | ||
303 | (unless (eq (char-before) ?:) ":") | ||
304 | ins | ||
305 | (unless (eq (char-after) ?:) ":")) | ||
306 | (when (org-at-heading-p) (org-align-tags)))))) | ||
266 | 307 | ||
267 | (provide '+org) | 308 | (provide '+org) |
309 | ;;; +org.el ends here | ||
diff --git a/lisp/+ox.el b/lisp/+ox.el deleted file mode 100644 index 8748a55..0000000 --- a/lisp/+ox.el +++ /dev/null | |||
@@ -1,29 +0,0 @@ | |||
1 | ;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'ox) | ||
8 | |||
9 | ;;; Run hooks before doing any exporting at all | ||
10 | |||
11 | (defcustom +org-export-pre-hook nil | ||
12 | "Functions to run /before/ `org-export-as' does anything. | ||
13 | These will run on the buffer about to be exported, NOT a copy." | ||
14 | :type 'hook) | ||
15 | |||
16 | (defun +org-export-pre-run-hooks (&rest _) | ||
17 | "Run hooks in `+org-export-pre-hook'." | ||
18 | (run-hooks '+org-export-pre-hook)) | ||
19 | |||
20 | (defun +org-export-pre-hooks-insinuate () | ||
21 | "Advise `org-export-as' to run `+org-export-pre-hook'." | ||
22 | (advice-add 'org-export-as :before #'+org-export-pre-run-hooks)) | ||
23 | |||
24 | (defun +org-export-pre-hooks-remove () | ||
25 | "Remove pre-hook advice on `org-export-as'." | ||
26 | (advice-remove 'org-export-as #'+org-export-pre-run-hooks)) | ||
27 | |||
28 | (provide '+ox) | ||
29 | ;;; +ox.el ends here | ||
diff --git a/lisp/+paredit.el b/lisp/+paredit.el new file mode 100644 index 0000000..ab176b8 --- /dev/null +++ b/lisp/+paredit.el | |||
@@ -0,0 +1,26 @@ | |||
1 | ;;; +paredit.el -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Fixing unquote-splicing behaviour with Paredit | ||
4 | ;; https://www.n16f.net/blog/fixing-unquote-splicing-behaviour-with-paredit/ | ||
5 | |||
6 | (require 'paredit) | ||
7 | (require 'seq) | ||
8 | |||
9 | (defcustom +paredit-no-space-prefixes '(",@") | ||
10 | "Prefix strings to not insert a space after in `paredit'." | ||
11 | :group 'paredit | ||
12 | :type '(repeat string)) | ||
13 | |||
14 | (defun +paredit-space-for-delimiter (endp delimiter) | ||
15 | (let ((point (point))) | ||
16 | (or endp | ||
17 | (seq-every-p | ||
18 | (lambda (prefix) | ||
19 | (and (> point (length prefix)) | ||
20 | (let ((start (- point (length prefix))) | ||
21 | (end point)) | ||
22 | (not (string= (buffer-substring start end) prefix))))) | ||
23 | +paredit-no-space-prefixes)))) | ||
24 | |||
25 | (provide '+paredit) | ||
26 | ;;; +paredit.el ends here | ||
diff --git a/lisp/+tempo.el b/lisp/+tempo.el deleted file mode 100644 index 2c81e54..0000000 --- a/lisp/+tempo.el +++ /dev/null | |||
@@ -1,45 +0,0 @@ | |||
1 | ;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*- | ||
2 | |||
3 | (require 'tempo) | ||
4 | (declare-function derived-mode-abbrev-table-name "tempo") | ||
5 | |||
6 | ;; TODO: I need to figure out where this function goes. | ||
7 | (defun delete2 (list &rest elems) | ||
8 | "Delete each element of ELEMS, and the next item, from LIST." | ||
9 | (let ((r nil)) | ||
10 | (while (consp list) | ||
11 | (if (member (car list) elems) | ||
12 | (setf list (cdr list)) | ||
13 | (setf r (cons (car list) r))) | ||
14 | (setf list (cdr list))) | ||
15 | (reverse r))) | ||
16 | |||
17 | (defmacro define-tempo (tag doc &rest elements) | ||
18 | "Define a template and add its tag to MODE's abbrev-table. | ||
19 | TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. | ||
20 | ABBREV, if given, is the abbrev string to use for template expansion | ||
21 | under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." | ||
22 | (declare (indent 1)) | ||
23 | (let* ((template (gensym)) | ||
24 | (tag (cond ((stringp tag) tag) | ||
25 | ((symbolp tag) (symbol-name tag)) | ||
26 | (t (user-error "TAG must be a string or symbol: %S" tag)))) | ||
27 | (mode (or (plist-get elements :mode) nil)) | ||
28 | (abbrev (or (plist-get elements :abbrev) tag)) | ||
29 | (taglist (or (plist-get elements :taglist) nil)) | ||
30 | (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) | ||
31 | (while (and tname (not (memq tname abbrev-table-name-list))) | ||
32 | (setq tname (and (get mode 'derived-mode-parent) | ||
33 | (derived-mode-abbrev-table-name | ||
34 | (get mode 'derived-mode-parent))))) | ||
35 | (or tname 'global-abbrev-table))) | ||
36 | (elements (delete2 elements :mode :abbrev :taglist))) | ||
37 | `(let ((,template (tempo-define-template ,tag | ||
38 | ',elements | ||
39 | ,(or abbrev tag) | ||
40 | ,doc | ||
41 | ,taglist))) | ||
42 | (define-abbrev ,table ,tag "" ,template :system t) | ||
43 | (put ,template 'no-self-insert t)))) | ||
44 | |||
45 | (provide '+tempo) | ||
diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el index 9266807..6defda7 100644 --- a/lisp/+titlecase.el +++ b/lisp/+titlecase.el | |||
@@ -22,11 +22,13 @@ With prefix ARG, toggle the value of | |||
22 | ;; See also `org-map-tree'. I'm not using that function because I want to | 22 | ;; See also `org-map-tree'. I'm not using that function because I want to |
23 | ;; skip the first headline. A better solution would be to patch | 23 | ;; skip the first headline. A better solution would be to patch |
24 | ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). | 24 | ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). |
25 | (let ((level (funcall outline-level))) | 25 | (let ((level (funcall outline-level)) |
26 | (org-special-ctrl-a/e t)) | ||
26 | (while (and (progn (outline-next-heading) | 27 | (while (and (progn (outline-next-heading) |
27 | (> (funcall outline-level) level)) | 28 | (> (funcall outline-level) level)) |
28 | (not (eobp))) | 29 | (not (eobp))) |
29 | (titlecase-line))))) | 30 | (titlecase-region (org-beginning-of-line) |
31 | (org-end-of-line)))))) | ||
30 | 32 | ||
31 | (provide '+titlecase) | 33 | (provide '+titlecase) |
32 | ;;; +titlecase.el ends here | 34 | ;;; +titlecase.el ends here |
diff --git a/lisp/+window.el b/lisp/+window.el deleted file mode 100644 index 52b3712..0000000 --- a/lisp/+window.el +++ /dev/null | |||
@@ -1,130 +0,0 @@ | |||
1 | ;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; Do I want to propose this change in the Emacs ML? | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'window) | ||
10 | |||
11 | ;;; Split windows based on `window-total-width', not `window-width' | ||
12 | ;; I have to just redefine these functions because the check is really deep in | ||
13 | ;; there. | ||
14 | |||
15 | (defun window-splittable-p (window &optional horizontal) | ||
16 | "Return non-nil if `split-window-sensibly' may split WINDOW. | ||
17 | Optional argument HORIZONTAL nil or omitted means check whether | ||
18 | `split-window-sensibly' may split WINDOW vertically. HORIZONTAL | ||
19 | non-nil means check whether WINDOW may be split horizontally. | ||
20 | |||
21 | WINDOW may be split vertically when the following conditions | ||
22 | hold: | ||
23 | - `window-size-fixed' is either nil or equals `width' for the | ||
24 | buffer of WINDOW. | ||
25 | - `split-height-threshold' is an integer and WINDOW is at least as | ||
26 | high as `split-height-threshold'. | ||
27 | - When WINDOW is split evenly, the emanating windows are at least | ||
28 | `window-min-height' lines tall and can accommodate at least one | ||
29 | line plus - if WINDOW has one - a mode line. | ||
30 | |||
31 | WINDOW may be split horizontally when the following conditions | ||
32 | hold: | ||
33 | - `window-size-fixed' is either nil or equals `height' for the | ||
34 | buffer of WINDOW. | ||
35 | - `split-width-threshold' is an integer and WINDOW is at least as | ||
36 | wide as `split-width-threshold'. | ||
37 | - When WINDOW is split evenly, the emanating windows are at least | ||
38 | `window-min-width' or two (whichever is larger) columns wide." | ||
39 | (when (and (window-live-p window) | ||
40 | (not (window-parameter window 'window-side))) | ||
41 | (with-current-buffer (window-buffer window) | ||
42 | (if horizontal | ||
43 | ;; A window can be split horizontally when its width is not | ||
44 | ;; fixed, it is at least `split-width-threshold' columns wide | ||
45 | ;; and at least twice as wide as `window-min-width' and 2 (the | ||
46 | ;; latter value is hardcoded). | ||
47 | (and (memq window-size-fixed '(nil height)) | ||
48 | ;; Testing `window-full-width-p' here hardly makes any | ||
49 | ;; sense nowadays. This can be done more intuitively by | ||
50 | ;; setting up `split-width-threshold' appropriately. | ||
51 | (numberp split-width-threshold) | ||
52 | (>= (window-total-width window) | ||
53 | (max split-width-threshold | ||
54 | (* 2 (max window-min-width 2))))) | ||
55 | ;; A window can be split vertically when its height is not | ||
56 | ;; fixed, it is at least `split-height-threshold' lines high, | ||
57 | ;; and it is at least twice as high as `window-min-height' and 2 | ||
58 | ;; if it has a mode line or 1. | ||
59 | (and (memq window-size-fixed '(nil width)) | ||
60 | (numberp split-height-threshold) | ||
61 | (>= (window-height window) | ||
62 | (max split-height-threshold | ||
63 | (* 2 (max window-min-height | ||
64 | (if mode-line-format 2 1)))))))))) | ||
65 | |||
66 | (defun split-window-sensibly (&optional window) | ||
67 | "Split WINDOW in a way suitable for `display-buffer'. | ||
68 | WINDOW defaults to the currently selected window. | ||
69 | If `split-height-threshold' specifies an integer, WINDOW is at | ||
70 | least `split-height-threshold' lines tall and can be split | ||
71 | vertically, split WINDOW into two windows one above the other and | ||
72 | return the lower window. Otherwise, if `split-width-threshold' | ||
73 | specifies an integer, WINDOW is at least `split-width-threshold' | ||
74 | columns wide and can be split horizontally, split WINDOW into two | ||
75 | windows side by side and return the window on the right. If this | ||
76 | can't be done either and WINDOW is the only window on its frame, | ||
77 | try to split WINDOW vertically disregarding any value specified | ||
78 | by `split-height-threshold'. If that succeeds, return the lower | ||
79 | window. Return nil otherwise. | ||
80 | |||
81 | By default `display-buffer' routines call this function to split | ||
82 | the largest or least recently used window. To change the default | ||
83 | customize the option `split-window-preferred-function'. | ||
84 | |||
85 | You can enforce this function to not split WINDOW horizontally, | ||
86 | by setting (or binding) the variable `split-width-threshold' to | ||
87 | nil. If, in addition, you set `split-height-threshold' to zero, | ||
88 | chances increase that this function does split WINDOW vertically. | ||
89 | |||
90 | In order to not split WINDOW vertically, set (or bind) the | ||
91 | variable `split-height-threshold' to nil. Additionally, you can | ||
92 | set `split-width-threshold' to zero to make a horizontal split | ||
93 | more likely to occur. | ||
94 | |||
95 | Have a look at the function `window-splittable-p' if you want to | ||
96 | know how `split-window-sensibly' determines whether WINDOW can be | ||
97 | split." | ||
98 | (let ((window (or window (selected-window)))) | ||
99 | (or (and (window-splittable-p window) | ||
100 | ;; Split window vertically. | ||
101 | (with-selected-window window | ||
102 | (split-window-below))) | ||
103 | (and (window-splittable-p window t) | ||
104 | ;; Split window horizontally. | ||
105 | (with-selected-window window | ||
106 | (split-window-right))) | ||
107 | (and | ||
108 | ;; If WINDOW is the only usable window on its frame (it is | ||
109 | ;; the only one or, not being the only one, all the other | ||
110 | ;; ones are dedicated) and is not the minibuffer window, try | ||
111 | ;; to split it vertically disregarding the value of | ||
112 | ;; `split-height-threshold'. | ||
113 | (let ((frame (window-frame window))) | ||
114 | (or | ||
115 | (eq window (frame-root-window frame)) | ||
116 | (catch 'done | ||
117 | (walk-window-tree (lambda (w) | ||
118 | (unless (or (eq w window) | ||
119 | (window-dedicated-p w)) | ||
120 | (throw 'done nil))) | ||
121 | frame nil 'nomini) | ||
122 | t))) | ||
123 | (not (window-minibuffer-p window)) | ||
124 | (let ((split-height-threshold 0)) | ||
125 | (when (window-splittable-p window) | ||
126 | (with-selected-window window | ||
127 | (split-window-below)))))))) | ||
128 | |||
129 | (provide '+window) | ||
130 | ;;; +window.el ends here | ||
diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el new file mode 100644 index 0000000..80b2bcc --- /dev/null +++ b/lisp/acdw-defaults.el | |||
@@ -0,0 +1,292 @@ | |||
1 | ;;; acdw-defaults.el --- measured defaults for Emacs -*- lexical-binding: t -*- | ||
2 | ;; by C. Duckworth <acdw@acdw.net> | ||
3 | |||
4 | ;;; Commentary: | ||
5 | |||
6 | ;; I find myself copy-pasting a lot of "boilerplate" type code when | ||
7 | ;; bankrupting my Emacs config and starting afresh. Instead of doing | ||
8 | ;; that, I'm putting it here, where it'll be easier to include in my | ||
9 | ;; config. | ||
10 | |||
11 | ;; Of course, some might say I could just ... stop bankrupting my | ||
12 | ;; Emacs. But like, why would I want to? | ||
13 | |||
14 | ;;; Code: | ||
15 | |||
16 | (require 'seq) | ||
17 | |||
18 | (defvar default-ring-max 256 | ||
19 | "Default maximum for ring variables.") | ||
20 | |||
21 | (unless (boundp 'use-short-answers) | ||
22 | (fset 'yes-or-no-p 'y-or-n-p)) | ||
23 | |||
24 | (setc async-shell-command-buffer 'new-buffer | ||
25 | async-shell-command-display-buffer nil | ||
26 | auto-hscroll-mode t | ||
27 | auto-window-vscroll nil | ||
28 | cursor-in-non-selected-windows 'hollow | ||
29 | cursor-type 'bar | ||
30 | echo-keystrokes 0.01 | ||
31 | fast-but-imprecise-scrolling t | ||
32 | fill-column 80 | ||
33 | global-mark-ring-max default-ring-max | ||
34 | hscroll-margin 1 | ||
35 | hscroll-step 1 | ||
36 | inhibit-startup-screen t | ||
37 | initial-buffer-choice t | ||
38 | kill-do-not-save-duplicates t | ||
39 | kill-read-only-ok t | ||
40 | kill-ring-max default-ring-max | ||
41 | kmacro-ring-max default-ring-max | ||
42 | mark-ring-max default-ring-max | ||
43 | read-answer-short t | ||
44 | read-process-output-max (* 10 1024 1024) | ||
45 | ring-bell-function #'ignore | ||
46 | save-interprogram-paste-before-kill t | ||
47 | scroll-conservatively 25 | ||
48 | scroll-margin 0 | ||
49 | scroll-preserve-screen-position 1 | ||
50 | scroll-step 1 | ||
51 | sentence-end-double-space t | ||
52 | set-mark-command-repeat-pop t | ||
53 | tab-width 8 | ||
54 | undo-limit (* 10 1024 1024) | ||
55 | use-dialog-box nil | ||
56 | use-file-dialog nil | ||
57 | use-short-answers t | ||
58 | window-resize-pixelwise t | ||
59 | yank-pop-change-selection t) | ||
60 | |||
61 | ;;; Encodings | ||
62 | |||
63 | ;; Allegedly, this is the only one you need... | ||
64 | (set-language-environment "UTF-8") | ||
65 | ;; But I still set all of these, for fun. | ||
66 | (setq-default buffer-file-coding-system 'utf-8-unix | ||
67 | coding-system-for-read 'utf-8-unix | ||
68 | coding-system-for-write 'utf-8-unix | ||
69 | default-process-coding-system '(utf-8-unix . utf-8-unix) | ||
70 | locale-coding-system 'utf-8-unix | ||
71 | x-select-request-type '(UTF8_STRING | ||
72 | COMPOUND_TEXT | ||
73 | TEXT | ||
74 | STRING)) | ||
75 | |||
76 | (set-charset-priority 'unicode) | ||
77 | (prefer-coding-system 'utf-8-unix) | ||
78 | (set-default-coding-systems 'utf-8-unix) | ||
79 | (set-terminal-coding-system 'utf-8-unix) | ||
80 | (set-keyboard-coding-system 'utf-8-unix) | ||
81 | |||
82 | (pcase system-type | ||
83 | ((or 'ms-dos 'windows-nt) | ||
84 | (set-clipboard-coding-system 'utf-16-le) | ||
85 | (set-selection-coding-system 'utf-16-le)) | ||
86 | (_ | ||
87 | (set-selection-coding-system 'utf-8) | ||
88 | (set-clipboard-coding-system 'utf-8))) | ||
89 | |||
90 | ;;; Modes | ||
91 | |||
92 | (dolist (enable-mode '(;; Enable these modes on startup | ||
93 | delete-selection-mode | ||
94 | global-so-long-mode | ||
95 | )) | ||
96 | (funcall enable-mode +1)) | ||
97 | |||
98 | (dolist (disable-mode '(;; Disable these modes on startup | ||
99 | horizontal-scroll-bar-mode | ||
100 | menu-bar-mode | ||
101 | scroll-bar-mode | ||
102 | tool-bar-mode | ||
103 | tooltip-mode | ||
104 | )) | ||
105 | (funcall disable-mode -1)) | ||
106 | |||
107 | ;;; Internal packages | ||
108 | |||
109 | (when (require 'abbrev nil t) | ||
110 | (custom-set-variables | ||
111 | '(abbrev-file-name (sync/ "abbrev.el")) | ||
112 | '(save-abbrevs 'silently))) | ||
113 | |||
114 | (when (require 'autorevert nil t) | ||
115 | (custom-set-variables | ||
116 | '(auto-revert-verbose nil) | ||
117 | '(global-auto-revert-non-file-buffers t)) | ||
118 | (global-auto-revert-mode +1)) | ||
119 | |||
120 | (when (require 'comp nil t) | ||
121 | (custom-set-variables | ||
122 | '(native-comp-async-report-warnings-errors 'silent) | ||
123 | '(native-comp-deferred-compilation t))) | ||
124 | |||
125 | (when (require 'custom nil t) | ||
126 | (custom-set-variables | ||
127 | '(custom-file (etc/ "custom.el")))) | ||
128 | |||
129 | (when (require 'ediff nil t) | ||
130 | (custom-set-variables | ||
131 | '(ediff-window-setup-function #'ediff-setup-windows-plain))) | ||
132 | |||
133 | (when (require 'eldoc nil t) | ||
134 | (custom-set-variables | ||
135 | '(eldoc-echo-area-use-multiline-p nil) | ||
136 | '(eldoc-idle-delay 0.1))) | ||
137 | |||
138 | (when (require 'executable nil t) | ||
139 | (custom-set-variables | ||
140 | '(executable-prefix-env t))) | ||
141 | |||
142 | (when (require 'files nil t) | ||
143 | (custom-set-variables | ||
144 | '(auto-save-default nil) | ||
145 | '(auto-save-interval 1) | ||
146 | '(auto-save-no-message t) | ||
147 | '(auto-save-timeout 1) | ||
148 | '(auto-save-visited-interval 1) | ||
149 | '(backup-by-copying t) | ||
150 | '(create-lockfiles nil) | ||
151 | '(delete-old-versions t) | ||
152 | '(find-file-visit-truename t) | ||
153 | '(kept-new-versions 8) | ||
154 | '(kept-old-versions 8) | ||
155 | '(mode-require-final-newline t) | ||
156 | '(version-control t) | ||
157 | '(view-read-only t)) | ||
158 | (dolist (h/f | ||
159 | '((after-save-hook . executable-make-buffer-file-executable-if-script-p) | ||
160 | (find-file-not-found-functions . create-missing-directories) | ||
161 | (find-file-hook . +vc-off@remote))) | ||
162 | (add-hook (car h/f) (cdr h/f))) | ||
163 | (auto-save-visited-mode)) | ||
164 | |||
165 | (when (require 'frame nil t) | ||
166 | (custom-set-variables | ||
167 | '(blink-cursor-blinks 1) | ||
168 | '(blink-cursor-interval 0.25) | ||
169 | '(blink-cursor-delay 0.25)) | ||
170 | (blink-cursor-mode)) | ||
171 | |||
172 | (when (require 'goto-addr nil t) | ||
173 | (if (fboundp 'global-goto-address-mode) | ||
174 | (global-goto-address-mode +1) | ||
175 | (add-hook 'after-change-major-mode-hook 'goto-address-mode))) | ||
176 | |||
177 | (when (require 'ibuffer nil t) | ||
178 | (global-set-key (kbd "C-x C-b") #'ibuffer) | ||
179 | (add-hook 'ibuffer-mode-hook #'hl-line-mode)) | ||
180 | |||
181 | (when (require 'image nil t) | ||
182 | (custom-set-variables | ||
183 | '(image-use-external-converter | ||
184 | (seq-some #'executable-find '("convert" "gm" "ffmpeg"))))) | ||
185 | |||
186 | (when (require 'imenu nil t) | ||
187 | (custom-set-variables | ||
188 | '(imenu-auto-rescan t))) | ||
189 | |||
190 | (when (require 'isearch nil t) | ||
191 | (custom-set-variables | ||
192 | '(regexp-search-ring-max default-ring-max) | ||
193 | '(search-ring-max default-ring-max))) | ||
194 | |||
195 | (when (require 'minibuffer nil t) | ||
196 | (custom-set-variables | ||
197 | '(completion-category-defaults nil) | ||
198 | '(completion-category-overrides '((file (styles partial-completion)))) | ||
199 | '(completion-ignore-case t) | ||
200 | '(completion-styles '(substring partial-completion)) | ||
201 | '(enable-recursive-minibuffers t) | ||
202 | '(file-name-shadow-properties '(invisible t intangible t)) | ||
203 | '(minibuffer-eldef-shorten-default t) | ||
204 | '(minibuffer-prompt-properties '( read-only t | ||
205 | cursor-intangible t | ||
206 | face minibuffer-prompt)) | ||
207 | '(read-buffer-completion-ignore-case t)) | ||
208 | (file-name-shadow-mode) | ||
209 | (minibuffer-electric-default-mode)) | ||
210 | |||
211 | (when (require 'mouse nil t) | ||
212 | (custom-set-variables | ||
213 | '(mouse-drag-copy-region t) | ||
214 | '(mouse-wheel-progressive-speed nil) | ||
215 | '(mouse-yank-at-point t))) | ||
216 | |||
217 | (when (require 'paren nil t) | ||
218 | (custom-set-variables | ||
219 | '(show-paren-delay 0.01) | ||
220 | '(show-paren-style 'parenthesis) | ||
221 | '(show-paren-when-point-in-periphery t) | ||
222 | '(show-paren-when-point-inside-paren t)) | ||
223 | (show-paren-mode) | ||
224 | (electric-pair-mode)) | ||
225 | |||
226 | (when (require 'recentf nil t) | ||
227 | (custom-set-variables | ||
228 | '(recentf-save-file (var/ "recentf.el")) | ||
229 | '(recentf-max-menu-items default-ring-max) | ||
230 | '(recentf-max-saved-items nil) | ||
231 | '(recentf-auto-cleanup 'mode)) | ||
232 | (add-to-list 'recentf-exclude etc/) | ||
233 | (add-to-list 'recentf-exclude var/) | ||
234 | (add-to-list 'recentf-exclude cache/) | ||
235 | (add-to-list 'recentf-exclude "-autoloads.el\\'") | ||
236 | (recentf-mode +1)) | ||
237 | |||
238 | (when (require 'savehist nil t) | ||
239 | (custom-set-variables | ||
240 | '(history-length 1024) | ||
241 | '(history-delete-duplicates t) | ||
242 | '(savehist-file (var/ "savehist.el")) | ||
243 | '(savehist-save-minibuffer-history t) | ||
244 | '(savehist-autosave-interval 30) | ||
245 | ;; Other variables --- don't truncate any of these. | ||
246 | ;; `add-to-history' uses the values of these variables unless | ||
247 | ;; they're nil, in which case it falls back to `history-length'. | ||
248 | '(kill-ring-max default-ring-max) | ||
249 | '(mark-ring-max default-ring-max) | ||
250 | '(global-mark-ring-max default-ring-max) | ||
251 | '(regexp-search-ring-max default-ring-max) | ||
252 | '(search-ring-max default-ring-max) | ||
253 | '(kmacro-ring-max default-ring-max) | ||
254 | '(eww-history-limit default-ring-max)) | ||
255 | (dolist (var '(global-mark-ring | ||
256 | mark-ring | ||
257 | kill-ring | ||
258 | kmacro-ring | ||
259 | regexp-search-ring | ||
260 | search-ring)) | ||
261 | (add-to-list 'savehist-additional-variables var)) | ||
262 | (savehist-mode +1)) | ||
263 | |||
264 | (when (require 'saveplace nil t) | ||
265 | (custom-set-variables | ||
266 | '(save-place-file (var/ "places.el")) | ||
267 | '(save-place-forget-unreadable-files (eq system-type 'gnu/linux))) | ||
268 | (save-place-mode 1)) | ||
269 | |||
270 | (when (require 'uniquify nil t) | ||
271 | (custom-set-variables | ||
272 | '(uniquify-after-kill-buffer-p t) | ||
273 | '(uniquify-buffer-name-style 'forward) | ||
274 | '(uniquify-ignore-buffers-re "^\\*") | ||
275 | '(uniquify-separator path-separator))) | ||
276 | |||
277 | (when (require 'vc nil t) | ||
278 | (custom-set-variables | ||
279 | '(vc-follow-symlinks t) | ||
280 | '(vc-make-backup-files t))) | ||
281 | |||
282 | (when (require 'window nil t) | ||
283 | (custom-set-variables | ||
284 | '(recenter-positions '(top 2 middle bottom)))) | ||
285 | |||
286 | ;;; New features | ||
287 | |||
288 | (when (fboundp 'pixel-scroll-precision-mode) | ||
289 | (pixel-scroll-precision-mode)) | ||
290 | |||
291 | (provide 'acdw-defaults) | ||
292 | ;;; acdw-defaults.el ends here | ||
diff --git a/lisp/acdw-funs.el b/lisp/acdw-funs.el new file mode 100644 index 0000000..ed41a61 --- /dev/null +++ b/lisp/acdw-funs.el | |||
@@ -0,0 +1,262 @@ | |||
1 | ;;; acdw-funs.el --- extra functions -*- lexical-binding: t -*- | ||
2 | |||
3 | |||
4 | ;;; Cribs from CRUX --- Advice | ||
5 | ;; https://github.com/bbatsov/crux | ||
6 | |||
7 | ;; All of these should go `:before' the function they're advising | ||
8 | (defun advise-region-or-buffer (&rest _) | ||
9 | "`:before' advice to work on the active region or whole buffer. | ||
10 | See also `with-region-or-buffer'." | ||
11 | (interactive (if mark-active | ||
12 | (list (region-beginning) (region-end)) | ||
13 | (list (point-min) (point-max))))) | ||
14 | |||
15 | (defun advise-region-or-line (&rest _) | ||
16 | "`:before' advice to work on the active region or whole line. | ||
17 | See also `with-region-or-line'." | ||
18 | (interactive (if mark-active | ||
19 | (list (region-beginning) (region-end)) | ||
20 | (list (line-beginning-position) (line-end-position))))) | ||
21 | |||
22 | (defun advise-region-or-to-eol (&rest _) | ||
23 | "`:before' advice to work on the active region or to end of line. | ||
24 | See also `with-region-or-to-eol'." | ||
25 | (INTERACTIVE (if mark-active | ||
26 | (list (region-beginning) (region-end)) | ||
27 | (list (point) (line-end-position))))) | ||
28 | |||
29 | |||
30 | ;;; Other functions and whatnot | ||
31 | |||
32 | (defun delete2 (list &rest elems) | ||
33 | "Delete each element of ELEMS, and the next item, from LIST." | ||
34 | (let ((r nil)) | ||
35 | (while (consp list) | ||
36 | (if (member (car list) elems) | ||
37 | (setf list (cdr list)) | ||
38 | (setf r (cons (car list) r))) | ||
39 | (setf list (cdr list))) | ||
40 | (reverse r))) | ||
41 | |||
42 | (unless (fboundp 'ensure-list) | ||
43 | (defun ensure-list (object) | ||
44 | "Return OBJECT as a list. | ||
45 | If OBJECT is already a list, return OBJECT itself. If it's | ||
46 | not a list, return a one-element list containing OBJECT." | ||
47 | (if (listp object) | ||
48 | object | ||
49 | (list object)))) | ||
50 | |||
51 | (defun +require (&rest features) | ||
52 | "Require FEATURES, plus my extras. | ||
53 | Each feature can be an atom (the feature name) or a list of the form | ||
54 | (FEATURE &optional FILENAME NOERROR), which is passed directly to | ||
55 | `require'. My extras are in lisp/ and named +FEATURE, so this | ||
56 | function will `require' them too---but not error if they don't | ||
57 | exist." | ||
58 | (dolist (feat features) | ||
59 | (apply #'require (ensure-list feat)) | ||
60 | (require (intern (format "+%s" feat)) nil :noerror))) | ||
61 | |||
62 | ;;; Improvements to default functions | ||
63 | |||
64 | (defun +save-buffers-kill-terminal (arg) | ||
65 | "Delete the current frame, or quit Emacs. | ||
66 | This function is my customization of `save-buffers-kill-terminal'." | ||
67 | (interactive "P") | ||
68 | (cond (arg (delete-frame nil :force)) | ||
69 | ((= 1 (length (frame-list))) | ||
70 | (and (yes-or-no-p "Kill emacs? ") | ||
71 | (save-buffers-kill-emacs t))) | ||
72 | (:else (delete-frame)))) | ||
73 | |||
74 | (defun really-quit-emacs (arg) | ||
75 | "Really, actually quit Emacs." | ||
76 | (interactive "P") | ||
77 | (cond (arg (save-buffers-kill-emacs t)) | ||
78 | (:else (save-buffers-kill-terminal t)))) | ||
79 | |||
80 | (defun +cycle-spacing (&optional n) | ||
81 | ;; `cycle-spacing' is wildly different in 29.1 over 28. | ||
82 | "Negate N argument on `cycle-spacing'. | ||
83 | That is, with a positive N, deletes newlines as well, leaving -N | ||
84 | spaces. If N is negative, it will not delete newlines and leave | ||
85 | N spaces." | ||
86 | (interactive "*p") | ||
87 | (cycle-spacing (- n))) | ||
88 | |||
89 | (defun delete-window|bury-buffer () | ||
90 | "Delete the current window, or bury the current buffer. | ||
91 | If the current window is the only window, bury the buffer." | ||
92 | (interactive) | ||
93 | (condition-case e | ||
94 | (delete-window) | ||
95 | (t (bury-buffer)))) | ||
96 | |||
97 | (defun other-window|switch-buffer (arg) | ||
98 | "Call `other-window' or `switch-buffer' depending on windows. | ||
99 | When called with prefix ARG, unconditionally switch buffer." | ||
100 | (interactive "P") | ||
101 | (if (or arg (one-window-p)) | ||
102 | (switch-to-buffer (other-buffer) nil t) | ||
103 | (other-window 1))) | ||
104 | |||
105 | (defun open-paragraph (&optional arg) | ||
106 | "Open a paragraph after paragraph at point. | ||
107 | A paragraph is defined as continguous non-empty lines of text | ||
108 | surrounded by empty lines, so opening a paragraph means to make | ||
109 | three blank lines, then place the point on the second one. | ||
110 | |||
111 | Called with prefix ARG, open a paragraph before point." | ||
112 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
113 | (interactive "*P") | ||
114 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
115 | ;; that's weird with org, and I'm guessing other modes too. | ||
116 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
117 | (while (and (not (looking-at "^$")) | ||
118 | (= 0 (forward-line (if arg -1 +1))))) | ||
119 | (newline) | ||
120 | (when arg (newline) (forward-line -2)) | ||
121 | (delete-blank-lines) | ||
122 | (newline 2) | ||
123 | (previous-line)) | ||
124 | |||
125 | (defun +initial-buffer () | ||
126 | (if (equal (get-buffer "*Messages*") | ||
127 | (other-buffer)) | ||
128 | (get-buffer "*scratch*") | ||
129 | (other-buffer))) | ||
130 | |||
131 | (defun open-paragraph (&optional arg) | ||
132 | "Open a paragraph after paragraph at point. | ||
133 | A paragraph is defined as continguous non-empty lines of text | ||
134 | surrounded by empty lines, so opening a paragraph means to make | ||
135 | three blank lines, then place the point on the second one. | ||
136 | |||
137 | Called with prefix ARG, open a paragraph before point." | ||
138 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
139 | (interactive "*P") | ||
140 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
141 | ;; that's weird with org, and I'm guessing other modes too. | ||
142 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
143 | (while (and (not (looking-at "^$")) | ||
144 | (= 0 (forward-line (if arg -1 +1))))) | ||
145 | (newline) | ||
146 | (when arg (newline) (forward-line -2)) | ||
147 | (delete-blank-lines) | ||
148 | (newline 2) | ||
149 | (previous-line)) | ||
150 | |||
151 | (defun create-missing-directories () | ||
152 | "Automatically create missing directories when finding a file." | ||
153 | ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ | ||
154 | (let ((target-dir (file-name-directory buffer-file-name))) | ||
155 | (unless (file-exists-p target-dir) | ||
156 | (make-directory target-dir t)))) | ||
157 | |||
158 | (defun +vc-off@remote () | ||
159 | (when (file-remote-p (buffer-file-name)) | ||
160 | (setq-local vc-handled-backends nil))) | ||
161 | |||
162 | (defun +auto-save-some-buffers (&rest _) | ||
163 | "Quietly run `save-some-buffers'." | ||
164 | (let ((inhibit-message t)) | ||
165 | (with-temp-message "" | ||
166 | (save-some-buffers t)))) | ||
167 | |||
168 | (defun comment-lines (str &optional comment-char) | ||
169 | "Comment each line of STR. | ||
170 | Returns the new, commented, string. | ||
171 | |||
172 | If COMMENT-CHAR is missing or nil, use `comment-start'." | ||
173 | (mapconcat (lambda (ln) | ||
174 | (concat (or comment-char comment-start) | ||
175 | ln)) | ||
176 | (string-lines str) | ||
177 | "\n")) | ||
178 | |||
179 | (defun clamp (value min max) | ||
180 | "Clamp VALUE between MIN and MAX." | ||
181 | (min max (max min value))) | ||
182 | |||
183 | (define-minor-mode truncate-lines-local-mode | ||
184 | "Truncate lines locally in a buffer." | ||
185 | :lighter " ..." | ||
186 | :group 'display | ||
187 | (setq-local truncate-lines truncate-lines-local-mode)) | ||
188 | |||
189 | (defun mapc-buffers (func &optional predicate) | ||
190 | "Map FUNC over buffers matching PREDICATE. | ||
191 | Both FUNC and PREDICATE will be executed with no arguments and in | ||
192 | the context of each buffer. | ||
193 | |||
194 | If PREDICATE is nil or not given, map FUNC over all buffers." | ||
195 | (cl-loop for buf being the buffers | ||
196 | do (with-current-buffer buf | ||
197 | (when (and predicate | ||
198 | (funcall predicate)) | ||
199 | (funcall func))))) | ||
200 | |||
201 | (defun mapc-buffers-modes (func &rest modes) | ||
202 | "Map FUNC over buffers derived from MODES. | ||
203 | FUNC will be executed with no arguments and in the context of | ||
204 | each buffer." | ||
205 | (mapc-buffers func | ||
206 | (lambda () | ||
207 | (apply #'derived-mode-p modes)))) | ||
208 | |||
209 | (defun ++concat (func strings) | ||
210 | "Concat STRINGS processed by FUNC. | ||
211 | Each of STRINGS can be a bare string or a list. Strings are | ||
212 | passed through as-is, but lists are passed to FUNC first as | ||
213 | arguments. Finally, all the resulting strings are `mapconcat'-ed | ||
214 | together. | ||
215 | |||
216 | As a special case, if `:separator' is the first of STRINGS, the | ||
217 | string following will be used as a separator. Otherwise, a | ||
218 | newline will be used." | ||
219 | (let (separator) | ||
220 | (when (eq (car strings) :separator) | ||
221 | (setq separator (cadr strings) | ||
222 | strings (cddr strings))) | ||
223 | (mapconcat (lambda (s) | ||
224 | (cond | ||
225 | ((listp s) (apply func s)) | ||
226 | ((stringp s) s) | ||
227 | (t (user-error "Bad argument: %S" s)))) | ||
228 | strings | ||
229 | (or separator "\n")))) | ||
230 | |||
231 | (defun nconcat (&rest strings) | ||
232 | "Concat STRINGS separated by SEPARATOR. | ||
233 | If `:separator' is the first of STRINGS, the next string will be used to | ||
234 | separate the rest of STRINGS." | ||
235 | (++concat #'concat strings)) | ||
236 | |||
237 | (defun format-concat (&rest strings) | ||
238 | "Concatenate formatted STRINGS. | ||
239 | Each of STRINGS can be a bare string or a list. Bare strings are passed as-is | ||
240 | to `mapconcat' for concatenation and separation. Lists, however, are passed to | ||
241 | `format' first. | ||
242 | |||
243 | If `:separator' is the first of STRINGS, the next string will be | ||
244 | used as a separator." | ||
245 | (++concat #'format strings)) | ||
246 | |||
247 | (defun choose-executable (&rest programs) | ||
248 | "Return the first of PROGRAMS that exists in the system's $PATH." | ||
249 | (seq-some #'executable-find programs)) | ||
250 | |||
251 | ;;; Update packages more better-er | ||
252 | |||
253 | (defun +package-update-all () | ||
254 | "Update all packages and vc packages." | ||
255 | (interactive) | ||
256 | (package-update-all) | ||
257 | ;; WTF! | ||
258 | (let ((package-archives-nil)) | ||
259 | (package-vc-update-all))) | ||
260 | |||
261 | (provide 'acdw-funs) | ||
262 | ;;; acdw-funs.el ends here | ||
diff --git a/lisp/acdw-macs.el b/lisp/acdw-macs.el new file mode 100644 index 0000000..e2258fa --- /dev/null +++ b/lisp/acdw-macs.el | |||
@@ -0,0 +1,293 @@ | |||
1 | ;;; acdw-macs.el --- extra macros -*- lexical-binding: t; -*- | ||
2 | |||
3 | (eval-when-compile | ||
4 | (require 'cl-lib) | ||
5 | (require 'tempo) | ||
6 | (declare-function derived-mode-abbrev-table-name "tempo")) | ||
7 | |||
8 | ;;; Extra functionality for `eval-after-load' | ||
9 | |||
10 | (defun eval-after-init (thunk) | ||
11 | "Evaluate THUNK after Emacs initiation, or now if already initialized." | ||
12 | (if after-init-time | ||
13 | (funcall thunk) | ||
14 | (add-hook 'after-init-hook thunk))) | ||
15 | |||
16 | (defmacro eval-after (prereqs &rest body) | ||
17 | "Evaluate body after PREREQS. | ||
18 | PREREQS can be a feature, a number, `t', or a list of those. | ||
19 | |||
20 | Features are used as arguments to `eval-after-load'. Numbers are | ||
21 | used as arguments to `run-with-idle-timer'. `t' will ensure BODY | ||
22 | runs after Emacs's init time. | ||
23 | |||
24 | When given a list of PREREQS, `eval-after' will nest each one | ||
25 | from left to right." | ||
26 | (declare (indent 1) (debug (form def-body))) | ||
27 | (setf prereqs (ensure-list prereqs)) | ||
28 | (if (null prereqs) | ||
29 | (macroexp-progn body) | ||
30 | (let* ((this (car prereqs)) | ||
31 | (form `((lambda () (eval-after ,(cdr prereqs) ,@body))))) | ||
32 | (cond | ||
33 | ((eq this :init) | ||
34 | (append '(eval-after-init) form)) | ||
35 | ((numberp this) | ||
36 | (append `(run-with-idle-timer ,this nil) form)) | ||
37 | ((symbolp this) | ||
38 | (append `(eval-after-load ',this) form)) | ||
39 | (:else (user-error "Eval-after: Bad prereq: %S" this)))))) | ||
40 | |||
41 | |||
42 | ;;; Easier customization of options | ||
43 | ;; At some point it might be nice to include more forms in the VAR slots, like | ||
44 | ;; `setup's `:option' macro. | ||
45 | |||
46 | (if (fboundp 'setopt) | ||
47 | ;; Emacs 29 introduces `setopt', which does basically the same thing as the | ||
48 | ;; macro below. Not exactly the same, of course---it uses `setopt--set' | ||
49 | ;; instead of `customize-set-variable'---but I'm going to trust the Emacs | ||
50 | ;; devs on this one. | ||
51 | (defalias 'setc 'setopt) | ||
52 | (defmacro setc (&rest args) | ||
53 | "Customize user options in a `setq'-like way." | ||
54 | (declare (debug setq)) | ||
55 | (unless (zerop (mod (length args) 2)) | ||
56 | (signal 'wrong-number-of-arguments `(evenp ,(length args)))) | ||
57 | (let (form defuns) | ||
58 | (while args | ||
59 | (let* ((var (pop args)) | ||
60 | (val (pop args))) | ||
61 | (when (memq (car-safe val) '(defun defmacro)) | ||
62 | (push val defuns) | ||
63 | (setq val `(function ,(cadr val)))) | ||
64 | (push `(customize-set-variable ',var ,val "Set by `setc'.") | ||
65 | form))) | ||
66 | `(progn ,@(append (nreverse defuns) (nreverse form)))))) | ||
67 | |||
68 | |||
69 | ;;; Extra def- forms | ||
70 | |||
71 | (defmacro defdir (name directory &optional docstring) | ||
72 | "Define a variable and a function NAME expanding to DIRECTORY. | ||
73 | DOCSTRING is applied to the variable; its default is DIRECTORY's | ||
74 | path." | ||
75 | (declare (indent 2) (doc-string 3)) | ||
76 | `(progn | ||
77 | (defvar ,name ,directory | ||
78 | ,(concat (or docstring (format "%s" directory)) "\n" | ||
79 | "Defined by `defdir'.")) | ||
80 | (defun ,name (file &optional mkdir) | ||
81 | ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" | ||
82 | "If MKDIR is non-nil, parent directories are created.\n" | ||
83 | "Defined by `defdir'.") | ||
84 | (let ((file-name (expand-file-name | ||
85 | (convert-standard-filename file) ,name))) | ||
86 | (when mkdir | ||
87 | (make-directory (file-name-directory file-name) :parents)) | ||
88 | file-name)))) | ||
89 | |||
90 | (defmacro defkeys (maps &rest bindings) | ||
91 | "Define key BINDINGS in MAPS. | ||
92 | If MAPS is nil or t, bind to `current-global-map'. Otherwise, | ||
93 | bind each of BINDINGS to the map or list of maps provided. | ||
94 | |||
95 | BINDINGS is a `setq'-style list of pairs of keys and definitions. | ||
96 | The key part of each binding can be a string, in which case it's | ||
97 | passed to `kbd', or a vector or anything else `define-key' | ||
98 | accepts in the KEY position. The definition part, likewise, can | ||
99 | be any form `define-key' accepts in that position, with this | ||
100 | addition: if the form is a `defun' form, it will be defined | ||
101 | before any keys are bound." | ||
102 | (declare (indent 1)) | ||
103 | (unless (cl-evenp (length bindings)) | ||
104 | (signal 'wrong-number-of-arguments `(evenp ,(length bindings)))) | ||
105 | `(progn | ||
106 | ,@(cl-loop | ||
107 | for map in (ensure-list maps) | ||
108 | for first-map-p = t then nil | ||
109 | append | ||
110 | (cl-loop | ||
111 | for (keys def) on bindings by #'cddr | ||
112 | for defp = (memq (car-safe def) '(defmap defun defmacro)) | ||
113 | if (and defp first-map-p) collect def into defuns | ||
114 | append | ||
115 | (cl-loop | ||
116 | for key in (ensure-list keys) | ||
117 | collect (list 'define-key | ||
118 | (if (memq map '(t nil)) | ||
119 | '(current-global-map) | ||
120 | (or (car-safe map) map)) | ||
121 | (if (stringp key) | ||
122 | `(kbd ,key) | ||
123 | key) | ||
124 | (if defp | ||
125 | (cl-case (car def) | ||
126 | ((defmap) (cadr def)) | ||
127 | ((defun defmacro) `#',(cadr def)) | ||
128 | (otherwise (error "Bad def type: %S" | ||
129 | (car def)))) | ||
130 | def))) | ||
131 | into keydefs | ||
132 | finally return | ||
133 | (let ((all (append defuns keydefs))) | ||
134 | (if-let ((after (plist-get (cdr-safe map) :after))) | ||
135 | `((eval-after ,after | ||
136 | ,@all)) | ||
137 | all)))))) | ||
138 | |||
139 | (defmacro defmap (name docstring &rest bindings) | ||
140 | "Define a keymap named NAME, with BINDINGS." | ||
141 | (declare (indent 1) (doc-string 2)) | ||
142 | `(,(if (boundp name) 'setq 'defvar) ,name | ||
143 | ;;; ^ probably a terrible hack | ||
144 | (let ((map (make-sparse-keymap))) | ||
145 | (defkeys map ,@bindings) | ||
146 | map) | ||
147 | ,@(unless (boundp name) (list docstring)))) | ||
148 | |||
149 | (defmacro defhook (hooks &rest body) | ||
150 | "Define a function to hook into HOOKS. | ||
151 | NAME and ARGS are passed to the generated `defun' form. | ||
152 | Each hook in HOOKS can be the name of a hook or a list of the form | ||
153 | (HOOK DEPTH LOCAL), where each argument is the same as in | ||
154 | `add-hook'." | ||
155 | (declare (indent 1)) | ||
156 | (let* ((name (or (plist-get body :name) | ||
157 | (intern (format "%s/h" | ||
158 | (mapconcat | ||
159 | (lambda (h) | ||
160 | (string-remove-suffix | ||
161 | "-hook" | ||
162 | (if (and (consp h) | ||
163 | (caddr h)) | ||
164 | (format "%s:local" (car h)) | ||
165 | (format "%s" (or (car-safe h) | ||
166 | h))))) | ||
167 | (ensure-list hooks) | ||
168 | "|"))))) | ||
169 | (args (or (plist-get body :args) nil)) | ||
170 | (doc (or (plist-get body :doc) nil)) | ||
171 | (forms ; (DEFUN . FUNCS) | ||
172 | (cl-loop for form in (delete2 body :name :args :doc) | ||
173 | if (eq (car form) 'function) | ||
174 | collect form into funcs | ||
175 | else collect form into defuns | ||
176 | finally return (cons defuns funcs))) | ||
177 | (defun-forms (car forms)) | ||
178 | (func-forms (cdr forms))) | ||
179 | `(progn | ||
180 | ,@(when defun-forms | ||
181 | `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) | ||
182 | ,@(cl-loop for hook in (ensure-list hooks) | ||
183 | for h = (or (car-safe hook) hook) | ||
184 | for ha = (cdr-safe hook) | ||
185 | if defun-forms | ||
186 | collect `(add-hook ',h #',name ,@ha) | ||
187 | append | ||
188 | (cl-loop for fn in func-forms | ||
189 | collect `(add-hook ',h ,fn ,@ha)))))) | ||
190 | |||
191 | ;; (autoload FUNCTION FILE &optional DOCSTRING INTERACTIVE TYPE) | ||
192 | (defmacro defautoload (file &rest fns) | ||
193 | "Autoload FNS from FILE. | ||
194 | Each of FNS can be an atom (function name) or a list of the | ||
195 | form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible | ||
196 | keys are `:doc' (docstring), `:interactive', and `:type', which are | ||
197 | used as the optional arguments to `autoload'. | ||
198 | |||
199 | You can also pass `:interactive' and `:type' as keyword arguments | ||
200 | just after FILE, and they'll serve as the default for the | ||
201 | autoloaded FNS." | ||
202 | (declare (indent 1)) | ||
203 | (let ((interactive (plist-get fns :interactive)) | ||
204 | (type (plist-get fns :type)) | ||
205 | (fns (delete2 fns :interactive :type))) | ||
206 | `(progn | ||
207 | ,@(cl-loop for fn in fns | ||
208 | for name = (or (car-safe fn) fn) | ||
209 | for args = (cdr-safe fn) | ||
210 | collect | ||
211 | `(autoload ',name ,(format "%s" file) | ||
212 | ,(plist-get args :doc) | ||
213 | ,(or (plist-get args :interactive) | ||
214 | interactive) | ||
215 | ,(or (plist-get args :type) | ||
216 | type)))))) | ||
217 | |||
218 | |||
219 | ;;; Miscellaneous | ||
220 | |||
221 | (defmacro with-message (message &rest body) | ||
222 | "Display MESSAGE then execute BODY. | ||
223 | If BODY executes without errors, display MESSAGE...done." | ||
224 | (declare (indent 1)) | ||
225 | (let ((msym (gensym)) | ||
226 | (esym (gensym))) | ||
227 | `(let ((,msym ,message)) | ||
228 | (condition-case ,esym | ||
229 | (progn (message "%s..." ,msym) | ||
230 | ,@body) | ||
231 | (:success (message "%s...done" ,msym)) | ||
232 | (t (signal (car ,esym) (cdr ,esym))))))) | ||
233 | |||
234 | (defmacro o (&rest fns) | ||
235 | "Compose FNS into a new function for one argument." | ||
236 | (if (null fns) | ||
237 | `(lambda (&rest args) args) | ||
238 | `(lambda (&rest args) | ||
239 | (apply | ||
240 | #',(car fns) | ||
241 | (ensure-list (apply (o ,@(cdr fns)) args)))))) | ||
242 | |||
243 | (defmacro with-region-or-buffer (&rest funcs) | ||
244 | "Advise FUNCS with `advise-region-or-buffer'." | ||
245 | `(progn | ||
246 | ,@(cl-loop for fn in funcs | ||
247 | collect | ||
248 | `(advice-add ',fn :before #'advise-region-or-buffer)))) | ||
249 | |||
250 | (defmacro with-region-or-line (&rest funcs) | ||
251 | "Advise FUNCS with `advise-region-or-line'." | ||
252 | `(progn | ||
253 | ,@(cl-loop for fn in funcs | ||
254 | collect | ||
255 | `(advice-add ',fn :before #'advise-region-or-line)))) | ||
256 | |||
257 | (defmacro with-region-or-to-eol (&rest funcs) | ||
258 | "Advise FUNCS with `advise-region-or-to-eol'." | ||
259 | `(progn | ||
260 | ,@(cl-loop for fn in funcs | ||
261 | collect | ||
262 | `(advice-add ',fn :before #'advise-region-or-to-eol)))) | ||
263 | |||
264 | (defmacro define-tempo (tag doc &rest elements) | ||
265 | "Define a template and add its tag to MODE's abbrev-table. | ||
266 | TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. | ||
267 | ABBREV, if given, is the abbrev string to use for template expansion | ||
268 | under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." | ||
269 | (declare (indent 1)) | ||
270 | (let* ((template (gensym)) | ||
271 | (tag (cond ((stringp tag) tag) | ||
272 | ((symbolp tag) (symbol-name tag)) | ||
273 | (t (user-error "TAG must be a string or symbol: %S" tag)))) | ||
274 | (mode (or (plist-get elements :mode) nil)) | ||
275 | (abbrev (or (plist-get elements :abbrev) tag)) | ||
276 | (taglist (or (plist-get elements :taglist) nil)) | ||
277 | (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) | ||
278 | (while (and tname (not (memq tname abbrev-table-name-list))) | ||
279 | (setq tname (and (get mode 'derived-mode-parent) | ||
280 | (derived-mode-abbrev-table-name | ||
281 | (get mode 'derived-mode-parent))))) | ||
282 | (or tname 'global-abbrev-table))) | ||
283 | (elements (delete2 elements :mode :abbrev :taglist))) | ||
284 | `(let ((,template (tempo-define-template ,tag | ||
285 | ',elements | ||
286 | ,(or abbrev tag) | ||
287 | ,doc | ||
288 | ,taglist))) | ||
289 | (define-abbrev ,table ,tag "" ,template :system t) | ||
290 | (put ,template 'no-self-insert t)))) | ||
291 | |||
292 | (provide 'acdw-macs) | ||
293 | ;;; acdw-macs.el ends here | ||
diff --git a/lisp/acdw.el b/lisp/acdw.el index a9ef893..30c4f44 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -1,272 +1,79 @@ | |||
1 | ;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- | 1 | ;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*- |
2 | ;; by C. Duckworth <acdw@acdw.net> | 2 | |
3 | (require 'cl-lib) | 3 | ;;; Code: |
4 | ;; def.el is here | 4 | |
5 | (require 'def) | 5 | (require 'acdw-funs) ; Extra functions |
6 | 6 | (require 'acdw-macs) ; Extra macros | |
7 | ;;; Define both a directory and a function expanding to a file in that directory | 7 | |
8 | 8 | (defdir etc/ (locate-user-emacs-file "etc") | |
9 | (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) | 9 | "Directory for package configuration files. |
10 | "Define a variable and function NAME expanding to DIRECTORY. | 10 | See `no-littering' for examples.") |
11 | DOCSTRING is applied to the variable. Ensure DIRECTORY exists in | 11 | |
12 | the filesystem, unless INHIBIT-MKDIR is non-nil." | 12 | (defdir var/ etc/ |
13 | (declare (indent 2) | 13 | "Directory for package data file. |
14 | (doc-string 3)) | 14 | See `no-littering' for examples.") |
15 | (unless inhibit-mkdir | 15 | |
16 | (make-directory (eval directory) :parents)) | 16 | (defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME"))) |
17 | `(progn | 17 | (expand-file-name "emacs/" xdg-cache) |
18 | (defvar ,name ,directory | 18 | etc/) |
19 | ,(concat docstring (when docstring "\n") | 19 | "Directory for cache files.") |
20 | "Defined by `/define-dir'.")) | 20 | |
21 | (defun ,name (file &optional mkdir) | 21 | (setq native-compile-target-directory (cache/ "eln" t)) |
22 | ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" | 22 | (when (fboundp 'startup-redirect-eln-cache) |
23 | "If MKDIR is non-nil, the directory is created.\n" | 23 | (startup-redirect-eln-cache (cache/ "eln" t))) |
24 | "Defined by `/define-dir'.") | 24 | |
25 | (let ((file-name (expand-file-name (convert-standard-filename file) | 25 | (defdir sync/ (expand-file-name "/home/case/Sync") |
26 | ,name))) | 26 | "My Syncthing directory.") |
27 | (when mkdir | 27 | |
28 | (make-directory (file-name-directory file-name) :parents)) | 28 | (defdir private/ (sync/ "emacs/private")) |
29 | file-name)))) | 29 | (add-to-list 'load-path private/) |
30 | 30 | ||
31 | ;;; Evaluating things after other things | 31 | (require 'acdw-defaults) ; Sane defaults |
32 | 32 | (require '_acdw) ; Private stuff | |
33 | (defun eval-after-init (fn) | 33 | (require '+lisp) ; Lispy goodness |
34 | "Evaluate FN after inititation, or now if Emacs is initialized. | 34 | |
35 | FN is called with no arguments." | 35 | (setc enable-recursive-minibuffers t |
36 | (if after-init-time | 36 | completions-detailed t |
37 | (funcall fn) | 37 | completion-ignore-case t |
38 | (add-hook 'after-init-hook fn))) | 38 | read-buffer-completion-ignore-case t |
39 | 39 | read-file-name-completion-ignore-case t | |
40 | (defmacro eval-after (features &rest body) | 40 | initial-buffer-choice #'+initial-buffer |
41 | "Evaluate BODY, but only after loading FEATURES. | 41 | initial-scratch-message |
42 | FEATURES can be an atom or a list; as an atom it works like | 42 | (format "%s\n\n" |
43 | `with-eval-after-load'. The special feature `init' will evaluate | 43 | (comment-lines |
44 | BODY after Emacs is finished initializing." | 44 | (shell-command-to-string "fortune") |
45 | (declare (indent 1) | 45 | ";; ")) |
46 | (debug (form def-body))) | 46 | sentence-end-double-space nil |
47 | (unless (listp features) | 47 | save-silently t) |
48 | (setf features (list features))) | 48 | |
49 | (if (null features) | 49 | (defkeys t |
50 | (macroexp-progn body) | 50 | "M-o" #'other-window|switch-buffer |
51 | (let* ((this (car features)) | 51 | "C-x 0" #'delete-window|bury-buffer |
52 | (rest (cdr features))) | 52 | "C-M-;" #'+lisp-comment-or-uncomment-sexp |
53 | (cond ((eq this 'init) | 53 | "M-SPC" #'+cycle-spacing |
54 | `(eval-after-init | 54 | "C-x C-k" #'kill-this-buffer) |
55 | (lambda () (eval-after ,rest ,@body)))) | 55 | |
56 | (:else | 56 | (defkeys t |
57 | `(with-eval-after-load ',this | 57 | "M-u" #'universal-argument) |
58 | (eval-after ,rest ,@body))))))) | 58 | |
59 | 59 | (defkeys universal-argument-map | |
60 | ;;; Convenience functions | 60 | "M-u" #'universal-argument-more) |
61 | 61 | ||
62 | (defun define-key* (maps &rest keydefs) | 62 | (define-advice switch-to-buffer (:after (&rest _) normal-mode) |
63 | "Define KEYDEFS in MAPS. | 63 | "Automatically determine the mode for created non-file buffers." |
64 | Convenience wrapper around `define-key'." | 64 | (when-let ((_ (and (eq major-mode 'fundamental-mode))) |
65 | (unless (zerop (mod (length keydefs) 2)) | 65 | (buffer-file-name (buffer-name))) |
66 | (user-error "Wrong number of arguments: %S" (length keydefs))) | 66 | (normal-mode))) |
67 | (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) | 67 | |
68 | (list maps) | 68 | (define-advice canonically-space-region |
69 | maps)) | 69 | (:around (orig &rest args) double-space-sentences) |
70 | (cl-loop for (key def) on keydefs by #'cddr | 70 | (let ((sentence-end-double-space t)) |
71 | do (let ((key (if (stringp key) (kbd key) key))) | 71 | (apply orig args))) |
72 | (define-key (if (symbolp map) | 72 | |
73 | (symbol-value map) | 73 | (with-region-or-buffer indent-region) |
74 | map) | 74 | |
75 | key def))))) | 75 | (winner-mode) |
76 | |||
77 | (unless (fboundp 'ensure-list) | ||
78 | ;; Just in case we're using an old version of Emacs. | ||
79 | (defun ensure-list (object) | ||
80 | "Return OBJECT as a list. | ||
81 | If OBJECT is already a list, return OBJECT itself. If it's | ||
82 | not a list, return a one-element list containing OBJECT." | ||
83 | (if (listp object) | ||
84 | object | ||
85 | (list object)))) | ||
86 | |||
87 | (defun add-to-list* (lists &rest things) | ||
88 | "Add THINGS to LISTS. | ||
89 | LISTS can be one list variable or a list. Each thing of THINGS | ||
90 | can be either a variable (the thing), or a list of the form | ||
91 | (ELEMENT &optional APPEND COMPARE-FN), which is passed to | ||
92 | `add-to-list'." | ||
93 | (declare (indent 1)) | ||
94 | (dolist (l (ensure-list lists)) | ||
95 | (dolist (thing things) | ||
96 | (apply #'add-to-list l (ensure-list thing))))) | ||
97 | |||
98 | (defun add-hook* (hooks &rest functions) | ||
99 | "Add FUNCTIONS to HOOKS. | ||
100 | Each function in FUNCTIONS can be a singleton or a list of the | ||
101 | form (FUNCTION &optional DEPTH LOCAL)." | ||
102 | (declare (indent 1)) | ||
103 | (dolist (hook (ensure-list hooks)) | ||
104 | (dolist (fn functions) | ||
105 | (apply #'add-hook hook (ensure-list fn))))) | ||
106 | |||
107 | (defun +concat (&rest strings) | ||
108 | "Concat STRINGS separated by SEPARATOR. | ||
109 | SEPARATOR is \"\\n\" unless the keyword argument `:separator' is | ||
110 | given, followed by the separator to use. Each item in STRINGS is | ||
111 | either a string or a list or strings, which is concatenated | ||
112 | without any separator." | ||
113 | (let (ret | ||
114 | ;; I don't know why a `cl-defun' with | ||
115 | ;; (&rest strings &key (separator "\n")) doesn't work | ||
116 | (separator (or (cl-loop for i from 0 upto (length strings) | ||
117 | if (eq (nth i strings) :separator) | ||
118 | return (nth (1+ i) strings)) | ||
119 | "\n"))) | ||
120 | (while strings | ||
121 | (let ((string (pop strings))) | ||
122 | (cond ((eq string :separator) (pop strings)) | ||
123 | ((listp string) (push (apply #'concat string) ret)) | ||
124 | ((stringp string) (push string ret))))) | ||
125 | (mapconcat #'identity (nreverse ret) separator))) | ||
126 | |||
127 | (defun require* (&rest features) | ||
128 | "Require FEATURES in order. | ||
129 | Each feature of FEATURES can also be a list of the arguments to | ||
130 | pass to `require', which see." | ||
131 | (condition-case e | ||
132 | (dolist (feature features) | ||
133 | (apply #'require (ensure-list feature))) | ||
134 | (:success (mapcar (lambda (f) (car (ensure-list f))) features)) | ||
135 | (t (signal (car e) (cdr e))))) | ||
136 | |||
137 | ;;; Convenience macros | ||
138 | |||
139 | (defmacro define-local-before-save-hook (mode-or-hook &rest body) | ||
140 | "Add a local `before-save-hook' to MODE-OR-HOOK." | ||
141 | (declare (indent 1)) | ||
142 | (let* ((name (format "%s" mode-or-hook)) | ||
143 | (external-name (intern (format "%s@before-save" name))) | ||
144 | (internal-name (intern (format "before-save@%s" name))) | ||
145 | (hook (if (string-suffix-p "-hook" name) | ||
146 | mode-or-hook | ||
147 | (intern (format "%s-hook" name))))) | ||
148 | `(progn | ||
149 | (defun ,internal-name () | ||
150 | ,@body) | ||
151 | (defun ,external-name () | ||
152 | (add-hook 'before-save-hook #',internal-name nil :local)) | ||
153 | (add-hook ',hook #',external-name)))) | ||
154 | |||
155 | (defmacro setq-local-hook (hooks &rest args) | ||
156 | "Run `setq-local' on ARGS when running HOOKs." | ||
157 | ;; FIXME: this is pretty messy, i think... | ||
158 | ;; The settings should be stored in an alist so that they can be deduplicated | ||
159 | (declare (indent 1)) | ||
160 | `(progn | ||
161 | ,@(cl-loop for hook in (ensure-list hooks) | ||
162 | collect | ||
163 | (let ((fn (intern (format "%s-setq-local" hook)))) | ||
164 | (when (and (fboundp fn) | ||
165 | (functionp fn)) | ||
166 | (setf args (append (function-get fn 'setq-local-hook-settings) args))) | ||
167 | (unless (and (< 0 (length args)) | ||
168 | (zerop (mod (length args) 2))) | ||
169 | (user-error "Wrong number of arguments: %S" (length args))) | ||
170 | `(progn | ||
171 | (defun ,fn () | ||
172 | ,(format "Set local variables after `%s'." hook) | ||
173 | (setq-local ,@args)) | ||
174 | (function-put ',fn 'setq-local-hook-settings ',args) | ||
175 | (dolist (buf (buffer-list)) | ||
176 | (with-current-buffer buf | ||
177 | (when (derived-mode-p | ||
178 | ',(intern (replace-regexp-in-string | ||
179 | "-hook" "" (format "%s" hook)))) | ||
180 | (,fn)))) | ||
181 | (add-hook ',hook #',fn)))))) | ||
182 | |||
183 | (defmacro with-message (message &rest body) | ||
184 | "Execute BODY, with MESSAGE. | ||
185 | If body executes without errors, MESSAGE...Done will be displayed." | ||
186 | (declare (indent 1)) | ||
187 | (let ((msg (gensym))) | ||
188 | `(let ((,msg ,message)) | ||
189 | (condition-case e | ||
190 | (progn (message "%s..." ,msg) | ||
191 | ,@body) | ||
192 | (:success (message "%s...done" ,msg)) | ||
193 | (t (signal (car e) (cdr e))))))) | ||
194 | |||
195 | (defmacro either (&rest clauses) | ||
196 | "Return the first of CLAUSES that returns non-nil." | ||
197 | (let* ((this (gensym "either"))) | ||
198 | (unless (null clauses) | ||
199 | `(let* ((,this ,(car clauses))) | ||
200 | (if ,this ,this (either ,@(cdr clauses))))))) | ||
201 | |||
202 | (defun mapc-buffers (fn &optional pred) | ||
203 | "Perform FN on buffers matching PRED. | ||
204 | If PRED is nil or absent, perform FN on all buffers. Both FN and | ||
205 | PRED are called within a `with-current-buffer' form and without | ||
206 | arguments." | ||
207 | (let ((pred (cond | ||
208 | ((listp pred) | ||
209 | (lambda () (apply #'derived-mode-p pred))) | ||
210 | ((functionp pred) pred) | ||
211 | ((null pred) (lambda () t)) | ||
212 | (:else (user-error "Bad predicate"))))) | ||
213 | (dolist (buf (buffer-list)) | ||
214 | (with-current-buffer buf | ||
215 | (when (funcall pred) | ||
216 | (funcall fn)))))) | ||
217 | |||
218 | ;; https://emacs.stackexchange.com/a/39324/37239 | ||
219 | ;; XXX: This shit don't work rn | ||
220 | (defun ignore-invisible-overlays (fn) | ||
221 | "Execute FN, ignoring invisible overlays. | ||
222 | FN should return a point." | ||
223 | (let ((overlay nil) | ||
224 | (point nil)) | ||
225 | (setq point (and (funcall fn) (point))) | ||
226 | (setq overlay (car (overlays-at (point)))) | ||
227 | (while (and overlay (member 'invisible (overlay-properties overlay))) | ||
228 | (goto-char (overlay-end overlay)) | ||
229 | (setq point (and (funcall fn) (point))) | ||
230 | (setq overlay (car (overlays-at (point))))) | ||
231 | point)) | ||
232 | |||
233 | ;;; Extras | ||
234 | ;; Trying to avoid a whole install of crux ... | ||
235 | |||
236 | (defun kill-and-join-forward (&optional arg) | ||
237 | "Kill the line or, if at the end of a line, join with the next. | ||
238 | This command is `visual-line-mode'-aware. If ARG is provided, | ||
239 | it's passed on to kill a line, but not to delete indentation. | ||
240 | When joining, this command deletes whitespace." | ||
241 | (interactive "P") | ||
242 | (if (and (eolp) (not (bolp))) | ||
243 | (delete-indentation 1) | ||
244 | (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) | ||
245 | |||
246 | (defun other-window|switch-buffer (arg) | ||
247 | "Call `other-window' or `switch-buffer' depending on windows. | ||
248 | When called with prefix ARG, unconditionally switch buffer." | ||
249 | (interactive "P") | ||
250 | (if (or arg (one-window-p)) | ||
251 | (switch-to-buffer (other-buffer) nil t) | ||
252 | (other-window 1))) | ||
253 | |||
254 | ;;; Set variables more better-er | ||
255 | ;; Now this doesn't do `setf'-style stuff. | ||
256 | |||
257 | (defmacro setc (&rest args) | ||
258 | "Customize user options using ARGS like `setq'." | ||
259 | (declare (debug setq)) | ||
260 | (unless (zerop (mod (length args) 2)) | ||
261 | (user-error "Dangling argument: %S" var)) | ||
262 | (let (form) | ||
263 | (while args | ||
264 | (push `(customize-set-variable | ||
265 | ',(pop args) | ||
266 | ,(pop args) | ||
267 | "Set by `setc'.") | ||
268 | form)) | ||
269 | `(progn ,@(nreverse form)))) | ||
270 | 76 | ||
271 | (provide 'acdw) | 77 | (provide 'acdw) |
78 | |||
272 | ;;; acdw.el ends here | 79 | ;;; acdw.el ends here |
diff --git a/lisp/browse-url-transform.el b/lisp/browse-url-transform.el deleted file mode 100644 index c290a1f..0000000 --- a/lisp/browse-url-transform.el +++ /dev/null | |||
@@ -1,45 +0,0 @@ | |||
1 | ;;; browse-url-transform --- transform URLs | ||
2 | |||
3 | (defgroup browse-url-transform nil | ||
4 | "Transformations for urls passed to `browse-url'." | ||
5 | :group 'browse-url) | ||
6 | |||
7 | (defcustom browse-url-transform-alist nil | ||
8 | "Transformation rules for URLs. | ||
9 | The keys are regexps matching URLs, and the values are how to | ||
10 | transform them. The replacements will use match capture data." | ||
11 | :type '(alist :key-type (string :tag "URL regexp match") | ||
12 | :value-type (string :tag "URL regexp transformation"))) | ||
13 | |||
14 | (defun browse-url-transform-url (url) | ||
15 | "Transform URL before passing it to `browse-url'." | ||
16 | (cl-loop with url = (substring-no-properties | ||
17 | (if (consp url) (car url) url)) | ||
18 | for (regex . transformation) in browse-url-transform-alist | ||
19 | if (string-match regex url) | ||
20 | return (replace-match transformation nil nil url) | ||
21 | finally return url)) | ||
22 | |||
23 | (defun browse-url-transform-advice (url &rest args) | ||
24 | "Advice to `browse-url' for URL transformations. | ||
25 | ARGS are passed on for further processing." | ||
26 | (apply #'list (and url (browse-url-transform-url url)) args)) | ||
27 | |||
28 | (define-minor-mode browse-url-transform-mode | ||
29 | "Minor mode to transform a URL before passing it to `browse-url'. | ||
30 | This can be used to \"redirect\" URLs, for example from an | ||
31 | information silo to a more privacy-respecting one (e.g., | ||
32 | \"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. | ||
33 | |||
34 | When using this mode, ensure that the transformed URL is also in | ||
35 | `browse-url-handlers', since that's what `browse-url' will see." | ||
36 | :lighter " Turl" | ||
37 | :keymap nil | ||
38 | :global t | ||
39 | (cond (browse-url-transform-mode | ||
40 | (advice-add 'browse-url :filter-args #'browse-url-transform-advice)) | ||
41 | (:else | ||
42 | (advice-remove 'browse-url #'browse-url-transform-advice)))) | ||
43 | |||
44 | (provide 'browse-url-transform) | ||
45 | ;;; browse-url-transform.el ends here | ||
diff --git a/lisp/dawn.el b/lisp/dawn.el deleted file mode 100644 index 30aab7c..0000000 --- a/lisp/dawn.el +++ /dev/null | |||
@@ -1,109 +0,0 @@ | |||
1 | ;;; dawn.el --- Lightweight dawn/dusk task scheduling -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;; Author: Case Duckworth | ||
6 | ;; Maintainer: Case Duckworth <acdw@acdw.net> | ||
7 | ;; URL: https://codeberg.org/acdw/dusk.el | ||
8 | ;; Version: 0.3.0 | ||
9 | ;; Keywords: calendar, themes, convenience | ||
10 | ;; Package-Requires: ((emacs "24.3")) | ||
11 | |||
12 | ;;; Commentary: | ||
13 | |||
14 | ;; There is also circadian.el, but it doesn't quite work for me. | ||
15 | ;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also | ||
16 | ;; somewhere else (which I've forgotten) and my own brain :) | ||
17 | |||
18 | ;;; Code: | ||
19 | |||
20 | (require 'calendar) | ||
21 | (require 'cl-lib) | ||
22 | (require 'solar) | ||
23 | |||
24 | ;;; Timers | ||
25 | |||
26 | (defvar dawn--dawn-timer nil | ||
27 | "Timer for dawn-command.") | ||
28 | |||
29 | (defvar dawn--dusk-timer nil | ||
30 | "Timer for dusk-command.") | ||
31 | |||
32 | (defvar dawn--reset-timer nil | ||
33 | "Timer to reset dawn at midnight.") | ||
34 | |||
35 | ;;; Functions | ||
36 | |||
37 | (defun dawn-encode-time (f) | ||
38 | "Encode fractional time F. | ||
39 | If F is nil, return nil." | ||
40 | (when f | ||
41 | (let ((hhmm (cl-floor f)) | ||
42 | (date (cdddr (decode-time)))) | ||
43 | (encode-time | ||
44 | (append (list 0 | ||
45 | (round (* 60 (cadr hhmm))) | ||
46 | (car hhmm)) | ||
47 | date))))) | ||
48 | |||
49 | (defun dawn-midnight () | ||
50 | "Return the time of the /next/ midnight." | ||
51 | (let ((date (cdddr (decode-time)))) | ||
52 | (encode-time | ||
53 | (append (list 0 0 0 (1+ (car date))) (cdr date))))) | ||
54 | |||
55 | (defun dawn-sunrise () | ||
56 | "Return the time of today's sunrise." | ||
57 | (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date))))) | ||
58 | |||
59 | (defun dawn-sunset () | ||
60 | "Return the time of today's sunset." | ||
61 | (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) | ||
62 | |||
63 | ;;; Interface | ||
64 | |||
65 | ;;;###autoload | ||
66 | (defun dawn-schedule (dawn-command dusk-command) | ||
67 | "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. | ||
68 | Requires `calendar-longitude' and `calendar-latitude' to be set; | ||
69 | if they're not, it will prompt the user for them or error." | ||
70 | (when (or (null calendar-longitude) | ||
71 | (null calendar-latitude)) | ||
72 | (or (solar-setup) | ||
73 | (user-error "`dawn' won't work without setting %s!" | ||
74 | (cond ((and (null calendar-longitude) | ||
75 | (null calendar-latitude)) | ||
76 | "`calendar-longitude' and `calendar-latitude'") | ||
77 | ((null calendar-longitude) | ||
78 | "`calendar-longitude'") | ||
79 | ((null calendar-latitude) | ||
80 | "`calendar-latitude'"))))) | ||
81 | (let ((dawn (dawn-sunrise)) | ||
82 | (dusk (dawn-sunset))) | ||
83 | (cond | ||
84 | ((or (null dawn) (null dusk)) | ||
85 | ;; There is no sunrise or sunset, due to how close we are to the poles. | ||
86 | ;; In this case, we must figure out whether it's day or night. | ||
87 | (pcase (caddr (solar-sunrise-sunset (calendar-current-date))) | ||
88 | ("0:00" (funcall dusk-command)) ; 0 hours of daylight | ||
89 | ("24:00" (funcall dawn-command)) ; 24 hours of daylight | ||
90 | )) | ||
91 | ((time-less-p nil dawn) | ||
92 | ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule | ||
93 | ;; DAWN-COMMAND and DUSK-COMMAND for later. | ||
94 | (funcall dusk-command) | ||
95 | (run-at-time dawn nil dawn-command) | ||
96 | (run-at-time dusk nil dusk-command)) | ||
97 | ((time-less-p nil dusk) | ||
98 | ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule | ||
99 | ;; DUSK-COMMAND. | ||
100 | (funcall dawn-command) | ||
101 | (run-at-time dusk nil dusk-command)) | ||
102 | (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. | ||
103 | (funcall dusk-command))) | ||
104 | ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. | ||
105 | (run-at-time (dawn-midnight) nil | ||
106 | #'dawn-schedule dawn-command dusk-command))) | ||
107 | |||
108 | (provide 'dawn) | ||
109 | ;;; dawn.el ends here | ||
diff --git a/lisp/def.el b/lisp/def.el deleted file mode 100644 index 0bf91b2..0000000 --- a/lisp/def.el +++ /dev/null | |||
@@ -1,142 +0,0 @@ | |||
1 | ;;; def.el --- defining macros -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | |||
7 | ;;; Utility | ||
8 | |||
9 | (defun def--assert-args (pred args &optional error-type &rest error-args) | ||
10 | "Assert that ARGS follows PRED. | ||
11 | If it doesn't, raise an error. ERROR-TYPE will be the type of | ||
12 | that error (defaults to `user-error'), and it and ERROR-ARGS are | ||
13 | passed in a list to `signal'." | ||
14 | (unless (funcall pred args) | ||
15 | (funcall #'signal | ||
16 | (or error-type 'user-error) | ||
17 | (or error-args | ||
18 | (list "Wrong arguments" args))))) | ||
19 | |||
20 | (defmacro o (&rest fns) | ||
21 | "Compose FNS into a new function for one argument." | ||
22 | (if (null fns) | ||
23 | `(lambda (&rest args) args) | ||
24 | `(lambda (&rest args) | ||
25 | (apply | ||
26 | #',(car fns) | ||
27 | (ensure-list (apply (o ,@(cdr fns)) args)))))) | ||
28 | |||
29 | ;; TODO: I need to figure out where this function goes. | ||
30 | (defun def--delete2 (list &rest elems) | ||
31 | "Delete each element of ELEMS, and the next item, from LIST." | ||
32 | (let ((r nil)) | ||
33 | (while (consp list) | ||
34 | (if (member (car list) elems) | ||
35 | (setf list (cdr list)) | ||
36 | (setf r (cons (car list) r))) | ||
37 | (setf list (cdr list))) | ||
38 | (reverse r))) | ||
39 | |||
40 | ;;; Keybindings | ||
41 | |||
42 | (defmacro defkeys (maps &rest bindings) | ||
43 | "Define key BINDINGS in MAPS. | ||
44 | If MAPS is nil or t, bind to `current-global-map'. Otherwise, | ||
45 | bind each of BINDINGS to the map or list of maps provided. | ||
46 | |||
47 | BINDINGS is a `setq'-style list of pairs of keys and definitions. | ||
48 | The key part of each binding can be a string, in which case it's | ||
49 | passed to `kbd', or a vector or anything else `define-key' | ||
50 | accepts in the KEY position. The definition part, likewise, can | ||
51 | be any form `define-key' accepts in that position, with this | ||
52 | addition: if the form is a `defun' form, it will be defined | ||
53 | before any keys are bound." | ||
54 | (declare (indent 1)) | ||
55 | (def--assert-args (o cl-evenp length) bindings | ||
56 | 'wrong-number-of-arguments 'defkeys 'evenp (length bindings)) | ||
57 | `(progn | ||
58 | ,@(cl-loop | ||
59 | for map in (ensure-list maps) | ||
60 | for first-map-p = t then nil | ||
61 | append | ||
62 | (cl-loop | ||
63 | for (keys def) on bindings by #'cddr | ||
64 | for defp = (memq (car-safe def) '(defmap defun defmacro)) | ||
65 | if (and defp first-map-p) collect def into defuns | ||
66 | append | ||
67 | (cl-loop | ||
68 | for key in (ensure-list keys) | ||
69 | collect (list 'define-key | ||
70 | (if (memq map '(t nil)) | ||
71 | '(current-global-map) | ||
72 | (or (car-safe map) map)) | ||
73 | (if (stringp key) | ||
74 | `(kbd ,key) | ||
75 | key) | ||
76 | (if defp | ||
77 | (cl-case (car def) | ||
78 | ((defmap) (cadr def)) | ||
79 | ((defun defmacro) `#',(cadr def)) | ||
80 | (otherwise (error "Bad def type: %S" | ||
81 | (car def)))) | ||
82 | def))) | ||
83 | into keydefs | ||
84 | finally return | ||
85 | (let ((all (append defuns keydefs))) | ||
86 | (if-let ((after (plist-get (cdr-safe map) :after))) | ||
87 | `((eval-after ,after | ||
88 | ,@all)) | ||
89 | all)))))) | ||
90 | |||
91 | (defmacro defmap (name docstring &rest bindings) | ||
92 | "Define a keymap named NAME, with BINDINGS." | ||
93 | (declare (indent 1) (doc-string 2)) | ||
94 | `(,(if (boundp name) 'setq 'defvar) ,name | ||
95 | ;;; ^ probably a terrible hack | ||
96 | (let ((map (make-sparse-keymap))) | ||
97 | (defkeys map ,@bindings) | ||
98 | map) | ||
99 | ,@(unless (boundp name) (list docstring)))) | ||
100 | |||
101 | ;;; Hooks | ||
102 | |||
103 | (defmacro defhook (hooks &rest body) | ||
104 | "Define a function to hook into HOOKS. | ||
105 | NAME and ARGS are passed to the generated `defun' form. | ||
106 | Each hook in HOOKS can be the name of a hook or a list of the form | ||
107 | (HOOK DEPTH LOCAL), where each argument is the same as in | ||
108 | `add-hook'." | ||
109 | (declare (indent 1)) | ||
110 | (let* ((name (or (plist-get body :name) | ||
111 | (intern (format "%s/h" | ||
112 | (mapconcat | ||
113 | (lambda (h) | ||
114 | (string-remove-suffix | ||
115 | "-hook" (symbol-name (or (car-safe h) | ||
116 | h)))) | ||
117 | (ensure-list hooks) | ||
118 | "|"))))) | ||
119 | (args (or (plist-get body :args) nil)) | ||
120 | (doc (or (plist-get body :doc) nil)) | ||
121 | (forms ; (DEFUN . FUNCS) | ||
122 | (cl-loop for form in (def--delete2 body :name :args :doc) | ||
123 | if (eq (car form) 'function) | ||
124 | collect form into funcs | ||
125 | else collect form into defuns | ||
126 | finally return (cons defuns funcs))) | ||
127 | (defun-forms (car forms)) | ||
128 | (func-forms (cdr forms))) | ||
129 | `(progn | ||
130 | ,@(when defun-forms | ||
131 | `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) | ||
132 | ,@(cl-loop for hook in (ensure-list hooks) | ||
133 | for h = (or (car-safe hook) hook) | ||
134 | for ha = (cdr-safe hook) | ||
135 | if defun-forms | ||
136 | collect `(add-hook ',h #',name ,@ha) | ||
137 | append | ||
138 | (cl-loop for fn in func-forms | ||
139 | collect `(add-hook ',h ,fn ,@ha)))))) | ||
140 | |||
141 | (provide 'def) | ||
142 | ;;; def.el ends here | ||
diff --git a/lisp/graveyard.el b/lisp/graveyard.el new file mode 100644 index 0000000..89a776d --- /dev/null +++ b/lisp/graveyard.el | |||
@@ -0,0 +1,50 @@ | |||
1 | ;;; graveyard.el --- stuff i'm not currently using right now | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; I spent a long time configuring these packages! And they're misbehaving, | ||
6 | ;; boo. So into the graveyard they go. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (use-package emms | ||
11 | :ensure t | ||
12 | :init | ||
13 | (require 'emms-setup) | ||
14 | (autoload #'+emms-streams "+emms" nil t) | ||
15 | (defkeys t "C-c p s" #'+emms-streams) | ||
16 | (defhook (emms-playlist-mode-hook | ||
17 | emms-browser-mode-hook | ||
18 | emms-show-all-mode-hook) | ||
19 | #'hl-line-mode | ||
20 | #'show-paren-mode) | ||
21 | :config | ||
22 | (require '+emms) | ||
23 | (emms-all) | ||
24 | (emms-default-players) | ||
25 | (emms-browser-make-filter "all" #'ignore) | ||
26 | (emms-browser-make-filter "recent" | ||
27 | (lambda (track) | ||
28 | (< 30 (time-to-number-of-days | ||
29 | (time-subtract (current-time) | ||
30 | (emms-info-track-file-mtime | ||
31 | track)))))) | ||
32 | (emms-browser-set-filter (assoc "all" emms-browser-filters)) | ||
33 | (emms-history-load) | ||
34 | (emms-playing-time-mode -1) | ||
35 | :bind | ||
36 | (("C-c p p" . emms-pause) | ||
37 | ("C-c p b" . emms-browser) | ||
38 | ("C-c p l" . emms-playlist-mode-go)) | ||
39 | :custom | ||
40 | (emms-source-file-default-directory (expand-file-name "~/var/music/")) | ||
41 | (emms-source-playlist-default-format 'm3u) | ||
42 | (emms-playlist-mode-center-when-go t) | ||
43 | (emms-playlist-default-major-mode 'emms-playlist-mode) | ||
44 | (emms-player-mpv-update-metadata t) | ||
45 | (emms-browser-covers #'emms-browser-cache-thumbnail-async) | ||
46 | (emms-browser-thumbnail-small-size 64) | ||
47 | (emms-browser-thumbnail-medium-size 128) | ||
48 | (emms-streams-file (expand-file-name "streams.emms" | ||
49 | emms-source-file-default-directory)) | ||
50 | (emms-mode-line-mode-line-function nil)) | ||
diff --git a/lisp/init-org.el b/lisp/init-org.el new file mode 100644 index 0000000..d2d5e77 --- /dev/null +++ b/lisp/init-org.el | |||
@@ -0,0 +1,144 @@ | |||
1 | ;;; init-org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (use-package org | ||
4 | :defer t | ||
5 | :custom | ||
6 | (org-adapt-indentation nil) | ||
7 | (org-auto-align-tags t) | ||
8 | (org-archive-mark-done t) | ||
9 | (org-fold-catch-invisible-edits 'show-and-error) | ||
10 | (org-clock-clocked-in-display 'mode-line) | ||
11 | (org-clock-string-limit 7) ; just the clock bit | ||
12 | |||
13 | (org-clock-persist nil) | ||
14 | (org-confirm-babel-evaluate nil) | ||
15 | (org-cycle-separator-lines 0) | ||
16 | (org-directory (sync/ "org/" t)) | ||
17 | (org-fontify-done-headline t) | ||
18 | (org-fontify-quote-and-verse-blocks t) | ||
19 | (org-fontify-whole-heading-line t) | ||
20 | (org-hide-emphasis-markers t) | ||
21 | (org-html-coding-system 'utf-8-unix) | ||
22 | (org-image-actual-width (list (* (window-font-width) | ||
23 | (- fill-column 8)))) | ||
24 | (org-imenu-depth 3) | ||
25 | (org-indent-indentation-per-level 0) | ||
26 | (org-indent-mode-turns-on-hiding-stars nil) | ||
27 | (org-insert-heading-respect-content t) | ||
28 | (org-list-demote-modify-bullet '(("-" . "+") | ||
29 | ("+" . "-"))) | ||
30 | (org-log-done 'time) | ||
31 | (org-log-into-drawer t) | ||
32 | (org-num-skip-commented t) | ||
33 | (org-num-skip-unnumbered t) | ||
34 | (org-num-skip-footnotes t) | ||
35 | (org-outline-path-complete-in-steps nil) | ||
36 | (org-pretty-entities t) | ||
37 | (org-pretty-entities-include-sub-superscripts nil) | ||
38 | (org-refile-targets '((nil . (:maxlevel . 2)) | ||
39 | (org-agenda-files . (:maxlevel . 1)))) | ||
40 | (org-refile-use-outline-path 'file) | ||
41 | (org-special-ctrl-a/e t) | ||
42 | (org-special-ctrl-k t) | ||
43 | (org-src-fontify-natively t) | ||
44 | (org-src-tab-acts-natively t) | ||
45 | (org-src-window-setup 'current-window) | ||
46 | (org-startup-truncated nil) | ||
47 | (org-startup-with-inline-images t) | ||
48 | (org-tags-column 0) | ||
49 | (org-todo-keywords | ||
50 | '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" | ||
51 | "|" "DONE(d!)" "ASSIGNED(a@/!)") | ||
52 | (sequence "|" "CANCELED(k@)") | ||
53 | (sequence "MEETING(m)"))) | ||
54 | (org-use-speed-commands t) | ||
55 | :config | ||
56 | (require '+org) | ||
57 | (defkeys org-mode-map | ||
58 | "C-M-k" #'kill-paragraph | ||
59 | "C-M-t" #'transpose-paragraphs | ||
60 | "RET" #'+org-return-dwim | ||
61 | "S-<return>" #'+org-table-copy-down|+org-return-dwim | ||
62 | "C-c C-o" #'+org-open-at-point-dwim) | ||
63 | (setc org-ellipsis | ||
64 | (or (bound-and-true-p truncate-string-ellipsis) "…") | ||
65 | org-emphasis-alist | ||
66 | '(("*" org-bold) | ||
67 | ("/" org-italic) | ||
68 | ("_" org-underline) | ||
69 | ("=" org-verbatim) | ||
70 | ("~" org-code) | ||
71 | ("+" org-strikethrough))) | ||
72 | (defhook org-mode-hook | ||
73 | #'variable-pitch-mode | ||
74 | #'visual-fill-column-mode | ||
75 | #'turn-off-auto-fill | ||
76 | #'org-indent-mode | ||
77 | #'prettify-symbols-mode | ||
78 | #'abbrev-mode | ||
79 | (defhook ((before-save-hook nil :local)) | ||
80 | :name before-save@org-mode | ||
81 | (+org-hide-drawers-except-point) | ||
82 | (org-align-tags 'all)))) | ||
83 | |||
84 | (use-package org-agenda | ||
85 | :custom | ||
86 | (org-agenda-skip-deadline-if-done t) | ||
87 | (org-agenda-skip-scheduled-if-done t) | ||
88 | (org-agenda-span 10) | ||
89 | (org-agenda-block-separator ?─) | ||
90 | (org-agenda-time-grid | ||
91 | '((daily today require-timed) | ||
92 | (800 1000 1200 1400 1600 1800 2000) | ||
93 | " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")) | ||
94 | (org-agenda-current-time-string | ||
95 | "← now ─────────────────────────────────────────────────") | ||
96 | (org-agenda-include-diary nil) ; I use the org-diary features | ||
97 | |||
98 | (org-agenda-todo-ignore-deadlines 'near) | ||
99 | (org-agenda-todo-ignore-scheduled 'future) | ||
100 | (org-agenda-include-deadlines t) | ||
101 | (org-deadline-warning-days 0) | ||
102 | (org-agenda-show-future-repeats 'next) | ||
103 | (org-agenda-window-setup 'current-window) | ||
104 | (org-agenda-file-skip-regexp "sync-conflict") | ||
105 | :bind (("C-c a" . org-agenda)) | ||
106 | :config | ||
107 | (require '+org) | ||
108 | (advice-add 'org-agenda-files :filter-return #'org-agenda-files@skip-regexp) | ||
109 | (defhook org-agenda-mode-hook | ||
110 | (setq-local truncate-lines t) | ||
111 | #'hl-line-mode) | ||
112 | (defhook org-agenda-after-show-hook | ||
113 | #'org-narrow-to-subtree)) | ||
114 | |||
115 | (use-package org-capture | ||
116 | :bind | ||
117 | (("C-c c" . org-capture))) | ||
118 | |||
119 | (use-package ol ; org-link | ||
120 | :after org | ||
121 | :config | ||
122 | (require '+org) | ||
123 | (+org-link-define-type sms (number _)) | ||
124 | (+org-link-define-type tel (number _))) | ||
125 | |||
126 | (use-package ox ; org-export | ||
127 | :defer t | ||
128 | :custom | ||
129 | (org-export-coding-system 'utf-8-unix) | ||
130 | (org-export-headline-levels 8) | ||
131 | (org-export-with-drawers nil) | ||
132 | (org-export-with-section-numbers nil) | ||
133 | (org-export-with-smart-quotes t) | ||
134 | (org-export-with-sub-superscripts t) | ||
135 | (org-export-with-toc nil) | ||
136 | :config | ||
137 | (require 'ox-md)) | ||
138 | |||
139 | (use-package org-word-count | ||
140 | :load-path "~/src/emacs/org-word-count/" | ||
141 | :hook org-mode-hook) | ||
142 | |||
143 | (provide 'init-org) | ||
144 | ;;; init-org.el ends here | ||
diff --git a/lisp/org-word-count.el b/lisp/org-word-count.el deleted file mode 100644 index d6d2598..0000000 --- a/lisp/org-word-count.el +++ /dev/null | |||
@@ -1,297 +0,0 @@ | |||
1 | ;;; org-word-count.el --- org-word-count in the modeline -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'org) | ||
8 | (require 'cl-lib) | ||
9 | |||
10 | (defgroup org-word-count nil | ||
11 | "Extra fast word-counting in `org-mode'." | ||
12 | :group 'org) | ||
13 | |||
14 | (defvar-local org-word-count-word-count nil | ||
15 | "Running total of words in this buffer.") | ||
16 | |||
17 | (defvar-local org-word-count-string nil | ||
18 | "String for the modeline.") | ||
19 | |||
20 | (defcustom org-word-count-format "%sw " | ||
21 | "Format for org word count in modeline." | ||
22 | :type 'string) | ||
23 | |||
24 | (defcustom org-word-count-huge-string "huge" | ||
25 | "String to display with a huge buffer." | ||
26 | :type 'string) | ||
27 | |||
28 | (defcustom org-word-count-update-after-funcs '(org-narrow-to-subtree | ||
29 | org-narrow-to-block | ||
30 | org-narrow-to-element | ||
31 | org-capture-narrow) | ||
32 | "Functions after which to update the word count." | ||
33 | :type '(repeat function)) | ||
34 | |||
35 | (defcustom org-word-count-deletion-idle-timer 0.25 | ||
36 | "Length of time, in seconds, to wait before updating word-count." | ||
37 | :type 'number) | ||
38 | |||
39 | (defcustom org-word-count-huge-change 5000 | ||
40 | "Number of characters that constitute a \"huge\" insertion." | ||
41 | :type 'number) | ||
42 | |||
43 | (defcustom org-word-count-huge-buffer 10000 | ||
44 | "Number of words past which we're not going to try to count." | ||
45 | :type 'number) | ||
46 | |||
47 | (defvar org-word-count-correction -5 | ||
48 | "Number to add to `org-word-count-word-count', for some reason? | ||
49 | `org-word-count-word-count' seems to consistently be off by 5. Thus | ||
50 | this correction. (At some point I should correct the underlying | ||
51 | code... probably).") | ||
52 | |||
53 | (defvar-local org-word-count-update-timer nil) | ||
54 | |||
55 | ;;; Variables from org-wc | ||
56 | |||
57 | (defun org-word-count-list-of-strings-p (arg) | ||
58 | (cl-every #'stringp arg)) | ||
59 | |||
60 | (defun org-word-count--downcase-list-of-strings-set-default (var val) | ||
61 | (set-default var (mapcar #'downcase val))) | ||
62 | |||
63 | (defcustom org-word-count-ignored-tags '("nowc" "noexport" "ARCHIVE") | ||
64 | "List of tags for which subtrees will be ignored in word counts" | ||
65 | :type '(repeat string) | ||
66 | :safe #'org-word-count-list-of-strings-p) | ||
67 | |||
68 | (defcustom org-word-count-ignore-commented-trees t | ||
69 | "Ignore trees with COMMENT-prefix if non-nil." | ||
70 | :type 'boolean | ||
71 | :safe #'booleanp) | ||
72 | |||
73 | (defcustom org-word-count-default-link-count 'description-or-path | ||
74 | "Default way of counting words in links. | ||
75 | This is applied to any link type not specified in any of | ||
76 | ‘org-word-count-ignored-link-types’,‘org-word-count-one-word-link-types’, or | ||
77 | ‘org-word-count-only-description-link-types’ " | ||
78 | :type '(choice | ||
79 | (const :tag "Count words in description or else path part of links" description-or-path) | ||
80 | (const :tag "Count words only in description part of links" description) | ||
81 | (const :tag "Count links as 0 words" ignore) | ||
82 | (const :tag "Count links as 1 word" oneword) | ||
83 | (const :tag "Count words only in path part of links" path)) | ||
84 | :safe 'symbolp) | ||
85 | |||
86 | (defcustom org-word-count-ignored-link-types nil | ||
87 | "Link types which won't be counted as a word" | ||
88 | :type '(repeat string) | ||
89 | :safe #'org-word-count-list-of-strings-p) | ||
90 | |||
91 | (defcustom org-word-count-one-word-link-types '("zotero") | ||
92 | "Link types which will be counted as one word" | ||
93 | :type '(repeat string) | ||
94 | :safe #'org-word-count-list-of-strings-p) | ||
95 | |||
96 | (defcustom org-word-count-description-or-path-link-types '() | ||
97 | "Link types for which the description or the path should be counted" | ||
98 | :type '(repeat string) | ||
99 | :safe #'org-word-count-list-of-strings-p) | ||
100 | |||
101 | (defcustom org-word-count-only-description-link-types '("note") | ||
102 | "Link types for which only the description should be counted" | ||
103 | :type '(repeat string) | ||
104 | :safe #'org-word-count-list-of-strings-p) | ||
105 | |||
106 | (defcustom org-word-count-only-path-link-types '() | ||
107 | "Link types for which only the path should be counted" | ||
108 | :type '(repeat string) | ||
109 | :safe #'org-word-count-list-of-strings-p) | ||
110 | |||
111 | (defcustom org-word-count-blocks-to-count '("quote" "verse") | ||
112 | "List of blocks which should be included in word count. | ||
113 | |||
114 | Use lower case block names" | ||
115 | :type '(repeat string) | ||
116 | :safe #'org-word-count-list-of-strings-p | ||
117 | :set #'org-word-count--downcase-list-of-strings-set-default) | ||
118 | |||
119 | (defun org-word-count-delayed-update (&rest _) | ||
120 | (if org-word-count-update-timer | ||
121 | (setq org-word-count-update-timer nil) | ||
122 | (setq org-word-count-update-timer | ||
123 | (run-with-idle-timer org-word-count-deletion-idle-timer nil | ||
124 | #'org-word-count-update)))) | ||
125 | |||
126 | (defun org-word-count-force-update () | ||
127 | (interactive) | ||
128 | (message "Counting words...") | ||
129 | (when (timerp org-word-count-update-timer) | ||
130 | (cancel-timer org-word-count-update-timer)) | ||
131 | (org-word-count-update) | ||
132 | (message "Counting words...done")) | ||
133 | |||
134 | (defun org-word-count-update (&rest _) ; Needs variadic parameters, since it's advice | ||
135 | (dlet ((org-word-count-counting t)) | ||
136 | (org-word-count-buffer) | ||
137 | (org-word-count-modeline) | ||
138 | (setq org-word-count-update-timer nil))) | ||
139 | |||
140 | (defun org-word-count-changed (start end length) | ||
141 | (org-word-count-delayed-update)) | ||
142 | |||
143 | (defun org-word-count-buffer () | ||
144 | "Count the words in the buffer." | ||
145 | (when (and (derived-mode-p 'org-mode) | ||
146 | (not (eq org-word-count-word-count 'huge))) | ||
147 | (setq org-word-count-word-count | ||
148 | (cond | ||
149 | ((> (count-words (point-min) (point-max)) | ||
150 | org-word-count-huge-buffer) | ||
151 | 'huge) | ||
152 | (t (org-word-count-aux (point-min) (point-max))))))) | ||
153 | |||
154 | ;;; From org-wc.el: | ||
155 | ;; https://github.com/tesujimath/org-wc/ | ||
156 | (defun org-word-count-aux (beg end) | ||
157 | "Return the number of words between BEG and END." | ||
158 | (let ((wc 0) | ||
159 | subtreecount | ||
160 | (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}")) | ||
161 | (save-excursion | ||
162 | (goto-char beg) | ||
163 | ;; Handle the case where we start in a drawer | ||
164 | (when (org-at-drawer-p) | ||
165 | (org-end-of-meta-data t)) | ||
166 | (while (< (point) end) | ||
167 | (cond | ||
168 | ;; Handle headlines and subtrees | ||
169 | ((org-at-heading-p) | ||
170 | (cond | ||
171 | ;; Ignore commented and org-wc-ignored-tags trees | ||
172 | ((or (and org-word-count-ignore-commented-trees (org-in-commented-heading-p)) | ||
173 | (cl-intersection org-word-count-ignored-tags (org-get-tags) :test #'string=)) | ||
174 | (org-end-of-subtree t t)) | ||
175 | ;; Re-use count for subtrees already counted | ||
176 | ((setq subtreecount (get-text-property (point) :org-wc)) | ||
177 | (cl-incf wc subtreecount) | ||
178 | (org-end-of-subtree t t)) | ||
179 | ;; Skip counting words in headline | ||
180 | (t (org-word-count--goto-char (point-at-eol) end)))) | ||
181 | ;; Ignore most blocks. | ||
182 | ((when (save-excursion | ||
183 | (beginning-of-line 1) | ||
184 | (looking-at org-block-regexp)) | ||
185 | (if (member (downcase (match-string 1)) org-word-count-blocks-to-count) | ||
186 | (progn ;; go inside block and subtract count of end line | ||
187 | (org-word-count--goto-char (match-beginning 4) end) | ||
188 | (cl-decf wc)) | ||
189 | (org-word-count--goto-char (match-end 0) end)))) | ||
190 | ;; Ignore comments. | ||
191 | ((org-at-comment-p) | ||
192 | (org-word-count--goto-char (point-at-eol) end)) | ||
193 | ;; Ignore drawers. | ||
194 | ((org-at-drawer-p) | ||
195 | (org-end-of-meta-data t)) | ||
196 | ;; Ignore all other #+ lines | ||
197 | ((looking-at "#+") | ||
198 | (org-word-count--goto-char (point-at-eol) end)) | ||
199 | ;; Handle links | ||
200 | ((save-excursion | ||
201 | (when (< (1+ (point-min)) (point)) (backward-char 2)) | ||
202 | (looking-at org-link-bracket-re)) | ||
203 | (let* ((type (car (save-match-data (split-string (match-string 1) ":")))) | ||
204 | (pathstart (+ 1 (length type) (match-beginning 1)))) | ||
205 | (cl-case (cond ((member type org-word-count-ignored-link-types) 'ignore) | ||
206 | ((member type org-word-count-one-word-link-types) 'oneword) | ||
207 | ((member type org-word-count-only-description-link-types) | ||
208 | 'description) | ||
209 | ((member type org-word-count-only-path-link-types) 'path) | ||
210 | ((member type org-word-count-description-or-path-link-types) | ||
211 | 'description-or-path) | ||
212 | (t org-word-count-default-link-count)) | ||
213 | (ignore (org-word-count--goto-char (match-end 0) end)) | ||
214 | (oneword (org-word-count--goto-char (match-end 0) end) | ||
215 | (cl-incf wc)) | ||
216 | (description (if (match-beginning 2) | ||
217 | (goto-char (match-beginning 2)) | ||
218 | (org-word-count--goto-char | ||
219 | (match-end 0) end))) | ||
220 | (path (cl-incf wc (count-words-region pathstart | ||
221 | (match-end 1))) | ||
222 | (org-word-count--goto-char (match-end 0) end)) | ||
223 | (description-or-path | ||
224 | (if (match-beginning 2) | ||
225 | (goto-char (match-beginning 2)) | ||
226 | (cl-incf wc (count-words-region pathstart | ||
227 | (match-end 1))) | ||
228 | (org-word-count--goto-char (match-end 0) end))) | ||
229 | (t (user-error "Error in org-word-count link configuration"))))) | ||
230 | ;; Count latex macros as 1 word, ignoring their arguments. | ||
231 | ((save-excursion | ||
232 | (when (< (point-min) (point)) (backward-char)) | ||
233 | (looking-at latex-macro-regexp)) | ||
234 | (org-word-count--goto-char (match-end 0) end) | ||
235 | (cl-incf wc)) | ||
236 | (t | ||
237 | (and (re-search-forward "\\w+\\W*" end 'skip) | ||
238 | (cl-incf wc)))))) | ||
239 | wc)) | ||
240 | |||
241 | (defun org-word-count--goto-char (char end) | ||
242 | "Moves point to CHAR and from there passes 0+ non-word characters. | ||
243 | Searchers to end as a maximum. | ||
244 | |||
245 | This ensures that we are in an expected state (at the first word | ||
246 | character after some non-word characters) after moving beyond | ||
247 | headlines, links etc." | ||
248 | (goto-char char) | ||
249 | (re-search-forward "\\W*" end 'skip)) | ||
250 | |||
251 | (defvar org-word-count-counting nil | ||
252 | "Are we currently counting?") | ||
253 | |||
254 | (defun org-word-count-recount-widen (&rest _) | ||
255 | (when (and (not org-word-count-counting)) | ||
256 | (org-word-count-update))) | ||
257 | |||
258 | (defun org-word-count-modeline () | ||
259 | (setq org-word-count-string | ||
260 | (cond | ||
261 | ((eq org-word-count-word-count 'huge) | ||
262 | org-word-count-huge-string) | ||
263 | (org-word-count-word-count | ||
264 | (format org-word-count-format | ||
265 | (max 0 (+ org-word-count-word-count | ||
266 | org-word-count-correction)))))) | ||
267 | (force-mode-line-update)) | ||
268 | |||
269 | (define-minor-mode org-word-count-mode | ||
270 | "Count words in `org-mode' buffers in the mode-line." | ||
271 | :lighter "" | ||
272 | :keymap (let ((map (make-sparse-keymap))) | ||
273 | (define-key map (kbd "C-c C-.") #'org-word-count-force-update) | ||
274 | map) | ||
275 | (cond (org-word-count-mode | ||
276 | (org-word-count-buffer) | ||
277 | (add-hook 'after-change-functions | ||
278 | #'org-word-count-delayed-update nil t) | ||
279 | (unless (member '(org-word-count-mode org-word-count-string) | ||
280 | mode-line-misc-info) | ||
281 | (add-to-list 'mode-line-misc-info | ||
282 | '(org-word-count-mode org-word-count-string) | ||
283 | nil | ||
284 | #'equal)) | ||
285 | (dolist (fn org-word-count-update-after-funcs) | ||
286 | (advice-add fn :after #'org-word-count-update))) | ||
287 | (:else | ||
288 | (remove-hook 'after-change-functions | ||
289 | #'org-word-count-delayed-update t) | ||
290 | (setf mode-line-misc-info | ||
291 | (delete '(org-word-count-mode org-word-count-string) | ||
292 | mode-line-misc-info)) | ||
293 | (dolist (fn org-word-count-update-after-funcs) | ||
294 | (advice-remove fn #'org-word-count-update))))) | ||
295 | |||
296 | (provide 'org-word-count) | ||
297 | ;;; org-word-count.el ends here | ||
diff --git a/lisp/pita.el b/lisp/pita.el deleted file mode 100644 index ed67c92..0000000 --- a/lisp/pita.el +++ /dev/null | |||
@@ -1,69 +0,0 @@ | |||
1 | ;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*- | ||
2 | ;; 🥙 | ||
3 | |||
4 | ;;; utils | ||
5 | |||
6 | (defun walk-tree-replace (tree find replace) | ||
7 | (let ((r nil)) | ||
8 | (dolist (form tree) | ||
9 | (push (cond ((eq find form) replace) | ||
10 | ((listp form) | ||
11 | (walk-tree-replace form find replace)) | ||
12 | (t form)) | ||
13 | r)) | ||
14 | (reverse r))) | ||
15 | |||
16 | ;;; crux advices | ||
17 | ;; these should all go :before the function they're advising. | ||
18 | |||
19 | (defun with-region-or-buffer (&rest _) | ||
20 | (interactive (if mark-active | ||
21 | (list (region-beginning) (region-end)) | ||
22 | (list (point-min) (point-max))))) | ||
23 | |||
24 | (defun with-region-or-line (&rest _) | ||
25 | (interactive (if mark-active | ||
26 | (list (region-beginning) (region-end)) | ||
27 | (list (line-beginning-position) (line-end-position))))) | ||
28 | |||
29 | (defun with-region-or-to-eol (&rest _) | ||
30 | (interactive (if mark-active | ||
31 | (list (region-beginning) (region-end)) | ||
32 | (list (point) (line-end-position))))) | ||
33 | |||
34 | ;;; wrappers | ||
35 | |||
36 | (defmacro with-message (msg &rest body) | ||
37 | (declare (indent 1)) | ||
38 | (when (listp msg) | ||
39 | (setq msg (apply #'format (car msg) (cdr msg)))) | ||
40 | (when (string-match "[[:alnum:]]\\'" msg) | ||
41 | (setq msg (concat msg "..."))) | ||
42 | (let ((m (gensym)) | ||
43 | (r (gensym))) | ||
44 | `(let ((,m ,msg) | ||
45 | (,r nil)) | ||
46 | (condition-case e | ||
47 | (setq r (progn (message ,m) ,@body)) | ||
48 | (:success (message "%s done" ,m) r) | ||
49 | (t (signal (car e) (cdr e))))))) | ||
50 | |||
51 | (defmacro with-pr (msg &rest body) | ||
52 | (declare (indent 1)) | ||
53 | (when (listp msg) | ||
54 | (setq msg (apply #'format (car msg) (cdr msg)))) | ||
55 | (when (string-match "[[:alnum:]]\\'" msg) | ||
56 | (setq msg (concat msg "..."))) | ||
57 | (let ((pr (gensym)) | ||
58 | (m (gensym))) | ||
59 | `(let* ((,m ,msg) | ||
60 | (,pr (unless (minibufferp) | ||
61 | (make-progress-reporter ,m)))) | ||
62 | ,@(or (and pr (walk-tree-replace body '@ `(progress-reporter-update ,pr))) | ||
63 | body) | ||
64 | (and ,pr (progress-reporter-done ,pr))))) | ||
65 | |||
66 | ;;; wrapper advice | ||
67 | |||
68 | (provide 'pita) | ||
69 | ;;; pita.el ends here | ||
diff --git a/lisp/private.el b/lisp/private.el deleted file mode 100644 index 4f6115e..0000000 --- a/lisp/private.el +++ /dev/null | |||
@@ -1,23 +0,0 @@ | |||
1 | ;;; private.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'acdw) | ||
8 | |||
9 | (defgroup private nil | ||
10 | "Private things are private. Shhhhh....") | ||
11 | |||
12 | ;; Private directory | ||
13 | |||
14 | (+define-dir private/ (sync/ "emacs/private") | ||
15 | "Private secretive secrets inside.") | ||
16 | (add-to-list 'load-path private/) | ||
17 | |||
18 | ;; Load random private stuff | ||
19 | |||
20 | (require '_acdw) | ||
21 | |||
22 | (provide 'private) | ||
23 | ;;; private.el ends here | ||
diff --git a/lisp/scule.el b/lisp/scule.el deleted file mode 100644 index 3ed58bb..0000000 --- a/lisp/scule.el +++ /dev/null | |||
@@ -1,61 +0,0 @@ | |||
1 | ;;; scule.el --- -scule twiddling -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;; Author: Case Duckworth <case@bob> | ||
6 | ;; Keywords: convenience | ||
7 | |||
8 | ;; This program is free software; you can redistribute it and/or modify | ||
9 | ;; it under the terms of the GNU General Public License as published by | ||
10 | ;; the Free Software Foundation, either version 3 of the License, or | ||
11 | ;; (at your option) any later version. | ||
12 | |||
13 | ;; This program is distributed in the hope that it will be useful, | ||
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
16 | ;; GNU General Public License for more details. | ||
17 | |||
18 | ;; You should have received a copy of the GNU General Public License | ||
19 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
20 | |||
21 | ;;; Commentary: | ||
22 | |||
23 | ;; DWIM functions for twiddling "scule", or text case (a fancy word for "upper | ||
24 | ;; case" is "magiscule", for example, and "lower case" is "miniscule"). | ||
25 | |||
26 | ;;; Code: | ||
27 | |||
28 | (require 'thingatpt) | ||
29 | |||
30 | ;;; Utility macro | ||
31 | ;;;###autoload | ||
32 | (defmacro defscule (name &optional region-fn word-fn) | ||
33 | (let ((fn-name (intern (format "scule-%s" name))) | ||
34 | (region-fn (or region-fn (intern (format "%s-region" name)))) | ||
35 | (word-fn (or word-fn (intern (format "%s-word" name))))) | ||
36 | `(defun ,fn-name (arg) | ||
37 | ,(concat (capitalize (symbol-name name)) " words in the region if active, or word at point.\n" | ||
38 | "If the region is active, call `" (symbol-name region-fn) "'.\n" | ||
39 | "Otherwise, it calls `" (symbol-name word-fn) "' on the word at point and\n" | ||
40 | "the following ARG - 1 words.") | ||
41 | (interactive "*p") | ||
42 | (if (use-region-p) | ||
43 | (,region-fn (region-beginning) (region-end) (region-noncontiguous-p)) | ||
44 | (let ((word-bound (save-excursion | ||
45 | (skip-chars-forward "^[:word:]") | ||
46 | (bounds-of-thing-at-point 'word)))) | ||
47 | (when (and (car word-bound) (cdr word-bound)) | ||
48 | (,region-fn (car word-bound) (cdr word-bound)) | ||
49 | (goto-char (cdr word-bound)) | ||
50 | (,word-fn (1- arg)))))))) | ||
51 | |||
52 | ;;;###autoload | ||
53 | (progn (defscule upcase) | ||
54 | (autoload 'scule-upcase "scule" nil t) | ||
55 | (defscule downcase) | ||
56 | (autoload 'scule-downcase "scule" nil t) | ||
57 | (defscule capitalize) | ||
58 | (autoload 'scule-capitalize "scule" nil t)) | ||
59 | |||
60 | (provide 'scule) | ||
61 | ;;; scule.el ends here | ||
diff --git a/lisp/upload-junk.el b/lisp/upload-junk.el new file mode 100644 index 0000000..5a9da84 --- /dev/null +++ b/lisp/upload-junk.el | |||
@@ -0,0 +1,47 @@ | |||
1 | ;;; upload-junk.el --- Upload junk -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'tramp) | ||
6 | |||
7 | (defvar upload-junk-ssh-host "hetzner" | ||
8 | "SSH host to upload to.") | ||
9 | |||
10 | (defvar upload-junk-ssh-root "/junk" | ||
11 | "SSH root folder to upload to.") | ||
12 | |||
13 | (defvar upload-junk-web-host "https://junk.acdw.net" | ||
14 | "Web host to link uploads to.") | ||
15 | |||
16 | (defun upload-junk-file-name (&optional file) | ||
17 | "Return the uploaded filename for FILE." | ||
18 | (let ((file (or file "_.txt"))) | ||
19 | (format "tmp_%s_%x%x.%s" | ||
20 | (file-name-nondirectory (file-name-sans-extension file)) | ||
21 | (time-convert (current-time) 'integer) | ||
22 | (random (* 8 8 8 8)) | ||
23 | (or (file-name-extension file) "txt")))) | ||
24 | |||
25 | (defun upload-junk-region (start end) | ||
26 | "Upload region from START to END to my server." | ||
27 | (interactive "r") | ||
28 | (let* ((s (buffer-substring-no-properties start end)) | ||
29 | (f (upload-junk-file-name (buffer-file-name))) | ||
30 | (w (format "%s/%s" upload-junk-web-host f))) | ||
31 | (with-temp-buffer | ||
32 | (insert s) | ||
33 | (write-file (format "/sshx:%s:%s/%s" | ||
34 | upload-junk-ssh-host | ||
35 | upload-junk-ssh-root | ||
36 | f))) | ||
37 | (kill-new w) | ||
38 | w)) | ||
39 | |||
40 | (defun upload-junk-region-or-buffer () | ||
41 | (interactive) | ||
42 | (if (region-active-p) | ||
43 | (upload-junk-region (region-beginning) (region-end)) | ||
44 | (upload-junk-region (point-min) (point-max)))) | ||
45 | |||
46 | (provide 'upload-junk) | ||
47 | ;;; upload-junk.el ends here | ||
diff --git a/lisp/yoke.el b/lisp/yoke.el index 8ca94fd..ec84f56 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el | |||
@@ -1,271 +1,360 @@ | |||
1 | ;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*- | 1 | ;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*- |
2 | ;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net> | 2 | |
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;; Author: Case Duckworth <case@bob> | ||
6 | ;; Keywords: convenience | ||
7 | ;; Package-Version: 0.61803398875 | ||
8 | ;; Homepage: https://junk.acdw.net/yoke.el | ||
9 | ;; Package-Requires: ((emacs "28.1")) | ||
10 | |||
11 | ;; This program is free software; you can redistribute it and/or modify | ||
12 | ;; it under the terms of the GNU General Public License as published by | ||
13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
14 | ;; (at your option) any later version. | ||
15 | |||
16 | ;; This program is distributed in the hope that it will be useful, | ||
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
19 | ;; GNU General Public License for more details. | ||
20 | |||
21 | ;; You should have received a copy of the GNU General Public License | ||
22 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
3 | 23 | ||
4 | ;;; Commentary: | 24 | ;;; Commentary: |
5 | 25 | ||
6 | ;; What's the most basic functionality of a package manager? In my view, all a | 26 | ;; THIS IS A WORK IN PROGRESS. DON'T USE IT. |
7 | ;; package manager should do is fetch packages from wherever they are, and | ||
8 | ;; provide the system with a method of accessing those packages' functionality. | ||
9 | ;; In Emacs, this means downloading packages from the Internet and adding their | ||
10 | ;; directories to `load-path'. That's what `yoke' tries to do. | ||
11 | ;; | ||
12 | ;; In fact, that's /all/ `yoke' tries to do, on the package front. It doesn't | ||
13 | ;; automatically fetch dependencies. It doesnt' do much else of anything | ||
14 | ;; --- hell, it doesn't have to generate autoloads or build the dang source | ||
15 | ;; files if you don't want it to. /I/ have it do those things because I like a | ||
16 | ;; few creature comforts, but you can turn 'em off. | ||
17 | ;; | ||
18 | ;; Instead of focusing too much on installing packages, `yoke' works harder to | ||
19 | ;; group---to "yoke together," if you will---related configurations together, à | ||
20 | ;; la `use-package' or `setup'. I used both of those packages before and found | ||
21 | ;; each somewhat lacking, and what I really wanted was a fancy `progn' that I | ||
22 | ;; could put whatever I want inside. So that's basically what `yoke' is. It's | ||
23 | ;; a configuration macro that automatically fetches packages from their repos | ||
24 | ;; and tells Emacs where they are, then executes its body in a `cl-block' for | ||
25 | ;; ... reasons. That's it. | ||
26 | 27 | ||
27 | ;;; Code: | 28 | ;;; Code: |
28 | 29 | ||
29 | (require 'cl-lib) | 30 | (require 'cl-lib) |
31 | (require 'package-vc) | ||
30 | 32 | ||
31 | ;;; Customization options | 33 | ;;; User options |
32 | 34 | ||
33 | (defgroup yoke nil | 35 | (defgroup yoke nil |
34 | "Customizations for `yoke'." | 36 | "Customizations for `yoke'." |
35 | :group 'applications | 37 | :group 'convenience |
36 | :prefix "yoke-") | 38 | :prefix "yoke-") |
37 | 39 | ||
38 | (defcustom yoke-dir (locate-user-emacs-file "yoke") | 40 | (defcustom yoke-directory package-user-dir |
39 | "Where to put yoked packages." | 41 | "Where to put yoked packages." |
40 | :type 'file) | 42 | :type 'file) |
41 | 43 | ||
42 | (defcustom yoke-get-default-fn #'yoke-get-git | 44 | (defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache" |
43 | "Default function to get packages with." | 45 | "~/.yoke-cache") |
44 | :type 'function) | 46 | "Where to put cached yoke files, like downloaded HTTP packages." |
47 | :type 'file) | ||
48 | |||
49 | (defcustom yoke-debug-on-error nil | ||
50 | "Whether to throw up the debugger on a yoke error. | ||
51 | If nil, errors will be inserted in the `yoke-message-buffer'.") | ||
52 | |||
53 | ;;; Variables | ||
54 | |||
55 | (defvar yoke-message-buffer " *yoke*" | ||
56 | "The buffer used for yoke messages.") | ||
57 | |||
58 | (defvar yoke-selected-packages nil | ||
59 | "List of packages managed by `yoke'.") | ||
60 | |||
61 | (defvar yoke-backends '(file http package) | ||
62 | "Backends handled by `yoke'.") | ||
63 | |||
64 | ;;; Main functionality | ||
65 | |||
66 | (defmacro yoke (package &rest body) | ||
67 | "Yoke a package into your Emacs session. | ||
68 | PACKAGE is either a symbol, in which case `yoke' expands to | ||
69 | basically a named `progn' (good for grouping configuration), or a | ||
70 | list of the form (NAME . ARGS), where ARGS can be one of the | ||
71 | following: | ||
72 | |||
73 | - nil: install NAME using `package'. | ||
74 | - a property list describing a package specification. Valid | ||
75 | key/value pairs include | ||
76 | |||
77 | `:backend' (symbol) | ||
78 | A symbol of the yoke backend to use for installing the | ||
79 | package. See `yoke-backends' for allowed backends. | ||
80 | |||
81 | `:url' (string) | ||
82 | The URL of the package's repository or source. | ||
83 | |||
84 | `:lisp-dir' (string) | ||
85 | The repository-relative name of the directory to use for | ||
86 | loading lisp sources. If not given, it defaults to the | ||
87 | repo's root directory. | ||
45 | 88 | ||
46 | (defvar yoke-buffer "*yoke*" | 89 | Other pairs may be valid for a given backend; see that |
47 | "Buffer to use for yoke process output.") | 90 | backend's `yoke-install' function for more details. |
48 | 91 | ||
49 | (defvar yoke-dirs nil | 92 | BODY is executed in a `condition-case' so that errors won't keep |
50 | "List of directories managed by `yoke'.") | 93 | the rest of Emacs from initializing. BODY can also be prepended |
94 | by the following keyword arguments: | ||
51 | 95 | ||
52 | ;;; GET YOKED | 96 | `:after' (FEATURE...) |
53 | 97 | ||
54 | (defmacro yoke (package | 98 | `:require' (FEATURE...) |
55 | &rest body) | ||
56 | "Yoke PACKAGE to work with your Emacs. | ||
57 | Execute BODY afterward. | ||
58 | 99 | ||
59 | \(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)" | 100 | `:depends' (PACKAGE-SPEC...) |
101 | |||
102 | `:build' (ACTION...) | ||
103 | |||
104 | `:unless' (PREDICATE) | ||
105 | |||
106 | `:when' (PREDICATE) | ||
107 | |||
108 | Other keywords are ignored. | ||
109 | |||
110 | \(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)" | ||
60 | (declare (indent 1)) | 111 | (declare (indent 1)) |
61 | (let* (;; State | 112 | (let* ((name (or (car-safe package) package)) |
62 | (pkg (cond ((consp package) (car package)) | 113 | (backend (yoke--pget package :backend)) |
63 | (:else package))) | 114 | ;; Body keyword arguments |
64 | (url (cond ((consp package) (cdr package)) | ||
65 | (:else nil))) | ||
66 | (pname (intern (format "yoke:%s" pkg))) | ||
67 | (dirvar '$yoke-dir) | ||
68 | ;; Keyword args --- TODO: Naming could probably be better. | ||
69 | (after (plist-get body :after)) | 115 | (after (plist-get body :after)) |
70 | (depends (plist-get body :depends)) | 116 | (depends (plist-get body :depends)) |
117 | (req (plist-get body :require)) | ||
118 | (buildp (plist-member body :build)) | ||
119 | (build (plist-get body :build)) | ||
71 | (whenp (plist-member body :when)) | 120 | (whenp (plist-member body :when)) |
121 | (when (if whenp (plist-get body :when) t)) | ||
72 | (unlessp (plist-member body :unless)) | 122 | (unlessp (plist-member body :unless)) |
73 | (when (cond (whenp (plist-get body :when)) | 123 | (unless (if unlessp (plist-get body :unless) nil)) |
74 | (:else t))) | ||
75 | (unless (cond (unlessp (plist-get body :unless)) | ||
76 | (:else nil))) | ||
77 | (autoload (cond ((plist-member body :autoload) | ||
78 | (plist-get body :autoload)) | ||
79 | (:else t))) | ||
80 | (pre (plist-get body :pre)) | ||
81 | ;; Body | 124 | ;; Body |
82 | (body (cl-loop for (this next) on body by #'cddr | 125 | (body (let ((b body) r) |
83 | unless (keywordp this) | 126 | (while (consp b) |
84 | append (list this next) into ret | 127 | (if (keywordp (car b)) |
85 | finally return (cond ((eq (car (last ret)) nil) | 128 | (setf b (cdr b)) |
86 | (butlast ret)) | 129 | (setf r (cons (car b) r))) |
87 | (:else ret)))) | 130 | (setf b (cdr b))) |
88 | (r (gensym))) | 131 | (reverse r))) |
89 | `(let ((,r (cl-block ,pname | 132 | (esym (make-symbol "yoke-error"))) |
90 | (condition-case err | 133 | ;; Body modifiers. These are applied in reverse order (that is, the last |
91 | (progn | 134 | ;; one will be on the outside). |
92 | ;; Pass `:when' or `:unless' clauses | 135 | ;; --- Require the current package |
93 | ,@(cond | 136 | (when req |
94 | ((and whenp unlessp) | 137 | (setf body |
95 | `((when (or (not ,when) ,unless) | 138 | (append (let (reqs) |
96 | (cl-return-from ,pname | 139 | (dolist (r (ensure-list req) reqs) |
97 | (format "%s (abort) :when %S :unless %S" | 140 | (let* ((feat (if (eq r t) name r)) |
98 | ',pname ',when ',unless))))) | 141 | (+feat (intern (format "+%s" feat)))) |
99 | (whenp | 142 | (push `(require ',feat) reqs) |
100 | `((unless ,when (cl-return-from ,pname | 143 | (push `(require ',+feat nil :noerror) reqs))) |
101 | (format "%s (abort) :when %S" | 144 | (reverse reqs)) |
102 | ',pname ',when))))) | 145 | body))) |
103 | (unlessp | 146 | ;; --- Install the package |
104 | `((when ,unless (cl-return-from ,pname | 147 | (when (consp package) |
105 | (format "%s (abort) :unless %S" | 148 | (push `(yoke-install ',(car package) ,@(cdr package)) |
106 | ',pname ',unless)))))) | 149 | body)) |
107 | ;; Evaluate `:pre' forms | 150 | ;; --- Dependencies |
108 | ,@pre | 151 | (when depends |
109 | ;; Get prerequisite packages | 152 | (setf body |
110 | ,@(cl-loop | 153 | (append (cl-loop for dep in (ensure-list depends) |
111 | for (pkg* . yoke-get-args) in depends | 154 | collect `(or (yoke-install ',@(ensure-list dep)) |
112 | collect `(or | 155 | (error "Dependency (%s): %S" |
113 | (let* ((pkg-spec (yoke-get ,@yoke-get-args | 156 | ',dep ',package))) |
114 | :dir ,(format "%s" pkg*))) | 157 | body))) |
115 | (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) | 158 | ;; --- Load after |
116 | "") | 159 | (when after |
117 | (car pkg-spec)))) | 160 | (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body)))) |
118 | (and dir | 161 | ;; --- Conditional expansion |
119 | ,@(if autoload | 162 | (when (or whenp unlessp) |
120 | `((yoke-generate-autoloads ',pkg* dir)) | 163 | (setf body |
121 | '(t)) | 164 | (append (cond |
122 | (add-to-list 'yoke-dirs dir nil #'string=))) | 165 | ((and whenp unlessp) |
123 | (cl-return-from ,pname | 166 | `((when (or (not ,when) ,unless) |
124 | (format "Error fetching prerequiste: %s" | 167 | (signal 'yoke-predicate |
125 | ',pkg*)))) | 168 | '(:when ,when :unless ,unless))))) |
126 | ;; Download the package, generate autoloads | 169 | (whenp |
127 | ,@(when url | 170 | `((unless ,when (signal 'yoke-predicate |
128 | `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) | 171 | '(:when ,when))))) |
129 | (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) | 172 | (unlessp |
130 | "") | 173 | `((when ,unless (signal 'yoke-predicate |
131 | (car pkg-spec)))) | 174 | '(:unless ,unless)))))) |
132 | ,@(when autoload | 175 | body))) |
133 | `((yoke-generate-autoloads ',pkg ,dirvar))) | 176 | ;; Expansion |
134 | (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) | 177 | `(condition-case ,esym |
135 | ;; Evaluate the body, optionally after the features in `:after' | 178 | (cl-letf (((symbol-function 'package--save-selected-packages) |
136 | ,@(cond (after | 179 | #'ignore)) |
137 | `((yoke-eval-after ,after ,@body))) | 180 | ;; Body |
138 | (:else body))) | 181 | ,@body) |
139 | (:success ',package) | 182 | (:success |
140 | (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) | 183 | ,(unless (atom package) |
141 | nil))))) | 184 | `(setf (alist-get ',name yoke-selected-packages) |
142 | (when (stringp ,r) (message "%S" ,r)) | 185 | (list ,@(cdr-safe package)))) |
143 | ,r))) | 186 | ',package) |
144 | 187 | (t ,(if yoke-debug-on-error | |
145 | (defun yoke-get (url &rest args) | 188 | `(signal (car ,esym) (cdr ,esym)) |
146 | "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. | 189 | `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym))))))) |
147 | URL can be a string or a list of the form (TYPE URL). The | 190 | |
148 | download will be dispatched to the TYPE, or to | 191 | ;;; Installing packages |
149 | `yoke-get-default-fn' if only a string is given. | 192 | |
150 | ARGS is a plist with the following possible keys: | 193 | (defun yoke-install (name &rest args) |
151 | 194 | "Install package NAME, with ARGS." | |
152 | :dir DIRECTORY --- the directory to put the URL. | 195 | (let ((custom-file null-device) |
153 | :load DIRECTORY --- the directory (relative to the download path) | 196 | (inhibit-message (and (not (plist-member args :update)) |
154 | to add to `load-path'. | 197 | (not debug-on-error))) |
155 | :type TYPE --- one of `http', `git', or `file' --- how to | 198 | (messages-buffer-name yoke-message-buffer)) |
156 | download URL." | 199 | (funcall |
157 | (let* ((dir (plist-get args :dir)) | 200 | (intern |
158 | (load (plist-get args :load)) | 201 | (format "yoke-install-%s" |
159 | (type (or (plist-get args :type))) | 202 | (or (plist-get args :backend) |
160 | (path (cond | 203 | (yoke--guess-backend (plist-get args :url)) |
161 | ((eq type 'http) (yoke-get-http url dir)) | 204 | 'package))) |
162 | ((or (eq type 'git) | 205 | name args)) |
163 | (string-match-p (rx bos "git:") url)) | 206 | (yoke--clean-load-path) |
164 | (yoke-get-git url dir)) | 207 | ;; Don't return nil |
165 | ((or (eq type 'file) | 208 | t) |
166 | (string-match-p (rx bos (or "file:" "~" "/")) url)) | 209 | |
167 | (yoke-get-file url dir)) | 210 | (defun yoke-install-package (name args &optional tries) |
168 | ((stringp url) | 211 | "Install package NAME with ARGS using `package' machinery. |
169 | (funcall yoke-get-default-fn url dir)) | 212 | TRIES is an internal variable." |
170 | (:else (error "Uknown URL type: %S" url))))) | 213 | (let ((package-user-dir yoke-directory) |
171 | (cond | 214 | (url (plist-get args :url)) |
172 | ((file-exists-p path) | 215 | (update (plist-get args :update)) |
173 | (add-to-list 'load-path (expand-file-name (or load "") path)) | 216 | (dirname (expand-file-name (format "%s" name) |
174 | (cons path args)) | 217 | yoke-directory)) |
175 | (:else (error "Directory \"%s\" doesn't exist." path) | 218 | (tries (or tries 0)) |
176 | nil)))) | 219 | load-dir autoloads-file-name) |
177 | 220 | (unless (file-exists-p dirname) | |
178 | (defun yoke-get--guess-directory (path &optional dir) | 221 | (setq dirname (or (car-safe (file-expand-wildcards |
179 | "Guess directory from PATH and DIR, and return it. | 222 | (concat dirname "*"))) |
180 | If DIR is present and relative, resolve it relative to | 223 | dirname))) |
181 | `yoke-dir', or if it's absolute, leave it as-is. If DIR is | 224 | (setq load-dir |
182 | absent, return the final component of PATH resolved relative to | 225 | (expand-file-name (or (plist-get args :lisp-dir) "") dirname) |
183 | `yoke-dir'." | 226 | generated-autoload-file |
184 | (expand-file-name (or dir (file-name-nondirectory path)) | 227 | (expand-file-name (format "%s-autoloads.el" name) load-dir)) |
185 | yoke-dir)) | 228 | (prog1 |
186 | 229 | (condition-case error | |
187 | (defun yoke-get-http (url &optional dir) | 230 | (cond |
188 | "Download URL to DIR and return its directory. | 231 | ;; -- Commented on 2022-12-21 |
189 | If DIR isn't given, it's guessed from the final component of the | 232 | ;; ((and (file-exists-p dirname) |
190 | URL's path and placed under `yoke-dir'." | 233 | ;; (not update)) |
191 | (let* ((dir (yoke-get--guess-directory url dir)) | 234 | ;; (add-to-list 'load-path |
192 | (basename (file-name-nondirectory url)) | 235 | ;; (expand-file-name |
193 | ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have | 236 | ;; (or (plist-get args :lisp-dir) "") |
194 | ;; a parameter (either dynamic var or passed in) that would give the | 237 | ;; dirname) |
195 | ;; name of the downloaded file. But that would take a bit of | 238 | ;; nil #'equal) |
196 | ;; re-engineering, I think. So for now, it stays thus. | 239 | ;; (require (intern (format "%s-autoloads" name)))) |
197 | (filename (expand-file-name | 240 | ((and url update) |
198 | (replace-regexp-in-string | 241 | (package-vc-update (cadr (assoc name package-alist)))) |
199 | (rx "-" (+ digit) ; major version | 242 | (update |
200 | (+ (group "." (+ digit))) ; following version numbers | 243 | (package-update name)) |
201 | (group "." (+ (not space)))) ; extension | 244 | (url |
202 | "\\2" | 245 | ;; I'm going to be honest here, this is extremely cursed. But I |
203 | basename) | 246 | ;; don't want to get asked about installing the packages, and when |
204 | dir))) | 247 | ;; the user answers 'no', the function errors. So.. this. |
205 | (cond ((file-exists-p filename) | 248 | (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) |
206 | dir) | 249 | (ignore-errors (package-vc-install (cons name args))))) |
207 | (:else | 250 | (:else |
208 | (message "Downloading %s..." url) | 251 | (package-install name))) |
209 | (with-current-buffer (let ((url-debug t)) | 252 | (file-error (if (> tries 1) |
210 | (url-retrieve-synchronously url)) | 253 | (error "(yoke) Can't install `%s'" name) |
211 | (condition-case e | 254 | (package-refresh-contents) |
212 | (progn | 255 | (yoke-install-package name args (1+ tries))))) |
213 | (goto-char (point-min)) | 256 | (add-to-list 'load-path load-dir nil #'equal) |
214 | (delete-region (point) (+ 1 (re-search-forward "^$"))) | 257 | (loaddefs-generate load-dir generated-autoload-file) |
215 | (make-directory dir :parents) | 258 | ;; Do it again, if it doesn't actually /generate/ anything |
216 | (write-file filename 1) | 259 | (when (eq 'provide |
217 | (message "Downloading %s... Done" url)) | 260 | (with-current-buffer (find-file-noselect generated-autoload-file) |
218 | (:success dir) | 261 | (read (buffer-substring (point-min) (point-max))))) |
219 | (t (signal (car e) (cdr e))))))))) | 262 | (loaddefs-generate load-dir generated-autoload-file nil nil nil |
220 | 263 | :generate-full)) | |
221 | (defun yoke-get-git (repo &optional dir) | 264 | (load generated-autoload-file :noerror) |
222 | "Clone REPO to DIR and return its directory. | 265 | (kill-buffer (get-file-buffer generated-autoload-file)) |
223 | If DIR isn't given, it's guessed from the repo's name and put | 266 | (package-activate name)))) |
224 | under `yoke-dir'. Return the cloned directory's name on success, | 267 | |
225 | or nil on failure." | 268 | (defun yoke-install-http (name args) |
226 | (let ((dir (yoke-get--guess-directory repo dir))) | 269 | "Install a package NAME using ARGS from an http source." |
227 | (cond ((file-exists-p dir) | 270 | (let* ((url (plist-get args :url)) |
228 | dir) | 271 | (cached (expand-file-name (file-name-nondirectory url) |
229 | (:else | 272 | yoke-cache-directory)) |
230 | (message "Cloning %s..." repo) | 273 | (update (plist-get args :update))) |
231 | (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil | 274 | (unless url |
232 | "clone" repo dir) | 275 | (error "No URL for HTTP download: %S" (cons name args))) |
233 | (0 (message "Cloning %s... Done" repo) | 276 | (when (or (not (file-exists-p cached)) |
234 | dir) | 277 | update) |
235 | (_ (message "Cloning %s... Error! See buffer %s for output." | 278 | (make-directory yoke-cache-directory :parents) |
236 | repo yoke-buffer) | 279 | (message "Downloading `%s'..." url) |
237 | nil)))))) | 280 | (let* ((url-debug t) |
238 | 281 | (buf (url-retrieve-synchronously url))) | |
239 | (defun yoke-get-file (file &optional _dir) | 282 | (with-current-buffer buf |
240 | "Add FILE's directory to `load-dir'. | 283 | (goto-char (point-min)) |
241 | _DIR is ignored." | 284 | (delete-region (point) (1+ (re-search-forward "^$"))) |
242 | (file-name-directory file)) | 285 | (write-file cached 1) |
243 | 286 | (message "Downloading `%s'...Done." url)))) | |
244 | (defun yoke-generate-autoloads (package dir) | 287 | (package-install-file cached))) |
245 | "Generate autoloads for PACKAGE in DIR." | 288 | |
246 | ;; Shamelessly stolen from `straight'. | 289 | (defun yoke-install-file (name args) |
247 | (eval-and-compile (require 'autoload)) | 290 | "Install package NAME using ARGS from a file on-disk." |
248 | (let ((generated-autoload-file | 291 | (let ((url (plist-get args :url)) |
249 | (expand-file-name (format "%s-autoloads.el" package) dir)) | 292 | (update (plist-get args :update)) |
250 | (backup-inhibited t) | 293 | (dirname (expand-file-name (format "%s" name) yoke-directory))) |
251 | (version-control 'never) | 294 | (if (file-exists-p url) |
252 | (message-log-max nil) | 295 | ;; This takes care of updating too. |
253 | (inhibit-message t)) | 296 | (package-install-file url) |
254 | (unless (file-exists-p generated-autoload-file) | 297 | (error "(yoke) No such file: `%s'" url)))) |
255 | (let ((find-file-hook nil) | 298 | |
256 | (write-file-functions nil) | 299 | ;;; Other package transactions |
257 | (debug-on-error nil) | 300 | |
258 | (left-margin 0)) | 301 | (defun yoke--choose-package () |
259 | (if (fboundp 'make-directory-autoloads) | 302 | "Choose a package from `yoke-selected-packages'." |
260 | (make-directory-autoloads dir generated-autoload-file) | 303 | (assoc (intern (completing-read "Package: " yoke-selected-packages)) |
261 | (and (fboundp 'update-directory-autoloads) | 304 | yoke-selected-packages)) |
262 | (update-directory-autoloads dir))))) | 305 | |
263 | (when-let ((buf (find-buffer-visiting generated-autoload-file))) | 306 | (defun yoke-update (name &rest args) |
264 | (kill-buffer buf)) | 307 | (interactive (yoke--choose-package)) |
265 | (load generated-autoload-file :noerror :nomessage) | 308 | (save-window-excursion |
266 | t)) | 309 | (apply #'yoke-install name (append '(:update t) |
267 | 310 | args)))) | |
268 | ;;; Evaluating forms after features | 311 | |
312 | (defun yoke-update-all () | ||
313 | (interactive) | ||
314 | (dolist (pkg yoke-selected-packages) | ||
315 | (apply #'yoke-update pkg))) | ||
316 | |||
317 | ;;; Emacs integration | ||
318 | |||
319 | (defun yoke-imenu-insinuate () | ||
320 | "Insinuate `yoke' forms for `imenu'." | ||
321 | (require 'imenu) | ||
322 | (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) | ||
323 | (list "(yoke[[:space:]]*(?\\([^\t\n )]*\\)" | ||
324 | 1)) | ||
325 | (with-eval-after-load 'consult-imenu | ||
326 | (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode | ||
327 | consult-imenu-config) | ||
328 | :types)) | ||
329 | '("Yoke")))) | ||
330 | |||
331 | ;;; Utility functions | ||
332 | |||
333 | (defun yoke--pget (spec prop &optional default) | ||
334 | "Get PROP's value from SPEC, a yoke specification. | ||
335 | If KEY doesn't exist, return DEFAULT." | ||
336 | (let ((pl (or (and (plistp spec) spec) | ||
337 | (cdr-safe spec)))) | ||
338 | (if (plist-member pl prop) | ||
339 | (plist-get pl prop) | ||
340 | default))) | ||
341 | |||
342 | (defun yoke--guess-backend (url) | ||
343 | "Guess the backend to use from URL. | ||
344 | If inconclusive, return nil." | ||
345 | (cond | ||
346 | ((or (string-prefix-p "file:" url t) | ||
347 | (string-prefix-p "~" url) | ||
348 | (string-prefix-p "/" url)) | ||
349 | 'file) | ||
350 | (:else nil))) | ||
351 | |||
352 | (defun yoke--clean-load-path () | ||
353 | (when-let ((first (string-remove-suffix "/" (car load-path))) | ||
354 | (second (string-remove-suffix "/" (cadr load-path))) | ||
355 | (_ (equal first second))) | ||
356 | (setf load-path (cdr load-path)) | ||
357 | (setf (car load-path) second))) | ||
269 | 358 | ||
270 | (defun yoke--eval-after-init (fn) | 359 | (defun yoke--eval-after-init (fn) |
271 | "Evaluate FN after inititation, or now if Emacs is initialized. | 360 | "Evaluate FN after inititation, or now if Emacs is initialized. |
@@ -274,79 +363,30 @@ FN is called with no arguments." | |||
274 | (funcall fn) | 363 | (funcall fn) |
275 | (add-hook 'after-init-hook fn))) | 364 | (add-hook 'after-init-hook fn))) |
276 | 365 | ||
277 | (defmacro yoke-eval-after (features &rest body) | 366 | (defmacro yoke--eval-after (prereqs &rest body) |
278 | "Evaluate BODY, but only after loading FEATURES. | 367 | "Evaluate body after PREREQS. |
279 | FEATURES can be an atom or a list; as an atom it works like | 368 | PREREQS can be a feature, a number, `:init', or a list of those. |
280 | `with-eval-after-load'. The special feature `init' will evaluate | ||
281 | BODY after Emacs is finished initializing." | ||
282 | (declare (indent 1) | ||
283 | (debug (form def-body))) | ||
284 | (unless (listp features) | ||
285 | (setf features (list features))) | ||
286 | (if (null features) | ||
287 | (macroexp-progn body) | ||
288 | (let* ((this (car features)) | ||
289 | (rest (cdr features))) | ||
290 | (cond ((eq this 'init) | ||
291 | `(yoke--eval-after-init | ||
292 | (lambda () (yoke-eval-after ,rest ,@body)))) | ||
293 | (:else | ||
294 | `(with-eval-after-load ',this | ||
295 | (yoke-eval-after ,rest ,@body))))))) | ||
296 | 369 | ||
297 | ;;; Integration | 370 | Features are used as arguments to `eval-after-load'. Numbers are |
371 | used as arguments to `run-with-idle-timer'. `:init' will ensure BODY | ||
372 | runs after Emacs's init time. | ||
298 | 373 | ||
299 | (defun yoke-imenu-insinuate () | 374 | When given a list of PREREQS, `eval-after' will nest each one |
300 | "Insinuate `yoke' forms for `imenu'." | 375 | from left to right." |
301 | (require 'imenu) | 376 | (declare (indent 1) (debug (form def-body))) |
302 | (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) | 377 | (setf prereqs (ensure-list prereqs)) |
303 | (list (rx (: "(yoke" (+ space) (? "(") | 378 | (if (null prereqs) |
304 | (group (+ (not (or "(" " " "\t" "\n")))) | 379 | (macroexp-progn body) |
305 | (* any))) | 380 | (let* ((this (car prereqs)) |
306 | 1))) | 381 | (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body))))) |
307 | 382 | (cond | |
308 | ;;; Package maintenance | 383 | ((eq this :init) |
309 | 384 | (append '(yoke--eval-after-init) form)) | |
310 | (defvar yoke--all "*all*" | 385 | ((numberp this) |
311 | "Value that `yoke--prompt-for-package' uses for all packages.") | 386 | (append `(run-with-idle-timer ,this nil) form)) |
312 | 387 | ((symbolp this) | |
313 | (defun yoke--choose-packages (prompt &optional onep) | 388 | (append `(eval-after-load ',this) form)) |
314 | "Choose from all of yoke's installed packages." | 389 | (:else (user-error "Eval-after: Bad prereq: %S" this)))))) |
315 | (funcall (if onep #'completing-read #'completing-read-multiple) | ||
316 | prompt | ||
317 | (cons yoke--all yoke-dirs) | ||
318 | nil :require-match nil nil | ||
319 | (unless onep yoke--all))) | ||
320 | |||
321 | (defun yoke--choices (&optional selections) | ||
322 | "Either the SELECTIONS given, or all of `yoke-dirs'. | ||
323 | If `yoke--all' is part of SELECTIONS, or if it's not given, | ||
324 | return the full list of `yoke-dirs'." | ||
325 | (cond ((or (null selections) | ||
326 | (member yoke--all selections)) | ||
327 | yoke-dirs) | ||
328 | (:else selections))) | ||
329 | |||
330 | (defun yoke-compile (&rest packages) | ||
331 | "Compile all elisp files in `yoke-dirs'." | ||
332 | (interactive (yoke--choose-packages "Compile packages: ")) | ||
333 | (dolist (dir (yoke--choices packages)) | ||
334 | (byte-recompile-directory dir 0))) | ||
335 | |||
336 | (defun yoke-update-autoloads (&rest packages) | ||
337 | "Update the autoloads in PACKAGES' directories." | ||
338 | (interactive (yoke--choose-packages "Generate autoloads for packages: ")) | ||
339 | (dolist (dir (yoke--choices packages)) | ||
340 | (message "Generating autoloads for %s..." dir) | ||
341 | (yoke-generate-autoloads (file-name-nondirectory dir) dir) | ||
342 | (message "Generating autoloads for %s... Done" dir))) | ||
343 | |||
344 | (defun yoke-remove (dir) | ||
345 | "Remove DIR from `yoke-dir'." | ||
346 | (interactive | ||
347 | (list (completing-read "Remove: " yoke-dirs | ||
348 | nil :require-match))) | ||
349 | (delete-directory dir :recursive :trash)) | ||
350 | 390 | ||
351 | (provide 'yoke) | 391 | (provide 'yoke) |
352 | ;;; yoke.el ends here | 392 | ;;; yoke.el ends here |