diff options
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | early-init.el | 11 | ||||
-rw-r--r-- | init.el | 479 | ||||
-rw-r--r-- | lisp/+emacs.el | 18 | ||||
-rw-r--r-- | lisp/+flyspell-correct.el | 4 | ||||
-rw-r--r-- | lisp/+ispell.el | 97 | ||||
-rw-r--r-- | lisp/+org-capture.el | 12 | ||||
-rw-r--r-- | lisp/+org.el | 167 | ||||
-rw-r--r-- | lisp/+tempo.el | 44 | ||||
-rw-r--r-- | lisp/+window.el | 130 | ||||
-rw-r--r-- | lisp/acdw.el | 113 | ||||
-rw-r--r-- | lisp/pita.el | 64 | ||||
-rw-r--r-- | lisp/scule.el | 61 | ||||
-rw-r--r-- | lisp/yoke.el | 72 |
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 |
6 | auto-save-list/ | 7 | auto-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) | 357 | CAPES 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. | ||
13 | Any keyword arguments to `cl-remove-duplicates' should come | ||
14 | before 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. | ||
56 | This function prompts the user to save .dir-locals.el, unless | ||
57 | prefix 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. |
38 | LIST is a symbol and defaults to `org-capture-templates'." | 38 | LIST 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 | |||
68 | properly process the variable." | 68 | properly 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. | ||
8 | TYPE should be an element type, like `item' or `paragraph'. | ||
9 | ELEMENT 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'. | ||
17 | With 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. | ||
18 | TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. | ||
19 | ABBREV, if given, is the abbrev string to use for template expansion | ||
20 | under 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. | ||
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.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. |
35 | Convenience wrapper around `define-key'." | 35 | Convenience 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. |
60 | LISTS can be one list variable or a list. | 60 | LISTS can be one list variable or a list. Each thing of THINGS |
61 | Each thing of THINGS can be either a variablel (the thing), or a list of the form | 61 | can 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. |
70 | Each function in FUNCTIONS can be a singleton or a list of the | 71 | Each function in FUNCTIONS can be a singleton or a list of the |
71 | form (FUNCTION &optional DEPTH LOCAL)." | 72 | form (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. | ||
80 | SEPARATOR is \"\\n\" unless the keyword argument `:separator' is | ||
81 | given, followed by the separator to use. Each item in STRINGS is | ||
82 | either a string or a list or strings, which is concatenated | ||
83 | without 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. | ||
100 | Each feature of FEATURES can also be a list of the arguments to | ||
101 | pass 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. | ||
159 | FN 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. | ||
175 | This command is `visual-line-mode'-aware. If ARG is provided, | ||
176 | it's passed on to kill a line, but not to delete indentation. | ||
177 | When 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 |
106 | BODY after Emacs is finished initializing." | 106 | BODY 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))) | ||