about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--early-init.el11
-rw-r--r--init.el479
-rw-r--r--lisp/+emacs.el18
-rw-r--r--lisp/+flyspell-correct.el4
-rw-r--r--lisp/+ispell.el97
-rw-r--r--lisp/+org-capture.el12
-rw-r--r--lisp/+org.el167
-rw-r--r--lisp/+tempo.el44
-rw-r--r--lisp/+window.el130
-rw-r--r--lisp/acdw.el113
-rw-r--r--lisp/pita.el64
-rw-r--r--lisp/scule.el61
-rw-r--r--lisp/yoke.el72
14 files changed, 1133 insertions, 140 deletions
diff --git a/.gitignore b/.gitignore index b9b0a28..a61fa52 100644 --- a/.gitignore +++ b/.gitignore
@@ -1,6 +1,7 @@
1*~ 1*~
2.#* 2.#*
3.* 3.*
4*.elc
4.etc/ 5.etc/
5.org-id-locations 6.org-id-locations
6auto-save-list/ 7auto-save-list/
diff --git a/early-init.el b/early-init.el index bc4ccdd..6f6a848 100644 --- a/early-init.el +++ b/early-init.el
@@ -30,9 +30,9 @@ restore that."
30(+set-during-startup 'gc-cons-threshold most-positive-fixnum) 30(+set-during-startup 'gc-cons-threshold most-positive-fixnum)
31 31
32(add-hook 'minibuffer-setup-hook (defun garbage-collect@minibuffer-enter () 32(add-hook 'minibuffer-setup-hook (defun garbage-collect@minibuffer-enter ()
33 (setq gc-cons-threshold most-positive-fixnum))) 33 (setf gc-cons-threshold most-positive-fixnum)))
34(add-hook 'minibuffer-exit-hook (defun garbage-collect@minibuffer-exit () 34(add-hook 'minibuffer-exit-hook (defun garbage-collect@minibuffer-exit ()
35 (setq gc-cons-threshold 800000))) 35 (setf gc-cons-threshold 800000)))
36 36
37;; Don't prematurely re-display 37;; Don't prematurely re-display
38(unless debug-on-error 38(unless debug-on-error
@@ -45,7 +45,7 @@ restore that."
45 45
46;;; Default frame settings 46;;; Default frame settings
47 47
48(setq default-frame-alist '((tool-bar-lines . 0) 48(setf default-frame-alist '((tool-bar-lines . 0)
49 (menu-bar-lines . 0) 49 (menu-bar-lines . 0)
50 (vertical-scroll-bars) 50 (vertical-scroll-bars)
51 (horizontal-scroll-bars)) 51 (horizontal-scroll-bars))
@@ -73,15 +73,16 @@ See `no-littering' for examples.")
73 73
74;;; Packages 74;;; Packages
75 75
76(setq package-enable-at-startup nil 76(setf package-enable-at-startup nil
77 package-quickstart nil) 77 package-quickstart nil)
78 78
79(require 'yoke) 79(require 'yoke)
80(add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate)
80 81
81(yoke compat "https://git.sr.ht/~pkal/compat") 82(yoke compat "https://git.sr.ht/~pkal/compat")
82 83
83(yoke no-littering "https://github.com/emacscollective/no-littering" 84(yoke no-littering "https://github.com/emacscollective/no-littering"
84 (setq no-littering-etc-directory .etc 85 (setf no-littering-etc-directory .etc
85 no-littering-var-directory .etc 86 no-littering-var-directory .etc
86 custom-file (.etc "custom.el")) 87 custom-file (.etc "custom.el"))
87 (require 'no-littering) 88 (require 'no-littering)
diff --git a/init.el b/init.el index 3cbf3cc..101e220 100644 --- a/init.el +++ b/init.el
@@ -10,57 +10,189 @@
10;; - Make good choices. 10;; - Make good choices.
11 11
12(yoke +emacs (locate-user-emacs-file "lisp/") 12(yoke +emacs (locate-user-emacs-file "lisp/")
13 (require '+emacs) 13 (require* '+emacs '+window)
14 ;; Settings 14 ;; Settings
15 (setq truncate-string-ellipsis "…" 15 (setf truncate-string-ellipsis "…"
16 ring-bell-function #'ignore 16 ring-bell-function #'ignore
17 read-file-name-completion-ignore-case t) 17 read-file-name-completion-ignore-case t
18 comment-auto-fill-only-comments t
19 password-cache t
20 password-cache-expiry (* 60 60))
21 ;; "Safe" variables
22 (dolist (var+pred
23 '((browse-url-browser-function
24 ;; All types defined by custom are safe.
25 . (lambda (f)
26 ;; Whooooo boy
27 (memq f (mapcar (lambda (i)
28 (plist-get (cdr i) :value))
29 (seq-filter
30 (lambda (i)
31 (eq (car i) 'function-item))
32 (cdr (get 'browse-url-browser-function
33 'custom-type)))))))))
34 (put (car var+pred) 'safe-local-variable (cdr var+pred)))
18 ;; Keys 35 ;; Keys
19 (define-keys (current-global-map) 36 (define-key* (current-global-map)
20 "C-x C-k" #'kill-current-buffer 37 "C-x C-k" #'kill-current-buffer
21 "C-/" #'undo-only 38 "C-/" #'undo-only
22 "C-?" #'undo-redo 39 "C-?" #'undo-redo
23 "C-x C-c" #'+save-buffers-quit 40 "C-x C-c" #'+save-buffers-quit
24 "M-SPC" #'+cycle-spacing 41 "M-SPC" #'+cycle-spacing
25 "M-/" #'hippie-expand 42 ;; "M-/" #'hippie-expand ; `hippie-completing-read'
26 "M-=" #'count-words 43 "M-=" #'count-words
27 "C-x C-b" #'ibuffer 44 "C-x C-b" #'ibuffer
28 "C-x 4 n" #'clone-buffer 45 "C-x 4 n" #'clone-buffer
29 "S-<down-mouse-1>" #'mouse-set-mark 46 "S-<down-mouse-1>" #'mouse-set-mark
30 "C-x 0" #'+delete-window-or-bury-buffer 47 "C-x 0" #'+delete-window-or-bury-buffer
31 "M-j" nil 48 "M-j" nil
32 "<Scroll_Lock>" nil) 49 "<Scroll_Lock>" nil
50 "M-o" #'other-window|switch-buffer)
51 (define-key* text-mode-map
52 "C-M-k" #'kill-paragraph)
33 ;; Hooks 53 ;; Hooks
34 (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) 54 (add-hook 'after-save-hook
55 #'executable-make-buffer-file-executable-if-script-p)
35 (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) 56 (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
36 (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) 57 (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs)
58 (add-hook 'text-mode-hook #'abbrev-mode)
59 (add-hook 'find-file-hook #'+vc-off-when-remote)
37 ;; Advice 60 ;; Advice
38 (add-function :after after-focus-change-function #'+save-some-buffers-debounce) 61 (add-function :after after-focus-change-function
39 (advice-add 'keyboard-escape-quit :around #'keyboard-escape-quit-keep-window-open) 62 #'+save-some-buffers-debounce)
63 (advice-add 'keyboard-escape-quit :around
64 #'keyboard-escape-quit-keep-window-open)
40 (define-advice keyboard-escape-quit (:around (fn &rest r)) 65 (define-advice keyboard-escape-quit (:around (fn &rest r))
41 "Don't close quits on `keyboard-escape-quit'." 66 "Don't close quits on `keyboard-escape-quit'."
42 (let ((buffer-quit-function #'ignore)) 67 (let ((buffer-quit-function #'ignore))
43 (apply fn r))) 68 (apply fn r)))
69 (advice-add 'indent-region :before #'with-region-or-buffer)
44 ;; Themes 70 ;; Themes
45 (load-theme 'modus-operandi) 71 (load-theme 'modus-operandi)
46 (set-face-attribute 'default nil :family "Comic Code" :height 100) 72 (set-face-attribute 'default nil :family "Comic Code" :height 100)
47 (set-face-attribute 'variable-pitch nil :family "Comic Code" :height 100)) 73 (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold)
74 (set-face-attribute 'variable-pitch nil :family "Comic Code")
75 ;; Modes
76 (winner-mode))
77
78(yoke whitespace nil
79 (setf whitespace-line-column nil
80 whitespace-style '( face trailing
81 tabs tab-mark
82 indentation
83 space-after-tab space-before-tab))
84 (defun +whitespace-mode-for-writable-buffers ()
85 "Turn on `whitespace-mode' if the buffer is writable, off otherwise."
86 (whitespace-mode (if buffer-read-only -1 t)))
87 (add-hook* '(text-mode-hook
88 prog-mode-hook
89 read-only-mode-hook)
90 #'+whitespace-mode-for-writable-buffers)
91 (add-hook 'before-save-hook #'whitespace-cleanup)
92 (define-advice whitespace-cleanup (:around (fn &rest r) preserve-point)
93 (let ((col (current-column)))
94 (apply fn r)
95 (move-to-column col t)
96 (set-buffer-modified-p nil))))
97
98(yoke elisp-mode nil
99 (setf eval-expression-print-length nil
100 eval-expression-print-level nil)
101 (define-key* '(emacs-lisp-mode-map lisp-interaction-mode-map)
102 "C-c C-c" #'eval-defun
103 "C-c C-k" (defun +elisp-eval-region-or-buffer ()
104 (interactive)
105 (cond
106 ((region-active-p)
107 (eval-region (region-beginning) (region-end))
108 (message "Region evaluated."))
109 (t
110 (eval-buffer)
111 (message "Buffer %s evaluated." (buffer-name)))))
112 "C-c C-z" #'ielm)
113 (define-advice eval-region (:around (fn beg end &rest args) pulse)
114 (apply fn beg end args)
115 (pulse-momentary-highlight-region beg end)))
48 116
49(yoke isearch nil 117(yoke isearch nil
50 (define-keys (current-global-map) 118 (define-key* (current-global-map)
51 "C-s" #'isearch-forward-regexp 119 "C-s" #'isearch-forward-regexp
52 "C-r" #'isearch-backward-regexp 120 "C-r" #'isearch-backward-regexp
53 "C-M-s" #'isearch-forward 121 "C-M-s" #'isearch-forward
54 "C-M-r" #'isearch-backward)) 122 "C-M-r" #'isearch-backward))
55 123
124(yoke ispell nil
125 (eval-after ispell
126 (require '+ispell)
127 (add-hook 'before-save-hook #'+ispell-move-buffer-words-to-dir-locals-hook))
128 (setf ispell-program-name (or (executable-find "ispell")
129 (executable-find "aspell")))
130 (put 'ispell-buffer-session-localwords
131 'safe-local-variable #'+ispell-safe-local-p))
132
133
134(yoke mouse nil
135 ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html
136 ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3
137 (when (fboundp 'context-menu-mode)
138 (setf context-menu-functions '(context-menu-ffap
139 context-menu-region
140 context-menu-undo
141 ;; context-menu-dictionary
142 ))
143 (context-menu-mode +1))
144 (dolist (click '(;; Fix scrolling in the margin
145 wheel-down double-wheel-down triple-wheel-down
146 wheel-up double-wheel-up triple-wheel-up))
147 (global-set-key (vector 'right-margin click) 'mwheel-scroll)
148 (global-set-key (vector 'left-margin click) 'mwheel-scroll)))
149
150(yoke dired nil
151 (require 'dired-x)
152 (setf dired-recursive-copies 'always
153 dired-recursive-deletes 'always
154 dired-create-destination-dirs 'always
155 dired-do-revert-buffer t
156 dired-hide-details-hide-symlink-targets nil
157 dired-isearch-filenames 'dwim
158 delete-by-moving-to-trash t
159 dired-auto-revert-buffer t
160 dired-listing-switches "-AlF"
161 ls-lisp-dirs-first t
162 dired-ls-F-marks-symlinks t
163 dired-clean-confirm-killing-deleted-buffers nil
164 dired-no-confirm '(byte-compile
165 load chgrp chmod chown
166 copy move hardlink symlink
167 shell touch)
168 dired-dwim-target t)
169 (setq-local-hook dired-mode-hook
170 truncate-lines t)
171 (define-key* (current-global-map)
172 "C-x C-j" #'dired-jump)
173 (eval-after dired
174 (define-key* dired-mode-map
175 "<backspace>" #'dired-up-directory
176 "C-j" #'dired-up-directory))
177 (add-hook* 'dired-mode-hook
178 #'dired-hide-details-mode
179 #'hl-line-mode))
180
181(yoke dired-hacks "https://github.com/Fuco1/dired-hacks"
182 (define-key* dired-mode-map
183 "TAB" #'dired-subtree-sycle
184 "i" #'dired-subtree-toggle)
185 (add-hook* 'dired-mode-hook
186 #'dired-collapse-mode))
187
56(yoke auth-source nil 188(yoke auth-source nil
57 (setq auth-sources `(default "secrets:passwords")) 189 (setf auth-sources `(default "secrets:passwords"))
58 (setq-local-hook authinfo-mode-hook 190 (setq-local-hook authinfo-mode-hook
59 truncate-lines t)) 191 truncate-lines t))
60 192
61(yoke consult "https://github.com/minad/consult" 193(yoke consult "https://github.com/minad/consult"
62 (require 'consult) 194 (require 'consult)
63 (setq register-preview-delay 0 195 (setf register-preview-delay 0
64 register-preview-function #'consult-register-format 196 register-preview-function #'consult-register-format
65 xref-show-xrefs-function #'consult-xref 197 xref-show-xrefs-function #'consult-xref
66 tab-always-indent 'complete 198 tab-always-indent 'complete
@@ -68,7 +200,7 @@
68 consult-narrow-key "<" 200 consult-narrow-key "<"
69 consult--regexp-compiler #'consult--default-regexp-compiler) 201 consult--regexp-compiler #'consult--default-regexp-compiler)
70 (advice-add #'register-preview :override #'consult-register-window) 202 (advice-add #'register-preview :override #'consult-register-window)
71 (define-keys (current-global-map) 203 (define-key* (current-global-map)
72 ;; C-c bindings (mode-specific-map) 204 ;; C-c bindings (mode-specific-map)
73 "C-c h" #'consult-history 205 "C-c h" #'consult-history
74 "C-c m" #'consult-mode-command 206 "C-c m" #'consult-mode-command
@@ -111,89 +243,123 @@
111 ;; Isearch integration 243 ;; Isearch integration
112 "M-s e" #'consult-isearch-history) 244 "M-s e" #'consult-isearch-history)
113 (eval-after isearch-mode 245 (eval-after isearch-mode
114 (define-keys isearch-mode-map 246 (define-key* isearch-mode-map
115 "M-e" #'consult-isearch-history 247 "M-e" #'consult-isearch-history
116 "M-s e" #'consult-isearch-history 248 "M-s e" #'consult-isearch-history
117 "M-s l" #'consult-line 249 "M-s l" #'consult-line
118 "M-s L" #'consult-line-multi)) 250 "M-s L" #'consult-line-multi))
119 (eval-after org 251 (eval-after org
120 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading))) 252 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading))
253 (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode
254 consult-imenu-config)
255 :types))
256 '("Yoke")))
121 257
122(yoke orderless "https://github.com/oantolin/orderless" 258(yoke orderless "https://github.com/oantolin/orderless"
123 (require 'orderless) 259 (require 'orderless)
124 (setq completion-styles '(substring orderless basic) 260 (setf completion-styles '(substring orderless basic)
125 completion-category-defaults nil 261 completion-category-defaults nil
126 completion-category-overrides '((file (styles basic partial-completion))) 262 completion-category-overrides
263 '((file (styles basic partial-completion)))
127 orderless-component-separator #'orderless-escapable-split-on-space)) 264 orderless-component-separator #'orderless-escapable-split-on-space))
128 265
129(yoke vertico "https://github.com/minad/vertico" 266(yoke vertico "https://github.com/minad/vertico"
130 (require 'vertico) 267 (require 'vertico)
131 (setq resize-mini-windows 'grow-only 268 (setf resize-mini-windows 'grow-only
132 vertico-count-format nil 269 vertico-count-format nil
133 vertico-cycle t) 270 vertico-cycle t)
134 (vertico-mode)) 271 (vertico-mode))
135 272
273(yoke embark "https://github.com/oantolin/embark"
274 (require 'embark)
275 (setf prefix-help-command #'embark-prefix-help-command
276 embar-keymap-prompter-key ";")
277 (define-key* (list (current-global-map)
278 'minibuffer-local-map)
279 "C-." #'embark-act
280 "M-." #'embark-dwim
281 "<f1> B" #'embark-bindings)
282 (define-key* embark-file-map
283 "l" #'vlf)
284 (eval-after (embark consult)
285 (require 'embark-consult)
286 (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode)))
287
136(yoke marginalia "https://github.com/minad/marginalia/" 288(yoke marginalia "https://github.com/minad/marginalia/"
137 (marginalia-mode)) 289 (marginalia-mode))
138 290
291(yoke wgrep "https://github.com/mhayashi1120/Emacs-wgrep"
292 (require 'wgrep))
293
139(yoke slime "https://github.com/slime/slime" 294(yoke slime "https://github.com/slime/slime"
140 ;; r7rs-swank 295 ;; r7rs-swank
141 (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank"))) 296 (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank")))
142 (cond 297 (cond
143 ((executable-find "chibi-scheme") 298 ((executable-find "chibi-scheme")
144 (defun chibi-scheme-start-swank (file encoding) 299 (defun chibi-scheme-start-swank (file encoding)
145 (format "%S\n\n" `(start-swank ,file))) 300 (format "%S\n\n" `(start-swank ,file)))
146 (setq slime-lisp-implementations 301 (setq slime-lisp-implementations
147 (cons `(chibi-scheme 302 (cons `(chibi-scheme
148 ("chibi-scheme" ,(format "-A%s" r7rsloc) 303 ("chibi-scheme" ,(format "-A%s" r7rsloc)
149 "-m" "(chibi-swank)") 304 "-m" "(chibi-swank)")
150 :init chibi-scheme-start-swank) 305 :init chibi-scheme-start-swank)
151 (bound-and-true-p slime-lisp-implementations))))))) 306 (bound-and-true-p slime-lisp-implementations)))))))
152 307
153(yoke puni "https://github.com/amaikinono/puni" 308(yoke puni "https://github.com/amaikinono/puni"
154 (puni-global-mode) 309 (define-key* puni-mode-map
155 (electric-pair-mode)
156 (define-keys puni-mode-map
157 "C-)" #'puni-slurp-forward 310 "C-)" #'puni-slurp-forward
158 "C-(" #'puni-slurp-backward 311 "C-(" #'puni-slurp-backward
159 "C-}" #'puni-barf-forward 312 "C-}" #'puni-barf-forward
160 "C-{" #'puni-barf-backward)) 313 "C-{" #'puni-barf-backward
314 "M-(" (defun +puni-open-then-slurp-forward (&optional n)
315 (interactive "p")
316 (insert "()")
317 (backward-char)
318 (puni-slurp-forward n)))
319 (electric-pair-mode)
320 (add-hook* '(prog-mode-hook
321 ielm-mode-hook)
322 #'puni-mode))
161 323
162(yoke hungry-delete "https://github.com/nflath/hungry-delete" 324(yoke hungry-delete "https://github.com/nflath/hungry-delete"
163 (setq hungry-delete-chars-to-skip " \t" 325 (setq hungry-delete-chars-to-skip " \t"
164 hungry-delete-join-reluctantly nil) 326 hungry-delete-join-reluctantly nil)
165 (eval-after hungry-delete 327 (eval-after hungry-delete
166 (add-to-list* 'hungry-delete-except-modes 328 (add-to-list* 'hungry-delete-except-modes
167 'eshell-mode 329 #'eshell-mode
168 'nim-mode 330 #'nim-mode
169 'python-mode)) 331 #'python-mode))
170 (defun +hungry-delete-or (hd-fn fn arg) 332 (defun +hungry-delete-or (hd-fn fn arg)
171 (funcall (if (looking-back (format "[%s]" hungry-delete-chars-to-skip) arg) 333 (funcall (if (looking-back (format "[%s]" hungry-delete-chars-to-skip) arg)
172 hd-fn 334 hd-fn
173 fn) 335 fn)
174 arg)) 336 arg))
175 (define-keys puni-mode-map 337 (define-key* puni-mode-map
176 [remap puni-backward-delete-char] 338 [remap puni-backward-delete-char]
177 (defun puni@hungry-delete-backward (arg) 339 (defun puni@hungry-delete-backward (arg)
178 (interactive "p") 340 (interactive "p")
179 (+hungry-delete-or #'hungry-delete-backward 341 (+hungry-delete-or #'hungry-delete-backward
180 #'puni-backward-delete-char 342 #'puni-backward-delete-char
181 arg)) 343 arg))
182 [remap puni-forward-delete-char] 344 [remap puni-forward-delete-char]
183 (defun puni@hungry-delete-forward (arg) 345 (defun puni@hungry-delete-forward (arg)
184 (interactive "p") 346 (interactive "p")
185 (+hungry-delete-or #'hungry-delete-forward 347 (+hungry-delete-or #'hungry-delete-forward
186 #'puni-forward-delete-char 348 #'puni-forward-delete-char
187 arg))) 349 arg)))
188 (global-hungry-delete-mode)) 350 (global-hungry-delete-mode))
189 351
190(yoke cape "https://github.com/minad/cape" 352(yoke cape "https://github.com/minad/cape"
191 (defun cape-insinuate () 353 ;; Insinuate in a lot of modes
192 (add-to-list* 'completion-at-point-functions 354 (defvar +capes '(cape-file cape-dabbrev))
193 #'cape-dabbrev 355 (defun +cape-insinuate (hook capf &optional capes)
194 #'cape-file)) 356 "Insinuate CAPES into a HOOK along with CAPF function.
195 (add-hook* '(text-mode-hook prog-mode-hook) 357CAPES defaults to `+capes'. CAPF will be made un-exclusive."
196 #'cape-insinuate)) 358 (setq-local-hook hook
359 completion-at-point-functions
360 (apply #'list (cape-capf-properties capf :exclusive 'no)
361 (or capes +capes))))
362 (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point))
197 363
198(yoke minions "https://github.com/tarsius/minions" 364(yoke minions "https://github.com/tarsius/minions"
199 (minions-mode)) 365 (minions-mode))
@@ -204,10 +370,13 @@
204 (locate-user-emacs-file "yoke/transient/lisp")) 370 (locate-user-emacs-file "yoke/transient/lisp"))
205 (dash "https://github.com/magnars/dash.el") 371 (dash "https://github.com/magnars/dash.el")
206 (with-editor "https://github.com/magit/with-editor" 372 (with-editor "https://github.com/magit/with-editor"
207 (locate-user-emacs-file "yoke/with-editor/lisp"))) 373 (locate-user-emacs-file "yoke/with-editor/lisp")))
208 (autoload #'transient--with-suspended-override "transient") 374 (autoload #'transient--with-suspended-override "transient")
209 (autoload #'magit "magit" nil :interactive)) 375 (autoload #'magit "magit" nil :interactive))
210 376
377(yoke git-modes "https://github.com/magit/git-modes"
378 (require 'git-modes))
379
211(yoke visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column" 380(yoke visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column"
212 (setq visual-fill-column-center-text t) 381 (setq visual-fill-column-center-text t)
213 (add-hook* 'visual-fill-column-mode-hook #'visual-line-mode) 382 (add-hook* 'visual-fill-column-mode-hook #'visual-line-mode)
@@ -219,7 +388,8 @@
219 (locate-user-emacs-file "yoke/org-contrib/lisp"))) 388 (locate-user-emacs-file "yoke/org-contrib/lisp")))
220 ;; DON'T load system org 389 ;; DON'T load system org
221 (setq load-path 390 (setq load-path
222 (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) load-path)) 391 (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path))
392 load-path))
223 (setq org-adapt-indentation nil 393 (setq org-adapt-indentation nil
224 org-auto-align-tags t 394 org-auto-align-tags t
225 org-archive-mark-done t 395 org-archive-mark-done t
@@ -279,29 +449,24 @@
279 ("=" org-verbatim) 449 ("=" org-verbatim)
280 ("~" org-code) 450 ("~" org-code)
281 ("+" org-strikethrough))) 451 ("+" org-strikethrough)))
282 ;; (setq org-todo-keywords
283 ;; '((sequence
284 ;; "TODO(t)"
285 ;; "NEXT(n!)" ; next action
286 ;; "DONE(d)" ; done)
287 ;; (sequence
288 ;; "WAIT(w@)" ; waiting to be actionable again
289 ;; "HOLD(h@/!)" ; actinable, but will do later
290 ;; "IDEA(i)" ; maybe someday
291 ;; "KILL(k@/!)" ; cancelled, aborted or is no longer applicable
292 ;; ))))))
293 (add-hook* 'org-mode-hook 452 (add-hook* 'org-mode-hook
294 #'variable-pitch-mode 453 #'variable-pitch-mode
295 #'visual-fill-column-mode 454 #'visual-fill-column-mode
296 #'turn-off-auto-fill 455 #'turn-off-auto-fill
297 #'org-indent-mode 456 #'org-indent-mode
298 #'prettify-symbols-mode 457 #'prettify-symbols-mode
299 #'abbrev-mode) 458 #'abbrev-mode)
459 (define-local-before-save-hook org-mode
460 (org-hide-drawer-all)
461 (org-align-tags 'all))
300 (eval-after org 462 (eval-after org
301 (require '+org) 463 (require '+org)
302 (define-keys org-mode-map 464 (define-key* org-mode-map
303 "C-M-k" #'kill-paragraph 465 "C-M-k" #'kill-paragraph
304 "C-M-t" #'transpose-paragraphs) 466 "C-M-t" #'transpose-paragraphs
467 "RET" #'+org-return-dwim
468 "S-<return>" #'+org-table-copy-down|+org-return
469 "C-c C-o" #'+org-open-at-point-dwim)
305 (org-clock-persistence-insinuate))) 470 (org-clock-persistence-insinuate)))
306 471
307(yoke org-agenda nil 472(yoke org-agenda nil
@@ -323,14 +488,23 @@
323 org-agenda-show-future-repeats 'next 488 org-agenda-show-future-repeats 'next
324 org-agenda-window-setup 'current-window) 489 org-agenda-window-setup 'current-window)
325 (setq-local-hook org-agenda-mode-hook 490 (setq-local-hook org-agenda-mode-hook
326 truncate-lines t) 491 truncate-lines t
327 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)) 492 electric-pair-pairs (append electric-pair-pairs
493 (mapcar (lambda (e)
494 (let ((ch (string-to-char (car e))))
495 (cons ch ch)))
496 org-emphasis-alist)))
497 (add-hook* 'org-agenda-mode-hook
498 #'hl-line-mode)
499 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)
500 (define-key* (current-global-map)
501 "C-c c" #'org-capture
502 "C-c a" #'org-agenda))
328 503
329(yoke ox nil ; org-export 504(yoke ox nil ; org-export
330 (eval-after org (require 'ox)) 505 (eval-after org (require 'ox))
331 (eval-after ox 506 (eval-after ox
332 (require '+ox) 507 (require* '+ox '(ox-md nil t))
333 (require 'ox-md nil :noerror)
334 (+org-export-pre-hooks-insinuate)) 508 (+org-export-pre-hooks-insinuate))
335 (setq org-export-coding-system 'utf-8-unix 509 (setq org-export-coding-system 'utf-8-unix
336 org-export-headline-levels 8 510 org-export-headline-levels 8
@@ -340,6 +514,11 @@
340 org-export-with-sub-superscripts t 514 org-export-with-sub-superscripts t
341 org-export-with-toc nil)) 515 org-export-with-toc nil))
342 516
517(yoke electric-cursor "https://codeberg.org/acdw/electric-cursor.el"
518 (setq electric-cursor-alist '((overwrite-mode . hbar)
519 (t . bar)))
520 (electric-cursor-mode))
521
343(yoke _work (sync/ "emacs/private") 522(yoke _work (sync/ "emacs/private")
344 :depends ((+org-capture (locate-user-emacs-file "lisp")) 523 :depends ((+org-capture (locate-user-emacs-file "lisp"))
345 (private (locate-user-emacs-file "lisp")) 524 (private (locate-user-emacs-file "lisp"))
@@ -347,27 +526,167 @@
347 (locate-user-emacs-file "yoke/bbdb/lisp")) 526 (locate-user-emacs-file "yoke/bbdb/lisp"))
348 (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) 527 (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/"))
349 (require 'bbdb) 528 (require 'bbdb)
350 (require 'private) 529 (require* 'private 'work)
351 (require '_work)
352 (bbdb-initialize 'gnus 'message) 530 (bbdb-initialize 'gnus 'message)
353 (setq bbdb-complete-mail-allow-cycling t)) 531 (setq bbdb-complete-mail-allow-cycling t))
354 532
355(yoke org-taskwise "https://codeberg.org/acdw/org-taskwise.el") 533(yoke org-taskwise "https://codeberg.org/acdw/org-taskwise.el")
356 534
357(yoke titlecase "https://codeberg.org/acdw/titlecase.el" 535(yoke titlecase "https://codeberg.org/acdw/titlecase.el"
358 (eval-after org (require 'titlecase)) 536 (eval-after org (require* 'titlecase '+titlecase))
359 (eval-after titlecase 537 (eval-after titlecase
360 (require '+titlecase)
361 (add-to-list* 'titlecase-skip-words-regexps (rx word-boundary 538 (add-to-list* 'titlecase-skip-words-regexps (rx word-boundary
362 (+ (any upper digit)) 539 (+ (any upper digit))
363 word-boundary)))) 540 word-boundary))))
364 541
365(yoke flyspell-correct "https://github.com/duckwork/flyspell-correct" 542(yoke flyspell-correct "https://github.com/duckwork/flyspell-correct"
366 (eval-after flyspell 543 (eval-after flyspell
367 (require 'flyspell-correct) 544 (require* 'flyspell-correct
368 (require '+flyspell-correct) 545 `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct")))
369 (define-keys flyspell-mode-map 546 (define-key* flyspell-mode-map
370 "C-;" #'flyspell-correct-wrapper 547 "C-;" #'flyspell-correct-wrapper
371 "<f7>" #'+flyspell-correct-buffer)) 548 "<f7>" #'+flyspell-correct-buffer))
372 (add-hook 'org-mode-hook #'flyspell-mode) 549 (add-hook 'org-mode-hook #'flyspell-mode)
373 (setq flyspell-correct--cr-key ";")) 550 (setq flyspell-correct--cr-key ";"))
551
552(yoke helpful "https://github.com/Wilfred/helpful"
553 :depends ((dash "https://github.com/magnars/dash.el")
554 (f "https://github.com/rejeep/f.el")
555 (s "https://github.com/magnars/s.el")
556 (elisp-refs "https://github.com/Wilfred/elisp-refs"))
557 (define-key* (current-global-map)
558 "<f1> f" #'helpful-callable
559 "<f1> v" #'helpful-variable
560 "<f1> k" #'helpful-key
561 "<f1> ." #'helpful-at-point
562 "<f1> o" #'helpful-symbol)
563 (unless (featurep 'info-look)
564 (run-with-idle-timer 1 nil (lambda ()
565 (require 'info-look)
566 (let ((inhibit-message t))
567 (info-lookup-setup-mode 'symbol
568 'emacs-lisp-mode)))))
569 (setf (alist-get "\\*helpful" display-buffer-alist nil nil #'string=)
570 '((display-buffer-in-side-window)
571 (side . bottom)
572 (window-height . 20))))
573
574(yoke hippie-completing-read
575 "https://codeberg.org/acdw/hippie-completing-read.el"
576 (define-key* (current-global-map)
577 "M-/" #'hippie-completing-read))
578
579(yoke dictionary nil ; Comes with Emacs 29!
580 (setq dictionary-server "localhost") ; Needs local dictd
581 (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=)
582 '((display-buffer-in-side-window)
583 (side . bottom)
584 (window-height . 20))))
585
586(yoke anzu "https://github.com/emacsorphanage/anzu"
587 (global-anzu-mode)
588 (define-key* (current-global-map)
589 [remap query-replace] #'anzu-query-replace-regexp
590 [remap query-replace-regexp] #'anzu-query-replace)
591 (define-key* isearch-mode-map
592 [remap isearch-query-replace] #'anzu-isearch-query-replace-regexp
593 [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace)
594 (defun anzu-qr@window (fn &rest r)
595 "ADVICE to query-replace from the beginning of the window."
596 (let ((scroll-margin 0))
597 (save-excursion
598 (goto-char (window-start))
599 (apply fn r))))
600 (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window)
601 (advice-add 'anzu-query-replace :around #'anzu-qr@window))
602
603(yoke tempo nil
604 (require '+tempo))
605
606;; (yoke tempel "https://github.com/minad/tempel"
607;; ;; I would use `tempo' but it's clunkier .. :(
608;; (define-key* (current-global-map)
609;; "M-+" #'tempel-complete
610;; "M-_" #'tempel-insert)
611;; (defun tempel-capf-insinuate ()
612;; (setq-local completion-at-point-functions
613;; (cons #'tempel-expand
614;; completion-at-point-functions)))
615;; (add-hook* '(prog-mode-hook
616;; text-mode-hook)
617;; #'tempel-capf-insinuate))
618
619(yoke scule (locate-user-emacs-file "lisp")
620 (defvar scule-map (let ((map (make-sparse-keymap)))
621 (define-key map (kbd "M-u") #'scule-upcase)
622 (define-key map (kbd "M-l") #'scule-downcase)
623 (define-key map (kbd "M-c") #'scule-capitalize)
624 map)
625 "Keymap for scule twiddling.")
626 (define-key* (current-global-map)
627 "M-c" scule-map
628 "M-u" #'universal-argument)
629 (define-key universal-argument-map (kbd "M-u") #'universal-argument-more))
630
631(yoke 0x0 "https://gitlab.com/willvaughn/emacs-0x0"
632 (setf 0x0-default-server 'ttm)
633 (eval-after embark
634 (define-key* embark-region-map
635 "U" #'0x0-dwim)))
636
637(yoke filldent "https://codeberg.org/acdw/filldent.el"
638 (define-key* (current-global-map)
639 "M-q" #'filldent-unfill-toggle))
640
641(yoke avy "https://github.com/abo-abo/avy"
642 (require 'avy)
643 (setf avy-background t
644 (alist-get ?. avy-dispatch-alist)
645 (defun avy-action-embark (pt)
646 (unwind-protect
647 (save-excursion
648 (goto-char pt)
649 (embark-act))
650 (select-window
651 (cdr (ring-ref avy-ring 0))))
652 t))
653 (define-key* (current-global-map)
654 "M-j" #'avy-goto-char-timer)
655 (define-key* isearch-mode-map
656 "M-j" #'avy-isearch))
657
658(yoke frowny "https://codeberg.org/acdw/frowny.el"
659 (setf frowny-eyes (rx (any ":=") (opt "'") (? "-")))
660 (global-frowny-mode))
661
662(yoke isearch-mb "https://github.com/astoff/isearch-mb"
663 (eval-after (consult anzu)
664 (require 'isearch-mb)
665 (dolist (spec '((isearch-mb--with-buffer
666 ("M-e" . consult-isearch)
667 ("C-o" . loccur-isearch))
668 (isearch-mb--after-exit
669 ("M-%" . anzu-isearch-query-replace)
670 ("M-s l" . consult-line))))
671 (let ((isearch-mb-list (car spec))
672 (isearch-mb-binds (cdr spec)))
673 (dolist (cell isearch-mb-binds)
674 (let ((key (car cell))
675 (command (cdr cell)))
676 (when (fboundp command)
677 (add-to-list isearch-mb-list command)
678 (define-key isearch-mb-minibuffer-map (kbd key) command)))))))
679 (isearch-mb-mode))
680
681(yoke keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el"
682 (keepassxc-shim-activate))
683
684(yoke keychain-environment "https://github.com/tarsius/keychain-environment"
685 :when (executable-find "keychain")
686 (keychain-refresh-environment))
687
688(yoke macrostep "https://github.com/joddie/macrostep"
689 (eval-after elisp-mode (require 'macrostep))
690 (define-key* '(emacs-lisp-mode-map
691 lisp-interaction-mode-map)
692 "C-c e" #'macrostep-expand))
diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 6f40cf0..8817c19 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el
@@ -229,7 +229,7 @@ Do this only if the buffer is not visiting a file."
229 (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time) 229 (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time)
230 +save-some-buffers-debounce-timeout)) 230 +save-some-buffers-debounce-timeout))
231 (save-some-buffers t) 231 (save-some-buffers t)
232 (setq +save-some-buffers-debounce-time (time-convert nil 'integer)))) 232 (setf +save-some-buffers-debounce-time (time-convert nil 'integer))))
233 233
234 234
235;;; Better-default functions ... 235;;; Better-default functions ...
@@ -304,6 +304,11 @@ ARG is passed to `backward-kill-word'."
304;; (advice-add #'yank :after #'+yank@indent) 304;; (advice-add #'yank :after #'+yank@indent)
305;; (advice-add #'yank-pop :after #'+yank@indent) 305;; (advice-add #'yank-pop :after #'+yank@indent)
306 306
307;; https://old.reddit.com/r/emacs/comments/y92y4b/tramp_users_slowness_got_you_down_check/it3a35r/
308(defun +vc-off-when-remote ()
309 (when (file-remote-p (buffer-file-name))
310 (setq-local vc-handled-backends nil)))
311
307 312
308;;; Extra functions 313;;; Extra functions
309 314
@@ -317,7 +322,7 @@ It returns nil with remote files and those without attached files."
317(defun +goto-matching-paren (&optional arg) 322(defun +goto-matching-paren (&optional arg)
318 "Go to the matching paren, similar to vi's %." 323 "Go to the matching paren, similar to vi's %."
319 (interactive "p") 324 (interactive "p")
320 (or arg (setq arg 1)) 325 (or arg (setf arg 1))
321 (cond 326 (cond
322 ;; Check for "outside of bracket" positions 327 ;; Check for "outside of bracket" positions
323 ((looking-at "[\[\(\{]") (forward-sexp arg)) 328 ((looking-at "[\[\(\{]") (forward-sexp arg))
@@ -338,6 +343,15 @@ If the current window is the only window, bury the buffer."
338 343
339;;; Required libraries 344;;; Required libraries
340 345
346(when (require 'abbrev nil :noerror)
347 (setq-default abbrev-file-name (sync/ "abbrev.el")
348 save-abbrevs 'silent))
349
350(when (require 'autorevert nil :noerror)
351 (setq-default global-auto-revert-non-file-buffers t
352 auto-revert-verbose nil)
353 (global-auto-revert-mode +1))
354
341(when (require 'uniquify nil :noerror) 355(when (require 'uniquify nil :noerror)
342 (setq-default uniquify-buffer-name-style 'forward 356 (setq-default uniquify-buffer-name-style 'forward
343 uniquify-separator path-separator 357 uniquify-separator path-separator
diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el index f4fc956..9a33cc0 100644 --- a/lisp/+flyspell-correct.el +++ b/lisp/+flyspell-correct.el
@@ -12,8 +12,8 @@ With PREFIX, prompt to change the current dictionary."
12 (when prefix 12 (when prefix
13 (let ((current-prefix-arg nil)) 13 (let ((current-prefix-arg nil))
14 (call-interactively #'ispell-change-dictionary))) 14 (call-interactively #'ispell-change-dictionary)))
15 (+with-message "Checking spelling" 15 (with-message "Checking spelling"
16 (flyspell-correct-move (point-min) :forward :rapid))) 16 (flyspell-correct-move (point-min) :forward :rapid)))
17 17
18(defun +flyspell-correct-buffer-h (&rest _) 18(defun +flyspell-correct-buffer-h (&rest _)
19 "Run `+flyspell-correct-buffer'. 19 "Run `+flyspell-correct-buffer'.
diff --git a/lisp/+ispell.el b/lisp/+ispell.el new file mode 100644 index 0000000..10c31b8 --- /dev/null +++ b/lisp/+ispell.el
@@ -0,0 +1,97 @@
1;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'cl-lib)
8(require 'seq)
9
10;; Utility function TODO: move elsewhere
11(defun +ispell-append-removing-duplicates (&rest lists)
12 "Append LISTS, removing duplicates from the result.
13Any keyword arguments to `cl-remove-duplicates' should come
14before the LISTS."
15 (let (cl-remove-duplicates-args)
16 (while (keywordp (car lists))
17 (push (pop lists) cl-remove-duplicates-args)
18 (push (pop lists) cl-remove-duplicates-args))
19 (apply #'cl-remove-duplicates (apply #'append lists)
20 (nreverse cl-remove-duplicates-args))))
21
22;;; Ispell in .dir-locals
23
24;; Let Emacs know a list of strings is safe
25(defun +ispell-safe-local-p (list)
26 (and (listp list)
27 (seq-every-p #'stringp list)))
28
29;; Can I instruct ispell to insert LocalWords in a different file?
30;; https://emacs.stackexchange.com/q/31396/2264
31
32;; How can I move all my file-local LocalWords to .dir-locals.el?
33;; https://emacs.stackexchange.com/q/31419
34
35;; Adapted from ispell.el:ispell-buffer-local-words
36(defun +ispell-buffer-local-words-list ()
37 (let (words)
38 (or ispell-buffer-local-name
39 (setf ispell-buffer-local-name (buffer-name)))
40 (save-excursion
41 (goto-char (point-min))
42 (while (search-forward ispell-words-keyword nil t)
43 (let ((end (point-at-eol))
44 (ispell-casechars (ispell-get-casechars))
45 string)
46 (while (re-search-forward " *\\([^ ]+\\)" end t)
47 (setf string (match-string-no-properties 1))
48 (if (and (< 1 (length string))
49 (equal 0 (string-match ispell-casechars string)))
50 (push string words))))))
51 words))
52
53;;;###autoload
54(defun +ispell-move-buffer-words-to-dir-locals (&optional arg)
55 "Move the current buffer-local words to .dir-locals.el.
56This function prompts the user to save .dir-locals.el, unless
57prefix ARG is non-nil; then it just saves them."
58 (interactive "P")
59 (unless (buffer-file-name)
60 (user-error "Buffer not attached to file"))
61 (hack-dir-local-variables)
62 (let ((print-level nil)
63 (print-length nil))
64 (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
65 ; where this came from
66 (+ispell-append-removing-duplicates
67 :test #'string=
68 ispell-buffer-session-localwords
69 (alist-get 'ispell-buffer-session-localwords
70 dir-local-variables-alist)
71 (alist-get 'ispell-buffer-session-localwords
72 file-local-variables-alist)
73 (+ispell-buffer-local-words-list)))))
74 (save-excursion
75 (add-dir-local-variable
76 major-mode
77 'ispell-buffer-session-localwords
78 (setf ispell-buffer-session-localwords
79 new-words))
80 (when (or arg
81 (y-or-n-p "Save .dir-locals.el?"))
82 (save-buffer))
83 (bury-buffer))
84 (or ispell-buffer-local-name
85 (setf ispell-buffer-local-name (buffer-name)))
86 (save-excursion
87 (goto-char (point-min))
88 (while (search-forward ispell-words-keyword nil t)
89 (delete-region (point-at-bol) (1+ (point-at-eol))))))))
90
91;;;###autoload
92(defun +ispell-move-buffer-words-to-dir-locals-hook ()
93 "Convenience function for binding to a hook."
94 (+ispell-move-buffer-words-to-dir-locals t))
95
96(provide '+ispell)
97;;; +ispell.el ends here
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el index 7ed4e00..06dfcfd 100644 --- a/lisp/+org-capture.el +++ b/lisp/+org-capture.el
@@ -17,7 +17,7 @@ LIST defaults to `org-capture-templates'."
17;; Set it up as a generic value. Based on the one for `alist-get'. 17;; Set it up as a generic value. Based on the one for `alist-get'.
18(gv-define-expander +org-capture--get 18(gv-define-expander +org-capture--get
19 (lambda (do key &optional alist) 19 (lambda (do key &optional alist)
20 (setq alist (or alist org-capture-templates)) 20 (setf alist (or alist org-capture-templates))
21 (macroexp-let2 macroexp-copyable-p k key 21 (macroexp-let2 macroexp-copyable-p k key
22 (gv-letplace (getter setter) alist 22 (gv-letplace (getter setter) alist
23 (macroexp-let2 nil p `(assoc ,k ,getter 'equal) 23 (macroexp-let2 nil p `(assoc ,k ,getter 'equal)
@@ -27,7 +27,7 @@ LIST defaults to `org-capture-templates'."
27 (let ((set-exp 27 (let ((set-exp
28 `(if ,p (setcdr ,p ,v) 28 `(if ,p (setcdr ,p ,v)
29 ,(funcall setter 29 ,(funcall setter
30 `(cons (setq ,p (cons ,k ,v)) 30 `(cons (setf ,p (cons ,k ,v))
31 ,getter))))) 31 ,getter)))))
32 `(progn 32 `(progn
33 ,set-exp 33 ,set-exp
@@ -36,7 +36,7 @@ LIST defaults to `org-capture-templates'."
36(defun +org-capture-sort (&optional list) 36(defun +org-capture-sort (&optional list)
37 "Sort LIST by string keys. 37 "Sort LIST by string keys.
38LIST is a symbol and defaults to `org-capture-templates'." 38LIST is a symbol and defaults to `org-capture-templates'."
39 (setq list (or list 'org-capture-templates)) 39 (setf list (or list 'org-capture-templates))
40 (set list (sort (symbol-value list) (lambda (a b) 40 (set list (sort (symbol-value list) (lambda (a b)
41 (string< (car a) (car b)))))) 41 (string< (car a) (car b))))))
42 42
@@ -68,9 +68,9 @@ SORT-AFTER, when set to t, will call
68properly process the variable." 68properly process the variable."
69 ;; LIST defaults to `org-capture-templates' 69 ;; LIST defaults to `org-capture-templates'
70 (declare (indent 2)) 70 (declare (indent 2))
71 (unless list (setq list 'org-capture-templates)) 71 (unless list (setf list 'org-capture-templates))
72 ;; Ensure VALUE is a list to cons properly 72 ;; Ensure VALUE is a list to cons properly
73 (unless (listp value) (setq value (list value))) 73 (unless (listp value) (setf value (list value)))
74 (when (> (length key) 1) 74 (when (> (length key) 1)
75 ;; Check for existence of groups. 75 ;; Check for existence of groups.
76 (let ((expected (cl-loop for i from 1 to (1- (length key)) 76 (let ((expected (cl-loop for i from 1 to (1- (length key))
@@ -87,7 +87,7 @@ properly process the variable."
87 87
88(defun +org-template--ensure-path (keys &optional list) 88(defun +org-template--ensure-path (keys &optional list)
89 "Ensure path of keys exists in `org-capture-templates'." 89 "Ensure path of keys exists in `org-capture-templates'."
90 (unless list (setq list 'org-capture-templates)) 90 (unless list (setf list 'org-capture-templates))
91 (when (> (length key) 1) 91 (when (> (length key) 1)
92 ;; Check for existence of groups. 92 ;; Check for existence of groups.
93 (let ((expected (cl-loop for i from 1 to (1- (length key)) 93 (let ((expected (cl-loop for i from 1 to (1- (length key))
diff --git a/lisp/+org.el b/lisp/+org.el index b17a1fa..70962d6 100644 --- a/lisp/+org.el +++ b/lisp/+org.el
@@ -1,5 +1,106 @@
1;;; +org.el --- -*- lexical-binding: t -*- 1;;; +org.el --- -*- lexical-binding: t -*-
2 2
3;;; Org Return DWIM
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]]
5
6(defun +org-element-descendant-of (type element)
7 "Return non-nil if ELEMENT is a descendant of TYPE.
8TYPE should be an element type, like `item' or `paragraph'.
9ELEMENT should be a list like that returned by `org-element-context'."
10 ;; MAYBE: Use `org-element-lineage'.
11 (when-let* ((parent (org-element-property :parent element)))
12 (or (eq type (car parent))
13 (+org-element-descendant-of type parent))))
14
15(defun +org-return-dwim (&optional prefix)
16 "A helpful replacement for `org-return'.
17With PREFIX, call `org-return'."
18 (interactive "P")
19 ;; Auto-fill if enabled
20 (when auto-fill-function
21 (dolist (func (ensure-list auto-fill-function))
22 (funcall func)))
23 (cond
24 (prefix ; Handle prefix
25 (pcase prefix
26 ('(4) (newline))
27 ('(16) (newline 2))
28 (_ (newline prefix))))
29 ((and org-return-follows-link ; Open link
30 (eq 'link (car (org-element-context))))
31 (org-open-at-point-global))
32 ((org-at-heading-p) ; Open a line after a heading
33 (let ((heading-start (org-entry-beginning-position)))
34 (goto-char (org-entry-end-position))
35 (cond ((and (org-at-heading-p)
36 (= heading-start (org-entry-beginning-position)))
37 ;; Entry ends on its heading, so add 2 newlines
38 (end-of-line)
39 (newline 2))
40 (t
41 ;; Entry ends after its heading, so back up
42 (forward-line -1)
43 (end-of-line)
44 (when (org-at-heading-p)
45 (forward-line)
46 (newline)
47 (forward-line -1))
48 (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n")))
49 nil))
50 (newline))
51 (forward-line -1)))))
52 ((org-at-item-checkbox-p) ; Insert a new checkbox item
53 (end-of-line)
54 (org-insert-todo-heading nil))
55 ((org-in-item-p) ; Insert a new list item
56 (let* ((context (org-element-context))
57 (first-item-p (eq 'plain-list (car context)))
58 (itemp (eq 'item (car context)))
59 (emptyp (or
60 ;; This (regular) list item is empty
61 (eq (org-element-property :contents-begin context)
62 (org-element-property :contents-end context))
63 ;; This (definition) list item is empty
64 (looking-at " *::")))
65 (item-child-p (+org-element-descendant-of 'item context)))
66 (cond ((and itemp emptyp)
67 (delete-region (line-beginning-position) (line-end-position))
68 (newline))
69 ((or first-item-p
70 (and itemp (not emptyp))
71 item-child-p)
72 (org-end-of-item)
73 (org-insert-item))
74 (t
75 (delete-region (line-beginning-position) (line-end-position))
76 (newline)))))
77 ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with
78 (org-inlinetask-in-task-p)) ; inline tasks
79 (org-return))
80 ((org-at-table-p) ; Insert a new org-table row
81 (cond ((save-excursion
82 (beginning-of-line)
83 (cl-loop with end = (line-end-position)
84 for cell = (org-element-table-cell-parser)
85 always (equal (org-element-property :contents-begin cell)
86 (org-element-property :contents-end cell))
87 while (re-search-forward "|" end t)))
88 ;; Empty row: end the table
89 (delete-region (line-beginning-position) (line-end-position))
90 (org-return))
91 (t
92 ;; Non-empty row
93 (org-return))))
94 (t ; Otherwise---just call `org-return'.
95 (org-return))))
96
97(defun +org-table-copy-down|+org-return (&optional n)
98 "Call `org-table-copy-down' or `+org-return' depending on context."
99 (interactive "P")
100 (if (org-table-check-inside-data-field 'noerror)
101 (org-table-copy-down (or n 1))
102 (+org-return-dwim n)))
103
3;;; Copy org trees as HTML 104;;; Copy org trees as HTML
4 105
5;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. 106;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]].
@@ -41,4 +142,70 @@ and POST-PROCESS are passed to `org-export-to-file'."
41 ("—" "---")))) 142 ("—" "---"))))
42 (replace-match replace nil nil))))) 143 (replace-match replace nil nil)))))
43 144
145;;; A ... different ... `org-open-at-point-dwim'
146;; I honestly don't remember what the difference is between this and the
147;; O.G. one is.. hopefully this one fixes annoying stupid problems.
148
149(defun +org-open-at-point-dwim (&optional arg)
150 "Open thing at point, or if there isn't something, list things."
151 (interactive "P")
152 (save-excursion
153 (let* ((this-char-type (org-element-type (org-element-context)))
154 (prev-char-type (ignore-errors
155 (save-excursion
156 (backward-char)
157 (org-element-type (org-element-context)))))
158 (types '(citation citation-reference clock comment comment-block
159 footnote-definition footnote-reference headline
160 inline-src-block inlinetask keyword link
161 node-property planning src-block timestamp))
162 (type this-char-type))
163 (when (and (memq this-char-type types) (memq prev-char-type types))
164 (backward-char)
165 (setq type prev-char-type)) ; what the fuckckckckck
166 ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well,
167 ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since
168 ;; I really just want to open the list of URLs /most of the time/, I'm
169 ;; fixing it like this instead.
170 (unless (and (memq type types)
171 (ignore-errors (org-open-at-point arg)
172 t))
173 (while (not
174 (progn
175 (org-back-to-heading)
176 (car (org-offer-links-in-entry (current-buffer) (point) 1))))
177 (org-up-heading-all 1))
178 (org-open-at-point arg)))))
179
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
192
193;;; Better org faces
194;; see `org-emphasis-alist'
195
196(defface org-bold '((t (:weight bold)))
197 "Bold face in `org-mode' documents.")
198
199(defface org-italic '((t (:slant italic)))
200 "Italic face in `org-mode' documents.")
201
202(defface org-underline '((t (:underline t)))
203 "Underline face in `org-mode' documents.")
204
205(defface org-strikethrough '((t (:strike-through t)))
206 "Strike-through face for `org-mode' documents.")
207
208;; `org-verbatim' and `org-code' are apparently already things, so we skip them
209;; here.
210
44(provide '+org) 211(provide '+org)
diff --git a/lisp/+tempo.el b/lisp/+tempo.el new file mode 100644 index 0000000..2324665 --- /dev/null +++ b/lisp/+tempo.el
@@ -0,0 +1,44 @@
1;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*-
2
3(require 'tempo)
4
5;; TODO: I need to figure out where this function goes.
6(defun delete2 (list &rest elems)
7 "Delete each element of ELEMS, and the next item, from LIST."
8 (let ((r nil))
9 (while (consp list)
10 (if (member (car list) elems)
11 (setf list (cdr list))
12 (setf r (cons (car list) r)))
13 (setf list (cdr list)))
14 (reverse r)))
15
16(defmacro define-tempo (tag doc &rest elements)
17 "Define a template and add its tag to MODE's abbrev-table.
18TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see.
19ABBREV, if given, is the abbrev string to use for template expansion
20under MODE's abbrev-table. If ABBREV isn't given, TAG will be used."
21 (declare (indent 1))
22 (let* ((template (gensym))
23 (tag (cond ((stringp tag) tag)
24 ((symbolp tag) (symbol-name tag))
25 (t (user-error "TAG must be a string or symbol: %S" tag))))
26 (mode (or (plist-get elements :mode) nil))
27 (abbrev (or (plist-get elements :abbrev) tag))
28 (taglist (or (plist-get elements :taglist) nil))
29 (table (let ((tname (and mode (derived-mode-abbrev-table-name mode))))
30 (while (and tname (not (memq tname abbrev-table-name-list)))
31 (setq tname (and (get mode 'derived-mode-parent)
32 (derived-mode-abbrev-table-name
33 (get mode 'derived-mode-parent)))))
34 (or tname 'global-abbrev-table)))
35 (elements (delete2 elements :mode :abbrev :taglist)))
36 `(let ((,template (tempo-define-template ,tag
37 ',elements
38 ,tag
39 ,doc
40 ,taglist)))
41 (define-abbrev ,table ,tag "" ,template :system t)
42 (put ,template 'no-self-insert t))))
43
44(provide '+tempo)
diff --git a/lisp/+window.el b/lisp/+window.el new file mode 100644 index 0000000..52b3712 --- /dev/null +++ b/lisp/+window.el
@@ -0,0 +1,130 @@
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.
17Optional argument HORIZONTAL nil or omitted means check whether
18`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
19non-nil means check whether WINDOW may be split horizontally.
20
21WINDOW may be split vertically when the following conditions
22hold:
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
31WINDOW may be split horizontally when the following conditions
32hold:
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'.
68WINDOW defaults to the currently selected window.
69If `split-height-threshold' specifies an integer, WINDOW is at
70least `split-height-threshold' lines tall and can be split
71vertically, split WINDOW into two windows one above the other and
72return the lower window. Otherwise, if `split-width-threshold'
73specifies an integer, WINDOW is at least `split-width-threshold'
74columns wide and can be split horizontally, split WINDOW into two
75windows side by side and return the window on the right. If this
76can't be done either and WINDOW is the only window on its frame,
77try to split WINDOW vertically disregarding any value specified
78by `split-height-threshold'. If that succeeds, return the lower
79window. Return nil otherwise.
80
81By default `display-buffer' routines call this function to split
82the largest or least recently used window. To change the default
83customize the option `split-window-preferred-function'.
84
85You can enforce this function to not split WINDOW horizontally,
86by setting (or binding) the variable `split-width-threshold' to
87nil. If, in addition, you set `split-height-threshold' to zero,
88chances increase that this function does split WINDOW vertically.
89
90In order to not split WINDOW vertically, set (or bind) the
91variable `split-height-threshold' to nil. Additionally, you can
92set `split-width-threshold' to zero to make a horizontal split
93more likely to occur.
94
95Have a look at the function `window-splittable-p' if you want to
96know how `split-window-sensibly' determines whether WINDOW can be
97split."
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.el b/lisp/acdw.el index 444f249..f039540 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -30,20 +30,20 @@ the filesystem, unless INHIBIT-MKDIR is non-nil."
30 30
31;;; Convenience functions 31;;; Convenience functions
32 32
33(defun define-keys (maps &rest keydefs) 33(defun define-key* (maps &rest keydefs)
34 "Define KEYDEFS in MAPS. 34 "Define KEYDEFS in MAPS.
35Convenience wrapper around `define-key'." 35Convenience wrapper around `define-key'."
36 (unless (zerop (mod (length keydefs) 2)) 36 (unless (zerop (mod (length keydefs) 2))
37 (user-error "Wrong number of arguments: %S" (length keydefs))) 37 (user-error "Wrong number of arguments: %S" (length keydefs)))
38 (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) 38 (dolist (map (if (or (atom maps) (eq (car maps) 'keymap))
39 (list maps) 39 (list maps)
40 maps)) 40 maps))
41 (cl-loop for (key def) on keydefs by #'cddr 41 (cl-loop for (key def) on keydefs by #'cddr
42 do (let ((key (if (stringp key) (kbd key) key))) 42 do (let ((key (if (stringp key) (kbd key) key)))
43 (define-key (if (symbolp map) 43 (define-key (if (symbolp map)
44 (symbol-value map) 44 (symbol-value map)
45 map) 45 map)
46 key def))))) 46 key def)))))
47 47
48(unless (fboundp 'ensure-list) 48(unless (fboundp 'ensure-list)
49 ;; Just in case we're using an old version of Emacs. 49 ;; Just in case we're using an old version of Emacs.
@@ -57,10 +57,11 @@ not a list, return a one-element list containing OBJECT."
57 57
58(defun add-to-list* (lists &rest things) 58(defun add-to-list* (lists &rest things)
59 "Add THINGS to LISTS. 59 "Add THINGS to LISTS.
60LISTS can be one list variable or a list. 60LISTS can be one list variable or a list. Each thing of THINGS
61Each thing of THINGS can be either a variablel (the thing), or a list of the form 61can be either a variablel (the thing), or a list of the form
62(ELEMENT &optional APPEND COMPARE-FN), which is passed to 62(ELEMENT &optional APPEND COMPARE-FN), which is passed to
63`add-to-list'." 63`add-to-list'."
64 (declare (indent 1))
64 (dolist (l (ensure-list lists)) 65 (dolist (l (ensure-list lists))
65 (dolist (thing things) 66 (dolist (thing things)
66 (apply #'add-to-list l (ensure-list thing))))) 67 (apply #'add-to-list l (ensure-list thing)))))
@@ -69,26 +70,73 @@ Each thing of THINGS can be either a variablel (the thing), or a list of the for
69 "Add FUNCTIONS to HOOKS. 70 "Add FUNCTIONS to HOOKS.
70Each function in FUNCTIONS can be a singleton or a list of the 71Each function in FUNCTIONS can be a singleton or a list of the
71form (FUNCTION &optional DEPTH LOCAL)." 72form (FUNCTION &optional DEPTH LOCAL)."
73 (declare (indent 1))
72 (dolist (hook (ensure-list hooks)) 74 (dolist (hook (ensure-list hooks))
73 (dolist (fn functions) 75 (dolist (fn functions)
74 (apply #'add-hook hook (ensure-list fn))))) 76 (apply #'add-hook hook (ensure-list fn)))))
75 77
78(defun +concat (&rest strings)
79 "Concat STRINGS separated by SEPARATOR.
80SEPARATOR is \"\\n\" unless the keyword argument `:separator' is
81given, followed by the separator to use. Each item in STRINGS is
82either a string or a list or strings, which is concatenated
83without any separator."
84 (let (ret
85 ;; I don't know why a `cl-defun' with
86 ;; (&rest strings &key (separator "\n")) doesn't work
87 (separator (or (cl-loop for i from 0 upto (length strings)
88 if (eq (nth i strings) :separator)
89 return (nth (1+ i) strings))
90 "\n")))
91 (while strings
92 (let ((string (pop strings)))
93 (cond ((eq string :separator) (pop strings))
94 ((listp string) (push (apply #'concat string) ret))
95 ((stringp string) (push string ret)))))
96 (mapconcat #'identity (nreverse ret) separator)))
97
98(defun require* (&rest features)
99 "Require FEATURES in order.
100Each feature of FEATURES can also be a list of the arguments to
101pass to `require', which see."
102 (condition-case e
103 (dolist (feature features)
104 (apply #'require (ensure-list feature)))
105 (:success (mapcar (lambda (f) (car (ensure-list f))) features))
106 (t (signal (car e) (cdr e)))))
107
76;;; Convenience macros 108;;; Convenience macros
77 109
110(defmacro define-local-before-save-hook (mode-or-hook &rest body)
111 "Add a local `before-save-hook' to MODE-OR-HOOK."
112 (declare (indent 1))
113 (let* ((name (format "%s" mode-or-hook))
114 (external-name (intern (format "%s@before-save" name)))
115 (internal-name (intern (format "before-save@%s" name)))
116 (hook (if (string-suffix-p "-hook" name)
117 mode-or-hook
118 (intern (format "%s-hook" name)))))
119 `(progn
120 (defun ,internal-name ()
121 ,@body)
122 (defun ,external-name ()
123 (add-hook 'before-save-hook #',internal-name nil :local))
124 (add-hook ',hook #',external-name))))
125
78(defmacro setq-local-hook (hook &rest args) 126(defmacro setq-local-hook (hook &rest args)
79 "Run `setq-local' on ARGS when running HOOK." 127 "Run `setq-local' on ARGS when running HOOK."
80 (declare (indent 1)) 128 (declare (indent 1))
81 (let ((fn (intern (format "%s-setq-local" hook)))) 129 (let ((fn (intern (format "%s-setq-local" hook))))
82 (when (and (fboundp fn) 130 (when (and (fboundp fn)
83 (functionp fn)) 131 (functionp fn))
84 (setq args (append (function-get fn 'setq-local-hook-settings) args))) 132 (setf args (append (function-get fn 'setq-local-hook-settings) args)))
85 (unless (and (< 0 (length args)) 133 (unless (and (< 0 (length args))
86 (zerop (mod (length args) 2))) 134 (zerop (mod (length args) 2)))
87 (user-error "Wrong number of arguments: %S" (length args))) 135 (user-error "Wrong number of arguments: %S" (length args)))
88 `(progn 136 `(progn
89 (defun ,fn () 137 (defun ,fn ()
90 ,(format "Set local variables after `%s'." hook) 138 ,(format "Set local variables after `%s'." hook)
91 (setq-local ,@args)) 139 (setq-local ,@args))
92 (function-put ',fn 'setq-local-hook-settings ',args) 140 (function-put ',fn 'setq-local-hook-settings ',args)
93 (add-hook ',hook #',fn)))) 141 (add-hook ',hook #',fn))))
94 142
@@ -103,3 +151,38 @@ If body executes without errors, MESSAGE...Done will be displayed."
103 ,@body) 151 ,@body)
104 (:success (message "%s...done" ,msg)) 152 (:success (message "%s...done" ,msg))
105 (t (signal (car e) (cdr e))))))) 153 (t (signal (car e) (cdr e)))))))
154
155;; https://emacs.stackexchange.com/a/39324/37239
156;; XXX: This shit don't work rn
157(defun ignore-invisible-overlays (fn)
158 "Execute FN, ignoring invisible overlays.
159FN should return a point."
160 (let ((overlay nil)
161 (point nil))
162 (setq point (and (funcall fn) (point)))
163 (setq overlay (car (overlays-at (point))))
164 (while (and overlay (member 'invisible (overlay-properties overlay)))
165 (goto-char (overlay-end overlay))
166 (setq point (and (funcall fn) (point)))
167 (setq overlay (car (overlays-at (point)))))
168 point))
169
170;;; Extras
171;; Trying to avoid a whole install of crux ...
172
173(defun kill-and-join-forward (&optional arg)
174 "Kill the line or, if at the end of a line, join with the next.
175This command is `visual-line-mode'-aware. If ARG is provided,
176it's passed on to kill a line, but not to delete indentation.
177When joining, this command deletes whitespace."
178 (interactive "P")
179 (if (and (eolp) (not (bolp)))
180 (delete-indentation 1)
181 (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg)))
182
183(defun other-window|switch-buffer ()
184 "Call `other-window' or `switch-buffer' depending on windows."
185 (interactive)
186 (if (one-window-p)
187 (switch-to-buffer nil)
188 (other-window 1)))
diff --git a/lisp/pita.el b/lisp/pita.el new file mode 100644 index 0000000..92ebf1b --- /dev/null +++ b/lisp/pita.el
@@ -0,0 +1,64 @@
1;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*-
2;; 🥙
3
4(defmacro with-message (msg &rest body)
5 (declare (indent 1))
6 (when (listp msg)
7 (setq msg (apply #'format (car msg) (cdr msg))))
8 (when (string-match "[[:alnum:]]\\'" msg)
9 (setq msg (concat msg "...")))
10 (let ((m (gensym))
11 (r (gensym)))
12 `(let ((,m ,msg)
13 (,r nil))
14 (condition-case e
15 (setq r (progn (message ,m) ,@body))
16 (:success (message "%s done" ,m) r)
17 (t (signal (car e) (cdr e)))))))
18
19(defun walk-tree-replace (tree find replace)
20 (let ((r nil))
21 (dolist (form tree)
22 (push (cond ((eq find form) replace)
23 ((listp form)
24 (walk-tree-replace form find replace))
25 (t form))
26 r))
27 (reverse r)))
28
29(defmacro with-pr (msg &rest body)
30 (declare (indent 1))
31 (when (listp msg)
32 (setq msg (apply #'format (car msg) (cdr msg))))
33 (when (string-match "[[:alnum:]]\\'" msg)
34 (setq msg (concat msg "...")))
35 (let ((pr (gensym))
36 (m (gensym)))
37 `(let* ((,m ,msg)
38 (,pr (unless (minibufferp)
39 (make-progress-reporter ,m))))
40 ,@(or (and pr (walk-tree-replace body '@ `(progress-reporter-update ,pr)))
41 body)
42 (and ,pr (progress-reporter-done ,pr)))))
43
44
45;;; crux advices
46;; these should all go :before the function they're advising.
47
48(defun with-region-or-buffer (&rest _)
49 (interactive (if mark-active
50 (list (region-beginning) (region-end))
51 (list (point-min) (point-max)))))
52
53(defun with-region-or-line (&rest _)
54 (interactive (if mark-active
55 (list (region-beginning) (region-end))
56 (list (line-beginning-position) (line-end-position)))))
57
58(defun with-region-or-to-eol (&rest _)
59 (interactive (if mark-active
60 (list (region-beginning) (region-end))
61 (list (point) (line-end-position)))))
62
63(provide 'pita)
64;;; pita.el ends here
diff --git a/lisp/scule.el b/lisp/scule.el new file mode 100644 index 0000000..3ed58bb --- /dev/null +++ b/lisp/scule.el
@@ -0,0 +1,61 @@
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/yoke.el b/lisp/yoke.el index 4f40869..68b02c4 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el
@@ -47,20 +47,20 @@ installed to `yoke-dir'."
47 (let ((generated-autoload-file 47 (let ((generated-autoload-file
48 (expand-file-name (format "%s-autoloads.el" pkg) dir)) 48 (expand-file-name (format "%s-autoloads.el" pkg) dir))
49 (backup-inhibited t) 49 (backup-inhibited t)
50 (version-control 'never) 50 (version-control 'never)
51 (message-log-max nil) 51 (message-log-max nil)
52 (inhibit-message t)) 52 (inhibit-message t))
53 (unless (file-exists-p generated-autoload-file) 53 (unless (file-exists-p generated-autoload-file)
54 (let ((find-file-hook nil) 54 (let ((find-file-hook nil)
55 (write-file-functions nil) 55 (write-file-functions nil)
56 (debug-on-error nil) 56 (debug-on-error nil)
57 (left-margin 0)) 57 (left-margin 0))
58 (if (fboundp 'make-directory-autoloads) 58 (if (fboundp 'make-directory-autoloads)
59 (make-directory-autoloads dir generated-autoload-file) 59 (make-directory-autoloads dir generated-autoload-file)
60 (and (fboundp 'update-directory-autoloads) 60 (and (fboundp 'update-directory-autoloads)
61 (update-directory-autoloads dir))))) 61 (update-directory-autoloads dir)))))
62 (when-let ((buf (find-buffer-visiting generated-autoload-file))) 62 (when-let ((buf (find-buffer-visiting generated-autoload-file)))
63 (kill-buffer buf)) 63 (kill-buffer buf))
64 (load generated-autoload-file :noerror :nomessage))) 64 (load generated-autoload-file :noerror :nomessage)))
65 (t (user-error "Directory \"%s\" doesn't exist." dir))) 65 (t (user-error "Directory \"%s\" doesn't exist." dir)))
66 dir)) 66 dir))
@@ -83,13 +83,13 @@ Similar-ish to `plist-get', but works on non-proper plists."
83 ,g)))) 83 ,g))))
84 84
85(defun delete2 (list &rest elems) 85(defun delete2 (list &rest elems)
86 "Delete ELEM and the next item from LIST." 86 "Delete each element of ELEMS, and the next item, from LIST."
87 (let ((r nil)) 87 (let ((r nil))
88 (while (consp list) 88 (while (consp list)
89 (if (member (car list) elems) 89 (if (member (car list) elems)
90 (setq list (cdr list)) 90 (setf list (cdr list))
91 (setq r (cons (car list) r))) 91 (setf r (cons (car list) r)))
92 (setq list (cdr list))) 92 (setf list (cdr list)))
93 (reverse r))) 93 (reverse r)))
94 94
95(defun eval-after-init (fn) 95(defun eval-after-init (fn)
@@ -105,17 +105,17 @@ FEATURES can be an atom or a list; as an atom it works like
105`with-eval-after-load'. The special feature `init' will evaluate 105`with-eval-after-load'. The special feature `init' will evaluate
106BODY after Emacs is finished initializing." 106BODY after Emacs is finished initializing."
107 (declare (indent 1) 107 (declare (indent 1)
108 (debug (form def-body))) 108 (debug (form def-body)))
109 (if (eq features 'init) 109 (if (eq features 'init)
110 `(eval-after-init (lambda () ,@body)) 110 `(eval-after-init (lambda () ,@body))
111 (unless (listp features) 111 (unless (listp features)
112 (setq features (list features))) 112 (setf features (list features)))
113 (if (null features) 113 (if (null features)
114 (macroexp-progn body) 114 (macroexp-progn body)
115 (let* ((this (car features)) 115 (let* ((this (car features))
116 (rest (cdr features))) 116 (rest (cdr features)))
117 `(with-eval-after-load ',this 117 `(with-eval-after-load ',this
118 (eval-after ,rest ,@body)))))) 118 (eval-after ,rest ,@body))))))
119 119
120(defun yoke-pkg-name (pkg) 120(defun yoke-pkg-name (pkg)
121 (intern (format "yoke:%s" pkg))) 121 (intern (format "yoke:%s" pkg)))
@@ -131,7 +131,7 @@ BODY after Emacs is finished initializing."
131 (unless nil unlessp) ; :unless PREDICATE 131 (unless nil unlessp) ; :unless PREDICATE
132 &allow-other-keys) 132 &allow-other-keys)
133 "Yoke a PKG into your Emacs session." 133 "Yoke a PKG into your Emacs session."
134 (declare (indent defun)) 134 (declare (indent 2))
135 (let ((name (yoke-pkg-name pkg)) 135 (let ((name (yoke-pkg-name pkg))
136 (body (delete2 body 136 (body (delete2 body
137 :depends :when :unless :after :load))) 137 :depends :when :unless :after :load)))
@@ -141,11 +141,11 @@ BODY after Emacs is finished initializing."
141 (*yoke-repo* ,repo) 141 (*yoke-repo* ,repo)
142 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo)))) 142 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo))))
143 ,@(cond 143 ,@(cond
144 ((and whenp unlessp) 144 ((and whenp unlessp)
145 `((when (or (not ,when) ,unless) 145 `((when (or (not ,when) ,unless)
146 (cl-return-from ,name nil)))) 146 (cl-return-from ,name nil))))
147 (whenp `((unless ,when (cl-return-from ,name nil)))) 147 (whenp `((unless ,when (cl-return-from ,name nil))))
148 (unlessp `((when ,unless (cl-return-from ,name nil))))) 148 (unlessp `((when ,unless (cl-return-from ,name nil)))))
149 ,@(cl-loop for (pkg* repo* load-path*) in depends 149 ,@(cl-loop for (pkg* repo* load-path*) in depends
150 collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*) 150 collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*)
151 (cl-return-from ,name nil))) 151 (cl-return-from ,name nil)))
@@ -157,3 +157,15 @@ BODY after Emacs is finished initializing."
157 body)) 157 body))
158 (:success ',pkg) 158 (:success ',pkg)
159 (t (message "%s: %s" ',name e)))))) 159 (t (message "%s: %s" ',name e))))))
160
161;;; Extras
162
163(defun yoke-imenu-insinuate ()
164 "Insinuate `yoke' forms for `imenu'."
165 (require 'imenu)
166 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
167 (list (rx (: "(yoke" (+ space)
168 (group (+ (not space)))
169 (+ space)
170 (group (+ (not space)))))
171 1)))