diff options
author | Case Duckworth | 2022-10-17 21:41:28 -0500 |
---|---|---|
committer | Case Duckworth | 2022-10-17 21:41:28 -0500 |
commit | aab5bfd074e57d06a79e39d7c7c4760e1f385a06 (patch) | |
tree | 7b111190a44458a970355f7a327cc5278c850293 /lisp | |
parent | asoi (diff) | |
download | emacs-aab5bfd074e57d06a79e39d7c7c4760e1f385a06.tar.gz emacs-aab5bfd074e57d06a79e39d7c7c4760e1f385a06.zip |
Bankruptcy 9
Diffstat (limited to 'lisp')
79 files changed, 215 insertions, 8055 deletions
diff --git a/lisp/+Info.el b/lisp/+Info.el deleted file mode 100644 index 46bd5f8..0000000 --- a/lisp/+Info.el +++ /dev/null | |||
@@ -1,84 +0,0 @@ | |||
1 | ;;; +Info.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'info) | ||
8 | |||
9 | (defun +Info-copy-current-node-name (&optional arg) | ||
10 | "Put the name of the current Info invocation intothe kill ring. | ||
11 | This is the same as `Info-copy-current-node-name', but with the | ||
12 | arg reversed." | ||
13 | (interactive "P" Info-mode) | ||
14 | (Info-copy-current-node-name (unless arg 0))) | ||
15 | |||
16 | (defun +Info-modeline-breadcrumbs () | ||
17 | (let ((nodes (Info-toc-nodes Info-current-file)) | ||
18 | (node Info-current-node) | ||
19 | (crumbs ()) | ||
20 | (depth Info-breadcrumbs-depth-internal) | ||
21 | (text "")) | ||
22 | ;; Get ancestors from the cached parent-children node info | ||
23 | (while (and (not (equal "Top" node)) (> depth 0)) | ||
24 | (setq node (nth 1 (assoc node nodes))) | ||
25 | (when node (push node crumbs)) | ||
26 | (setq depth (1- depth))) | ||
27 | ;; Add bottom node. | ||
28 | (setq crumbs (nconc crumbs (list Info-current-node))) | ||
29 | (when crumbs | ||
30 | ;; Add top node (and continuation if needed). | ||
31 | (setq crumbs (cons "Top" (if (member (pop crumbs) '(nil "Top")) | ||
32 | crumbs | ||
33 | (cons nil crumbs)))) | ||
34 | (dolist (node crumbs) | ||
35 | (let ((crumbs-map (make-sparse-keymap)) | ||
36 | (menu-map (make-sparse-keymap "Breadcrumbs in Mode Line"))) | ||
37 | (define-key crumbs-map [mode-line mouse-3] menu-map) | ||
38 | (when node | ||
39 | (define-key menu-map [Info-prev] | ||
40 | `(menu-item "Previous Node" Info-prev | ||
41 | :visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node")) | ||
42 | (define-key menu-map [Info-next] | ||
43 | `(menu-item "Next Node" Info-next | ||
44 | :visible ,(Info-check-pointer "next") :help "Go to the next node")) | ||
45 | (define-key menu-map [separator] '("--")) | ||
46 | (define-key menu-map [Info-breadcrumbs-in-mode-line-mode] | ||
47 | `(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode | ||
48 | :help "Toggle displaying breadcrumbs in the Info mode-line" | ||
49 | :button (:toggle . Info-breadcrumbs-in-mode-line-mode))) | ||
50 | (define-key menu-map [Info-set-breadcrumbs-depth] | ||
51 | `(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth | ||
52 | :help "Set depth of breadcrumbs to show in the mode-line")) | ||
53 | (setq node (if (equal node Info-current-node) | ||
54 | (propertize | ||
55 | (replace-regexp-in-string "%" "%%" Info-current-node) | ||
56 | 'face 'mode-line-buffer-id | ||
57 | 'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu" | ||
58 | 'mouse-face 'mode-line-highlight | ||
59 | 'local-map | ||
60 | (progn | ||
61 | (define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down) | ||
62 | (define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up) | ||
63 | crumbs-map)) | ||
64 | (propertize | ||
65 | node | ||
66 | 'local-map (progn (define-key crumbs-map [mode-line mouse-1] | ||
67 | `(lambda () (interactive) (Info-goto-node ,node))) | ||
68 | (define-key crumbs-map [mode-line mouse-2] | ||
69 | `(lambda () (interactive) (Info-goto-node ,node))) | ||
70 | crumbs-map) | ||
71 | 'mouse-face 'mode-line-highlight | ||
72 | 'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu"))))) | ||
73 | (let ((nodetext (if (not (equal node "Top")) | ||
74 | node | ||
75 | (concat (format "(%s)" (if (stringp Info-current-file) | ||
76 | (file-name-nondirectory Info-current-file) | ||
77 | ;; Some legacy code can still use a symbol. | ||
78 | Info-current-file)) | ||
79 | node)))) | ||
80 | (setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "..."))))) | ||
81 | text))) | ||
82 | |||
83 | (provide '+Info) | ||
84 | ;;; +Info.el ends here | ||
diff --git a/lisp/+ace-window.el b/lisp/+ace-window.el deleted file mode 100644 index 9e631a2..0000000 --- a/lisp/+ace-window.el +++ /dev/null | |||
@@ -1,40 +0,0 @@ | |||
1 | ;;; +ace-window.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'ace-window) | ||
6 | |||
7 | ;;;###autoload | ||
8 | (define-minor-mode +ace-window-display-mode | ||
9 | "Minor mode for updating data for `+modeline-ace-window-display'." | ||
10 | ;; This is stolen from ace-window.el but with the mode-line stuff ripped out. | ||
11 | :global t | ||
12 | (if +ace-window-display-mode | ||
13 | (progn ; Enable | ||
14 | (aw-update) | ||
15 | (force-mode-line-update t) | ||
16 | (add-hook 'window-configuration-change-hook 'aw-update) | ||
17 | (add-hook 'after-make-frame-functions 'aw--after-make-frame t) | ||
18 | (advice-add 'aw--lead-overlay :override 'ignore)) | ||
19 | (progn ; Disable | ||
20 | (remove-hook 'window-configuration-change-hook 'aw-update) | ||
21 | (remove-hook 'after-make-frame-functions 'aw--after-make-frame) | ||
22 | (advice-remove 'aw--lead-overlay 'ignore)))) | ||
23 | |||
24 | ;; (defun +ace-window--mode-line-hint (path leaf) | ||
25 | ;; (let ((wnd (cdr leaf))) | ||
26 | ;; (with-selected-window wnd | ||
27 | ;; ()))) | ||
28 | |||
29 | ;;;###autoload | ||
30 | (defun +ace-window-or-switch-buffer (arg) | ||
31 | "Call `ace-window' with ARG if more than one window is visible. | ||
32 | Switch to most recent buffer otherwise." | ||
33 | ;; cribbed from `crux-other-window-or-switch-buffer' | ||
34 | (interactive "p") | ||
35 | (if (one-window-p) | ||
36 | (switch-to-buffer nil) | ||
37 | (ace-window arg))) | ||
38 | |||
39 | (provide '+ace-window) | ||
40 | ;;; +ace-window.el ends here | ||
diff --git a/lisp/+apheleia.el b/lisp/+apheleia.el deleted file mode 100644 index 51cf145..0000000 --- a/lisp/+apheleia.el +++ /dev/null | |||
@@ -1,50 +0,0 @@ | |||
1 | ;;; +apheleia.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'el-patch) | ||
7 | (require 'user-save) | ||
8 | |||
9 | ;; https://github.com/raxod502/apheleia/pull/63#issue-1077529623 | ||
10 | (cl-defun +apheleia-indent-region (&key buffer scratch formatter callback &allow-other-keys) | ||
11 | (with-current-buffer scratch | ||
12 | (setq-local indent-line-function | ||
13 | (buffer-local-value 'indent-line-function buffer)) | ||
14 | (indent-region (point-min) | ||
15 | (point-max)) | ||
16 | (funcall callback))) | ||
17 | |||
18 | ;;; Why does the original function have to check for `apheleia-mode' ? | ||
19 | (el-patch-defun apheleia--format-after-save () | ||
20 | "Run code formatter for current buffer if any configured, then save." | ||
21 | (unless apheleia--format-after-save-in-progress | ||
22 | (when (el-patch-swap apheleia-mode | ||
23 | (or apheleia-mode | ||
24 | +apheleia/user-save-mode)) | ||
25 | (when-let ((formatters (apheleia--get-formatters))) | ||
26 | (apheleia-format-buffer | ||
27 | formatters | ||
28 | (lambda () | ||
29 | (with-demoted-errors "Apheleia: %s" | ||
30 | (when buffer-file-name | ||
31 | (let ((apheleia--format-after-save-in-progress t)) | ||
32 | (apheleia--save-buffer-silently))) | ||
33 | (run-hooks 'apheleia-post-format-hook)))))))) | ||
34 | |||
35 | |||
36 | (define-minor-mode +apheleia/user-save-mode | ||
37 | "Minor mode for reformatting code on `user-save'. | ||
38 | Customize with `apheleia-mode-alist' and `apheleia-formatters'." | ||
39 | :lighter " Apheleia/US" | ||
40 | (if +apheleia/user-save-mode | ||
41 | (add-hook 'user-save-after-save-hook #'apheleia--format-after-save nil 'local) | ||
42 | (remove-hook 'user-save-after-save-hook #'apheleia--format-after-save 'local))) | ||
43 | |||
44 | (define-globalized-minor-mode +apheleia/user-save-global-mode | ||
45 | +apheleia/user-save-mode +apheleia/user-save-mode) | ||
46 | |||
47 | (put '+apheleia/user-save-mode 'safe-local-variable #'booleanp) | ||
48 | |||
49 | (provide '+apheleia) | ||
50 | ;;; +apheleia.el ends here | ||
diff --git a/lisp/+avy.el b/lisp/+avy.el deleted file mode 100644 index b0837a3..0000000 --- a/lisp/+avy.el +++ /dev/null | |||
@@ -1,97 +0,0 @@ | |||
1 | ;;; +avy.el -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; https://karthinks.com/software/avy-can-do-anything/ | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'avy) | ||
10 | |||
11 | (defun avy-action-embark (pt) | ||
12 | (unwind-protect | ||
13 | (save-excursion | ||
14 | (goto-char pt) | ||
15 | (embark-act)) | ||
16 | (select-window | ||
17 | (cdr (ring-ref avy-ring 0)))) | ||
18 | t) | ||
19 | |||
20 | |||
21 | ;;; Remove `buffer-face-mode' when avy is active. | ||
22 | |||
23 | (defcustom +avy-buffer-face-functions '(avy-goto-char | ||
24 | avy-goto-char-in-line | ||
25 | avy-goto-char-2 | ||
26 | avy-goto-char-2-above | ||
27 | avy-goto-char-2-below | ||
28 | avy-goto-word-0 | ||
29 | avy-goto-whitespace-end | ||
30 | avy-goto-word-0-above | ||
31 | avy-goto-word-0-below | ||
32 | avy-goto-whitespace-end-above | ||
33 | avy-goto-whitespace-end-below | ||
34 | avy-goto-word-1 | ||
35 | avy-goto-word-1-above | ||
36 | avy-goto-word-1-below | ||
37 | avy-goto-symbol-1 | ||
38 | avy-goto-symbol-1-above | ||
39 | avy-goto-symbol-1-below | ||
40 | avy-goto-subword-0 | ||
41 | avy-goto-subword-1 | ||
42 | avy-goto-word-or-subword-1 | ||
43 | avy-goto-line | ||
44 | avy-goto-line-above | ||
45 | avy-goto-line-below | ||
46 | avy-goto-end-of-line | ||
47 | avy-goto-char-timer) | ||
48 | "Functions to disable `buffer-face-mode' during.") | ||
49 | |||
50 | (defvar-local +avy-buffer-face-mode-face nil | ||
51 | "The state of `buffer-face-mode' before calling `avy-with'.") | ||
52 | |||
53 | ;;; XXX: Doesn't switch back if avy errors out or quits | ||
54 | (defun +avy@un-buffer-face (win) | ||
55 | "BEFORE advice on `avy-with' to disable `buffer-face-mode'." | ||
56 | (with-current-buffer (window-buffer win) | ||
57 | (when buffer-face-mode | ||
58 | (setq +avy-buffer-face-mode-face buffer-face-mode-face) | ||
59 | (buffer-face-mode -1)))) | ||
60 | |||
61 | (defun +avy@re-buffer-face (win) | ||
62 | "AFTER advice on `avy-with' to re-enable `buffer-face-mode'." | ||
63 | (with-current-buffer (window-buffer win) | ||
64 | (when +avy-buffer-face-mode-face | ||
65 | (setq buffer-face-mode-face +avy-buffer-face-mode-face) | ||
66 | (buffer-face-mode +1))) | ||
67 | (let ((bounds (bounds-of-thing-at-point 'symbol))) | ||
68 | (when (and (car bounds) | ||
69 | (cdr bounds)) | ||
70 | (pulse-momentary-highlight-region (car bounds) (cdr bounds))))) | ||
71 | |||
72 | (defun +avy@buffer-face (fn &rest r) | ||
73 | "AROUND advice for avy to dis/enable `buffer-face-mode'." | ||
74 | (if avy-all-windows | ||
75 | (walk-windows #'+avy@un-buffer-face nil (eq avy-all-windows 'all-frames))) | ||
76 | (condition-case e | ||
77 | (apply fn r) | ||
78 | ((quit error) (message "Avy: %S" e) nil) | ||
79 | (:sucess e)) | ||
80 | (if avy-all-windows | ||
81 | (walk-windows #'+avy@re-buffer-face nil (eq avy-all-windows 'all-frames)))) | ||
82 | |||
83 | (define-minor-mode +avy-buffer-face-mode | ||
84 | "Turn off `buffer-face-mode' before doing Avy selections. | ||
85 | Restore the mode after the selection." | ||
86 | :lighter "" | ||
87 | :global t | ||
88 | (setq +avy-buffer-face-mode-face nil) | ||
89 | (cond | ||
90 | (+avy-buffer-face-mode | ||
91 | (dolist (fn +avy-buffer-face-functions) | ||
92 | (advice-add fn :around #'+avy@buffer-face))) | ||
93 | (t (dolist (fn +avy-buffer-face-functions) | ||
94 | (advice-remove fn #'+avy@buffer-face))))) | ||
95 | |||
96 | (provide '+avy) | ||
97 | ;;; avy.el ends here | ||
diff --git a/lisp/+bongo.el b/lisp/+bongo.el deleted file mode 100644 index da68024..0000000 --- a/lisp/+bongo.el +++ /dev/null | |||
@@ -1,60 +0,0 @@ | |||
1 | ;;; +bongo.el --- customizations in bongo -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (defgroup +bongo nil | ||
8 | "Extra customization for `bongo'." | ||
9 | :group 'bongo) | ||
10 | |||
11 | (defun +bongo-notify () | ||
12 | (notifications-notify | ||
13 | :title "Now Playing" | ||
14 | :body (let ((bongo-field-separator " | ||
15 | ")) | ||
16 | (substring-no-properties (bongo-formatted-infoset))) | ||
17 | :urgency 'low | ||
18 | :transient t)) | ||
19 | |||
20 | (defun +bongo-stop-all () | ||
21 | "Ensure only one bongo playlist is playing at a time. | ||
22 | This is intended to be :before advice to `bongo-play'." | ||
23 | (mapc (lambda (b) | ||
24 | (with-current-buffer b | ||
25 | (when-let* ((modep (derived-mode-p | ||
26 | 'bongo-playlist-mode)) | ||
27 | (bongo-playlist-buffer b) | ||
28 | (playingp (bongo-playing-p))) | ||
29 | (bongo-stop)))) | ||
30 | (buffer-list))) | ||
31 | |||
32 | |||
33 | ;;; Bongo Radio | ||
34 | |||
35 | (defcustom +bongo-radio-stations nil | ||
36 | "Stations to play using `+bongo-radio'.") | ||
37 | |||
38 | (defcustom +bongo-radio-buffer-name "*Bongo Radio*" | ||
39 | "Name of the buffer that holds all bongo radio stations." | ||
40 | :type 'string) | ||
41 | |||
42 | (defun +bongo-radio () | ||
43 | (interactive) | ||
44 | (switch-to-buffer (or (get-buffer +bongo-radio-buffer-name) | ||
45 | (+bongo-radio-init)))) | ||
46 | |||
47 | (defun +bongo-radio-init () | ||
48 | (interactive) | ||
49 | (let ((bongo-playlist-buffer (get-buffer-create +bongo-radio-buffer-name)) | ||
50 | (bongo-confirm-flush-playlist nil)) | ||
51 | (with-bongo-playlist-buffer | ||
52 | (bongo-playlist-mode) | ||
53 | (bongo-flush-playlist :delete-all) | ||
54 | (cl-loop for (name . url) in +bongo-radio-stations | ||
55 | do (bongo-insert-uri url name))) | ||
56 | (prog1 (switch-to-buffer bongo-playlist-buffer) | ||
57 | (goto-char (point-min))))) | ||
58 | |||
59 | (provide '+bongo) | ||
60 | ;;; +bongo.el ends here | ||
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index fc479e4..0000000 --- a/lisp/+browse-url.el +++ /dev/null | |||
@@ -1,156 +0,0 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'browse-url) | ||
6 | (require 'cl-lib) | ||
7 | |||
8 | (defgroup +browse-url nil | ||
9 | "Group for my `browse-url' extras." | ||
10 | :group 'browse-url) | ||
11 | |||
12 | ;;; URL Handlers | ||
13 | |||
14 | (defun +browse-url-set-handlers (&optional handlers) | ||
15 | "Set HANDLERS for `browse-url'. | ||
16 | Set `browse-url-handlers', if they exist; else | ||
17 | `browse-url-browser-function'. The reason for this switch is | ||
18 | that the latter is deprecated in Emacs 28+. | ||
19 | |||
20 | If HANDLERS is absent or nil, recompute handlers. This can be | ||
21 | useful when changing the default browser." | ||
22 | (let ((h (if (boundp 'browse-url-handlers) | ||
23 | 'browse-url-handlers | ||
24 | 'browse-url-browser-function))) | ||
25 | (set-default h (or handlers (symbol-value h))))) | ||
26 | |||
27 | (cl-defmacro +browse-url-make-external-viewer-handler | ||
28 | (viewer default-args &optional (prompt "URL: ") | ||
29 | &key | ||
30 | (custom-group '+browse-url) | ||
31 | (name (format "+browse-url-with-%s" viewer)) | ||
32 | (fallback #'browse-url-generic)) | ||
33 | "Create a `browse-url' handler function that calls VIEWER on the url. | ||
34 | Also create a `customize' setting in CUSTOM-GROUP for VIEWER's | ||
35 | arguments. DEFAULT-ARGS specifies the default arguments that | ||
36 | setting should have. PROMPT will be shown to user in the | ||
37 | function's `interactive' spec, as an argument to | ||
38 | `browse-url-interactive-arg'. The resulting function will be | ||
39 | named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable | ||
40 | \"NAME-args\". | ||
41 | |||
42 | If FALLBACK is non-nil, it's a function to fallback on if the | ||
43 | `start-process' call fails in anyway." | ||
44 | (declare (indent 1)) | ||
45 | `(progn | ||
46 | (defcustom ,(intern (format "%s-args" name)) | ||
47 | ,default-args | ||
48 | ,(format "Arguments to pass to %s in `%s'." viewer name) | ||
49 | :type '(repeat :tag "Command-line argument" string) | ||
50 | :group ',custom-group) | ||
51 | (defun ,(intern name) (url &optional new-window) | ||
52 | ,(format "Open URL in %s." viewer) | ||
53 | (interactive (browse-url-interactive-arg ,prompt)) | ||
54 | (let* ((url (browse-url-encode-url url)) | ||
55 | (process-environment (browse-url-process-environment))) | ||
56 | (message ,(format "Opening %%s in %s..." viewer) url) | ||
57 | (unless (ignore-errors | ||
58 | (apply #'start-process | ||
59 | (concat ,viewer " " url) nil | ||
60 | ,viewer | ||
61 | (append ,(intern (format "%s-args" name)) | ||
62 | (list url)))) | ||
63 | (funcall fallback url new-window)))))) | ||
64 | |||
65 | ;; Reference implementation: mpv | ||
66 | (+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" | ||
67 | "--cache-pause-initial=yes") | ||
68 | "Video URL: ") | ||
69 | ;; And feh too | ||
70 | (+browse-url-make-external-viewer-handler "feh" '("--auto-zoom" | ||
71 | "--geometry" "800x600")) | ||
72 | ;; And ... mpv, but for images | ||
73 | (+browse-url-make-external-viewer-handler "mpv" | ||
74 | '("--image-display-duration=inf") | ||
75 | "Image URL: " | ||
76 | :name "+browse-image-with-mpv") | ||
77 | |||
78 | ;;; Easily add extra domains to open in `browse-url-secondary-browser-function' | ||
79 | ;; I like to open most websites in eww, but a lot of website on the modern web | ||
80 | ;; just make that hard to do. Right now I have a list in `browse-url-handlers' | ||
81 | ;; with domains in an (rx (or ...)) form, but that's not super easy to config. | ||
82 | ;; With this custom setting, I'm making it a list that'll be way easier to | ||
83 | ;; customize. | ||
84 | |||
85 | (defcustom +browse-url-secondary-browser-regexps nil | ||
86 | "List of URL regexps to open with `browse-url-secondary-browser-function'." | ||
87 | :type '(repeat regexp)) | ||
88 | |||
89 | ;; Because `browse-url-browser-function', when set to an alist, must be of the | ||
90 | ;; form (REGEXP . FUNCTION), I need to convert | ||
91 | ;; `+browse-url-secondary-browser-regexps' into a regexp. | ||
92 | |||
93 | (defun +browse-url-secondary-browser-regexps-combine () | ||
94 | "Combine `+browse-url-secondary-browser-regexps'. | ||
95 | This combines a list of regexps into one regexp." | ||
96 | (mapconcat #'identity +browse-url-secondary-browser-regexps "\\\|")) | ||
97 | |||
98 | ;;; URL Transformation Functions | ||
99 | ;; There's a lot of bad websites out there. Luckily we can easily redirect | ||
100 | ;; requests to more privacy-respecting, or just less javascript-ridden, sites | ||
101 | ;; using some basic regex magic. Inspired by add-ons like | ||
102 | ;; https://einaregilsson.com/redirector/. | ||
103 | |||
104 | (defcustom +browse-url-transformations nil | ||
105 | "Transformation rules for various URLs. | ||
106 | This is an alist, the keys of which are regexen to match URLs | ||
107 | against, and the values are how to transform them. Match capture | ||
108 | data will be used in the transformations." | ||
109 | :type | ||
110 | '(alist :key-type (string :tag "URL regex match") | ||
111 | :value-type (string :tag "URL regex transformation")) | ||
112 | :group '+browse-url) | ||
113 | |||
114 | (defun +browse-url-transform-advice (url &rest args) | ||
115 | "ADVICE to transform URL for later opening by `browse-url'. | ||
116 | ARGS are ignored here, but passed on for later processing." | ||
117 | ;; Basically, loop through `+browse-url-transformations' until finding a CAR | ||
118 | ;; that matches the URL. If one is found, transform it using `replace-match' | ||
119 | ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged, | ||
120 | ;; along with the rest of the args, in a list to the original caller (probably | ||
121 | ;; `browse-url'.) | ||
122 | (apply 'list | ||
123 | (cl-loop with url = (substring-no-properties | ||
124 | (if (consp url) (car url) url)) | ||
125 | for (regex . transformation) in +browse-url-transformations | ||
126 | if (string-match regex url) | ||
127 | return (replace-match transformation nil nil url) | ||
128 | ;; else | ||
129 | finally return url) | ||
130 | args)) | ||
131 | |||
132 | (define-minor-mode +browse-url-transform-url-mode | ||
133 | "Minor mode to transform a URL before passing it to `browse-url'. | ||
134 | This can be used to \"redirect\" URLs, for example from an | ||
135 | information silo to a more privacy-respecting one (e.g., | ||
136 | \"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. | ||
137 | |||
138 | When using this mode, ensure that the transformed URL is also in | ||
139 | `browse-url-handlers', since that's what `browse-url' will see." | ||
140 | :lighter " Xurl" | ||
141 | :keymap nil | ||
142 | (if +browse-url-transform-url-mode | ||
143 | (advice-add 'browse-url :filter-args '+browse-url-transform-advice) | ||
144 | (advice-remove 'browse-url '+browse-url-transform-advice))) | ||
145 | |||
146 | (define-global-minor-mode +browse-url-transform-url-global-mode | ||
147 | +browse-url-transform-url-mode +browse-url-transform-url-mode) | ||
148 | |||
149 | (defun +browse-url-other-window (&rest args) | ||
150 | "Browse URL in the other window." | ||
151 | (let ((browsed (apply #'browse-url args))) | ||
152 | (when (bufferp browsed) | ||
153 | (switch-to-buffer-other-window browsed)))) | ||
154 | |||
155 | (provide '+browse-url) | ||
156 | ;;; +browse-url.el ends here | ||
diff --git a/lisp/+burly.el b/lisp/+burly.el deleted file mode 100644 index a32bc97..0000000 --- a/lisp/+burly.el +++ /dev/null | |||
@@ -1,63 +0,0 @@ | |||
1 | ;;; +burly.el --- Bespoke burly add-ons -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'burly) | ||
8 | |||
9 | (defgroup +burly nil | ||
10 | "Extra `burly' customizations." | ||
11 | :group 'burly | ||
12 | :prefix "+burly-") | ||
13 | |||
14 | (defcustom +burly-windows-bookmark-name "pre-close-window-config" | ||
15 | "The name of the window config bookmark pre-frame deletion.") | ||
16 | |||
17 | (defun +burly--get-name (arg) | ||
18 | "Get the name of a Burly bookmark to restore. | ||
19 | If ARG is passed, ask for the bookmark's name; otherwise, just | ||
20 | use `+burly-windows-bookmark-name'." | ||
21 | (if arg | ||
22 | (completing-read "Save Burly bookmark: " (burly-bookmark-names) | ||
23 | nil nil burly-bookmark-prefix) | ||
24 | +burly-windows-bookmark-name)) | ||
25 | |||
26 | (defun +burly-recover-windows-bookmark (&optional arg frame) | ||
27 | "Recover the window configuration from a previous bookmark. | ||
28 | ARG is passed to `+burly--get-name', which see." | ||
29 | (interactive (list current-prefix-arg | ||
30 | (selected-frame))) | ||
31 | (with-selected-frame frame | ||
32 | (burly-open-bookmark (+burly--get-name arg)))) | ||
33 | |||
34 | (defun +burly--recover-windows-on-new-frame (frame) | ||
35 | "Recover the current window configuration in a new frame. | ||
36 | This function removes itself from `after-make-frame-functions'." | ||
37 | ;; XXX: For some reason, *scratch* pops up. So I need to run this after a | ||
38 | ;; short delay, which sadly causes a flash of *scratch*. | ||
39 | (run-with-idle-timer 0.1 nil | ||
40 | (lambda (f) (+burly-recover-windows-bookmark nil f)) | ||
41 | frame) | ||
42 | (remove-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame)) | ||
43 | |||
44 | (defun +burly-save-then-close-frame (&optional arg) | ||
45 | "Save window configuration and close the frame. | ||
46 | ARG is passed to `+burly--get-name', which see." | ||
47 | (interactive "P") | ||
48 | (if (not (frame-parameter nil 'client)) | ||
49 | (when (yes-or-no-p "Sure you want to quit? ") | ||
50 | (save-buffers-kill-emacs)) | ||
51 | (save-some-buffers t) | ||
52 | (burly-bookmark-windows (+burly--get-name arg)) | ||
53 | (delete-frame nil :force))) | ||
54 | |||
55 | (defun +burly-save-then-close-frame-remembering () | ||
56 | "Save window configurations and close the frame. | ||
57 | The next frame created will restore the window configuration." | ||
58 | (interactive) | ||
59 | (add-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame 90) | ||
60 | (+burly-save-then-close-frame)) | ||
61 | |||
62 | (provide '+burly) | ||
63 | ;;; +burly.el ends here | ||
diff --git a/lisp/+casing.el b/lisp/+casing.el deleted file mode 100644 index c8e9e4d..0000000 --- a/lisp/+casing.el +++ /dev/null | |||
@@ -1,82 +0,0 @@ | |||
1 | ;;; +casing.el --- Word-case-twiddling things -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'thingatpt) | ||
6 | |||
7 | ;;;###autoload | ||
8 | (defun +upcase-dwim (arg) | ||
9 | "Upcase words in the region, or upcase word at point. | ||
10 | If the region is active, this function calls `upcase-region'. | ||
11 | Otherwise, it calls `upcase-word' on the word at point (using | ||
12 | `thingatpt'), and the following ARG - 1 words." | ||
13 | (interactive "*p") | ||
14 | (if (use-region-p) | ||
15 | (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) | ||
16 | (let ((following (1- arg)) | ||
17 | (word-bound (save-excursion | ||
18 | (skip-chars-forward "^[:word:]") | ||
19 | (bounds-of-thing-at-point 'word)))) | ||
20 | (when (and (car word-bound) (cdr word-bound)) | ||
21 | (upcase-region (car word-bound) (cdr word-bound)) | ||
22 | (goto-char (cdr word-bound)) | ||
23 | (upcase-word following))))) | ||
24 | |||
25 | ;;;###autoload | ||
26 | (defun +downcase-dwim (arg) | ||
27 | "Downcase words in the region, or downcase word at point. | ||
28 | If the region is active, this function calls `downcase-region'. | ||
29 | Otherwise, it calls `downcase-word' on the word at point (using | ||
30 | `thingatpt'), and the following ARG - 1 words." | ||
31 | (interactive "*p") | ||
32 | (if (use-region-p) | ||
33 | (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) | ||
34 | (let ((following (1- arg)) | ||
35 | (word-bound (save-excursion | ||
36 | (skip-chars-forward "^[:word:]") | ||
37 | (bounds-of-thing-at-point 'word)))) | ||
38 | (when (and (car word-bound) (cdr word-bound)) | ||
39 | (downcase-region (car word-bound) (cdr word-bound)) | ||
40 | (goto-char (cdr word-bound)) | ||
41 | (downcase-word following))))) | ||
42 | |||
43 | ;;;###autoload | ||
44 | (defun +capitalize-dwim (arg) | ||
45 | "Capitalize words in the region, or capitalize word at point. | ||
46 | If the region is active, this function calls `capitalize-region'. | ||
47 | Otherwise, it calls `capitalize-word' on the word at point (using | ||
48 | `thingatpt'), and the following ARG - 1 words." | ||
49 | (interactive "*p") | ||
50 | (if (use-region-p) | ||
51 | (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p)) | ||
52 | (let ((following (1- arg)) | ||
53 | (word-bound (save-excursion | ||
54 | (skip-chars-forward "^[:word:]") | ||
55 | (bounds-of-thing-at-point 'word)))) | ||
56 | (when (and (car word-bound) (cdr word-bound)) | ||
57 | (capitalize-region (car word-bound) (cdr word-bound)) | ||
58 | (goto-char (cdr word-bound)) | ||
59 | (capitalize-word following))))) | ||
60 | |||
61 | ;; Later on, I'll add repeat maps and stuff in here... | ||
62 | |||
63 | (defvar +casing-map (let ((map (make-sparse-keymap))) | ||
64 | (define-key map "u" #'+upcase-dwim) | ||
65 | (define-key map (kbd "M-u") #'+upcase-dwim) | ||
66 | (define-key map "l" #'+downcase-dwim) | ||
67 | (define-key map (kbd "M-l") #'+downcase-dwim) | ||
68 | (define-key map "c" #'+capitalize-dwim) | ||
69 | (define-key map (kbd "M-c") #'+capitalize-dwim) | ||
70 | map) | ||
71 | "Keymap for case-related twiddling.") | ||
72 | |||
73 | (define-minor-mode +casing-mode | ||
74 | "Enable easy case-twiddling commands." | ||
75 | :lighter " cC" | ||
76 | :global t | ||
77 | :keymap (let ((map (make-sparse-keymap))) | ||
78 | (define-key map (kbd "M-c") +casing-map) | ||
79 | map)) | ||
80 | |||
81 | (provide '+casing) | ||
82 | ;;; +casing.el ends here | ||
diff --git a/lisp/+chicken.el b/lisp/+chicken.el deleted file mode 100644 index 15713f8..0000000 --- a/lisp/+chicken.el +++ /dev/null | |||
@@ -1,34 +0,0 @@ | |||
1 | ;;; +chicken.el --- Chicken Scheme additions -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | ;; Reload [[https://wiki.call-cc.org/eggref/5/awful][awful]] with a keybinding | ||
8 | |||
9 | (defun +chicken-awful-reload () | ||
10 | "Reload awful by visiting /reload." | ||
11 | (interactive) | ||
12 | (save-buffer) | ||
13 | (condition-case e | ||
14 | (url-retrieve-synchronously "http://localhost:8080/reload") | ||
15 | (file-error (progn | ||
16 | (message "Couldn't ping awful's server. Starting...") | ||
17 | (start-process "awful" (generate-new-buffer "*awful*") | ||
18 | "awful" "--development-mode" (buffer-file-name)))) | ||
19 | (t (message "Some awful error occurred!")))) | ||
20 | |||
21 | (defun +chicken-indentation-insinuate () | ||
22 | "Insinuate indentation from | ||
23 | https://wiki.call-cc.org/emacs#tweaking-stock-scheme-mode-indentation." | ||
24 | (defun scheme-module-indent (state indent-point normal-indent) 0) | ||
25 | (put 'module 'scheme-indent-function 'scheme-module-indent) | ||
26 | (put 'and-let* 'scheme-indent-function 1) | ||
27 | (put 'parameterize 'scheme-indent-function 1) | ||
28 | (put 'handle-exceptions 'scheme-indent-function 1) | ||
29 | (put 'when 'scheme-indent-function 1) | ||
30 | (put 'unless 'scheme-indent-function 1) | ||
31 | (put 'match 'scheme-indent-function 1)) | ||
32 | |||
33 | (provide '+chicken) | ||
34 | ;;; +chicken.el ends here | ||
diff --git a/lisp/+circe.el b/lisp/+circe.el deleted file mode 100644 index 382f0ab..0000000 --- a/lisp/+circe.el +++ /dev/null | |||
@@ -1,285 +0,0 @@ | |||
1 | ;;; +circe.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require '+util) | ||
6 | (require 'circe) | ||
7 | |||
8 | (defgroup +circe nil | ||
9 | "Extra customizations for Circe." | ||
10 | :group 'circe) | ||
11 | |||
12 | (defcustom +circe-left-margin 16 | ||
13 | "The size of the margin on the left." | ||
14 | :type 'integer) | ||
15 | |||
16 | (defcustom +circe-network-inhibit-autoconnect nil | ||
17 | "Servers to inhibit autoconnecting from `circe-network-options'." | ||
18 | :type '(repeat string)) | ||
19 | |||
20 | ;;; Connecting to IRC | ||
21 | |||
22 | ;;;###autoload | ||
23 | (defun +irc () | ||
24 | "Connect to all IRC networks in `circe-network-options'." | ||
25 | (interactive) | ||
26 | (dolist (network (mapcar 'car circe-network-options)) | ||
27 | (unless (member network +circe-network-inhibit-autoconnect) | ||
28 | (+circe-maybe-connect network)))) | ||
29 | |||
30 | (defun +circe-network-connected-p (network) | ||
31 | "Return t if connected to NETWORK, nil otherwise." | ||
32 | (catch 'return | ||
33 | (dolist (buffer (circe-server-buffers)) | ||
34 | (with-current-buffer buffer | ||
35 | (when (string= network circe-server-network) | ||
36 | (throw 'return t)))))) | ||
37 | |||
38 | (defun +circe-maybe-connect (network) | ||
39 | "Connect to NETWORK, asking for confirmation to reconnect." | ||
40 | (interactive ("sNetwork: ")) | ||
41 | (when (or (not (+circe-network-connected-p network)) | ||
42 | (yes-or-no-p (format "Already connected to %s, reconnect? " | ||
43 | network))) | ||
44 | (circe network))) | ||
45 | |||
46 | ;;; Channel information | ||
47 | |||
48 | (defvar-local +circe-current-topic "" | ||
49 | "Cached topic of the buffer's channel.") | ||
50 | |||
51 | (defun +circe-current-topic (&optional message) | ||
52 | "Return the topic of the current channel. | ||
53 | When called with optional MESSAGE non-nil, or interactively, also | ||
54 | message the current topic." | ||
55 | (interactive "p") | ||
56 | (let ((topic | ||
57 | (or (save-excursion | ||
58 | (goto-char (point-max)) | ||
59 | (and (re-search-backward | ||
60 | (rx (group "*** " | ||
61 | (or "Topic" "topic" "TOPIC") | ||
62 | (* (not ":")) ": ") | ||
63 | (group (+ nonl))) | ||
64 | nil t) | ||
65 | (buffer-substring-no-properties | ||
66 | (match-beginning 2) (match-end 2)))) | ||
67 | +circe-current-topic))) | ||
68 | (setq +circe-current-topic topic) | ||
69 | (when message | ||
70 | (message "%s" topic)) | ||
71 | topic)) | ||
72 | |||
73 | ;;; Formatting messages | ||
74 | |||
75 | (defun +circe-format-meta (string &optional no-nick) | ||
76 | "Return a format string for `lui-format' for metadata messages. | ||
77 | Include nick unless NO-NICK is non-nil. If NO-NICK is a string, | ||
78 | replace {nick} in the string with {NO-NICK}." | ||
79 | (cond | ||
80 | ((stringp no-nick) | ||
81 | (format "{%1$s:%2$d.%2$ds} *** %3$s" | ||
82 | no-nick (- +circe-left-margin 3) string)) | ||
83 | (no-nick | ||
84 | (format (format "%%%ds *** %s" (- +circe-left-margin 3) string) " ")) | ||
85 | (t | ||
86 | (format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string)))) | ||
87 | |||
88 | (defun +circe-format-meta* (string) | ||
89 | "Return a format string for `lui-format' for metadata messages, /without/ ") | ||
90 | |||
91 | (defmacro +lui-make-formatting-list-rx (char) | ||
92 | "Make a formatting regex for CHAR delimiters. | ||
93 | For entry into `lui-formatting-list'." | ||
94 | `(rx (or bol whitespace) | ||
95 | (group ,char (+? (not (any whitespace ,char))) ,char) | ||
96 | (or eol whitespace))) | ||
97 | |||
98 | ;;; Hooks & Advice | ||
99 | |||
100 | (defun +circe-chat@set-prompt () | ||
101 | "Set the prompt to the (shortened) buffer name." | ||
102 | (interactive) | ||
103 | (lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin | ||
104 | :after " > " | ||
105 | :ellipsis "~" | ||
106 | :alignment 'right)))) | ||
107 | |||
108 | (defun +circe-kill-buffer (&rest _) | ||
109 | "Kill a circe buffer without confirmation, and after a delay." | ||
110 | (let ((circe-channel-killed-confirmation) | ||
111 | (circe-server-killed-confirmation)) | ||
112 | (when (derived-mode-p 'lui-mode) ; don't spuriously kill | ||
113 | (ignore-errors | ||
114 | (kill-buffer))))) | ||
115 | |||
116 | (defun +circe-quit@kill-buffer (&rest _) | ||
117 | "ADVICE: kill all buffers of a server after `circe-command-QUIT'." | ||
118 | (with-circe-server-buffer | ||
119 | (dolist (buf (circe-server-buffers)) | ||
120 | (with-current-buffer buf | ||
121 | (+circe-kill-buffer))) | ||
122 | (+circe-kill-buffer))) | ||
123 | |||
124 | (defun +circe-gquit@kill-buffer (&rest _) | ||
125 | "ADVICE: kill all Circe buffers after `circe-command-GQUIT'." | ||
126 | (let ((circe-channel-killed-confirmation) | ||
127 | (circe-server-killed-confirmation)) | ||
128 | (dolist (buf (circe-server-buffers)) | ||
129 | (with-current-buffer buf | ||
130 | (+circe-quit@kill-buffer))))) | ||
131 | |||
132 | (defun +circe-quit-all@kill-emacs () | ||
133 | "Quit all circe buffers when killing Emacs." | ||
134 | (ignore-errors | ||
135 | (advice-remove 'circe-command-GQUIT | ||
136 | 'circe-gquit@kill-buffer) | ||
137 | (circe-command-GQUIT "Quitting Emacs, bye!"))) | ||
138 | |||
139 | ;;; Patches | ||
140 | |||
141 | (require 'el-patch) | ||
142 | |||
143 | (el-patch-feature circe) | ||
144 | (defvar +circe-server-buffer-action 'pop-to-buffer-same-window | ||
145 | "What to do with `circe-server' buffers when created.") | ||
146 | |||
147 | (el-patch-defun circe (network-or-server &rest server-options) | ||
148 | "Connect to IRC. | ||
149 | |||
150 | Connect to the given network specified by NETWORK-OR-SERVER. | ||
151 | |||
152 | When this function is called, it collects options from the | ||
153 | SERVER-OPTIONS argument, the user variable | ||
154 | `circe-network-options', and the defaults found in | ||
155 | `circe-network-defaults', in this order. | ||
156 | |||
157 | If NETWORK-OR-SERVER is not found in any of these variables, the | ||
158 | argument is assumed to be the host name for the server, and all | ||
159 | relevant settings must be passed via SERVER-OPTIONS. | ||
160 | |||
161 | All SERVER-OPTIONS are treated as variables by getting the string | ||
162 | \"circe-\" prepended to their name. This variable is then set | ||
163 | locally in the server buffer. | ||
164 | |||
165 | See `circe-network-options' for a list of common options." | ||
166 | (interactive (circe--read-network-and-options)) | ||
167 | (let* ((options (circe--server-get-network-options network-or-server | ||
168 | server-options)) | ||
169 | (buffer (circe--server-generate-buffer options))) | ||
170 | (with-current-buffer buffer | ||
171 | (circe-server-mode) | ||
172 | (circe--server-set-variables options) | ||
173 | (circe-reconnect)) | ||
174 | (el-patch-swap (pop-to-buffer-same-window buffer) | ||
175 | (funcall +circe-server-buffer-action buffer)))) | ||
176 | |||
177 | ;;; Chat commands | ||
178 | |||
179 | (defun circe-command-SLAP (nick) | ||
180 | "Slap NICK around a bit with a large trout." | ||
181 | (interactive (list (completing-read "Nick to slap: " | ||
182 | (circe-channel-nicks) | ||
183 | nil t nil))) | ||
184 | (circe-command-ME (format "slaps %s about a bit with a large trout" nick))) | ||
185 | |||
186 | ;;; Filtering functions --- XXX: These don't work right. | ||
187 | ;; Set `lui-input-function' to `+lui-filter', then add the filters you want to | ||
188 | ;; `circe-channel-mode-hook'. | ||
189 | |||
190 | (defvar +lui-filters nil | ||
191 | "Stack of input functions to apply. | ||
192 | This is an alist with cells of the structure (TAG . FN), so we | ||
193 | can easily remove elements.") | ||
194 | (make-variable-buffer-local '+lui-filters) | ||
195 | |||
196 | (defun +lui-filter (text &optional fn-alist) | ||
197 | (let ((fs (nreverse (purecopy (or fn-alist +lui-filters))))) | ||
198 | (while fs | ||
199 | (setq text (funcall (cdr (pop fs)) text))) | ||
200 | (circe--input text))) | ||
201 | |||
202 | (defmacro +circe-define-filter (name docstring &rest body) | ||
203 | "Define a filter for circe-inputted text." | ||
204 | (declare (doc-string 2) | ||
205 | (indent 1)) | ||
206 | (let (plist) | ||
207 | (while (keywordp (car-safe body)) | ||
208 | (push (pop body) plist) | ||
209 | (push (pop body) plist)) | ||
210 | ;; Return value | ||
211 | `(define-minor-mode ,name | ||
212 | ,docstring | ||
213 | ,@(nreverse plist) | ||
214 | (when (derived-mode-p 'circe-chat-mode) | ||
215 | (if ,name | ||
216 | (push '(,name . (lambda (it) ,@body)) +lui-filters) | ||
217 | (setq +lui-filters | ||
218 | (assoc-delete-all ',name +lui-filters))))))) | ||
219 | |||
220 | ;; CAPPY HOUR! (Pure idiocy) | ||
221 | |||
222 | (+circe-define-filter +circe-cappy-hour-mode | ||
223 | "ENABLE CAPPY HOUR IN CIRCE!" | ||
224 | :lighter " CAPPY HOUR" | ||
225 | (upcase it)) | ||
226 | |||
227 | ;; URL Shortener | ||
228 | |||
229 | (+circe-define-filter +circe-shorten-url-mode | ||
230 | "Shorten long urls when chatting." | ||
231 | :lighter " c0x0" | ||
232 | (+circe-0x0-shorten-urls it)) | ||
233 | |||
234 | (defvar +circe-0x0-max-length 20 | ||
235 | "Maximum length of URLs before using a shortener.") | ||
236 | |||
237 | (defun +circe-0x0-shorten-urls (text) | ||
238 | "Find urls in TEXT and shorten them using `0x0'." | ||
239 | (require '0x0) | ||
240 | (require 'browse-url) | ||
241 | (let ((case-fold-search t)) | ||
242 | (replace-regexp-in-string | ||
243 | browse-url-button-regexp | ||
244 | (lambda (match) | ||
245 | (if (> (length match) +circe-0x0-max-length) | ||
246 | (+with-message (format "Shortening URL: %s" match) | ||
247 | (0x0-shorten-uri (0x0--choose-server) | ||
248 | (substring-no-properties match))) | ||
249 | match)) | ||
250 | text))) | ||
251 | |||
252 | (defun +circe-shorten-urls-all () | ||
253 | "Turn on `+circe-shorten-url-mode' in all chat buffers." | ||
254 | (interactive) | ||
255 | (+mapc-some-buffers | ||
256 | (lambda () (+circe-shorten-url-mode +1)) | ||
257 | (lambda (buf) | ||
258 | (derived-mode-p 'circe-chat-mode)))) | ||
259 | |||
260 | ;; Temperature conversion | ||
261 | |||
262 | (+circe-define-filter +circe-F/C-mode | ||
263 | "Convert degF to degF/degC for international chats." | ||
264 | :lighter " F/C" | ||
265 | (str-F/C it)) | ||
266 | |||
267 | (defun fahrenheit-to-celsius (degf) | ||
268 | "Convert DEGF to Celsius." | ||
269 | (round (* (/ 5.0 9.0) (- degf 32)))) | ||
270 | |||
271 | (defun celsius-to-fahrenheit (degc) | ||
272 | "Convert DEGC to Fahrenheit." | ||
273 | (round (+ 32 (* (/ 9.0 5.0) degc)))) | ||
274 | |||
275 | (defun str-F/C (text) | ||
276 | (replace-regexp-in-string "[^.]\\([[:digit:]]+\\(?:\\.[[:digit:]]+\\)?[fF]\\)" | ||
277 | (lambda (match) | ||
278 | (format "%s/%dC" match | ||
279 | (fahrenheit-to-celsius | ||
280 | (string-to-number match)))) | ||
281 | text | ||
282 | nil 1)) | ||
283 | |||
284 | (provide '+circe) | ||
285 | ;;; +circe.el ends here | ||
diff --git a/lisp/+compat.el b/lisp/+compat.el deleted file mode 100644 index 286d5da..0000000 --- a/lisp/+compat.el +++ /dev/null | |||
@@ -1,64 +0,0 @@ | |||
1 | ;;; +compat.el --- Thin backward-compatibility shim -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; I use different versionso of Emacs. Sometimes I have to copy-paste functions | ||
6 | ;; from newer Emacs to make my customizations work. This is that file. | ||
7 | |||
8 | ;; This is probably ill-advised. | ||
9 | |||
10 | ;;; Code: | ||
11 | |||
12 | ;;; Load stuff in +compat/ subdirectory | ||
13 | (dolist (file (directory-files (locate-user-emacs-file "lisp/+compat") :full "\\.el\\'")) | ||
14 | (load file :noerror)) | ||
15 | |||
16 | ;;; Only define things if not already defined | ||
17 | (defmacro +compat-defun (name &rest args) | ||
18 | `(if (fboundp ',name) | ||
19 | (message "+compat: `%s' already bound." ',name) | ||
20 | (defun ,name ,@args))) | ||
21 | |||
22 | (defmacro +compat-defmacro (name &rest args) | ||
23 | `(if (fboundp ',name) | ||
24 | (message "+compat: `%s' already bound." ',name) | ||
25 | (defmacro ,name ,@args))) | ||
26 | |||
27 | ;;; Single functions | ||
28 | |||
29 | (+compat-defmacro dlet (binders &rest body) | ||
30 | "Like `let' but using dynamic scoping." | ||
31 | (declare (indent 1) (debug let)) | ||
32 | ;; (defvar FOO) only affects the current scope, but in order for | ||
33 | ;; this not to affect code after the main `let' we need to create a new scope, | ||
34 | ;; which is what the surrounding `let' is for. | ||
35 | ;; FIXME: (let () ...) currently doesn't actually create a new scope, | ||
36 | ;; which is why we use (let (_) ...). | ||
37 | `(let (_) | ||
38 | ,@(mapcar (lambda (binder) | ||
39 | `(defvar ,(if (consp binder) (car binder) binder))) | ||
40 | binders) | ||
41 | (let ,binders ,@body))) | ||
42 | |||
43 | ;; https://git.savannah.gnu.org/cgit/emacs.git/diff/?id=772b189143453745a8e014e21d4b6b78f855bba3 | ||
44 | (+compat-defun rename-visited-file (new-location) | ||
45 | "Rename the file visited by the current buffer to NEW-LOCATION. | ||
46 | This command also sets the visited file name. If the buffer | ||
47 | isn't visiting any file, that's all it does. | ||
48 | |||
49 | Interactively, this prompts for NEW-LOCATION." | ||
50 | (interactive | ||
51 | (list (if buffer-file-name | ||
52 | (read-file-name "Rename visited file to: ") | ||
53 | (read-file-name "Set visited file name: " | ||
54 | default-directory | ||
55 | (expand-file-name | ||
56 | (file-name-nondirectory (buffer-name)) | ||
57 | default-directory))))) | ||
58 | (when (and buffer-file-name | ||
59 | (file-exists-p buffer-file-name)) | ||
60 | (rename-file buffer-file-name new-location)) | ||
61 | (set-visited-file-name new-location nil t)) | ||
62 | |||
63 | (provide '+compat) | ||
64 | ;;; +compat.el ends here | ||
diff --git a/lisp/+compile.el b/lisp/+compile.el deleted file mode 100644 index a69db7d..0000000 --- a/lisp/+compile.el +++ /dev/null | |||
@@ -1,20 +0,0 @@ | |||
1 | ;;; +compile.el --- Extras for compile -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (defcustom +compile-function nil | ||
8 | "Function to run to \"compile\" a buffer." | ||
9 | :type 'function | ||
10 | :local t | ||
11 | :risky nil) | ||
12 | |||
13 | (defun +compile-dispatch (&optional arg) | ||
14 | "Run `+compile-function', if bound, or `compile'. | ||
15 | Any prefix ARG is passed to that function." | ||
16 | (interactive "P") | ||
17 | (call-interactively (or +compile-function #'compile))) | ||
18 | |||
19 | (provide '+compile) | ||
20 | ;;; +compile.el ends here | ||
diff --git a/lisp/+consult.el b/lisp/+consult.el deleted file mode 100644 index 21c2565..0000000 --- a/lisp/+consult.el +++ /dev/null | |||
@@ -1,47 +0,0 @@ | |||
1 | ;;; +consult.el --- consult additions -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (defun +consult-project-root () | ||
6 | "Return either the current project, or the VC root, of current file." | ||
7 | (if (and (functionp 'project-current) | ||
8 | (project-current)) | ||
9 | (car (project-roots (project-current))) | ||
10 | (vc-root-dir))) | ||
11 | |||
12 | ;;; Cribbed functions | ||
13 | ;; https://github.com/minad/consult/wiki | ||
14 | |||
15 | (defun consult--orderless-regexp-compiler (input type &rest _) | ||
16 | (setq input (orderless-pattern-compiler input)) | ||
17 | (cons | ||
18 | (mapcar (lambda (r) (consult--convert-regexp r type)) input) | ||
19 | (lambda (str) (orderless--highlight input str)))) | ||
20 | |||
21 | (defmacro consult-history-to-modes (map-hook-alist) | ||
22 | (let (defuns) | ||
23 | (dolist (map-hook map-hook-alist) | ||
24 | (let ((map-name (symbol-name (car map-hook))) | ||
25 | (key-defs `(progn (define-key | ||
26 | ,(car map-hook) | ||
27 | (kbd "M-r") | ||
28 | (function consult-history)) | ||
29 | (define-key ,(car map-hook) | ||
30 | (kbd "M-s") nil)))) | ||
31 | (push (if (cdr map-hook) | ||
32 | `(add-hook ',(cdr map-hook) | ||
33 | (defun | ||
34 | ,(intern (concat map-name | ||
35 | "@consult-history-bind")) | ||
36 | nil | ||
37 | ,(concat | ||
38 | "Bind `consult-history' to M-r in " | ||
39 | map-name ".\n" | ||
40 | "Defined by `consult-history-to-modes'.") | ||
41 | ,key-defs)) | ||
42 | key-defs) | ||
43 | defuns))) | ||
44 | `(progn ,@ (nreverse defuns)))) | ||
45 | |||
46 | (provide '+consult) | ||
47 | ;;; +consult.el ends here | ||
diff --git a/lisp/+crux.el b/lisp/+crux.el deleted file mode 100644 index c55a0b9..0000000 --- a/lisp/+crux.el +++ /dev/null | |||
@@ -1,58 +0,0 @@ | |||
1 | ;;; +crux.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'crux) | ||
6 | |||
7 | (defgroup +crux nil | ||
8 | "Extra crux customizations." | ||
9 | :group 'crux | ||
10 | :prefix "+crux-") | ||
11 | |||
12 | (defun +crux-kill-ring-save (begin end arg) | ||
13 | "Copy region to the kill-ring, possibly indenting it first. | ||
14 | Copy from BEGIN to END using `kill-ring-save' if no argument was | ||
15 | passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if | ||
16 | one was." | ||
17 | (interactive "r\nP") | ||
18 | (call-interactively (if arg | ||
19 | #'crux-indent-rigidly-and-copy-to-clipboard | ||
20 | #'kill-ring-save)) | ||
21 | (pulse-momentary-highlight-region begin end)) | ||
22 | |||
23 | (defcustom +crux-default-date-format "%c" | ||
24 | "Default date format to use for `+crux-insert-date-or-time'. | ||
25 | Should be a format parsable by `format-time-string'." | ||
26 | :type 'string) | ||
27 | |||
28 | (defcustom +crux-alternate-date-format "%FT%T%z" | ||
29 | "Alternate date format to use for `+crux-insert-date-or-time'. | ||
30 | Should be a format parsable by `format-time-string'." | ||
31 | :type 'string) | ||
32 | |||
33 | (defun +crux-insert-date-or-time (arg) | ||
34 | "Insert current date or time. | ||
35 | Called without a prefix ARG, insert the time formatted by | ||
36 | `+crux-default-date-format'. When called with \\[universal-argument], | ||
37 | format the time with `+crux-alternate-date-format'. Otherwise, | ||
38 | prompt for the time format." | ||
39 | (interactive "*P") | ||
40 | (let ((time (current-time))) | ||
41 | (insert (cond | ||
42 | ((null arg) (format-time-string +crux-default-date-format time)) | ||
43 | ((eq (car-safe arg) 4) | ||
44 | (format-time-string +crux-alternate-date-format time)) | ||
45 | (t (format-time-string (read-string "Time Format: ") time)))))) | ||
46 | |||
47 | (defun +crux-kill-and-join-forward (&optional arg) | ||
48 | "If at end of line, join with following; else (visual)-kill line. | ||
49 | In `visual-line-mode', runs command `kill-visual-line'; in other | ||
50 | modes, runs command `kill-line'. Passes ARG to command when | ||
51 | provided. Deletes whitespace at join." | ||
52 | (interactive "P") | ||
53 | (if (and (eolp) (not (bolp))) | ||
54 | (delete-indentation 1) | ||
55 | (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) | ||
56 | |||
57 | (provide '+crux) | ||
58 | ;;; +crux.el ends here | ||
diff --git a/lisp/+cus-edit.el b/lisp/+cus-edit.el deleted file mode 100644 index a67279c..0000000 --- a/lisp/+cus-edit.el +++ /dev/null | |||
@@ -1,80 +0,0 @@ | |||
1 | ;;; +cus-edit.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; The naming convention for this library, called "cus-edit.el" on the | ||
6 | ;; filesystem, is all over the damn place. Whatever. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (require 'cl-lib) | ||
11 | (require 'seq) | ||
12 | |||
13 | (defgroup +customize nil | ||
14 | "Extra customize customizations." | ||
15 | :prefix "+customize-" | ||
16 | :group 'customize) | ||
17 | |||
18 | (defcustom +cus-edit-imenu-generic-expression ; thanks u/oantolin! | ||
19 | `(("Faces" ,(rx (seq bol | ||
20 | (or "Show" "Hide") " " | ||
21 | (group (zero-or-more nonl)) | ||
22 | " face: [sample]")) | ||
23 | 1) | ||
24 | ("Variables" ,(rx (seq bol | ||
25 | (or "Show Value" "Hide") " " | ||
26 | (group (zero-or-more | ||
27 | (not (any "\n:")))))) | ||
28 | 1)) | ||
29 | "Show faces and variables in `imenu' in a `customize' buffer." | ||
30 | :type 'sexp ; This is .. over-simplified. | ||
31 | ) | ||
32 | |||
33 | (defcustom +custom-variable-allowlist nil | ||
34 | "Variables to allow changing while loading the Custom file.") | ||
35 | |||
36 | (defcustom +custom-after-load-hook nil | ||
37 | "Functions to run after loading the custom file.") | ||
38 | |||
39 | (defun +custom-load-ignoring-most-customizations (&optional | ||
40 | error | ||
41 | nomessage | ||
42 | nosuffix | ||
43 | must-suffix) | ||
44 | "Load `custom-file', ignoring most customizations. | ||
45 | Ignore all faces, and only load variables in | ||
46 | `+customize-variable-allowlist'. All the optional | ||
47 | variables---ERROR, NOMESSAGE, NOSUFFIX, MUST-SUFFIX---are | ||
48 | passed on to `load'. | ||
49 | |||
50 | NOTE: ERROR is the opposite of its value in `load' -- meaning | ||
51 | that this function by default does /not/ error, but will if you | ||
52 | pass t to it." | ||
53 | (cl-letf (((symbol-function 'custom-set-faces) 'ignore) | ||
54 | ((symbol-function 'custom-set-variables) | ||
55 | (lambda (&rest args) | ||
56 | (apply #'custom-theme-set-variables 'user | ||
57 | (seq-filter (lambda (el) | ||
58 | (memq (car el) | ||
59 | +custom-variable-allowlist)) | ||
60 | args))))) | ||
61 | (load custom-file (not error) nomessage nosuffix must-suffix)) | ||
62 | (run-hooks '+custom-after-load-hook)) | ||
63 | |||
64 | (defun +cus-edit-expand-widgets (&rest _) | ||
65 | "Expand descriptions in `Custom-mode' buffers." | ||
66 | (interactive) | ||
67 | ;; "More/Hide" widgets (thanks alphapapa!) | ||
68 | (widget-map-buttons (lambda (widget _) | ||
69 | (pcase (widget-get widget :off) | ||
70 | ("More" (widget-apply-action widget))) | ||
71 | nil)) | ||
72 | ;; "Show Value" widgets (the little triangles) | ||
73 | (widget-map-buttons (lambda (widget _) | ||
74 | (pcase (widget-get widget :off) | ||
75 | ("Show Value" | ||
76 | (widget-apply-action widget))) | ||
77 | nil))) | ||
78 | |||
79 | (provide '+cus-edit) | ||
80 | ;;; +cus-edit.el ends here | ||
diff --git a/lisp/+dired.el b/lisp/+dired.el deleted file mode 100644 index 2e42c19..0000000 --- a/lisp/+dired.el +++ /dev/null | |||
@@ -1,28 +0,0 @@ | |||
1 | ;;; +dired.el -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (with-eval-after-load 'vertico | ||
6 | (defun +dired-goto-file (file) | ||
7 | "ADVICE for `dired-goto-file' to make RET call `vertico-exit'." | ||
8 | (interactive ; stolen from `dired-goto-file' | ||
9 | (prog1 | ||
10 | (list (dlet ((vertico-map (copy-keymap vertico-map))) | ||
11 | (define-key vertico-map (kbd "RET") #'vertico-exit) | ||
12 | (expand-file-name (read-file-name "Goto file: " | ||
13 | (dired-current-directory))))) | ||
14 | (push-mark))) | ||
15 | (dired-goto-file file))) | ||
16 | |||
17 | ;;; [[https://www.reddit.com/r/emacs/comments/u2lf9t/weekly_tips_tricks_c_thread/i4n9aoa/?context=3][Dim files in .gitignore]] | ||
18 | |||
19 | (defun +dired-dim-git-ignores () | ||
20 | "Dim out .gitignore contents" | ||
21 | (require 'vc) | ||
22 | (when-let ((ignores (vc-default-ignore-completion-table 'git ".gitignore")) | ||
23 | (exts (make-local-variable 'completion-ignored-extensions))) | ||
24 | (dolist (item ignores) | ||
25 | (add-to-list exts item)))) | ||
26 | |||
27 | (provide '+dired) | ||
28 | ;;; +dired.el ends here | ||
diff --git a/lisp/+ecomplete.el b/lisp/+ecomplete.el deleted file mode 100644 index b1392cf..0000000 --- a/lisp/+ecomplete.el +++ /dev/null | |||
@@ -1,45 +0,0 @@ | |||
1 | ;;; +ecomplete.el --- ecomplete extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; see [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/ecomplete-extras.el][oantolin's config]] | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'ecomplete) | ||
10 | |||
11 | (defun +ecomplete--name+address (email) | ||
12 | "Return a pair of the name and address for an EMAIL." | ||
13 | (let (name) | ||
14 | (when (string-match "^\\(?:\\(.*\\) \\)?<\\(.*\\)>$" email) | ||
15 | (setq name (match-string 1 email) | ||
16 | email (match-string 2 email))) | ||
17 | (cons name email))) | ||
18 | |||
19 | (defun +ecomplete-add-email (email) | ||
20 | "Add email address to ecomplete's database." | ||
21 | (interactive "sEmail address: ") | ||
22 | (pcase-let ((`(,name . ,email) (+ecomplete--name+address email))) | ||
23 | (unless name (setq name (read-string "Name: "))) | ||
24 | (ecomplete-add-item | ||
25 | 'mail email | ||
26 | (format (cond ((equal name "") "%s%s") | ||
27 | ((string-match-p "^\\(?:[A-Za-z0-9 ]*\\|\".*\"\\)$" name) | ||
28 | "%s <%s>") | ||
29 | (t "\"%s\" <%s>")) | ||
30 | name email)) | ||
31 | (ecomplete-save))) | ||
32 | |||
33 | (defun +ecomplete-remove-email (email) | ||
34 | "Remove email address from ecomplete's database." | ||
35 | (interactive | ||
36 | (list (completing-read "Email address: " | ||
37 | (ecomplete-completion-table 'mail)))) | ||
38 | (when-let ((email (cdr (+ecomplete--name+address email))) | ||
39 | (entry (ecomplete-get-item 'mail email))) | ||
40 | (setf (cdr (assq 'mail ecomplete-database)) | ||
41 | (remove entry (cdr (assq 'mail ecomplete-database)))) | ||
42 | (ecomplete-save))) | ||
43 | |||
44 | (provide '+ecomplete) | ||
45 | ;;; +ecomplete.el ends here | ||
diff --git a/lisp/+elfeed.el b/lisp/+elfeed.el deleted file mode 100644 index c3e5301..0000000 --- a/lisp/+elfeed.el +++ /dev/null | |||
@@ -1,185 +0,0 @@ | |||
1 | ;;; +elfeed.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'elfeed) | ||
6 | |||
7 | ;; https://karthinks.com/software/lazy-elfeed/ | ||
8 | (defun +elfeed-scroll-up-command (&optional arg) | ||
9 | "Scroll up or go to next feed item in Elfeed" | ||
10 | (interactive "^P") | ||
11 | (let ((scroll-error-top-bottom nil)) | ||
12 | (condition-case-unless-debug nil | ||
13 | (scroll-up-command arg) | ||
14 | (error (elfeed-show-next))))) | ||
15 | |||
16 | (defun +elfeed-scroll-down-command (&optional arg) | ||
17 | "Scroll up or go to next feed item in Elfeed" | ||
18 | (interactive "^P") | ||
19 | (let ((scroll-error-top-bottom nil)) | ||
20 | (condition-case-unless-debug nil | ||
21 | (scroll-down-command arg) | ||
22 | (error (elfeed-show-prev))))) | ||
23 | |||
24 | (defun +elfeed-search-browse-generic () | ||
25 | "Browse a url with `browse-url-generic-browser'." | ||
26 | (interactive) | ||
27 | (elfeed-search-browse-url t)) | ||
28 | |||
29 | (defun +elfeed-show-browse-generic () | ||
30 | "Browse a url with `browse-url-generic-browser'." | ||
31 | (interactive) | ||
32 | (elfeed-show-visit t)) | ||
33 | |||
34 | (defun +elfeed-show-mark-read-and-advance () | ||
35 | "Mark an item as read and advance to the next item. | ||
36 | If multiple items are selected, don't advance." | ||
37 | (interactive) | ||
38 | (call-interactively #'elfeed-search-untag-all-unread) | ||
39 | (unless (region-active-p) | ||
40 | (call-interactively #'next-line))) | ||
41 | |||
42 | ;;; Fetch feeds async | ||
43 | ;; https://github.com/skeeto/elfeed/issues/367 | ||
44 | |||
45 | (defun +elfeed--update-message () | ||
46 | (message "[Elfeed] Update in progress") | ||
47 | 'ignore) | ||
48 | |||
49 | (defvar +elfeed--update-running-p nil "Whether an update is currently running.") | ||
50 | (defvar +elfeed--update-count 0 "How many times `+elfeed-update-command' has run.") | ||
51 | (defcustom +elfeed-update-niceness 15 | ||
52 | "How \"nice\" `+elfeed-update-command' should be." | ||
53 | :type 'integer | ||
54 | :group 'elfeed) | ||
55 | |||
56 | (defcustom +elfeed-update-lockfile | ||
57 | (expand-file-name "+elfeed-update-lock" (temporary-file-directory)) | ||
58 | "The file to ") | ||
59 | |||
60 | (defun +elfeed-update-command () | ||
61 | (interactive) | ||
62 | (unless (or +elfeed--update-running-p | ||
63 | (derived-mode-p 'elfeed-show-mode 'elfeed-search-mode)) | ||
64 | (let ((script (expand-file-name "/tmp/elfeed-update.el")) | ||
65 | (update-message-format "[Elfeed] Background update: %s")) | ||
66 | (setq +elfeed--update-running-p t) | ||
67 | (elfeed-db-save) | ||
68 | (advice-add 'elfeed :override #'+elfeed--update-message) | ||
69 | (ignore-errors (kill-buffer "*elfeed-search*")) | ||
70 | (ignore-errors (kill-buffer "*elfeed-log*")) | ||
71 | (elfeed-db-unload) | ||
72 | (make-directory (file-name-directory script) :parents) | ||
73 | (with-temp-buffer | ||
74 | (insert | ||
75 | (let ((print-level nil) | ||
76 | (print-length nil)) | ||
77 | (prin1-to-string ;; Print the following s-expression to a string | ||
78 | `(progn | ||
79 | ;; Set up the environment | ||
80 | (setq lexical-binding t) | ||
81 | (load (locate-user-emacs-file "early-init")) | ||
82 | (dolist (pkg '(elfeed elfeed-org)) | ||
83 | (straight-use-package pkg) | ||
84 | (require pkg)) | ||
85 | ;; Copy variables from current environment | ||
86 | (progn | ||
87 | ,@(cl-loop for copy-var in '(rmh-elfeed-org-files | ||
88 | elfeed-db-directory | ||
89 | elfeed-curl-program-name | ||
90 | elfeed-use-curl | ||
91 | elfeed-curl-extra-arguments | ||
92 | elfeed-enclosure-default-dir) | ||
93 | collect `(progn (message "%S = %S" ',copy-var ',(symbol-value copy-var)) | ||
94 | (setq ,copy-var ',(symbol-value copy-var))))) | ||
95 | ;; Define new variables for this environment | ||
96 | (progn | ||
97 | ,@(cl-loop for (new-var . new-val) in '((elfeed-curl-max-connections . 4)) | ||
98 | collect `(progn (message "%S = %S" ',new-var ',new-val) | ||
99 | (setq ,new-var ',new-val)))) | ||
100 | ;; Redefine `elfeed-log' to log everything | ||
101 | (defun elfeed-log (level fmt &rest objects) | ||
102 | (princ (format "[%s] [%s]: %s\n" | ||
103 | (format-time-string "%F %T") | ||
104 | level | ||
105 | (apply #'format fmt objects)))) | ||
106 | ;; Run elfeed | ||
107 | (elfeed-org) | ||
108 | (elfeed) | ||
109 | (elfeed-db-load) | ||
110 | (elfeed-update) | ||
111 | ;; Wait for `elfeed-update' to finish | ||
112 | (let ((q<5-count 0)) | ||
113 | (while (and (> (elfeed-queue-count-total) 0) | ||
114 | (< q<5-count 5)) | ||
115 | (sleep-for 5) | ||
116 | (message "Elfeed queue count total: %s" (elfeed-queue-count-total)) | ||
117 | (when (< (elfeed-queue-count-total) 5) | ||
118 | (cl-incf q<5-count)) | ||
119 | (accept-process-output))) | ||
120 | ;; Garbage collect and save the database | ||
121 | (elfeed-db-gc) | ||
122 | (elfeed-db-save) | ||
123 | (princ (format ,update-message-format "done.")))))) | ||
124 | (write-file script)) | ||
125 | (chmod script #o777) | ||
126 | (message update-message-format "start") | ||
127 | (set-process-sentinel (start-process-shell-command | ||
128 | "Elfeed" "*+elfeed-update-background*" | ||
129 | (format "nice -n %d %s %s" | ||
130 | +elfeed-update-niceness | ||
131 | "emacs -Q --script" | ||
132 | script)) | ||
133 | (lambda (proc stat) | ||
134 | (advice-remove 'elfeed #'+elfeed--update-message) | ||
135 | (setq +elfeed--update-running-p nil) | ||
136 | (unless (string= stat "killed") | ||
137 | (setq +elfeed--update-count (1+ +elfeed--update-count))) | ||
138 | (message update-message-format (string-trim stat))))))) | ||
139 | |||
140 | (defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.") | ||
141 | (defvar +elfeed--update-first-time 6 "How long to wait for the first time.") | ||
142 | (defvar +elfeed--update-repeat (* 60 15) "How long between updates.") | ||
143 | |||
144 | (defcustom +elfeed-update-proceed-hook nil | ||
145 | "Predicates to query before running `+elfeed-update-command'. | ||
146 | Each hook is passed no arguments." | ||
147 | :type 'hook) | ||
148 | |||
149 | (defun +elfeed-update-command-wrapper () | ||
150 | "Run `+elfeed-update-command', but only sometimes. | ||
151 | If any of the predicates in `+elfeed-update-proceed-hook' return | ||
152 | nil, don't run `+elfeed-update-command'. If they all return | ||
153 | non-nil, proceed." | ||
154 | (when (run-hook-with-args-until-failure '+elfeed-update-proceed-hook) | ||
155 | (+elfeed-update-command))) | ||
156 | |||
157 | (defun +elfeed--cancel-update-timer () | ||
158 | "Cancel `+elfeed--update-timer'." | ||
159 | (unless +elfeed--update-running-p | ||
160 | (ignore-errors (cancel-timer +elfeed--update-timer)) | ||
161 | (setq +elfeed--update-timer nil))) | ||
162 | |||
163 | (defun +elfeed--reinstate-update-timer () | ||
164 | "Reinstate `+elfeed--update-timer'." | ||
165 | ;; First, unload the db | ||
166 | (setq +elfeed--update-timer | ||
167 | (run-at-time +elfeed--update-first-time | ||
168 | +elfeed--update-repeat | ||
169 | #'+elfeed-update-command-wrapper))) | ||
170 | |||
171 | (define-minor-mode +elfeed-update-async-mode | ||
172 | "Minor mode to update elfeed async-style." | ||
173 | :global t | ||
174 | (if +elfeed-update-async-mode | ||
175 | (progn ; enable | ||
176 | (+elfeed--reinstate-update-timer) | ||
177 | (advice-add 'elfeed :before '+elfeed--cancel-update-timer) | ||
178 | (advice-add 'elfeed-search-quit-window :after '+elfeed--reinstate-update-timer)) | ||
179 | (progn ; disable | ||
180 | (advice-remove 'elfeed '+elfeed--cancel-update-timer) | ||
181 | (advice-remove 'elfeed-search-quit-window '+elfeed--reinstate-update-timer) | ||
182 | (+elfeed--cancel-update-timer)))) | ||
183 | |||
184 | (provide '+elfeed) | ||
185 | ;;; +elfeed.el ends here | ||
diff --git a/lisp/+elisp.el b/lisp/+elisp.el deleted file mode 100644 index 3eafbf3..0000000 --- a/lisp/+elisp.el +++ /dev/null | |||
@@ -1,18 +0,0 @@ | |||
1 | ;;; +elisp.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (defun +elisp-eval-region-or-buffer () | ||
6 | (interactive) | ||
7 | (if (region-active-p) | ||
8 | (eval-region (region-beginning) (region-end)) | ||
9 | (+eval-region@pulse (lambda (_ _) (eval-buffer)) (point-min) (point-max)))) | ||
10 | |||
11 | ;; Should I move this to `+pulse' ? | ||
12 | (defun +eval-region@pulse (advised beg end &rest args) | ||
13 | "ADVICE to pulse an eval'd region." | ||
14 | (apply advised beg end args) | ||
15 | (pulse-momentary-highlight-region beg end)) | ||
16 | |||
17 | (provide '+elisp) | ||
18 | ;;; +elisp.el ends here | ||
diff --git a/lisp/+emacs.el b/lisp/+emacs.el deleted file mode 100644 index 9158b62..0000000 --- a/lisp/+emacs.el +++ /dev/null | |||
@@ -1,434 +0,0 @@ | |||
1 | ;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; I find myself copy-pasting a lot of "boilerplate" type code when | ||
6 | ;; bankrupting my Emacs config and starting afresh. Instead of doing | ||
7 | ;; that, I'm putting it here, where it'll be easier to include in my | ||
8 | ;; config. | ||
9 | |||
10 | ;; Of course, some might say I could just ... stop bankrupting my | ||
11 | ;; Emacs. But like, why would I want to? | ||
12 | |||
13 | ;; Other notable packages include | ||
14 | ;; - https://git.sr.ht/~technomancy/better-defaults/ | ||
15 | ;; - https://github.com/susam/emfy | ||
16 | |||
17 | ;;; Code: | ||
18 | |||
19 | (require 'early-init (locate-user-emacs-file "early-init.el")) | ||
20 | |||
21 | (defun +set-major-mode-from-buffer-name (&optional buf) | ||
22 | "Set the major mode for BUF from the buffer's name. | ||
23 | Do this only if the buffer is not visiting a file." | ||
24 | (unless buffer-file-name | ||
25 | (let ((buffer-file-name (buffer-name buf))) | ||
26 | (set-auto-mode)))) | ||
27 | |||
28 | |||
29 | ;;; General settings | ||
30 | |||
31 | (setq-default | ||
32 | apropos-do-all t | ||
33 | async-shell-command-buffer 'new-buffer | ||
34 | async-shell-command-display-buffer nil | ||
35 | auto-hscroll-mode 'current-line | ||
36 | auto-revert-verbose t | ||
37 | auto-save-default nil | ||
38 | auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms))) | ||
39 | (".*" ,(.etc "auto-save/") t)) | ||
40 | auto-save-interval 30 | ||
41 | auto-save-list-file-prefix (.etc "auto-save/.saves-" t) | ||
42 | auto-save-timeout 30 | ||
43 | auto-save-visited-interval 5 | ||
44 | auto-window-vscroll nil | ||
45 | backup-by-copying t | ||
46 | backup-directory-alist `((".*" . ,(.etc "backup/" t))) | ||
47 | blink-cursor-blinks 1 | ||
48 | comp-deferred-compilation nil | ||
49 | completion-category-defaults nil | ||
50 | completion-category-overrides '((file (styles . (partial-completion)))) | ||
51 | completion-ignore-case t | ||
52 | completion-styles '(substring partial-completion) | ||
53 | create-lockfiles nil | ||
54 | cursor-in-non-selected-windows 'hollow | ||
55 | cursor-type 'bar | ||
56 | custom-file (.etc "custom.el") | ||
57 | delete-old-versions t | ||
58 | echo-keystrokes 0.1 | ||
59 | ediff-window-setup-function 'ediff-setup-windows-plain | ||
60 | eldoc-echo-area-use-multiline-p nil | ||
61 | eldoc-idle-delay 0.1 | ||
62 | enable-recursive-minibuffers t | ||
63 | executable-prefix-env t | ||
64 | fast-but-imprecise-scrolling t | ||
65 | file-name-shadow-properties '(invisible t intangible t) | ||
66 | fill-column 80 | ||
67 | find-file-visit-truename t | ||
68 | frame-resize-pixelwise t | ||
69 | global-auto-revert-non-file-buffers t | ||
70 | global-mark-ring-max 100 | ||
71 | hscroll-margin 1 | ||
72 | hscroll-step 1 | ||
73 | imenu-auto-rescan t | ||
74 | image-use-external-converter (or (executable-find "convert") | ||
75 | (executable-find "gm") | ||
76 | (executable-find "ffmpeg")) | ||
77 | indent-tabs-mode nil | ||
78 | inhibit-startup-screen t | ||
79 | initial-buffer-choice t | ||
80 | kept-new-versions 6 | ||
81 | kept-old-versions 2 | ||
82 | kill-do-not-save-duplicates t | ||
83 | kill-read-only-ok t | ||
84 | kill-ring-max 500 | ||
85 | kmacro-ring-max 20 | ||
86 | load-prefer-newer noninteractive | ||
87 | major-mode '+set-major-mode-from-buffer-name | ||
88 | mark-ring-max 50 | ||
89 | minibuffer-eldef-shorten-default t | ||
90 | minibuffer-prompt-properties (list 'read-only t | ||
91 | 'cursor-intangible t | ||
92 | 'face 'minibuffer-prompt) | ||
93 | mode-require-final-newline 'visit-save | ||
94 | mouse-drag-copy-region t | ||
95 | mouse-wheel-progressive-speed nil | ||
96 | mouse-yank-at-point t | ||
97 | native-comp-async-report-warnings-errors 'silent | ||
98 | native-comp-deferred-compilation nil | ||
99 | read-answer-short t | ||
100 | read-buffer-completion-ignore-case t | ||
101 | ;; read-extended-command-predicate | ||
102 | ;; (when (fboundp | ||
103 | ;; 'command-completion-default-include-p) | ||
104 | ;; 'command-completion-default-include-p) | ||
105 | read-process-output-max (+bytes 1 :mib) ; We’re in the future man. Set that to at least a megabyte | ||
106 | recenter-positions '(top middle bottom) | ||
107 | regexp-search-ring-max 100 | ||
108 | regexp-search-ring-max 200 | ||
109 | save-interprogram-paste-before-kill t | ||
110 | save-some-buffers-default-predicate #'+save-some-buffers-p | ||
111 | scroll-conservatively 101 | ||
112 | scroll-down-aggressively 0.01 | ||
113 | scroll-margin 2 | ||
114 | scroll-preserve-screen-position 1 | ||
115 | scroll-step 1 | ||
116 | scroll-up-aggressively 0.01 | ||
117 | search-ring-max 200 | ||
118 | search-ring-max 200 | ||
119 | sentence-end-double-space t | ||
120 | set-mark-command-repeat-pop t | ||
121 | show-paren-delay 0 | ||
122 | show-paren-style 'parenthesis | ||
123 | show-paren-when-point-in-periphery t | ||
124 | show-paren-when-point-inside-paren t | ||
125 | ;;show-trailing-whitespace t | ||
126 | tab-bar-show 1 | ||
127 | tab-width 8 ; so alignment expecting the default looks right | ||
128 | tramp-backup-directory-alist backup-directory-alist | ||
129 | undo-limit 100000000 ; 10 MB | ||
130 | use-dialog-box nil | ||
131 | use-file-dialog nil | ||
132 | use-short-answers t | ||
133 | vc-follow-symlinks t | ||
134 | vc-make-backup-files t | ||
135 | version-control t | ||
136 | view-read-only t | ||
137 | visible-bell nil | ||
138 | window-resize-pixelwise t | ||
139 | x-select-enable-clipboard t | ||
140 | x-select-enable-primary t | ||
141 | yank-pop-change-selection t | ||
142 | ) | ||
143 | |||
144 | ;; Programming language offsets. | ||
145 | ;; Set these after the initial block so I can use `tab-width' | ||
146 | (setq-default | ||
147 | c-basic-offset tab-width) | ||
148 | |||
149 | ;; Emacs 28 ships with an option, `use-short-answers', that makes this form | ||
150 | ;; obsolete, but I still use 27 at work. | ||
151 | (when (version< emacs-version "28") | ||
152 | (fset 'yes-or-no-p 'y-or-n-p)) | ||
153 | |||
154 | |||
155 | ;;; Encodings | ||
156 | |||
157 | ;; Allegedly, this is the only one you need... | ||
158 | (set-language-environment "UTF-8") | ||
159 | ;; But I still set all of these, for fun. | ||
160 | (setq-default locale-coding-system 'utf-8-unix | ||
161 | coding-system-for-read 'utf-8-unix | ||
162 | coding-system-for-write 'utf-8-unix | ||
163 | buffer-file-coding-system 'utf-8-unix | ||
164 | default-process-coding-system '(utf-8-unix . utf-8-unix) | ||
165 | x-select-request-type '(UTF8_STRING | ||
166 | COMPOUND_TEXT | ||
167 | TEXT | ||
168 | STRING)) | ||
169 | |||
170 | (set-charset-priority 'unicode) | ||
171 | (prefer-coding-system 'utf-8-unix) | ||
172 | (set-default-coding-systems 'utf-8-unix) | ||
173 | (set-terminal-coding-system 'utf-8-unix) | ||
174 | (set-keyboard-coding-system 'utf-8-unix) | ||
175 | |||
176 | (pcase system-type | ||
177 | ((or 'ms-dos 'windows-nt) | ||
178 | (set-clipboard-coding-system 'utf-16-le) | ||
179 | (set-selection-coding-system 'utf-16-le)) | ||
180 | (_ | ||
181 | (set-selection-coding-system 'utf-8) | ||
182 | (set-clipboard-coding-system 'utf-8))) | ||
183 | |||
184 | |||
185 | ;;; Modes | ||
186 | |||
187 | (dolist (enable-mode '(global-auto-revert-mode | ||
188 | blink-cursor-mode | ||
189 | electric-pair-mode | ||
190 | show-paren-mode | ||
191 | global-so-long-mode | ||
192 | minibuffer-depth-indicate-mode | ||
193 | file-name-shadow-mode | ||
194 | minibuffer-electric-default-mode | ||
195 | delete-selection-mode | ||
196 | auto-save-visited-mode | ||
197 | ;; column-number-mode | ||
198 | )) | ||
199 | (when (fboundp enable-mode) | ||
200 | (funcall enable-mode +1))) | ||
201 | |||
202 | (dolist (disable-mode '(tooltip-mode | ||
203 | tool-bar-mode | ||
204 | menu-bar-mode | ||
205 | scroll-bar-mode | ||
206 | horizontal-scroll-bar-mode)) | ||
207 | (when (fboundp disable-mode) | ||
208 | (funcall disable-mode -1))) | ||
209 | |||
210 | |||
211 | ;;; Hooks | ||
212 | |||
213 | (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) | ||
214 | (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) | ||
215 | |||
216 | (defun +auto-create-missing-dirs () | ||
217 | "Automatically create missing directories when finding a file." | ||
218 | ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ | ||
219 | (let ((target-dir (file-name-directory buffer-file-name))) | ||
220 | (unless (file-exists-p target-dir) | ||
221 | (make-directory target-dir t)))) | ||
222 | |||
223 | (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) | ||
224 | |||
225 | (defvar +save-some-buffers-debounce-time nil | ||
226 | "Last time `+save-some-buffers-debounce' was run.") | ||
227 | |||
228 | (defcustom +save-some-buffers-debounce-timeout 5 | ||
229 | "Number of seconds to wait before saving buffers again.") | ||
230 | |||
231 | (defun +save-some-buffers-debounce (&rest _) | ||
232 | "Run `save-some-buffers', but only if it's been a while." | ||
233 | (unless (and +save-some-buffers-debounce-time | ||
234 | (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time) | ||
235 | +save-some-buffers-debounce-timeout)) | ||
236 | (save-some-buffers t) | ||
237 | (setq +save-some-buffers-debounce-time (time-convert nil 'integer)))) | ||
238 | |||
239 | (add-function :after after-focus-change-function #'+save-some-buffers-debounce) | ||
240 | |||
241 | |||
242 | ;;; Better-default functions ... | ||
243 | |||
244 | (defun +cycle-spacing (&optional n preserve-nl-back mode) | ||
245 | "Negate N argument on `cycle-spacing'. | ||
246 | That is, with a positive N, deletes newlines as well, leaving -N | ||
247 | spaces. If N is negative, it will not delete newlines and leave | ||
248 | N spaces. See docstring of `cycle-spacing' for the meaning of | ||
249 | PRESERVE-NL-BACK and MODE." | ||
250 | (interactive "*p") | ||
251 | (cycle-spacing (- n) preserve-nl-back mode)) | ||
252 | |||
253 | (defun +save-buffers-quit (&optional arg) | ||
254 | "Silently save each buffer, then kill the current connection. | ||
255 | If the current frame has no client, kill Emacs itself using | ||
256 | `save-buffers-kill-emacs' after confirming with the user. | ||
257 | |||
258 | With prefix ARG, silently save all file-visiting buffers, then | ||
259 | kill without asking." | ||
260 | (interactive "P") | ||
261 | (save-some-buffers t) | ||
262 | (if (and (not (frame-parameter nil 'client)) | ||
263 | (and (not arg))) | ||
264 | (when (yes-or-no-p "Sure you want to quit? ") | ||
265 | (save-buffers-kill-emacs)) | ||
266 | (delete-frame nil :force))) | ||
267 | |||
268 | (defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn) | ||
269 | "Kill active region or ARG words backward. | ||
270 | BACKWARD-KILL-WORD-FN is the function to call to kill a word | ||
271 | backward. It defaults to `backward-kill-word'." | ||
272 | (interactive "P") | ||
273 | (call-interactively (if (region-active-p) | ||
274 | #'kill-region | ||
275 | (or backward-kill-word-fn #'backward-kill-word)))) | ||
276 | |||
277 | (defun +backward-kill-word-wrapper (fn &optional arg) | ||
278 | "Kill backward using FN until the beginning of a word, smartly. | ||
279 | If point is on at the beginning of a line, kill the previous new | ||
280 | line. If the only thing before point on the current line is | ||
281 | whitespace, kill that whitespace. | ||
282 | |||
283 | With argument ARG: if ARG is a number, just call FN | ||
284 | ARG times. Otherwise, just call FN." | ||
285 | ;; I want this to be a wrapper so that I can call other word-killing functions | ||
286 | ;; with it. It's *NOT* advice because those functions probably use | ||
287 | ;; `backward-kill-word' under the hood (looking at you, paredit), so advice | ||
288 | ;; will make things weird. | ||
289 | (if (null arg) | ||
290 | (cond | ||
291 | ((looking-back "^" 1) | ||
292 | (let ((delete-active-region nil)) | ||
293 | (delete-backward-char 1))) | ||
294 | ((looking-back "^[ ]*") | ||
295 | (delete-horizontal-space :backward-only)) | ||
296 | (t (call-interactively fn))) | ||
297 | (funcall fn (if (listp arg) 1 arg)))) | ||
298 | |||
299 | (defun +backward-kill-word (&optional arg) | ||
300 | "Kill word backward using `backward-kill-word'. | ||
301 | ARG is passed to `backward-kill-word'." | ||
302 | (interactive "P") | ||
303 | (+backward-kill-word-wrapper #'backward-kill-word arg)) | ||
304 | |||
305 | ;;; ... and advice | ||
306 | |||
307 | ;; Indent the region after a yank. | ||
308 | (defun +yank@indent (&rest _) | ||
309 | "Indent the current region." | ||
310 | (indent-region (min (point) (mark)) (max (point) (mark)))) | ||
311 | (advice-add #'yank :after #'+yank@indent) | ||
312 | (advice-add #'yank-pop :after #'+yank@indent) | ||
313 | |||
314 | |||
315 | ;;; Extra functions | ||
316 | |||
317 | (defun +save-some-buffers-p () | ||
318 | "Predicate for `save-some-buffers-default-predicate'. | ||
319 | It returns nil with remote files and those without attached files." | ||
320 | (and (buffer-file-name) | ||
321 | (not (file-remote-p (buffer-file-name))))) | ||
322 | |||
323 | ;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block | ||
324 | (defun +goto-matching-paren (&optional arg) | ||
325 | "Go to the matching paren, similar to vi's %." | ||
326 | (interactive "p") | ||
327 | (or arg (setq arg 1)) | ||
328 | (cond | ||
329 | ;; Check for "outside of bracket" positions | ||
330 | ((looking-at "[\[\(\{]") (forward-sexp arg)) | ||
331 | ((looking-back "[\]\)\}]" 1) (backward-sexp arg)) | ||
332 | ;; Otherwise, move from inside the bracket | ||
333 | ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg)) | ||
334 | ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg)) | ||
335 | (t (up-list arg t t)))) | ||
336 | |||
337 | (defun +delete-window-or-bury-buffer () | ||
338 | "Delete the current window, or bury the current buffer. | ||
339 | If the current window is the only window, bury the buffer." | ||
340 | (interactive) | ||
341 | (condition-case e | ||
342 | (delete-window) | ||
343 | (t (bury-buffer)))) | ||
344 | |||
345 | |||
346 | ;;; Bindings | ||
347 | |||
348 | (global-set-key (kbd "C-x C-c") #'+save-buffers-quit) | ||
349 | (global-set-key (kbd "M-SPC") #'+cycle-spacing) | ||
350 | (global-set-key (kbd "M-/") #'hippie-expand) | ||
351 | (global-set-key (kbd "M-=") #'count-words) | ||
352 | (global-set-key (kbd "C-x C-b") #'ibuffer) | ||
353 | (global-set-key (kbd "C-s") #'isearch-forward-regexp) | ||
354 | (global-set-key (kbd "C-r") #'isearch-backward-regexp) | ||
355 | (global-set-key (kbd "C-M-s") #'isearch-forward) | ||
356 | (global-set-key (kbd "C-M-r") #'isearch-backward) | ||
357 | (global-set-key (kbd "C-x 4 n") #'clone-buffer) | ||
358 | ;; https://christiantietze.de/posts/2022/07/shift-click-in-emacs-to-select/ | ||
359 | (global-set-key (kbd "S-<down-mouse-1>") #'mouse-set-mark) | ||
360 | (global-set-key (kbd "C-x 0") #'+delete-window-or-bury-buffer) | ||
361 | |||
362 | |||
363 | ;;; Required libraries | ||
364 | |||
365 | (when (require 'uniquify nil :noerror) | ||
366 | (setq-default uniquify-buffer-name-style 'forward | ||
367 | uniquify-separator path-separator | ||
368 | uniquify-after-kill-buffer-p t | ||
369 | uniquify-ignore-buffers-re "^\\*")) | ||
370 | |||
371 | (when (require 'goto-addr) | ||
372 | (if (fboundp 'global-goto-address-mode) | ||
373 | (global-goto-address-mode +1) | ||
374 | (add-hook 'after-change-major-mode-hook 'goto-address-mode))) | ||
375 | |||
376 | (when (require 'recentf nil :noerror) | ||
377 | (setq-default recentf-save-file (.etc "recentf.el") | ||
378 | recentf-max-menu-items 100 | ||
379 | recentf-max-saved-items nil | ||
380 | recentf-auto-cleanup 'mode) | ||
381 | (add-to-list 'recentf-exclude .etc) | ||
382 | (recentf-mode +1)) | ||
383 | |||
384 | (when (require 'savehist nil :noerror) | ||
385 | (setq-default history-length t | ||
386 | history-delete-duplicates t | ||
387 | history-autosave-interval 60 | ||
388 | savehist-file (.etc "savehist.el") | ||
389 | ;; Other variables --- don't truncate any of these. | ||
390 | ;; `add-to-history' uses the values of these variables unless | ||
391 | ;; they're nil, in which case it falls back to `history-length'. | ||
392 | kill-ring-max 100 | ||
393 | mark-ring-max 100 | ||
394 | global-mark-ring-max 100 | ||
395 | regexp-search-ring-max 100 | ||
396 | search-ring-max 100 | ||
397 | kmacro-ring-max 100 | ||
398 | eww-history-limit 100) | ||
399 | (dolist (var '(extended-command-history | ||
400 | global-mark-ring | ||
401 | mark-ring | ||
402 | kill-ring | ||
403 | kmacro-ring | ||
404 | regexp-search-ring | ||
405 | search-ring)) | ||
406 | (add-to-list 'savehist-additional-variables var)) | ||
407 | (savehist-mode +1)) | ||
408 | |||
409 | (when (require 'saveplace nil :noerror) | ||
410 | (setq-default save-place-file (.etc "places.el") | ||
411 | save-place-forget-unreadable-files (eq system-type 'gnu/linux)) | ||
412 | (save-place-mode +1)) | ||
413 | |||
414 | ;; (when (require 'tramp) | ||
415 | ;; ;; thanks Irreal! https://irreal.org/blog/?p=895 | ||
416 | ;; (add-to-list 'tramp-default-proxies-alist | ||
417 | ;; '(nil "\\`root\\'" "/ssh:%h:")) | ||
418 | ;; (add-to-list 'tramp-default-proxies-alist | ||
419 | ;; '((regexp-quote (system-name)) nil nil))) | ||
420 | |||
421 | |||
422 | ;;; Newer features | ||
423 | ;; These aren't in older version of Emacs, but they're so nice. | ||
424 | |||
425 | (when (fboundp 'repeat-mode) | ||
426 | (setq-default repeat-exit-key "g" | ||
427 | repeat-exit-timeout 5) | ||
428 | (repeat-mode +1)) | ||
429 | |||
430 | (when (fboundp 'pixel-scroll-precision-mode) | ||
431 | (pixel-scroll-precision-mode +1)) | ||
432 | |||
433 | (provide '+emacs) | ||
434 | ;;; +emacs.el ends here | ||
diff --git a/lisp/+embark.el b/lisp/+embark.el deleted file mode 100644 index e66d4b3..0000000 --- a/lisp/+embark.el +++ /dev/null | |||
@@ -1,28 +0,0 @@ | |||
1 | ;;; +embark.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; https://github.com/oantolin/embark/wiki/Additional-Actions | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'embark) | ||
10 | |||
11 | (embark-define-keymap embark-straight-map | ||
12 | ("u" straight-visit-package-website) | ||
13 | ("r" straight-get-recipe) | ||
14 | ("i" straight-use-package) | ||
15 | ("c" straight-check-package) | ||
16 | ("F" straight-pull-package) | ||
17 | ("f" straight-fetch-package) | ||
18 | ("p" straight-push-package) | ||
19 | ("n" straight-normalize-package) | ||
20 | ("m" straight-merge-package)) | ||
21 | |||
22 | (add-to-list 'embark-keymap-alist '(straight . embark-straight-map)) | ||
23 | |||
24 | (with-eval-after-load 'marginalia | ||
25 | (add-to-list 'marginalia-prompt-categories '("recipe\\|package" . straight))) | ||
26 | |||
27 | (provide '+embark) | ||
28 | ;;; +embark.el ends here | ||
diff --git a/lisp/+emms.el b/lisp/+emms.el deleted file mode 100644 index 403cbff..0000000 --- a/lisp/+emms.el +++ /dev/null | |||
@@ -1,46 +0,0 @@ | |||
1 | ;;; +emms.el --- EMMS customizations -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'emms-player-mpv) | ||
8 | (require 'el-patch) | ||
9 | |||
10 | ;; https://lists.gnu.org/archive/html/emms-help/2022-01/msg00006.html | ||
11 | (el-patch-feature emms-player-mpv) | ||
12 | (with-eval-after-load 'emms-player-mpv | ||
13 | (el-patch-defun emms-player-mpv-start (track) | ||
14 | (setq emms-player-mpv-stopped nil) | ||
15 | (emms-player-mpv-proc-playing nil) | ||
16 | (let | ||
17 | ((track-name (emms-track-get track 'name)) | ||
18 | (track-is-playlist (memq (emms-track-get track 'type) | ||
19 | '(streamlist playlist)))) | ||
20 | (if (emms-player-mpv-ipc-fifo-p) | ||
21 | (progn | ||
22 | ;; ipc-stop is to clear any buffered commands | ||
23 | (emms-player-mpv-ipc-stop) | ||
24 | (emms-player-mpv-proc-init (if track-is-playlist "--playlist" "--") | ||
25 | track-name) | ||
26 | (emms-player-started emms-player-mpv)) | ||
27 | (let* | ||
28 | ((play-cmd | ||
29 | `(batch | ||
30 | ((,(el-patch-swap | ||
31 | (if track-is-playlist 'loadlist 'loadfile) | ||
32 | 'loadfile) | ||
33 | ,track-name replace)) | ||
34 | ((set pause no)))) | ||
35 | (start-func | ||
36 | ;; Try running play-cmd and retry it on connection failure, e.g. if mpv died | ||
37 | (apply-partially 'emms-player-mpv-cmd play-cmd | ||
38 | (lambda (_mpv-data mpv-error) | ||
39 | (when (eq mpv-error 'connection-error) | ||
40 | (emms-player-mpv-cmd play-cmd)))))) | ||
41 | (if emms-player-mpv-ipc-stop-command | ||
42 | (setq emms-player-mpv-ipc-stop-command start-func) | ||
43 | (funcall start-func))))))) | ||
44 | |||
45 | (provide '+emms) | ||
46 | ;;; +emms.el ends here | ||
diff --git a/lisp/+eshell.el b/lisp/+eshell.el deleted file mode 100644 index b874141..0000000 --- a/lisp/+eshell.el +++ /dev/null | |||
@@ -1,126 +0,0 @@ | |||
1 | ;;; +eshell.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | ;; https://karthinks.com/software/jumping-directories-in-eshell/ | ||
6 | (defun eshell/z (&optional regexp) | ||
7 | "Navigate to a previously visited directory in eshell, or to | ||
8 | any directory proferred by `consult-dir'." | ||
9 | (let ((eshell-dirs (delete-dups | ||
10 | (mapcar 'abbreviate-file-name | ||
11 | (ring-elements eshell-last-dir-ring))))) | ||
12 | (cond | ||
13 | ((and (not regexp) (featurep 'consult-dir)) | ||
14 | (let* ((consult-dir--source-eshell `(:name "Eshell" | ||
15 | :narrow ?e | ||
16 | :category file | ||
17 | :face consult-file | ||
18 | :items ,eshell-dirs)) | ||
19 | (consult-dir-sources (cons consult-dir--source-eshell | ||
20 | consult-dir-sources))) | ||
21 | (eshell/cd (substring-no-properties | ||
22 | (consult-dir--pick "Switch directory: "))))) | ||
23 | (t (eshell/cd (if regexp (eshell-find-previous-directory regexp) | ||
24 | (completing-read "cd: " eshell-dirs))))))) | ||
25 | |||
26 | ;;; Start and quit | ||
27 | |||
28 | ;; from https://old.reddit.com/r/emacs/comments/1zkj2d/advanced_usage_of_eshell/ | ||
29 | (defun +eshell-here () | ||
30 | "Go to eshell and set current directory to current buffer's." | ||
31 | ;; consider: make a new eshell buffer when given a prefix argument. | ||
32 | (interactive) | ||
33 | (let ((dir (file-name-directory (or (buffer-file-name) | ||
34 | default-directory)))) | ||
35 | (eshell) | ||
36 | (eshell/pushd ".") | ||
37 | (cd dir) | ||
38 | (goto-char (point-max)) | ||
39 | (eshell-kill-input) | ||
40 | (eshell-send-input) | ||
41 | (setq-local scroll-margin 0) | ||
42 | (recenter 0))) | ||
43 | |||
44 | (defun +eshell-quit-or-delete-char (arg) | ||
45 | "Delete the character to the right, or quit eshell on an empty line." | ||
46 | (interactive "p") | ||
47 | (if (and (eolp) (looking-back eshell-prompt-regexp)) | ||
48 | (progn (eshell-life-is-too-much) | ||
49 | (when (and (<= 1 (count-windows)) | ||
50 | ;; TODO: This is not what I want. What I really want is | ||
51 | ;; for an eshell-only frame (i.e., called from a | ||
52 | ;; keybind) to delete itself, but a regular Emacs frame | ||
53 | ;; with Eshell inside to stick around. I think I'll | ||
54 | ;; need to make a frame-local (?) variable for that to | ||
55 | ;; work. | ||
56 | (> (length (frame-list)) 2) | ||
57 | server-process) | ||
58 | (delete-frame))) | ||
59 | (delete-forward-char arg))) | ||
60 | |||
61 | ;;; Insert previous arguments | ||
62 | ;; Record arguments | ||
63 | |||
64 | (defvar eshell-arg-history nil) | ||
65 | (defvar eshell-arg-history-index nil) | ||
66 | (add-to-list 'savehist-additional-variables 'eshell-arg-history) | ||
67 | |||
68 | (defun eshell-record-args (&rest _) | ||
69 | "Record unique arguments onto the front of `eshell-arg-history'." | ||
70 | (setq eshell-arg-history | ||
71 | (cl-loop with history = eshell-arg-history | ||
72 | for arg in (reverse eshell-last-arguments) | ||
73 | do (setq history (cons arg (remove arg history))) | ||
74 | finally return history))) | ||
75 | |||
76 | (defun eshell-insert-prev-arg () | ||
77 | "Insert an argument from `eshell-arg-history' at point." | ||
78 | (interactive) | ||
79 | (if (eq last-command 'eshell-insert-prev-arg) | ||
80 | (progn | ||
81 | (let ((pos (point))) | ||
82 | (eshell-backward-argument 1) | ||
83 | (delete-region (point) pos)) | ||
84 | (if-let ((text (nth eshell-arg-history-index | ||
85 | eshell-arg-history))) | ||
86 | (progn | ||
87 | (insert text) | ||
88 | (cl-incf eshell-arg-history-index)) | ||
89 | (insert (cl-first eshell-arg-history)) | ||
90 | (setq eshell-arg-history-index 1))) | ||
91 | (insert (cl-first eshell-arg-history)) | ||
92 | (setq eshell-arg-history-index 1))) | ||
93 | |||
94 | ;;;###autoload | ||
95 | (define-minor-mode eshell-arg-hist-mode | ||
96 | "Minor mode to enable argument history, like bash/zsh with M-." | ||
97 | :lighter "$." | ||
98 | :keymap (let ((map (make-sparse-keymap))) | ||
99 | (define-key map (kbd "M-.") #'eshell-insert-prev-arg) | ||
100 | map) | ||
101 | (if eshell-arg-hist-mode | ||
102 | (add-hook 'eshell-post-command-hook #'eshell-record-args nil t) | ||
103 | (remove-hook 'eshell-post-command-hook #'eshell-record-args t))) | ||
104 | |||
105 | ;;;###autoload | ||
106 | (defmacro +eshell-eval-after-load (&rest forms) | ||
107 | "Execute FORMS after Eshell is loaded. | ||
108 | If Eshell is already loaded in the session, immediately execute | ||
109 | forms. | ||
110 | |||
111 | I wrote this because Eshell doesn't properly do loading or | ||
112 | something, it's really annoying to work with." | ||
113 | (declare (indent 0)) | ||
114 | `(progn | ||
115 | (defun +eshell@setup () | ||
116 | "Setup the Eshell session." | ||
117 | ,@forms) | ||
118 | (when (featurep 'eshell) | ||
119 | `(dolist (buf (buffer-list)) | ||
120 | (with-current-buffer buf | ||
121 | (when (derived-mode-p 'eshell-mode) | ||
122 | (+eshell@setup))))) | ||
123 | (add-hook 'eshell-mode-hook #'+eshell@setup))) | ||
124 | |||
125 | (provide '+eshell) | ||
126 | ;;; +eshell.el ends here | ||
diff --git a/lisp/+eww.el b/lisp/+eww.el deleted file mode 100644 index 8d53571..0000000 --- a/lisp/+eww.el +++ /dev/null | |||
@@ -1,71 +0,0 @@ | |||
1 | ;;; +eww.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'bookmark) | ||
6 | (require 'eww) | ||
7 | |||
8 | ;; Track whether the current page is readable | ||
9 | |||
10 | (defvar-local +eww-readable-p nil | ||
11 | "Whether `eww-readable' has been toggled on the current buffer.") | ||
12 | |||
13 | (defun +eww-mark-readable (&rest _) | ||
14 | "ADVICE to mark current eww buffer \"readable.\"" | ||
15 | (setq-local +eww-readable-p t)) | ||
16 | |||
17 | (defun +eww-mark-unreadable (&rest _) | ||
18 | "ADVICE to mark current eww buffer \"unreadable.\"" | ||
19 | (setq-local +eww-readable-p nil)) | ||
20 | |||
21 | (defvar +eww-readable-unreadable-after-functions '(eww-render | ||
22 | eww-reload | ||
23 | eww-back-url) | ||
24 | "Functions after which the page is rendered \"unreadable\".") | ||
25 | |||
26 | ;;;###autoload | ||
27 | (define-minor-mode +eww-track-readable-mode | ||
28 | "Track whether the current webpage has been rendered readable." | ||
29 | :lighter "" | ||
30 | (if +eww-track-readable-mode | ||
31 | (progn | ||
32 | (advice-add 'eww-readable :after #'+eww-mark-readable) | ||
33 | (dolist (func +eww-readable-unreadable-after-functions) | ||
34 | (advice-add func :after #'+eww-mark-unreadable))) | ||
35 | (dolist (func +eww-readable-unreadable-after-functions) | ||
36 | (advice-remove func #'+eww-mark-unreadable)) | ||
37 | (advice-remove 'eww-readable #'+eww-mark-readable))) | ||
38 | |||
39 | ;; Integrate bookmarks in eww | ||
40 | |||
41 | (defun +eww-bookmark--make () | ||
42 | "Make eww bookmark record." | ||
43 | `((filename . ,(plist-get eww-data :url)) | ||
44 | (title . ,(plist-get eww-data :title)) | ||
45 | (time . ,(current-time-string)) | ||
46 | (handler . ,#'+eww-bookmark-handler) | ||
47 | (defaults . (,(concat | ||
48 | ;; url without the https and path | ||
49 | (replace-regexp-in-string | ||
50 | "/.*" "" | ||
51 | (replace-regexp-in-string | ||
52 | "\\`https?://" "" | ||
53 | (plist-get eww-data :url))) | ||
54 | " - " | ||
55 | ;; page title | ||
56 | (replace-regexp-in-string | ||
57 | "\\` +\\| +\\'" "" | ||
58 | (replace-regexp-in-string | ||
59 | "[\n\t\r ]+" " " | ||
60 | (plist-get eww-data :title)))))))) | ||
61 | |||
62 | (defun +eww-bookmark-handler (bm) | ||
63 | "Handler for eww bookmarks." | ||
64 | (eww-browse-url (alist-get 'filename bm))) | ||
65 | |||
66 | (defun +eww-bookmark-setup () | ||
67 | "Setup eww bookmark integration." | ||
68 | (setq-local bookmark-make-record-function #'+eww-bookmark--make)) | ||
69 | |||
70 | (provide '+eww) | ||
71 | ;;; +eww.el ends here | ||
diff --git a/lisp/+expand-region.el b/lisp/+expand-region.el deleted file mode 100644 index 8aac3ce..0000000 --- a/lisp/+expand-region.el +++ /dev/null | |||
@@ -1,24 +0,0 @@ | |||
1 | ;;; +expand-region.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | ;; Because of `wrap-region', I can't use `expand-region-fast-keys-enabled'. So | ||
10 | ;; instead of that, I'm adding this to the binding to C--, but I also want to be | ||
11 | ;; able to use the negative argument. So there's this. | ||
12 | (defun +er/contract-or-negative-argument (arg) | ||
13 | "Contract the region if the last command expanded it. | ||
14 | Otherwise, pass the ARG as a negative argument." | ||
15 | (interactive "p") | ||
16 | (cond ((memq last-command '(er/expand-region | ||
17 | er/contract-region | ||
18 | +er/contract-or-negative-argument)) | ||
19 | |||
20 | (er/contract-region arg)) | ||
21 | (t (call-interactively #'negative-argument)))) | ||
22 | |||
23 | (provide '+expand-region) | ||
24 | ;;; +expand-region.el ends here | ||
diff --git a/lisp/+finger.el b/lisp/+finger.el deleted file mode 100644 index 1a878bc..0000000 --- a/lisp/+finger.el +++ /dev/null | |||
@@ -1,46 +0,0 @@ | |||
1 | ;;; +finger.el --- Finger bugfix -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; `net-utils' defines `finger', which purportedly consults | ||
6 | ;; `finger-X.500-host-regexps' to determine what hosts to only send a username | ||
7 | ;; to. I've found that that is not the case, and so I've patched it. At some | ||
8 | ;; point I'll submit this to Emacs itself. | ||
9 | |||
10 | ;;; Code: | ||
11 | |||
12 | (require 'net-utils) ; this requires everything else I'll need. | ||
13 | (require 'seq) | ||
14 | |||
15 | (defun finger (user host) | ||
16 | "Finger USER on HOST. | ||
17 | This command uses `finger-X.500-host-regexps' | ||
18 | and `network-connection-service-alist', which see." | ||
19 | ;; One of those great interactive statements that's actually | ||
20 | ;; longer than the function call! The idea is that if the user | ||
21 | ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the | ||
22 | ;; host name. If we don't see an "@", we'll prompt for the host. | ||
23 | (interactive | ||
24 | (let* ((answer (read-from-minibuffer "Finger User: " | ||
25 | (net-utils-url-at-point))) | ||
26 | (index (string-match (regexp-quote "@") answer))) | ||
27 | (if index | ||
28 | (list (substring answer 0 index) | ||
29 | (substring answer (1+ index))) | ||
30 | (list answer | ||
31 | (read-from-minibuffer "At Host: " | ||
32 | (net-utils-machine-at-point)))))) | ||
33 | (let* ((user-and-host (concat user "@" host)) | ||
34 | (process-name (concat "Finger [" user-and-host "]")) | ||
35 | (regexps finger-X.500-host-regexps) | ||
36 | ) ;; found | ||
37 | (when (seq-some (lambda (r) (string-match-p r host)) regexps) | ||
38 | (setq user-and-host user)) | ||
39 | (run-network-program | ||
40 | process-name | ||
41 | host | ||
42 | (cdr (assoc 'finger network-connection-service-alist)) | ||
43 | user-and-host))) | ||
44 | |||
45 | (provide '+finger) | ||
46 | ;;; +finger.el ends here | ||
diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 22f8c82..0000000 --- a/lisp/+flyspell-correct.el +++ /dev/null | |||
@@ -1,24 +0,0 @@ | |||
1 | ;;; +flyspell-correct.el --- -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'flyspell-correct) | ||
6 | |||
7 | (defun +flyspell-correct-buffer (&optional prefix) | ||
8 | "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. | ||
9 | With PREFIX, prompt to change the current dictionary." | ||
10 | (interactive "P") | ||
11 | (flyspell-buffer) | ||
12 | (when prefix | ||
13 | (let ((current-prefix-arg nil)) | ||
14 | (call-interactively #'ispell-change-dictionary))) | ||
15 | (+with-message "Checking spelling" | ||
16 | (flyspell-correct-move (point-min) :forward :rapid))) | ||
17 | |||
18 | (defun +flyspell-correct-buffer-h (&rest _) | ||
19 | "Run `+flyspell-correct-buffer'. | ||
20 | This is suitable for placement in a hook." | ||
21 | (+flyspell-correct-buffer)) | ||
22 | |||
23 | (provide '+flyspell-correct) | ||
24 | ;;; +flyspell-correct.el ends here | ||
diff --git a/lisp/+god-mode.el b/lisp/+god-mode.el deleted file mode 100644 index f70e76b..0000000 --- a/lisp/+god-mode.el +++ /dev/null | |||
@@ -1,17 +0,0 @@ | |||
1 | ;;; +god-mode.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (defun +god-mode-insert () | ||
6 | "Leave `god-local-mode' at point." | ||
7 | (interactive) | ||
8 | (god-local-mode -1)) | ||
9 | |||
10 | (defun +god-mode-append () | ||
11 | "Leave `god-local-mode' after point." | ||
12 | (interactive) | ||
13 | (forward-char 1) | ||
14 | (god-local-mode -1)) | ||
15 | |||
16 | (provide '+god-mode) | ||
17 | ;;; +god-mode.el ends here | ||
diff --git a/lisp/+hideshow.el b/lisp/+hideshow.el deleted file mode 100644 index e60efb8..0000000 --- a/lisp/+hideshow.el +++ /dev/null | |||
@@ -1,44 +0,0 @@ | |||
1 | ;;; +hideshow.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; initiated by https://karthinks.com/software/simple-folding-with-hideshow/ | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (defun +hs-cycle (&optional level) | ||
10 | (interactive "p") | ||
11 | (let (message-log-max | ||
12 | (inhibit-message t)) | ||
13 | (if (= level 1) | ||
14 | (pcase last-command | ||
15 | ('+hs-cycle | ||
16 | (hs-hide-level 1) | ||
17 | (setq this-command 'hs-cycle-children)) | ||
18 | ('hs-cycle-children | ||
19 | ;; TODO: Fix this case. `hs-show-block' needs to be | ||
20 | ;; called twice to open all folds of the parent | ||
21 | ;; block. | ||
22 | (save-excursion (hs-show-block)) | ||
23 | (hs-show-block) | ||
24 | (setq this-command 'hs-cycle-subtree)) | ||
25 | ('hs-cycle-subtree | ||
26 | (hs-hide-block)) | ||
27 | (_ | ||
28 | (if (not (hs-already-hidden-p)) | ||
29 | (hs-hide-block) | ||
30 | (hs-hide-level 1) | ||
31 | (setq this-command 'hs-cycle-children)))) | ||
32 | (hs-hide-level level) | ||
33 | (setq this-command 'hs-hide-level)))) | ||
34 | |||
35 | (defun +hs-global-cycle () | ||
36 | (interactive) | ||
37 | (pcase last-command | ||
38 | ('+hs-global-cycle | ||
39 | (save-excursion (hs-show-all)) | ||
40 | (setq this-command 'hs-global-show)) | ||
41 | (_ (hs-hide-all)))) | ||
42 | |||
43 | (provide '+hideshow) | ||
44 | ;;; +hideshow.el ends here | ||
diff --git a/lisp/+init.el b/lisp/+init.el deleted file mode 100644 index 903f2dc..0000000 --- a/lisp/+init.el +++ /dev/null | |||
@@ -1,117 +0,0 @@ | |||
1 | ;;; +init.el --- extra init.el stuff -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; Yes, I edit my init.el often enough I need to write a mode for it. The | ||
6 | ;; sorting function is based on code from | ||
7 | ;; https://github.com/alphapapa/unpackaged.el | ||
8 | |||
9 | ;;; Code: | ||
10 | |||
11 | (require '+lisp) | ||
12 | |||
13 | ;;; Sort `setup' forms | ||
14 | |||
15 | (defun +init--sexp-setup-p (sexp-str &optional head) | ||
16 | "Is SEXP-STR a `setup' form, optionally with a HEAD form?" | ||
17 | (let ((head (if (and head (symbolp head)) | ||
18 | (symbol-name head) | ||
19 | head))) | ||
20 | (and (string-match-p (rx (: bos (* whitespace) "(setup")) sexp-str) | ||
21 | (if head | ||
22 | (string-match-p (concat "\\`.*" head) sexp-str) | ||
23 | t)))) | ||
24 | |||
25 | (defun +init-sort () | ||
26 | "Sort init.el. | ||
27 | Sort based on the following heuristic: `setup' forms (the | ||
28 | majority of my init.el) are sorted after everything else, and | ||
29 | within that group, forms with a HEAD of `:require' are sorted | ||
30 | first, and `:straight' HEADs are sorted last. All other forms | ||
31 | are sorted lexigraphically." | ||
32 | (interactive) | ||
33 | ;; I have to make my own "version" of `save-excursion', since the mark and | ||
34 | ;; point are lost (I think that's the problem) when sorting the buffer. | ||
35 | (let* ((current-point (point)) | ||
36 | (current-defun (beginning-of-defun)) | ||
37 | (defun-point (- current-point (point))) | ||
38 | (current-defun-re (buffer-substring-no-properties (line-beginning-position) | ||
39 | (line-end-position)))) | ||
40 | (widen) ; It makes no sense to `save-restriction' | ||
41 | (+lisp-sort-sexps | ||
42 | (point-min) (point-max) | ||
43 | ;; Key function | ||
44 | nil | ||
45 | ;; Sort function | ||
46 | (lambda (s1 s2) | ||
47 | (let ((s1 (cdr s1)) (s2 (cdr s2))) | ||
48 | (cond | ||
49 | ;; Sort everything /not/ `setup' /before/ `setup' | ||
50 | ((and (+init--sexp-setup-p s1) | ||
51 | (not (+init--sexp-setup-p s2))) | ||
52 | nil) | ||
53 | ((and (+init--sexp-setup-p s2) | ||
54 | (not (+init--sexp-setup-p s1))) | ||
55 | t) | ||
56 | ;; otherwise... | ||
57 | (t (let ((s1-straight (+init--sexp-setup-p s1 :straight)) | ||
58 | (s2-straight (+init--sexp-setup-p s2 :straight)) | ||
59 | (s1-require (+init--sexp-setup-p s1 :require)) | ||
60 | (s2-require (+init--sexp-setup-p s2 :require))) | ||
61 | (cond | ||
62 | ;; `:straight' setups have extra processing | ||
63 | ((and s1-straight s2-straight) | ||
64 | (let* ((r (rx (: ":straight" (? "-when") (* space) (? "(")))) | ||
65 | (s1 (replace-regexp-in-string r "" s1)) | ||
66 | (s2 (replace-regexp-in-string r "" s2))) | ||
67 | (string< s1 s2))) | ||
68 | ;; `:require' setups go first | ||
69 | ((and s1-require (not s2-require)) t) | ||
70 | ((and s2-require (not s1-require)) nil) | ||
71 | ;; `:straight' setups go last | ||
72 | ((and s1-straight (not s2-straight)) nil) | ||
73 | ((and s2-straight (not s1-straight)) t) | ||
74 | ;; otherwise, sort lexigraphically | ||
75 | (t (string< s1 s2))))))))) | ||
76 | ;; Return to original point relative to the defun we were in | ||
77 | (ignore-errors (goto-char (point-min)) | ||
78 | (re-search-forward current-defun-re) | ||
79 | (beginning-of-defun) | ||
80 | (goto-char (+ (point) defun-point))))) | ||
81 | |||
82 | (defun +init-sort-then-save () | ||
83 | "Sort init.el, then save it." | ||
84 | (interactive) | ||
85 | (+init-sort) | ||
86 | (if (fboundp #'user-save-buffer) | ||
87 | (user-save-buffer) | ||
88 | (save-buffer))) | ||
89 | |||
90 | ;;; Add `setup' forms to `imenu-generic-expression' | ||
91 | |||
92 | (defun +init-add-setup-to-imenu () | ||
93 | "Recognize `setup' forms in `imenu'." | ||
94 | ;; `imenu-generic-expression' automatically becomes buffer-local when set | ||
95 | (setf (alist-get "Setup" imenu-generic-expression nil nil #'equal) | ||
96 | (list | ||
97 | (rx (: "(setup" (+ space) | ||
98 | (group (? "(") (* nonl)))) | ||
99 | 1)) | ||
100 | (when (boundp 'consult-imenu-config) | ||
101 | (setf (alist-get ?s | ||
102 | (plist-get | ||
103 | (alist-get 'emacs-lisp-mode consult-imenu-config) | ||
104 | :types)) | ||
105 | '("Setup")))) | ||
106 | |||
107 | ;;; Major mode | ||
108 | |||
109 | ;;;###autoload | ||
110 | (define-derived-mode +init-mode emacs-lisp-mode "Init.el" | ||
111 | "`emacs-lisp-mode', but with a few specialized bits and bobs for init.el.") | ||
112 | |||
113 | ;;;###autoload | ||
114 | (add-to-list 'auto-mode-alist '("/init\\.el\\'" . +init-mode)) | ||
115 | |||
116 | (provide '+init) | ||
117 | ;;; +init.el ends here | ||
diff --git a/lisp/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index fbfc0f0..0000000 --- a/lisp/+ispell.el +++ /dev/null | |||
@@ -1,97 +0,0 @@ | |||
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 | (setq 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 | (setq 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 | (setq 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 | (setq 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/+jabber.el b/lisp/+jabber.el deleted file mode 100644 index e018b0c..0000000 --- a/lisp/+jabber.el +++ /dev/null | |||
@@ -1,278 +0,0 @@ | |||
1 | ;;; +jabber.el --- Customizations for jabber.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; Most changes I want to PR and contribute, but a few don't make sense to | ||
6 | ;; contribute upstream, at least not now. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (require 'jabber) | ||
11 | (require 'tracking) | ||
12 | |||
13 | (defgroup +jabber nil | ||
14 | "Extra jabber.el customizations." | ||
15 | :group 'jabber) | ||
16 | |||
17 | (defcustom +jabber-ws-prefix 0 | ||
18 | "Width to pad left side of chats." | ||
19 | :type 'string) | ||
20 | |||
21 | (defcustom +jabber-pre-prompt "\n" | ||
22 | "String to put before the prompt." | ||
23 | :type 'string) | ||
24 | |||
25 | (defvar +jabber-tracking-show-p #'jabber-activity-show-p-default | ||
26 | "Function that checks if the given JID should be shown in the mode line. | ||
27 | This does the same as `jabber-activity-show-p', but for the | ||
28 | `tracking-mode' mode-line.") | ||
29 | |||
30 | (defun +jabber-tracking-add (from buffer text proposed-alert) | ||
31 | "ADVICE to add jabber buffers to `tracking-buffers'." | ||
32 | (when (funcall +jabber-tracking-show-p from) | ||
33 | (tracking-add-buffer buffer 'jabber-activity-face))) | ||
34 | |||
35 | (defun +jabber-tracking-add-muc (nick group buffer text proposed-alert) | ||
36 | "ADVICE to add jabber MUC buffers to `tracking-buffers'." | ||
37 | (when (funcall +jabber-tracking-show-p group) | ||
38 | (tracking-add-buffer buffer 'jabber-activity-face))) | ||
39 | |||
40 | ;;; Hiding presence messages: | ||
41 | ;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f | ||
42 | |||
43 | ;; Tame MUC presence notifications. | ||
44 | |||
45 | ;; This patch hides or applies a face to MUC presence notifications in | ||
46 | ;; the MUC chat buffer. To control its behavior, customize | ||
47 | ;; ’jabber-muc-decorate-presence-patterns’. By default it does nothing. | ||
48 | |||
49 | ;; ’jabber-muc-decorate-presence-patterns’ is a list of pairs consisting | ||
50 | ;; of a regular expression and a either a face or ‘nil’. If a the | ||
51 | ;; regular expression matches a presence notification, then either: | ||
52 | |||
53 | ;; - the specified face is applied to the notification message | ||
54 | ;; - or if the second value of the pair is nil, the notification is | ||
55 | ;; discarded | ||
56 | |||
57 | ;; If no regular expression in the list of pairs matches the notification | ||
58 | ;; message, the message is displayed unchanged. | ||
59 | |||
60 | ;; For example, the customization: | ||
61 | |||
62 | ;; '(jabber-muc-decorate-presence-patterns | ||
63 | ;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") | ||
64 | ;; ("." . jabber-muc-presence-dim))) | ||
65 | |||
66 | ;; hides participant enter/leave notifications. It also diminishes other | ||
67 | ;; presence notification messages to make it easier to distinguish | ||
68 | ;; between conversation and notifications. | ||
69 | |||
70 | (defface jabber-muc-presence-dim | ||
71 | '((t (:foreground "dark grey" :weight light :slant italic))) | ||
72 | "face for diminished presence notifications.") | ||
73 | |||
74 | (defcustom jabber-muc-decorate-presence-patterns nil | ||
75 | "List of regular expressions and face pairs. | ||
76 | When a presence notification matches a pattern, display it with | ||
77 | associated face. Ignore notification if face is ‘nil’." | ||
78 | :type '(repeat | ||
79 | :tag "Patterns" | ||
80 | (cons :format "%v" | ||
81 | (regexp :tag "Regexp") | ||
82 | (choice | ||
83 | (const :tag "Ignore" nil) | ||
84 | (face :tag "Face" :value jabber-muc-presence-dim)))) | ||
85 | :group 'jabber-alerts) | ||
86 | |||
87 | (defun jabber-muc-maybe-decorate-presence (node) | ||
88 | "Filter presence notifications." | ||
89 | (cl-destructuring-bind (key msg &key time) node | ||
90 | (let* ((match (cl-find-if | ||
91 | (lambda (pair) | ||
92 | (string-match (car pair) msg)) | ||
93 | jabber-muc-decorate-presence-patterns)) | ||
94 | (face (cdr-safe match))) | ||
95 | (if match | ||
96 | (when face | ||
97 | (jabber-maybe-print-rare-time | ||
98 | (ewoc-enter-last | ||
99 | jabber-chat-ewoc | ||
100 | (list key | ||
101 | (propertize msg 'face face) | ||
102 | :time time)))) | ||
103 | (jabber-maybe-print-rare-time | ||
104 | (ewoc-enter-last jabber-chat-ewoc node)))))) | ||
105 | |||
106 | (defun jabber-muc-process-presence (jc presence) | ||
107 | (let* ((from (jabber-xml-get-attribute presence 'from)) | ||
108 | (type (jabber-xml-get-attribute presence 'type)) | ||
109 | (x-muc (cl-find-if | ||
110 | (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns) | ||
111 | "http://jabber.org/protocol/muc#user")) | ||
112 | (jabber-xml-get-children presence 'x))) | ||
113 | (group (jabber-jid-user from)) | ||
114 | (nickname (jabber-jid-resource from)) | ||
115 | (symbol (jabber-jid-symbol from)) | ||
116 | (our-nickname (gethash symbol jabber-pending-groupchats)) | ||
117 | (item (car (jabber-xml-get-children x-muc 'item))) | ||
118 | (actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid)) | ||
119 | (reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason))))) | ||
120 | (error-node (car (jabber-xml-get-children presence 'error))) | ||
121 | (status-codes (if error-node | ||
122 | (list (jabber-xml-get-attribute error-node 'code)) | ||
123 | (mapcar | ||
124 | (lambda (status-element) | ||
125 | (jabber-xml-get-attribute status-element 'code)) | ||
126 | (jabber-xml-get-children x-muc 'status))))) | ||
127 | ;; handle leaving a room | ||
128 | (cond | ||
129 | ((or (string= type "unavailable") (string= type "error")) | ||
130 | ;; error from room itself? or are we leaving? | ||
131 | (if (or (null nickname) | ||
132 | (member "110" status-codes) | ||
133 | (string= nickname our-nickname)) | ||
134 | ;; Assume that an error means that we were thrown out of the | ||
135 | ;; room... | ||
136 | (let* ((leavingp t) | ||
137 | (message (cond | ||
138 | ((string= type "error") | ||
139 | (cond | ||
140 | ;; ...except for certain cases. | ||
141 | ((or (member "406" status-codes) | ||
142 | (member "409" status-codes)) | ||
143 | (setq leavingp nil) | ||
144 | (concat "Nickname change not allowed" | ||
145 | (when error-node | ||
146 | (concat ": " (jabber-parse-error error-node))))) | ||
147 | (t | ||
148 | (concat "Error entering room" | ||
149 | (when error-node | ||
150 | (concat ": " (jabber-parse-error error-node))))))) | ||
151 | ((member "301" status-codes) | ||
152 | (concat "You have been banned" | ||
153 | (when actor (concat " by " actor)) | ||
154 | (when reason (concat " - '" reason "'")))) | ||
155 | ((member "307" status-codes) | ||
156 | (concat "You have been kicked" | ||
157 | (when actor (concat " by " actor)) | ||
158 | (when reason (concat " - '" reason "'")))) | ||
159 | (t | ||
160 | "You have left the chatroom")))) | ||
161 | (when leavingp | ||
162 | (jabber-muc-remove-groupchat group)) | ||
163 | ;; If there is no buffer for this groupchat, don't bother | ||
164 | ;; creating one just to tell that user left the room. | ||
165 | (let ((buffer (get-buffer (jabber-muc-get-buffer group)))) | ||
166 | (if buffer | ||
167 | (with-current-buffer buffer | ||
168 | (jabber-muc-maybe-decorate-presence | ||
169 | (list (if (string= type "error") | ||
170 | :muc-error | ||
171 | :muc-notice) | ||
172 | message | ||
173 | :time (current-time))))) | ||
174 | (message "%s: %s" (jabber-jid-displayname group) message)))) | ||
175 | ;; or someone else? | ||
176 | (let* ((plist (jabber-muc-participant-plist group nickname)) | ||
177 | (jid (plist-get plist 'jid)) | ||
178 | (name (concat nickname | ||
179 | (when jid | ||
180 | (concat " <" | ||
181 | (jabber-jid-user jid) | ||
182 | ">"))))) | ||
183 | (jabber-muc-remove-participant group nickname) | ||
184 | (with-current-buffer (jabber-muc-create-buffer jc group) | ||
185 | (jabber-muc-maybe-decorate-presence | ||
186 | (list :muc-notice | ||
187 | (cond | ||
188 | ((member "301" status-codes) | ||
189 | (concat name " has been banned" | ||
190 | (when actor (concat " by " actor)) | ||
191 | (when reason (concat " - '" reason "'")))) | ||
192 | ((member "307" status-codes) | ||
193 | (concat name " has been kicked" | ||
194 | (when actor (concat " by " actor)) | ||
195 | (when reason (concat " - '" reason "'")))) | ||
196 | ((member "303" status-codes) | ||
197 | (concat name " changes nickname to " | ||
198 | (jabber-xml-get-attribute item 'nick))) | ||
199 | (t | ||
200 | (concat name " has left the chatroom"))) | ||
201 | :time (current-time)))))) | ||
202 | (t | ||
203 | ;; someone is entering | ||
204 | |||
205 | (when (or (member "110" status-codes) (string= nickname our-nickname)) | ||
206 | ;; This is us. We just succeeded in entering the room. | ||
207 | ;; | ||
208 | ;; The MUC server is supposed to send a 110 code whenever this | ||
209 | ;; is our presence ("self-presence"), but at least one | ||
210 | ;; (ejabberd's mod_irc) doesn't, so check the nickname as well. | ||
211 | ;; | ||
212 | ;; This check might give incorrect results if the server | ||
213 | ;; changed our nickname to avoid collision with an existing | ||
214 | ;; participant, but even in this case the window where we have | ||
215 | ;; incorrect information should be very small, as we should be | ||
216 | ;; getting our own 110+210 presence shortly. | ||
217 | (let ((whichgroup (assoc group *jabber-active-groupchats*))) | ||
218 | (if whichgroup | ||
219 | (setcdr whichgroup nickname) | ||
220 | (add-to-list '*jabber-active-groupchats* (cons group nickname)))) | ||
221 | ;; The server may have changed our nick. Record the new one. | ||
222 | (puthash symbol nickname jabber-pending-groupchats)) | ||
223 | |||
224 | ;; Whoever enters, we create a buffer (if it didn't already | ||
225 | ;; exist), and print a notice. This is where autojoined MUC | ||
226 | ;; rooms have buffers created for them. We also remember some | ||
227 | ;; metadata. | ||
228 | (let ((old-plist (jabber-muc-participant-plist group nickname)) | ||
229 | (new-plist (jabber-muc-parse-affiliation x-muc))) | ||
230 | (jabber-muc-modify-participant group nickname new-plist) | ||
231 | (let ((report (jabber-muc-report-delta nickname old-plist new-plist | ||
232 | reason actor))) | ||
233 | (when report | ||
234 | (with-current-buffer (jabber-muc-create-buffer jc group) | ||
235 | (jabber-muc-maybe-decorate-presence | ||
236 | (list :muc-notice report | ||
237 | :time (current-time))) | ||
238 | ;; Did the server change our nick? | ||
239 | (when (member "210" status-codes) | ||
240 | (ewoc-enter-last | ||
241 | jabber-chat-ewoc | ||
242 | (list :muc-notice | ||
243 | (concat "Your nick was changed to " nickname " by the server") | ||
244 | :time (current-time)))) | ||
245 | ;; Was this room just created? If so, it's a locked | ||
246 | ;; room. Notify the user. | ||
247 | (when (member "201" status-codes) | ||
248 | (ewoc-enter-last | ||
249 | jabber-chat-ewoc | ||
250 | (list :muc-notice | ||
251 | (with-temp-buffer | ||
252 | (insert "This room was just created, and is locked to other participants.\n" | ||
253 | "To unlock it, ") | ||
254 | (insert-text-button | ||
255 | "configure the room" | ||
256 | 'action (apply-partially 'call-interactively 'jabber-muc-get-config)) | ||
257 | (insert " or ") | ||
258 | (insert-text-button | ||
259 | "accept the default configuration" | ||
260 | 'action (apply-partially 'call-interactively 'jabber-muc-instant-config)) | ||
261 | (insert ".") | ||
262 | (buffer-string)) | ||
263 | :time (current-time)))))))))))) | ||
264 | |||
265 | (defun +jabber-colors-update (&optional buffer) | ||
266 | "Update jabber colors in BUFFER, defaulting to the current." | ||
267 | (with-current-buffer (or buffer (current-buffer)) | ||
268 | (when jabber-buffer-connection | ||
269 | (setq jabber-muc-participant-colors nil) | ||
270 | (cond (jabber-chatting-with | ||
271 | (jabber-chat-create-buffer jabber-buffer-connection | ||
272 | jabber-chatting-with)) | ||
273 | (jabber-group | ||
274 | (jabber-muc-create-buffer jabber-buffer-connection | ||
275 | jabber-group)))))) | ||
276 | |||
277 | (provide '+jabber) | ||
278 | ;;; +jabber.el ends here | ||
diff --git a/lisp/+key.el b/lisp/+key.el deleted file mode 100644 index a217dad..0000000 --- a/lisp/+key.el +++ /dev/null | |||
@@ -1,106 +0,0 @@ | |||
1 | ;;; +key.el --- minor mode for keymaps -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; Much of the code here was cribbed from https://emacs.stackexchange.com/a/358, | ||
6 | ;; which in turn was cribbed in part from | ||
7 | ;; https://github.com/kaushalmodi/.emacs.d/blob/master/elisp/modi-mode.el, | ||
8 | ;; https://github.com/jwiegley/use-package/blob/master/bind-key.el and | ||
9 | ;; elsewhere. | ||
10 | |||
11 | ;; The basic idea is to have a minor-mode for my personal key customizations, | ||
12 | ;; especially a "leader key" set up à la vim. In Emacs, I use `C-z' for this | ||
13 | ;; leader key, because of its easy location and relative uselessness by default. | ||
14 | |||
15 | ;;; Code: | ||
16 | |||
17 | (require 'easy-mmode) | ||
18 | (require 'setup nil t) | ||
19 | |||
20 | ;; I need to define this map before the proper mode map. | ||
21 | (defvar +key-leader-map (let ((map (make-sparse-keymap)) | ||
22 | (c-z (global-key-binding "\C-z"))) | ||
23 | ;;(define-key map "\C-z" c-z) | ||
24 | map) | ||
25 | "A leader keymap under the \"C-z\" bind.") | ||
26 | |||
27 | ;; http://xahlee.info/emacs/emacs/emacs_menu_app_keys.html and | ||
28 | (defvar +key-menu-map (let ((map (make-sparse-keymap))) | ||
29 | (define-key map (kbd "<menu>") | ||
30 | #'execute-extended-command) | ||
31 | map) | ||
32 | "Custom bindings behind the menu key.") | ||
33 | |||
34 | (defvar +key-mode-map (let ((map (make-sparse-keymap))) | ||
35 | (define-key map "\C-z" +key-leader-map) | ||
36 | (define-key map (kbd "<menu>") +key-menu-map) | ||
37 | map) | ||
38 | "Keymap for `+key-mode'.") | ||
39 | |||
40 | (defun turn-off-+key-mode () | ||
41 | "Turn off `+key-mode'." | ||
42 | (+key-mode -1)) | ||
43 | |||
44 | ;;;###autoload | ||
45 | (define-minor-mode +key-mode | ||
46 | "A minor mode with keybindings that will override every other mode." | ||
47 | :init-value t | ||
48 | :lighter " +" | ||
49 | (if +key-mode | ||
50 | (progn ; Enable | ||
51 | (add-to-list 'emulation-mode-map-alists | ||
52 | `((+key-mode . ,+key-mode-map))) | ||
53 | ;; Disable in minibuffer | ||
54 | (add-hook 'minibuffer-setup-hook #'turn-off-+key-mode) | ||
55 | ;; compat Linux-Windows | ||
56 | (define-key key-translation-map (kbd "<apps>") (kbd "<menu>")) | ||
57 | ;; curse you, thinkpad keyboard!!! | ||
58 | (define-key key-translation-map (kbd "<print>") (kbd "<menu>")) | ||
59 | ) | ||
60 | ;; Disable | ||
61 | (setq emulation-mode-map-alists | ||
62 | (assoc-delete-all '+key-mode emulation-mode-map-alists | ||
63 | (lambda (a b) | ||
64 | (equal (car a) b)))) | ||
65 | (remove-hook 'minibuffer-setup-hook #'turn-off-+key-mode) | ||
66 | (define-key key-translation-map (kbd "<print>") nil) | ||
67 | (define-key key-translation-map (kbd "<apps>") nil))) | ||
68 | |||
69 | ;;;###autoload | ||
70 | (defun +key-setup () | ||
71 | "Ensure `+key-mode' happens after init." | ||
72 | (if after-init-time | ||
73 | (+key-global-mode) | ||
74 | (add-hook 'after-init-hook #'+key-global-mode))) | ||
75 | |||
76 | ;;;###autoload | ||
77 | (define-globalized-minor-mode +key-global-mode +key-mode +key-mode) | ||
78 | |||
79 | ;; Extras for `setup' | ||
80 | (with-eval-after-load 'setup | ||
81 | (setup-define :+key | ||
82 | (lambda (key command) | ||
83 | `(define-key +key-mode-map ,key ,command)) | ||
84 | :documentation "Bind KEY to COMMAND in `+key-mode-map'." | ||
85 | :debug '(form sexp) | ||
86 | :ensure '(kbd nil) | ||
87 | :repeatable t) | ||
88 | |||
89 | (setup-define :+leader | ||
90 | (lambda (key command) | ||
91 | `(define-key +key-leader-map ,key ,command)) | ||
92 | :documentation "Bind KEY to COMMAND in `+key-leader-map'." | ||
93 | :debug '(form sexp) | ||
94 | :ensure '(kbd nil) | ||
95 | :repeatable t) | ||
96 | |||
97 | (setup-define :+menu | ||
98 | (lambda (key command) | ||
99 | `(define-key +key-menu-map ,key ,command)) | ||
100 | :documentation "Bind KEY to COMMAND in `+key-leader-map'." | ||
101 | :debug '(form sexp) | ||
102 | :ensure '(kbd nil) | ||
103 | :repeatable t)) | ||
104 | |||
105 | (provide '+key) | ||
106 | ;;; +key.el ends here | ||
diff --git a/lisp/+kmacro.el b/lisp/+kmacro.el deleted file mode 100644 index a3cde61..0000000 --- a/lisp/+kmacro.el +++ /dev/null | |||
@@ -1,70 +0,0 @@ | |||
1 | ;;; +kmacro.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; Many of these come from this Reddit thread: | ||
6 | ;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/ | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (require 'kmacro) | ||
11 | |||
12 | ;; Indicate when a kmacro is being recorded in the mode-line | ||
13 | |||
14 | (defface +kmacro-modeline nil | ||
15 | "Face when kmacro is active") | ||
16 | |||
17 | (set-face-attribute '+kmacro-modeline nil | ||
18 | :background "Firebrick" | ||
19 | :box '(:line-width -1 :color "salmon" | ||
20 | :style released-button)) | ||
21 | |||
22 | (defun +kmacro-change-mode-line (&rest _) | ||
23 | "Remap the mode-line face when recording a kmacro." | ||
24 | |||
25 | (add-to-list 'face-remapping-alist '(mode-line . +kmacro-modeline))) | ||
26 | |||
27 | (defun +kmacro-restore-mode-line (&rest _) | ||
28 | "Restore the mode-line face after kmacro is done recording." | ||
29 | (setf face-remapping-alist | ||
30 | (assoc-delete-all 'mode-line face-remapping-alist))) | ||
31 | |||
32 | (define-minor-mode +kmacro-recording-indicator-mode | ||
33 | "Change the mode-line's face when recording a kmacro." | ||
34 | :lighter "" | ||
35 | :global t | ||
36 | (if +kmacro-recording-indicator-mode | ||
37 | (progn | ||
38 | (advice-add #'kmacro-start-macro :before #'+kmacro-change-mode-line) | ||
39 | (advice-add #'kmacro-keyboard-quit :after #'+kmacro-restore-mode-line) | ||
40 | (advice-add #'kmacro-end-macro :after #'+kmacro-restore-mode-line)) | ||
41 | (+kmacro-restore-mode-line) | ||
42 | (advice-remove #'kmacro-start-macro #'+kmacro-change-mode-line) | ||
43 | (advice-remove #'kmacro-keyboard-quit #'+kmacro-restore-mode-line) | ||
44 | (advice-remove #'kmacro-end-macro #'+kmacro-restore-mode-line))) | ||
45 | |||
46 | ;; Undo keyboard macros in a single bound (like vi!) | ||
47 | |||
48 | (defun +kmacro-block-undo (fn &rest args) | ||
49 | (let ((marker (prepare-change-group))) | ||
50 | (unwind-protect (apply fn args) | ||
51 | (undo-amalgamate-change-group marker)))) | ||
52 | |||
53 | (define-minor-mode +kmacro-block-undo-mode | ||
54 | "Undo kmacros all at once (like vi)." | ||
55 | :global t | ||
56 | :lighter " KUndo" | ||
57 | (if +kmacro-block-undo-mode | ||
58 | (dolist (fn '(kmacro-call-macro | ||
59 | kmacro-exec-ring-item | ||
60 | dot-mode-execute | ||
61 | apply-macro-to-region-lines)) | ||
62 | (advice-add fn :around #'+kmacro-block-undo)) | ||
63 | (dolist (fn '(kmacro-call-macro | ||
64 | kmacro-exec-ring-item | ||
65 | dot-mode-execute | ||
66 | apply-macro-to-region-lines)) | ||
67 | (advice-remove fn #'+kmacro-block-undo)))) | ||
68 | |||
69 | (provide '+kmacro) | ||
70 | ;;; +kmacro.el ends here | ||
diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 205e915..0000000 --- a/lisp/+link-hint.el +++ /dev/null | |||
@@ -1,169 +0,0 @@ | |||
1 | ;;; +link-hint.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'link-hint) | ||
7 | |||
8 | (defgroup +link-hint nil | ||
9 | "Extra customizations for `link-hint'." | ||
10 | :group 'link-hint) | ||
11 | |||
12 | (defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url | ||
13 | gnus-w3m-url | ||
14 | markdown-link | ||
15 | mu4e-attachment | ||
16 | mu4e-url | ||
17 | notmuch-hello | ||
18 | nov-link | ||
19 | org-link | ||
20 | shr-url | ||
21 | text-url | ||
22 | w3m-link | ||
23 | w3m-message-link) | ||
24 | "Link types to define `:open-secondary' for.") | ||
25 | |||
26 | (defvar +link-hint-map (make-sparse-keymap) | ||
27 | "Keymap for `link-hint' functionality.") | ||
28 | |||
29 | (cl-defmacro +link-hint-define-keyword (keyword handler docstring | ||
30 | &optional (types 'link-hint-types) | ||
31 | &rest rest | ||
32 | &key multiple &allow-other-keys) | ||
33 | "Set up a `link-hint' KEYWORD, with optional TYPES. | ||
34 | If TYPES is not present, use `link-hint-types'. | ||
35 | |||
36 | KEYWORD defines the link-hint type. It will be used to create a | ||
37 | function for opening links of the form \"link-hint-openKEYWORD\". | ||
38 | |||
39 | HANDLER is the function to open a link with. | ||
40 | |||
41 | DOCSTRING is the macro's documentation. | ||
42 | |||
43 | Keyword arguments are passed to `link-hint-define-type' prefixed | ||
44 | with the KEYWORD." | ||
45 | (declare (indent 2) | ||
46 | (doc-string 3)) | ||
47 | (let ((types (symbol-value types)) | ||
48 | (func-sym (intern (format "+link-hint-open%s" keyword))) | ||
49 | (mult-sym (intern (format "%s-multiple" keyword))) | ||
50 | (expr)) | ||
51 | ;; Define the type | ||
52 | (push `(dolist (type ',types) | ||
53 | (link-hint-define-type type | ||
54 | ,keyword ,handler | ||
55 | ,@(mapcar (lambda (el) | ||
56 | (if (eq el :multiple) | ||
57 | mult-sym | ||
58 | el)) | ||
59 | rest))) | ||
60 | expr) | ||
61 | ;; Define an opener | ||
62 | (push `(defun ,func-sym () | ||
63 | ,(format "%s\n\nDefined by `+link-hint-define'." docstring) | ||
64 | (interactive) | ||
65 | (avy-with link-hint-open-link | ||
66 | (link-hint--one ,keyword))) | ||
67 | expr) | ||
68 | ;; Handle `:multiple' | ||
69 | (when multiple | ||
70 | (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () | ||
71 | ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." | ||
72 | func-sym) | ||
73 | (avy-with link-hint-open-multiple-links | ||
74 | (link-hint--multiple ,keyword))) | ||
75 | expr) | ||
76 | (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () | ||
77 | ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." | ||
78 | func-sym) | ||
79 | (avy-with link-hint-open-all-links | ||
80 | (link-hint--all ,keyword))) | ||
81 | expr)) | ||
82 | ;; Return the built expression | ||
83 | `(progn ,@(nreverse expr)))) | ||
84 | |||
85 | (+link-hint-define-keyword :secondary browse-url-secondary-browser-function | ||
86 | "Open a link in the secondary browser." | ||
87 | +link-hint-open-secondary-types | ||
88 | :multiple t) | ||
89 | |||
90 | (defun +link-hint-open-secondary-setup (&optional types) | ||
91 | "Define the `:open-secondary' link-hint type for TYPES. | ||
92 | If TYPES is nil, define it for `+link-hint-open-secondary-types'." | ||
93 | (dolist (type (or types +link-hint-open-secondary-types)) | ||
94 | (link-hint-define-type type | ||
95 | :open-secondary browse-url-secondary-browser-function | ||
96 | :open-secondary-multiple t))) | ||
97 | |||
98 | (defun +link-hint-open-secondary () | ||
99 | "Open a link in the secondary browser." | ||
100 | (interactive) | ||
101 | (avy-with link-hint-open-link | ||
102 | (link-hint--one :open-secondary))) | ||
103 | |||
104 | (defun +link-hint-open-chrome-setup (&optional types) | ||
105 | "Define the `:open-chrome' link-hint type for TYPES. | ||
106 | If TYPES is nil, define it for `+link-hint-open-secondary-types'." | ||
107 | (dolist (type (or types +link-hint-open-secondary-types)) | ||
108 | (link-hint-define-type type | ||
109 | :open-chrome #'browse-url-chrome | ||
110 | :open-chrome-multiple t))) | ||
111 | |||
112 | (defun +link-hint-open-chrome () | ||
113 | "Open a link with chrome." | ||
114 | (interactive) | ||
115 | (avy-with link-hint-open-link | ||
116 | (link-hint--one :open-chrome))) | ||
117 | |||
118 | ;; (cl-defmacro +link-hint-add-type (keyword ) | ||
119 | ;; "Define link-hint type KEYWORD to operate on TYPES. | ||
120 | ;; If TYPES is nil or absent, define KEYWORD for all | ||
121 | ;; `link-hint-types'." | ||
122 | ;; (let (forms) | ||
123 | ;; (dolist (type (or types link-hint-types)) | ||
124 | ;; (push `(link-hint-define-type ,type ,keyword ,function) forms)) | ||
125 | ;; (push `(defun ,(intern (format "+link-hint%s" ,keyword)) | ||
126 | ;; )))) | ||
127 | |||
128 | (defun +link-hint-open-link (prefix) | ||
129 | "Open a link. | ||
130 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
131 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
132 | (interactive "P") | ||
133 | (avy-with link-hint-open-link | ||
134 | (link-hint--one (if prefix :open-secondary :open)))) | ||
135 | |||
136 | (defun +link-hint-open-multiple-links (prefix) | ||
137 | "Open multiple links. | ||
138 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
139 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
140 | (interactive "P") | ||
141 | (avy-with link-hint-open-multiple-links | ||
142 | (link-hint--one (if prefix :open-secondary :open)))) | ||
143 | |||
144 | (defun +link-hint-open-all-links (prefix) | ||
145 | "Open all visible links. | ||
146 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
147 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
148 | (interactive "P") | ||
149 | (avy-with link-hint-open-all-links | ||
150 | (link-hint--one (if prefix :open-secondary :open)))) | ||
151 | |||
152 | ;;; Pocket-reader.el integration | ||
153 | |||
154 | (defun +link-hint-pocket-add-setup (&optional types) | ||
155 | "Define the `:pocket-add' link-hint type for TYPES. | ||
156 | If TYPES is nil, define it for `link-hint-types'." | ||
157 | (dolist (type (or types link-hint-types)) | ||
158 | (link-hint-define-type type | ||
159 | :pocket-add #'pocket-reader-generic-add-link | ||
160 | :pocket-add-multiple t))) | ||
161 | |||
162 | (defun +link-hint-pocket-add () | ||
163 | "Add a link to the Pocket reader." | ||
164 | (interactive) | ||
165 | (avy-with link-hint-open-link | ||
166 | (link-hint--one :pocket-add))) | ||
167 | |||
168 | (provide '+link-hint) | ||
169 | ;;; +link-hint.el ends here | ||
diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index a78e40e..0000000 --- a/lisp/+lisp.el +++ /dev/null | |||
@@ -1,195 +0,0 @@ | |||
1 | ;;; +lisp.el --- extra lisp functionality -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | ;;; Sort sexps in a region. | ||
6 | ;; https://github.com/alphapapa/unpackaged.el | ||
7 | |||
8 | (defun +lisp-skip-whitespace () | ||
9 | (while (looking-at (rx (1+ (or space "\n")))) | ||
10 | (goto-char (match-end 0)))) | ||
11 | |||
12 | (defun +lisp-skip-both () | ||
13 | (while (cond ((or (nth 4 (syntax-ppss)) | ||
14 | (ignore-errors | ||
15 | (save-excursion | ||
16 | (forward-char 1) | ||
17 | (nth 4 (syntax-ppss))))) | ||
18 | (forward-line 1)) | ||
19 | ((looking-at (rx (1+ (or space "\n")))) | ||
20 | (goto-char (match-end 0)))))) | ||
21 | |||
22 | (defun +lisp-sort-sexps (beg end &optional key-fn sort-fn) | ||
23 | "Sort sexps between BEG and END. | ||
24 | Comments stay with the code below. | ||
25 | |||
26 | Optional argument KEY-FN will determine where in each sexp to | ||
27 | start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) | ||
28 | |||
29 | Optional argument SORT-FN will determine how to sort two sexps' | ||
30 | strings. It's passed to `sort'. By default, it sorts the sexps | ||
31 | with `string<' starting with the key determined by KEY-FN." | ||
32 | (interactive "r") | ||
33 | (save-excursion | ||
34 | (save-restriction | ||
35 | (narrow-to-region beg end) | ||
36 | (goto-char beg) | ||
37 | (+lisp-skip-both) | ||
38 | (cl-destructuring-bind (sexps markers) | ||
39 | (cl-loop do (+lisp-skip-whitespace) | ||
40 | for start = (point-marker) | ||
41 | for sexp = (ignore-errors | ||
42 | (read (current-buffer))) | ||
43 | for end = (point-marker) | ||
44 | while sexp | ||
45 | ;; Collect the real string, then one used for sorting. | ||
46 | collect (cons (buffer-substring (marker-position start) | ||
47 | (marker-position end)) | ||
48 | (save-excursion | ||
49 | (goto-char (marker-position start)) | ||
50 | (+lisp-skip-both) | ||
51 | (if key-fn | ||
52 | (funcall key-fn sexp) | ||
53 | (buffer-substring | ||
54 | (point) | ||
55 | (marker-position end))))) | ||
56 | into sexps | ||
57 | collect (cons start end) | ||
58 | into markers | ||
59 | finally return (list sexps markers)) | ||
60 | (setq sexps (sort sexps (if sort-fn sort-fn | ||
61 | (lambda (a b) | ||
62 | (string< (cdr a) (cdr b)))))) | ||
63 | (cl-loop for (real . sort) in sexps | ||
64 | for (start . end) in markers | ||
65 | do (progn | ||
66 | (goto-char (marker-position start)) | ||
67 | (insert-before-markers real) | ||
68 | (delete-region (point) (marker-position end)))))))) | ||
69 | |||
70 | ;;; Comment-or-uncomment-sexp | ||
71 | ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html | ||
72 | |||
73 | (defun +lisp-uncomment-sexp (&optional n) | ||
74 | "Uncomment N sexps around point." | ||
75 | (interactive "P") | ||
76 | (let* ((initial-point (point-marker)) | ||
77 | (inhibit-field-text-motion t) | ||
78 | (p) | ||
79 | (end (save-excursion | ||
80 | (when (elt (syntax-ppss) 4) | ||
81 | (re-search-backward comment-start-skip | ||
82 | (line-beginning-position) | ||
83 | t)) | ||
84 | (setq p (point-marker)) | ||
85 | (comment-forward (point-max)) | ||
86 | (point-marker))) | ||
87 | (beg (save-excursion | ||
88 | (forward-line 0) | ||
89 | (while (and (not (bobp)) | ||
90 | (= end (save-excursion | ||
91 | (comment-forward (point-max)) | ||
92 | (point)))) | ||
93 | (forward-line -1)) | ||
94 | (goto-char (line-end-position)) | ||
95 | (re-search-backward comment-start-skip | ||
96 | (line-beginning-position) | ||
97 | t) | ||
98 | (ignore-errors | ||
99 | (while (looking-at-p comment-start-skip) | ||
100 | (forward-char -1))) | ||
101 | (point-marker)))) | ||
102 | (unless (= beg end) | ||
103 | (uncomment-region beg end) | ||
104 | (goto-char p) | ||
105 | ;; Indentify the "top-level" sexp inside the comment. | ||
106 | (while (and (ignore-errors (backward-up-list) t) | ||
107 | (>= (point) beg)) | ||
108 | (skip-chars-backward (rx (syntax expression-prefix))) | ||
109 | (setq p (point-marker))) | ||
110 | ;; Re-comment everything before it. | ||
111 | (ignore-errors | ||
112 | (comment-region beg p)) | ||
113 | ;; And everything after it. | ||
114 | (goto-char p) | ||
115 | (forward-sexp (or n 1)) | ||
116 | (skip-chars-forward "\r\n[:blank:]") | ||
117 | (if (< (point) end) | ||
118 | (ignore-errors | ||
119 | (comment-region (point) end)) | ||
120 | ;; If this is a closing delimiter, pull it up. | ||
121 | (goto-char end) | ||
122 | (skip-chars-forward "\r\n[:blank:]") | ||
123 | (when (eq 5 (car (syntax-after (point)))) | ||
124 | (delete-indentation)))) | ||
125 | ;; Without a prefix, it's more useful to leave point where | ||
126 | ;; it was. | ||
127 | (unless n | ||
128 | (goto-char initial-point)))) | ||
129 | |||
130 | (defun +lisp-comment-sexp--raw () | ||
131 | "Comment the sexp at point or ahead of point." | ||
132 | (pcase (or (bounds-of-thing-at-point 'sexp) | ||
133 | (save-excursion | ||
134 | (skip-chars-forward "\r\n[:blank:]") | ||
135 | (bounds-of-thing-at-point 'sexp))) | ||
136 | (`(,l . ,r) | ||
137 | (goto-char r) | ||
138 | (skip-chars-forward "\r\n[:blank:]") | ||
139 | (save-excursion | ||
140 | (comment-region l r)) | ||
141 | (skip-chars-forward "\r\n[:blank:]")))) | ||
142 | |||
143 | (defun +lisp-comment-or-uncomment-sexp (&optional n) | ||
144 | "Comment the sexp at point and move past it. | ||
145 | If already inside (or before) a comment, uncomment instead. | ||
146 | With a prefix argument N, (un)comment that many sexps." | ||
147 | (interactive "P") | ||
148 | (if (or (elt (syntax-ppss) 4) | ||
149 | (< (save-excursion | ||
150 | (skip-chars-forward "\r\n[:blank:]") | ||
151 | (point)) | ||
152 | (save-excursion | ||
153 | (comment-forward 1) | ||
154 | (point)))) | ||
155 | (+lisp-uncomment-sexp n) | ||
156 | (dotimes (_ (or n 1)) | ||
157 | (+lisp-comment-sexp--raw)))) | ||
158 | |||
159 | ;;; Sort `setq' constructs | ||
160 | ;;https://emacs.stackexchange.com/questions/33039/ | ||
161 | |||
162 | (defun +lisp-sort-setq () | ||
163 | (interactive) | ||
164 | (save-excursion | ||
165 | (save-restriction | ||
166 | (let ((sort-end (progn | ||
167 | (end-of-defun) | ||
168 | (backward-char) | ||
169 | (point-marker))) | ||
170 | (sort-beg (progn | ||
171 | (beginning-of-defun) | ||
172 | (or (re-search-forward "[ \\t]*(" (point-at-eol) t) | ||
173 | (point-at-eol)) | ||
174 | (forward-sexp) | ||
175 | (or (re-search-forward "\\<" (point-at-eol) t) | ||
176 | (point-at-eol)) | ||
177 | (point-marker)))) | ||
178 | (narrow-to-region (1- sort-beg) (1+ sort-end)) | ||
179 | (sort-subr nil #'+lisp-sort-setq-next-record | ||
180 | #'+lisp-sort-setq-end-record))))) | ||
181 | |||
182 | (defun +lisp-sort-setq-next-record () | ||
183 | (condition-case nil | ||
184 | (progn | ||
185 | (forward-sexp 1) | ||
186 | (backward-sexp)) | ||
187 | ('scan-error (end-of-buffer)))) | ||
188 | |||
189 | (defun +lisp-sort-setq-end-record () | ||
190 | (condition-case nil | ||
191 | (forward-sexp 2) | ||
192 | ('scan-error (end-of-buffer)))) | ||
193 | |||
194 | (provide '+lisp) | ||
195 | ;;; +lisp.el ends here | ||
diff --git a/lisp/+message.el b/lisp/+message.el deleted file mode 100644 index b8bc234..0000000 --- a/lisp/+message.el +++ /dev/null | |||
@@ -1,26 +0,0 @@ | |||
1 | ;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | ;; Thanks to Alex Schroeder for this! | ||
8 | ;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically | ||
9 | |||
10 | (defun +message-check-for-signature-change (&rest ignore) | ||
11 | "Check for a change in the To: or Cc: fields" | ||
12 | (when (and (message--in-tocc-p) | ||
13 | (not (buffer-narrowed-p))) | ||
14 | (save-excursion | ||
15 | (goto-char (point-max)) | ||
16 | (let ((end (point))) | ||
17 | (when (re-search-backward message-signature-separator nil t) | ||
18 | (delete-region (1- (match-beginning 0)) end))) | ||
19 | (message-insert-signature)))) | ||
20 | |||
21 | (defun +message-signature-setup () | ||
22 | (make-local-variable 'after-change-functions) | ||
23 | (push '+message-check-for-signature-change after-change-functions)) | ||
24 | |||
25 | (provide '+message) | ||
26 | ;;; +message.el ends here | ||
diff --git a/lisp/+minibuffer.el b/lisp/+minibuffer.el deleted file mode 100644 index 7aa57a5..0000000 --- a/lisp/+minibuffer.el +++ /dev/null | |||
@@ -1,14 +0,0 @@ | |||
1 | ;;; +minibuffer.el -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | ;; https://www.manueluberti.eu//emacs/2021/12/10/shell-command/ | ||
6 | (defun +minibuffer-complete-history () | ||
7 | "Complete minibuffer history." | ||
8 | (interactive) | ||
9 | (completion-in-region (minibuffer--completion-prompt-end) (point-max) | ||
10 | (symbol-value minibuffer-history-variable) | ||
11 | nil)) | ||
12 | |||
13 | (provide '+minibuffer) | ||
14 | ;;; +minibuffer.el ends here | ||
diff --git a/lisp/+modeline.el b/lisp/+modeline.el deleted file mode 100644 index c6e8463..0000000 --- a/lisp/+modeline.el +++ /dev/null | |||
@@ -1,488 +0,0 @@ | |||
1 | ;;; +modeline.el --- my modeline customizations -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; `+modeline.el' is kind of a dumping ground for various | ||
6 | ;; modeline-related functions. I probably don't use everything in | ||
7 | ;; here. Credit given where possible. | ||
8 | |||
9 | ;;; Code: | ||
10 | |||
11 | (require '+util) | ||
12 | (require 'actually-selected-window) | ||
13 | (require 'simple-modeline) | ||
14 | (require 'minions) | ||
15 | |||
16 | (defgroup +modeline nil | ||
17 | "Various customization options for my modeline things." | ||
18 | :prefix "+modeline-" | ||
19 | :group 'simple-modeline) | ||
20 | |||
21 | (defcustom +modeline-default-spacer " " | ||
22 | "Default spacer to use for modeline elements. | ||
23 | All modeline elements take an optional argument, `spacer', which | ||
24 | will default to this string.") | ||
25 | |||
26 | ;;; Combinators | ||
27 | |||
28 | (defun +modeline-concat (segments &optional separator) | ||
29 | "Concatenate multiple functional modeline SEGMENTS. | ||
30 | Each segment in SEGMENTS is a function returning a mode-line | ||
31 | construct. | ||
32 | |||
33 | Segments are separated using SEPARATOR, which defaults to | ||
34 | `+modeline-default-spacer'. Only segments that evaluate to a | ||
35 | non-zero-length string will be separated, for a cleaner look. | ||
36 | |||
37 | This function returns a lambda that should be `:eval'd or | ||
38 | `funcall'd in a mode-line context." | ||
39 | (let ((separator (or separator +modeline-default-spacer))) | ||
40 | (lambda () | ||
41 | (let (this-sep result) | ||
42 | (dolist (segment segments) | ||
43 | (let ((segstr (funcall segment this-sep))) | ||
44 | (when (and segstr | ||
45 | (not (equal segstr ""))) | ||
46 | (push segstr result) | ||
47 | (setq this-sep separator)))) | ||
48 | (apply #'concat | ||
49 | (nreverse result)))))) | ||
50 | |||
51 | (defun +modeline-spacer (&optional n spacer &rest strings) | ||
52 | "Make an N-length SPACER, or prepend SPACER to STRINGS. | ||
53 | When called with no arguments, insert `+modeline-default-spacer'. | ||
54 | N will repeat SPACER N times, and defaults to 1. SPACER defaults | ||
55 | to `+modeline-default-spacer', but can be any string. STRINGS | ||
56 | should form a mode-line construct when `concat'ed." | ||
57 | (declare (indent 2)) | ||
58 | (let ((spacer (or spacer +modeline-default-spacer)) | ||
59 | (n (or n 1)) | ||
60 | (strings (cond((null strings) '("")) | ||
61 | ((equal strings '("")) nil) | ||
62 | ((atom strings) (list strings)) | ||
63 | (t strings))) | ||
64 | r) | ||
65 | (when strings (dotimes (_ n) (push spacer r))) | ||
66 | (apply #'concat (apply #'concat r) strings))) | ||
67 | |||
68 | ;;; Modeline segments | ||
69 | |||
70 | (defun +modeline-sanitize-string (string) | ||
71 | "Sanitize a string for `format-mode-line'." | ||
72 | (when string | ||
73 | (string-replace "%" "%%" string))) | ||
74 | |||
75 | (defcustom +modeline-buffer-name-max-length 0 | ||
76 | "Maximum length of `+modeline-buffer-name'. | ||
77 | If > 0 and < 1, use that portion of the window's width. If > 1, | ||
78 | use that many characters. If anything else, don't limit. If the | ||
79 | buffer name is longer than the max length, it will be shortened | ||
80 | and appended with `truncate-string-ellipsis'." | ||
81 | :type '(choice (const :tag "No maximum length" 0) | ||
82 | (natnum :tag "Number of characters") | ||
83 | (float :tag "Fraction of window's width"))) | ||
84 | |||
85 | (defcustom +modeline-buffer-position nil | ||
86 | "What to put in the `+modeline-buffer-name' position." | ||
87 | :type 'function | ||
88 | :local t) | ||
89 | |||
90 | (defun +modeline-buffer-name (&optional spacer) ; gonsie | ||
91 | "Display the buffer name." | ||
92 | (let ((bufname (string-trim (string-replace "%" "%%%%" (buffer-name))))) | ||
93 | (+modeline-spacer nil spacer | ||
94 | (if (and +modeline-buffer-position (fboundp +modeline-buffer-position)) | ||
95 | (funcall +modeline-buffer-position) | ||
96 | (propertize (cond | ||
97 | ((ignore-errors | ||
98 | (and | ||
99 | (> +modeline-buffer-name-max-length 0) | ||
100 | (< +modeline-buffer-name-max-length 1))) | ||
101 | (truncate-string-to-width bufname | ||
102 | (* (window-total-width) | ||
103 | +modeline-buffer-name-max-length) | ||
104 | nil nil t)) | ||
105 | ((ignore-errors | ||
106 | (> +modeline-buffer-name-max-length 1)) | ||
107 | (truncate-string-to-width bufname | ||
108 | +modeline-buffer-name-max-length | ||
109 | nil nil t)) | ||
110 | (t bufname)) | ||
111 | 'help-echo (or (buffer-file-name) | ||
112 | (buffer-name)) | ||
113 | 'mouse-face 'mode-line-highlight))))) | ||
114 | |||
115 | (defcustom +modeline-minions-icon "&" | ||
116 | "The \"icon\" for `+modeline-minions' button." | ||
117 | :type 'string) | ||
118 | |||
119 | (defun +modeline-minions (&optional spacer) | ||
120 | "Display a button for `minions-minor-modes-menu'." | ||
121 | (+modeline-spacer nil spacer | ||
122 | (propertize | ||
123 | +modeline-minions-icon | ||
124 | 'help-echo "Minor modes menu\nmouse-1: show menu." | ||
125 | 'local-map (purecopy (simple-modeline-make-mouse-map | ||
126 | 'mouse-1 | ||
127 | (lambda (event) | ||
128 | (interactive "e") | ||
129 | (with-selected-window | ||
130 | (posn-window (event-start event)) | ||
131 | (minions-minor-modes-menu))))) | ||
132 | 'mouse-face 'mode-line-highlight))) | ||
133 | |||
134 | (defcustom +modeline-major-mode-faces '((text-mode . font-lock-string-face) | ||
135 | (prog-mode . font-lock-keyword-face) | ||
136 | (t . font-lock-warning-face)) | ||
137 | "Mode->face mapping for `+modeline-major-mode'. | ||
138 | If the current mode is derived from the car of a cell, the face | ||
139 | in the cdr will be applied to the major-mode in the mode line." | ||
140 | :type '(alist :key-type function | ||
141 | :value-type face)) | ||
142 | |||
143 | (defface +modeline-major-mode-face nil | ||
144 | "Face for modeline major-mode.") | ||
145 | |||
146 | (defun +modeline-major-mode (&optional spacer) | ||
147 | "Display the current `major-mode'." | ||
148 | (+modeline-spacer nil spacer | ||
149 | "(" | ||
150 | (propertize ;; (+string-truncate (format-mode-line mode-name) 16) | ||
151 | (format-mode-line mode-name) | ||
152 | 'face (when (actually-selected-window-p) | ||
153 | ;; XXX: This is probably really inefficient. I need to | ||
154 | ;; simply detect which mode it's in when I change major | ||
155 | ;; modes (`change-major-mode-hook') and change the face | ||
156 | ;; there, probably. | ||
157 | ;; (catch :done (dolist (cel +modeline-major-mode-faces) | ||
158 | ;; (when (derived-mode-p (car cel)) | ||
159 | ;; (throw :done (cdr cel)))) | ||
160 | ;; (alist-get t +modeline-major-mode-faces)) | ||
161 | '+modeline-major-mode-face) | ||
162 | 'keymap (let ((map (make-sparse-keymap))) | ||
163 | (bindings--define-key map [mode-line down-mouse-1] | ||
164 | `(menu-item "Menu Bar" ignore | ||
165 | :filter ,(lambda (_) (mouse-menu-major-mode-map)))) | ||
166 | (define-key map [mode-line mouse-2] 'describe-mode) | ||
167 | (bindings--define-key map [mode-line down-mouse-3] | ||
168 | `(menu-item "Minions" minions-minor-modes-menu)) | ||
169 | map) | ||
170 | 'help-echo (+concat (list (format-mode-line mode-name) " mode") | ||
171 | "mouse-1: show menu" | ||
172 | "mouse-2: describe mode" | ||
173 | "mouse-3: display minor modes") | ||
174 | 'mouse-face 'mode-line-highlight) | ||
175 | ")")) | ||
176 | |||
177 | (defcustom +modeline-modified-icon-alist '((ephemeral . "*") | ||
178 | (readonly . "=") | ||
179 | (modified . "+") | ||
180 | (special . "~") | ||
181 | (t . "-")) | ||
182 | "\"Icons\" to display depending on buffer status in modeline. | ||
183 | The CAR of each field is one of `readonly', `modified', | ||
184 | `special', `ephemeral', or t, and the CDR is a string to display | ||
185 | in that mode. | ||
186 | |||
187 | `readonly' is true if the buffer is read-only and visiting a file. | ||
188 | `modified' is true if the buffer is modified. | ||
189 | `special' is true if the buffer is a special-mode or derived buffer. | ||
190 | `ephemeral' is true if the buffer is not visiting a file. | ||
191 | t is the fall-back, shown when nothing else in the alist applies. | ||
192 | |||
193 | The order of elements matters: whichever one matches first is applied." | ||
194 | :type '(alist :key-type symbol | ||
195 | :value-type string) | ||
196 | :options '("readonly" "modified" "special" "t")) | ||
197 | |||
198 | (defcustom +modeline-modified-icon-special-modes '(special-mode) | ||
199 | "Modes to apply the `special-mode' icon to in the | ||
200 | `+modeline-modified'." | ||
201 | :type '(repeat function)) | ||
202 | |||
203 | (defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified' | ||
204 | "Display a color-coded \"icon\" indicator for the buffer's status." | ||
205 | (let* ((icon (catch :icon | ||
206 | (dolist (cell +modeline-modified-icon-alist) | ||
207 | (when (pcase (car cell) | ||
208 | ('ephemeral (not (buffer-file-name))) | ||
209 | ('readonly buffer-read-only) | ||
210 | ('modified (buffer-modified-p)) | ||
211 | ('special | ||
212 | (apply 'derived-mode-p | ||
213 | +modeline-modified-icon-special-modes)) | ||
214 | ('t t) | ||
215 | (_ nil)) | ||
216 | (throw :icon cell)))))) | ||
217 | (+modeline-spacer nil spacer | ||
218 | (propertize (or (cdr-safe icon) "") | ||
219 | 'help-echo (format "Buffer \"%s\" is %s." | ||
220 | (buffer-name) | ||
221 | (pcase (car-safe icon) | ||
222 | ('t "unmodified") | ||
223 | ('nil "unknown") | ||
224 | (_ (car-safe icon)))))))) | ||
225 | |||
226 | (defun +modeline-narrowed (&optional spacer) | ||
227 | "Display an indication that the buffer is narrowed." | ||
228 | (when (buffer-narrowed-p) | ||
229 | (+modeline-spacer nil spacer | ||
230 | (propertize "N" | ||
231 | 'help-echo (format "%s\n%s" | ||
232 | "Buffer is narrowed." | ||
233 | "mouse-2: widen buffer.") | ||
234 | 'local-map (purecopy (simple-modeline-make-mouse-map | ||
235 | 'mouse-2 'mode-line-widen)) | ||
236 | 'face 'font-lock-doc-face | ||
237 | 'mouse-face 'mode-line-highlight)))) | ||
238 | |||
239 | (defun +modeline-reading-mode (&optional spacer) | ||
240 | "Display an indication that the buffer is in `reading-mode'." | ||
241 | (when reading-mode | ||
242 | (+modeline-spacer nil spacer | ||
243 | (propertize | ||
244 | (concat "R" (when (bound-and-true-p +eww-readable-p) "w")) | ||
245 | 'help-echo (format "%s\n%s" | ||
246 | "Buffer is in reading-mode." | ||
247 | "mouse-2: disable reading-mode.") | ||
248 | 'local-map (purecopy | ||
249 | (simple-modeline-make-mouse-map | ||
250 | 'mouse-2 (lambda (ev) | ||
251 | (interactive "e") | ||
252 | (with-selected-window | ||
253 | (posn-window | ||
254 | (event-start ev)) | ||
255 | (reading-mode -1) | ||
256 | (force-mode-line-update))))) | ||
257 | 'face 'font-lock-doc-face | ||
258 | 'mouse-face 'mode-line-highlight)))) | ||
259 | |||
260 | (define-minor-mode file-percentage-mode | ||
261 | "Toggle the percentage display in the mode line (File Percentage Mode)." | ||
262 | :init-value t :global t :group 'mode-line) | ||
263 | |||
264 | (defun +modeline--percentage () | ||
265 | "Return point's progress through current file as a percentage." | ||
266 | (let ((tot (count-screen-lines (point-min) (point-max) :ignore-invisible))) | ||
267 | (floor (* 100 (/ (float (line-number-at-pos)) tot))))) | ||
268 | |||
269 | (defun +modeline--buffer-contained-in-window-p () | ||
270 | "Whether the buffer is totally contained within its window." | ||
271 | (let ((window-min (save-excursion (move-to-window-line 0) (point))) | ||
272 | (window-max (save-excursion (move-to-window-line -1) (point)))) | ||
273 | (and (<= window-min (point-min)) | ||
274 | (>= window-max (point-max))))) | ||
275 | |||
276 | (defun +modeline-file-percentage (&optional spacer) | ||
277 | "Display the position in the current file." | ||
278 | (when file-percentage-mode | ||
279 | ;; (let ((perc (+modeline--percentage))) | ||
280 | ;; (propertize (+modeline-spacer nil spacer | ||
281 | ;; (cond | ||
282 | ;; ((+modeline--buffer-contained-in-window-p) "All") | ||
283 | ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top") | ||
284 | ;; ((= (line-number-at-pos) (line-number-at-pos (point-max))) "Bot") | ||
285 | ;; ;; Why the 10 %s? Not sure. `format' knocks them | ||
286 | ;; ;; down to 5, then `format-mode-line' kills all but | ||
287 | ;; ;; two. If I use only 8, the margin is much too | ||
288 | ;; ;; large. Something else is obviously going on, but | ||
289 | ;; ;; I'm at a loss as to what it could be. | ||
290 | ;; (t (format "%d%%%%%%%%%%" perc)))) | ||
291 | ;; ;; TODO: add scroll-up and scroll-down bindings. | ||
292 | ;; )) | ||
293 | (let ((perc (format-mode-line '(-2 "%p")))) | ||
294 | (+modeline-spacer nil spacer | ||
295 | "/" | ||
296 | (pcase perc | ||
297 | ("To" "Top") | ||
298 | ("Bo" "Bot") | ||
299 | ("Al" "All") | ||
300 | (_ (format ".%02d" (string-to-number perc)))))))) | ||
301 | |||
302 | (defun +modeline-file-percentage-ascii-icon (&optional spacer) | ||
303 | (when file-percentage-mode | ||
304 | (+modeline-spacer nil spacer | ||
305 | (let ((perc (format-mode-line '(-2 "%p")))) | ||
306 | (pcase perc | ||
307 | ("To" "/\\") | ||
308 | ("Bo" "\\/") | ||
309 | ("Al" "[]") | ||
310 | (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|")) | ||
311 | (perc (string-to-number perc))) | ||
312 | (aref vec (floor (/ perc 17)))))))))) | ||
313 | |||
314 | (defun +modeline-file-percentage-icon (&optional spacer) | ||
315 | "Display the position in the current file as an icon." | ||
316 | (when file-percentage-mode | ||
317 | (let ((perc (+modeline--percentage))) | ||
318 | (propertize (+modeline-spacer nil spacer | ||
319 | (cond | ||
320 | ((+modeline--buffer-contained-in-window-p) "111") | ||
321 | ((= perc 0) "000") | ||
322 | ((< perc 20) "001") | ||
323 | ((< perc 40) "010") | ||
324 | ((< perc 60) "011") | ||
325 | ((< perc 80) "100") | ||
326 | ((< perc 100) "101") | ||
327 | ((>= perc 100) "110"))) | ||
328 | 'help-echo (format "Point is %d%% through the buffer." | ||
329 | perc))))) | ||
330 | |||
331 | (define-minor-mode region-indicator-mode | ||
332 | "Toggle the region indicator in the mode line." | ||
333 | :init-value t :global t :group 'mode-line) | ||
334 | |||
335 | (defun +modeline-region (&optional spacer) | ||
336 | "Display an indicator if the region is active." | ||
337 | (when (and region-indicator-mode | ||
338 | (region-active-p)) | ||
339 | (+modeline-spacer nil spacer | ||
340 | (propertize (format "%d%s" | ||
341 | (apply '+ (mapcar (lambda (pos) | ||
342 | (- (cdr pos) | ||
343 | (car pos))) | ||
344 | (region-bounds))) | ||
345 | (if (and (< (point) (mark))) "-" "+")) | ||
346 | 'font-lock-face 'font-lock-variable-name-face)))) | ||
347 | |||
348 | (defun +modeline-line (&optional spacer) | ||
349 | (when line-number-mode | ||
350 | (+modeline-spacer nil spacer | ||
351 | "%3l"))) | ||
352 | |||
353 | (defun +modeline-column (&optional spacer) | ||
354 | (when column-number-mode | ||
355 | (+modeline-spacer nil spacer | ||
356 | "|" | ||
357 | (if column-number-indicator-zero-based "%2c" "%2C")))) | ||
358 | |||
359 | (defcustom +modeline-position-function nil | ||
360 | "Function to use instead of `+modeline-position' in modeline." | ||
361 | :type '(choice (const :tag "Default" nil) | ||
362 | function) | ||
363 | :local t) | ||
364 | |||
365 | (defun +modeline-position (&optional spacer) | ||
366 | "Display the current cursor position. | ||
367 | See `line-number-mode', `column-number-mode', and | ||
368 | `file-percentage-mode'. If `+modeline-position-function' is set | ||
369 | to a function in the current buffer, call that function instead." | ||
370 | (cond ((functionp +modeline-position-function) | ||
371 | (when-let* ((str (funcall +modeline-position-function))) | ||
372 | (+modeline-spacer nil spacer str))) | ||
373 | (t (funcall (+modeline-concat '(+modeline-region | ||
374 | +modeline-line | ||
375 | +modeline-column | ||
376 | +modeline-file-percentage) | ||
377 | ""))))) | ||
378 | |||
379 | (defun +modeline-vc (&optional spacer) | ||
380 | "Display the version control branch of the current buffer in the modeline." | ||
381 | ;; from https://www.gonsie.com/blorg/modeline.html, from Doom | ||
382 | (when-let ((backend (vc-backend buffer-file-name))) | ||
383 | (+modeline-spacer nil spacer | ||
384 | (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))))) | ||
385 | |||
386 | (defun +modeline-track (&optional spacer) | ||
387 | "Display `tracking-mode' information." | ||
388 | (when tracking-mode | ||
389 | tracking-mode-line-buffers)) | ||
390 | |||
391 | (defun +modeline-anzu (&optional spacer) | ||
392 | "Display `anzu--update-mode-line'." | ||
393 | (+modeline-spacer nil spacer | ||
394 | (anzu--update-mode-line))) | ||
395 | |||
396 | (defun +modeline-text-scale (&optional spacer) | ||
397 | "Display text scaling level." | ||
398 | ;; adapted from https://github.com/seagle0128/doom-modeline | ||
399 | (when (and (boundp 'text-scale-mode-amount) | ||
400 | (/= text-scale-mode-amount 0)) | ||
401 | (+modeline-spacer nil spacer | ||
402 | (concat (if (> text-scale-mode-amount 0) "+" "-") | ||
403 | (number-to-string text-scale-mode-amount))))) | ||
404 | |||
405 | (defun +modeline-ace-window-display (&optional spacer) | ||
406 | "Display `ace-window-display-mode' information in the modeline." | ||
407 | (when (and +ace-window-display-mode | ||
408 | ace-window-mode) | ||
409 | (+modeline-spacer nil spacer | ||
410 | (window-parameter (selected-window) 'ace-window-path)))) | ||
411 | |||
412 | (defun +modeline-god-mode (&optional spacer) | ||
413 | "Display an icon when `god-mode' is active." | ||
414 | (when (and (boundp 'god-local-mode) god-local-mode) | ||
415 | (+modeline-spacer nil spacer | ||
416 | (propertize "Ω" | ||
417 | 'help-echo (concat "God mode is active." | ||
418 | "\nmouse-1: exit God mode.") | ||
419 | 'local-map (purecopy | ||
420 | (simple-modeline-make-mouse-map | ||
421 | 'mouse-1 (lambda (e) | ||
422 | (interactive "e") | ||
423 | (with-selected-window | ||
424 | (posn-window | ||
425 | (event-start e)) | ||
426 | (god-local-mode -1) | ||
427 | (force-mode-line-update))))) | ||
428 | 'mouse-face 'mode-line-highlight)))) | ||
429 | |||
430 | (defun +modeline-input-method (&optional spacer) | ||
431 | "Display which input method is active." | ||
432 | (when current-input-method | ||
433 | (+modeline-spacer nil spacer | ||
434 | (propertize current-input-method-title | ||
435 | 'help-echo (format | ||
436 | (concat "Current input method: %s\n" | ||
437 | "mouse-1: Describe current input method\n" | ||
438 | "mouse-3: Toggle input method") | ||
439 | current-input-method) | ||
440 | 'local-map (purecopy | ||
441 | (let ((map (make-sparse-keymap))) | ||
442 | (define-key map [mode-line mouse-1] | ||
443 | (lambda (e) | ||
444 | (interactive "e") | ||
445 | (with-selected-window (posn-window (event-start e)) | ||
446 | (describe-current-input-method)))) | ||
447 | (define-key map [mode-line mouse-3] | ||
448 | (lambda (e) | ||
449 | (interactive "e") | ||
450 | (with-selected-window (posn-window (event-start e)) | ||
451 | (toggle-input-method nil :interactive)))) | ||
452 | map)) | ||
453 | 'mouse-face 'mode-line-highlight)))) | ||
454 | |||
455 | (defface +modeline-kmacro-indicator '((t :foreground "Firebrick")) | ||
456 | "Face for the kmacro indicator in the modeline.") | ||
457 | |||
458 | (defun +modeline-kmacro-indicator (&optional spacer) | ||
459 | "Display an indicator when recording a kmacro." | ||
460 | (when defining-kbd-macro | ||
461 | (+modeline-spacer nil spacer | ||
462 | (propertize "●" | ||
463 | 'face '+modeline-kmacro-indicator | ||
464 | 'help-echo (format (concat "Defining a macro\n" | ||
465 | "Current step: %d\n" | ||
466 | "mouse-1: Stop recording") | ||
467 | kmacro-counter) | ||
468 | 'local-map (purecopy (simple-modeline-make-mouse-map | ||
469 | 'mouse-1 (lambda (e) | ||
470 | (interactive "e") | ||
471 | (with-selected-window | ||
472 | (posn-window (event-start e)) | ||
473 | (kmacro-end-macro nil))))) | ||
474 | 'mouse-face 'mode-line-highlight)))) | ||
475 | |||
476 | (defface +nyan-mode-line nil | ||
477 | "Face for nyan-cat in mode line.") | ||
478 | |||
479 | (defun +modeline-nyan-on-focused (&optional spacer) | ||
480 | "Display the cat from `nyan-mode', but only on the focused window." | ||
481 | (require 'nyan-mode) | ||
482 | (when (and (or nyan-mode (bound-and-true-p +nyan-local-mode)) | ||
483 | (actually-selected-window-p)) | ||
484 | (+modeline-spacer nil spacer | ||
485 | (propertize (nyan-create) 'face '+nyan-mode-line)))) | ||
486 | |||
487 | (provide '+modeline) | ||
488 | ;;; +modeline.el ends here | ||
diff --git a/lisp/+mwim.el b/lisp/+mwim.el deleted file mode 100644 index 97a2b04..0000000 --- a/lisp/+mwim.el +++ /dev/null | |||
@@ -1,42 +0,0 @@ | |||
1 | ;;; +mwim.el --- Extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'seq) | ||
8 | |||
9 | (defgroup +mwim nil | ||
10 | "Extra `mwim' customizations." | ||
11 | :group 'mwim) | ||
12 | |||
13 | (defcustom +mwim-passthrough-modes nil | ||
14 | "Modes to not move-where-I-mean." | ||
15 | :type '(repeat function)) | ||
16 | |||
17 | (defun +mwim-beginning-maybe (&optional arg) | ||
18 | "Perform `mwim-beginning', maybe. | ||
19 | Will just do \\[beginning-of-line] in one of | ||
20 | `+mwim-passthrough-modes'." | ||
21 | (interactive) | ||
22 | (if (apply #'derived-mode-p +mwim-passthrough-modes) | ||
23 | (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode)))) | ||
24 | (key "C-a")) | ||
25 | (call-interactively (or (keymap-lookup this-mode-map key t t) | ||
26 | (keymap-lookup (current-global-map) key t t)))) | ||
27 | (call-interactively #'mwim-beginning))) | ||
28 | |||
29 | (defun +mwim-end-maybe (&optional arg) | ||
30 | "Perform `mwim-beginning', maybe. | ||
31 | Will just do \\[end-of-line] in one of | ||
32 | `+mwim-passthrough-modes'." | ||
33 | (interactive) | ||
34 | (if (apply #'derived-mode-p +mwim-passthrough-modes) | ||
35 | (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode)))) | ||
36 | (key "C-e")) | ||
37 | (call-interactively (or (keymap-lookup this-mode-map key t t) | ||
38 | (keymap-lookup (current-global-map) key t t)))) | ||
39 | (call-interactively #'mwim-end))) | ||
40 | |||
41 | (provide '+mwim) | ||
42 | ;;; +mwim.el ends here | ||
diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el deleted file mode 100644 index 9e79c5a..0000000 --- a/lisp/+notmuch.el +++ /dev/null | |||
@@ -1,97 +0,0 @@ | |||
1 | ;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't. | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'cl-lib) | ||
10 | (require 'notmuch) | ||
11 | |||
12 | (defvar +notmuch-send-dispatch-rules nil | ||
13 | "Alist of from addresses and variables to set when sending.") | ||
14 | |||
15 | (defun +notmuch-query-concat (&rest queries) | ||
16 | "Concatenate notmuch queries." | ||
17 | (mapconcat #'identity queries " AND ")) | ||
18 | |||
19 | (defun +send-mail-dispatch () | ||
20 | "Dispatch mail sender, depending on account." | ||
21 | (let ((from (message-fetch-field "from"))) | ||
22 | (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules | ||
23 | if (string-match-p addr from) return vars)) | ||
24 | (set (car vars) (cdr vars))))) | ||
25 | |||
26 | (defun +notmuch-correct-tags (args) | ||
27 | (list (car args) (mapcar #'string-trim (cadr args)))) | ||
28 | |||
29 | (defun +notmuch-goto (&optional prefix) | ||
30 | "Go straight to a `notmuch' search. | ||
31 | Without PREFIX argument, go to the first one in | ||
32 | `notmuch-saved-searches'; with a PREFIX argument, prompt the user | ||
33 | for which saved search to go to; with a double PREFIX | ||
34 | argument (\\[universal-argument] \\[universal-argument]), prompt | ||
35 | for search." | ||
36 | (interactive "P") | ||
37 | (pcase prefix | ||
38 | ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) | ||
39 | ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: " | ||
40 | (mapcar (lambda (el) | ||
41 | (plist-get el :name)) | ||
42 | notmuch-saved-searches)) | ||
43 | notmuch-saved-searches | ||
44 | :key (lambda (el) (plist-get el :name)) | ||
45 | :test #'equal) | ||
46 | :query))) | ||
47 | (_ (notmuch-search)))) | ||
48 | |||
49 | ;; Don't add an initial input when completing addresses | ||
50 | (el-patch-feature notmuch) | ||
51 | (with-eval-after-load 'notmuch | ||
52 | (el-patch-defun notmuch-address-selection-function (prompt collection initial-input) | ||
53 | "Call (`completing-read' | ||
54 | PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" | ||
55 | (completing-read | ||
56 | prompt collection nil nil | ||
57 | (el-patch-swap initial-input | ||
58 | nil) | ||
59 | 'notmuch-address-history))) | ||
60 | |||
61 | (defcustom +notmuch-spam-tags '("+spam" "+Spam") | ||
62 | "A list of tag changes to apply when marking a thread as spam." | ||
63 | :type '(repeat string)) | ||
64 | |||
65 | (defun +notmuch-tree-mark-spam-then-next (&optional ham beg end) | ||
66 | "Mark the current message as spam and move to the next." | ||
67 | (interactive "P") | ||
68 | (+notmuch-tree-mark-spam ham) | ||
69 | (notmuch-tree-next-matching-message)) | ||
70 | |||
71 | (defun +notmuch-tree-mark-spam (&optional ham) | ||
72 | "Mark the current message as spam. | ||
73 | That is, apply the tag changes in `+notmuch-spam-tags' to it. If | ||
74 | an optional prefix HAM argument is given, the message will be | ||
75 | marked as not-spam (\"ham\"), i.e., the tag changes in | ||
76 | `+notmuch-spam-tags' will be reversed." | ||
77 | (interactive "P") | ||
78 | (when +notmuch-spam-tags | ||
79 | (notmuch-tree-tag | ||
80 | (notmuch-tag-change-list +notmuch-spam-tags ham)))) | ||
81 | |||
82 | (defun +notmuch-search-mark-spam (&optional ham beg end) | ||
83 | "Mark the current thread or region as spam. | ||
84 | This adds the tags in `+notmuch-spam-tags' to the message. With | ||
85 | an optional HAM prefix argument, mark the messages as | ||
86 | not-spam (\"ham\"). | ||
87 | |||
88 | This function advances the next thread when finished." | ||
89 | (interactive (cons current-prefix-arg (notmuch-interactive-region))) | ||
90 | (when +notmuch-spam-tags | ||
91 | (notmuch-search-tag | ||
92 | (notmuch-tag-change-list +notmuch-spam-tags ham) beg end)) | ||
93 | (when (eq beg end) | ||
94 | (notmuch-search-next-thread))) | ||
95 | |||
96 | (provide '+notmuch) | ||
97 | ;;; +notmuch.el ends here | ||
diff --git a/lisp/+nyan-mode.el b/lisp/+nyan-mode.el deleted file mode 100644 index 33ae9af..0000000 --- a/lisp/+nyan-mode.el +++ /dev/null | |||
@@ -1,42 +0,0 @@ | |||
1 | ;;; +nyan-mode.el --- Extras for nyan-mode -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | ;;; Update even without line number in the mode line. | ||
8 | |||
9 | (defcustom +nyan-mode-update-functions | ||
10 | '( end-of-buffer beginning-of-buffer | ||
11 | next-line previous-line | ||
12 | org-next-visible-heading org-previous-visible-heading) | ||
13 | "Functions after which to force a mode-line update." | ||
14 | :type '(repeat function)) | ||
15 | |||
16 | (defun +nyan-mode--fmlu (&rest _) | ||
17 | "Update the mode-line, advice-style." | ||
18 | (force-mode-line-update)) | ||
19 | |||
20 | (defun +nyan-mode-advice (&rest _) | ||
21 | "Advise line-moving functions when in `nyan-mode'." | ||
22 | (dolist (fn +nyan-mode-update-functions) | ||
23 | (if nyan-mode | ||
24 | (advice-add fn :after #'+nyan-mode--fmlu) | ||
25 | (advice-remove fn #'+nyan-mode--fmlu)))) | ||
26 | |||
27 | (defface +nyan-mode-line nil | ||
28 | "Face for the nyan-mode mode-line indicator.") | ||
29 | |||
30 | (define-minor-mode +nyan-local-mode | ||
31 | "My very own `nyan-mode' that isn't global and doesn't update the mode-line." | ||
32 | :global nil | ||
33 | :group 'nyan | ||
34 | (dolist (fn +nyan-mode-update-functions) | ||
35 | (if +nyan-local-mode | ||
36 | (advice-add fn :after #'+nyan-mode--fmlu) | ||
37 | (advice-remove fn #'+nyan-mode--fmlu)))) | ||
38 | |||
39 | (define-globalized-minor-mode +nyan-mode +nyan-local-mode +nyan-local-mode) | ||
40 | |||
41 | (provide '+nyan-mode) | ||
42 | ;;; +nyan-mode.el ends here | ||
diff --git a/lisp/+orderless.el b/lisp/+orderless.el deleted file mode 100644 index ac8c1b4..0000000 --- a/lisp/+orderless.el +++ /dev/null | |||
@@ -1,60 +0,0 @@ | |||
1 | ;;; +orderless.el --- Mostly from minad -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; See https://github.com/minad/consult/wiki#minads-orderless-configuration | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'orderless) | ||
10 | |||
11 | ;;; Dispataching | ||
12 | |||
13 | (defvar +orderless-dispatch-alist '((?% . char-fold-to-regexp) | ||
14 | (?! . orderless-without-literal) | ||
15 | (?` . orderless-initialism) | ||
16 | (?= . orderless-literal) | ||
17 | (?~ . orderless-flex)) | ||
18 | "Charcters to dispatch styles on orderless segments.") | ||
19 | |||
20 | (defun +orderless-dispatch (pattern index _total) | ||
21 | "Dispatch orderless segments of a search string. | ||
22 | Dispatchers are taken from `+orderless-dispatch-alist', and added | ||
23 | to the following defaults: | ||
24 | |||
25 | - regexp$ :: matches REGEXP at the end of the pattern. | ||
26 | - .ext :: matches EXT (at end of pattern) | ||
27 | |||
28 | Dispatch characters can be added at the beginning or ending of a | ||
29 | segment to make that segment match accordingly." | ||
30 | (cond | ||
31 | ;; Ensure that $ works with Consult commands, which add disambiguation | ||
32 | ;; suffixes | ||
33 | ((string-suffix-p "$" pattern) | ||
34 | (cons 'orderless-regexp | ||
35 | (concat (substring pattern 0 -1) "[\x100000-\x10FFFD]*$"))) | ||
36 | ;; File extensions | ||
37 | ((and | ||
38 | ;; Completing filename or eshell | ||
39 | (or minibuffer-completing-file-name | ||
40 | (derived-mode-p 'eshell-mode)) | ||
41 | ;; File extension | ||
42 | (string-match-p "\\`\\.." pattern)) | ||
43 | (cons 'orderless-regexp | ||
44 | (concat "\\." (substring pattern 1) "[\x100000-\x10FFFD]*$"))) | ||
45 | ;; Ignore single ! | ||
46 | ((string= "!" pattern) `(orderless-literal . "")) | ||
47 | ;; Prefix and suffix | ||
48 | ((if-let (x (assq (aref pattern 0) +orderless-dispatch-alist)) | ||
49 | (cons (cdr x) (substring pattern 1)) | ||
50 | (when-let (x (assq (aref pattern (1- (length pattern))) | ||
51 | +orderless-dispatch-alist)) | ||
52 | (cons (cdr x) (substring pattern 0 -1))))))) | ||
53 | |||
54 | (orderless-define-completion-style +orderless-with-initialism | ||
55 | (orderless-matching-styles '(orderless-initialism | ||
56 | orderless-literal | ||
57 | orderless-regexp))) | ||
58 | |||
59 | (provide '+orderless) | ||
60 | ;;; +orderless.el ends here | ||
diff --git a/lisp/+org-attach.el b/lisp/+org-attach.el deleted file mode 100644 index 5e7cc7f..0000000 --- a/lisp/+org-attach.el +++ /dev/null | |||
@@ -1,29 +0,0 @@ | |||
1 | ;;; +org-attach.el --- Fixes for org-attach -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; `org-attach-attach' doesn't fix the path name. Before I submit a bug, I'm | ||
6 | ;; just fixing it by advising `org-attach-attach'. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (defun +org-attach-attach-fix-args (args) | ||
11 | "ADVICE for `org-attach-attach' to normalize FILE first. | ||
12 | VISIT-DIR and METHOD are passed through unchanged. | ||
13 | |||
14 | This should be applied as `:filter-args' advice." | ||
15 | (cons (expand-file-name (car args)) (cdr args))) | ||
16 | |||
17 | (define-minor-mode +org-attach-fix-args-mode | ||
18 | "Fix the arguments passed to `org-attach-attach'. | ||
19 | This mode normalizes the filename passed to `org-attach-attach' | ||
20 | so that links can be properly made." | ||
21 | :lighter "" | ||
22 | :keymap nil | ||
23 | :global t ; I figure, what does this hurt? | ||
24 | (if +org-attach-fix-args-mode | ||
25 | (advice-add 'org-attach-attach :filter-args #'+org-attach-attach-fix-args) | ||
26 | (advice-remove 'org-attach-attach #'+org-attach-attach-fix-args))) | ||
27 | |||
28 | (provide '+org-attach) | ||
29 | ;;; +org-attach.el ends here | ||
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 7ed4e00..0000000 --- a/lisp/+org-capture.el +++ /dev/null | |||
@@ -1,164 +0,0 @@ | |||
1 | ;;; +org-capture.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'acdw) | ||
7 | ;; We don't require `org-capture' here because I'll have to require this library | ||
8 | ;; to init.el /before/ org-capture is fully needed. But I do need to declare | ||
9 | ;; `org-capture-templates'. | ||
10 | (defvar org-capture-templates nil) | ||
11 | |||
12 | (defun +org-capture--get (key &optional list) | ||
13 | "Find KEY in LIST, or return nil. | ||
14 | LIST defaults to `org-capture-templates'." | ||
15 | (alist-get key (or list org-capture-templates) nil nil #'equal)) | ||
16 | |||
17 | ;; Set it up as a generic value. Based on the one for `alist-get'. | ||
18 | (gv-define-expander +org-capture--get | ||
19 | (lambda (do key &optional alist) | ||
20 | (setq alist (or alist org-capture-templates)) | ||
21 | (macroexp-let2 macroexp-copyable-p k key | ||
22 | (gv-letplace (getter setter) alist | ||
23 | (macroexp-let2 nil p `(assoc ,k ,getter 'equal) | ||
24 | (funcall do `(cdr ,p) | ||
25 | (lambda (v) | ||
26 | (macroexp-let2 nil v v | ||
27 | (let ((set-exp | ||
28 | `(if ,p (setcdr ,p ,v) | ||
29 | ,(funcall setter | ||
30 | `(cons (setq ,p (cons ,k ,v)) | ||
31 | ,getter))))) | ||
32 | `(progn | ||
33 | ,set-exp | ||
34 | ,v)))))))))) | ||
35 | |||
36 | (defun +org-capture-sort (&optional list) | ||
37 | "Sort LIST by string keys. | ||
38 | LIST is a symbol and defaults to `org-capture-templates'." | ||
39 | (setq list (or list 'org-capture-templates)) | ||
40 | (set list (sort (symbol-value list) (lambda (a b) | ||
41 | (string< (car a) (car b)))))) | ||
42 | |||
43 | (defun +org-capture-sort-after-init (&optional list) | ||
44 | "Sort LIST with `+org-capture-sort' after Emacs init." | ||
45 | (+ensure-after-init #'+org-capture-sort)) | ||
46 | |||
47 | ;;;###autoload | ||
48 | (defun +org-capture-templates-setf (key value &optional list sort-after) | ||
49 | "Add KEY to LIST, using `setf'. | ||
50 | LIST is a symbol and defaults to `org-capture-templates' -- so | ||
51 | this function sets values on a list that's structured as such. | ||
52 | |||
53 | Thus, KEY is a string key. If it's longer than one character, | ||
54 | this function will search LIST for each successive run of | ||
55 | characters before the final, ensuring sub-lists exist of the | ||
56 | form (CHARS DESCRIPTION). | ||
57 | |||
58 | For example, if KEY is \"abc\", first a LIST item of the form (a | ||
59 | DESCRIPTION), if non-existant, will be added to the list (with a | ||
60 | default description), then an item of the | ||
61 | form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST. | ||
62 | |||
63 | VALUE is the template or group header required for | ||
64 | `org-capture-templates', which see. | ||
65 | |||
66 | SORT-AFTER, when set to t, will call | ||
67 | `+org-capture-templates-sort' after setting, to ensure org can | ||
68 | properly process the variable." | ||
69 | ;; LIST defaults to `org-capture-templates' | ||
70 | (declare (indent 2)) | ||
71 | (unless list (setq list 'org-capture-templates)) | ||
72 | ;; Ensure VALUE is a list to cons properly | ||
73 | (unless (listp value) (setq value (list value))) | ||
74 | (when (> (length key) 1) | ||
75 | ;; Check for existence of groups. | ||
76 | (let ((expected (cl-loop for i from 1 to (1- (length key)) | ||
77 | collect (substring key 0 i) into keys | ||
78 | finally return keys))) | ||
79 | (cl-loop for ek in expected | ||
80 | if (not (+org-capture--get ek (symbol-value list))) do | ||
81 | (setf (+org-capture--get ek (symbol-value list)) | ||
82 | (list (format "(Group %s)" ek)))))) | ||
83 | (prog1 ;; Set KEY to VALUE | ||
84 | (setf (+org-capture--get key (symbol-value list)) value) | ||
85 | ;; Sort after, maybe | ||
86 | (when sort-after (+org-capture-sort list)))) | ||
87 | |||
88 | (defun +org-template--ensure-path (keys &optional list) | ||
89 | "Ensure path of keys exists in `org-capture-templates'." | ||
90 | (unless list (setq list 'org-capture-templates)) | ||
91 | (when (> (length key) 1) | ||
92 | ;; Check for existence of groups. | ||
93 | (let ((expected (cl-loop for i from 1 to (1- (length key)) | ||
94 | collect (substring key 0 i) into keys | ||
95 | finally return keys))) | ||
96 | (cl-loop for ek in expected | ||
97 | if (not (+org-capture--get ek (symbol-value list))) do | ||
98 | (setf (+org-capture--get ek (symbol-value list)) | ||
99 | (list (format "(Group %s)" ek))))))) | ||
100 | |||
101 | (defcustom +org-capture-default-type 'entry | ||
102 | "Default template for `org-capture-templates'." | ||
103 | :type '(choice (const :tag "Entry" entry) | ||
104 | (const :tag "Item" item) | ||
105 | (const :tag "Check Item" checkitem) | ||
106 | (const :tag "Table Line" table-line) | ||
107 | (const :tag "Plain Text" plain))) | ||
108 | |||
109 | (defcustom +org-capture-default-target "" | ||
110 | "Default target for `org-capture-templates'." | ||
111 | ;; TODO: type | ||
112 | ) | ||
113 | |||
114 | (defcustom +org-capture-default-template nil | ||
115 | "Default template for `org-capture-templates'." | ||
116 | ;; TODO: type | ||
117 | ) | ||
118 | |||
119 | (defun +org-define-capture-templates-group (keys description) | ||
120 | "Add a group title to `org-capture-templates'." | ||
121 | (setf (+org-capture--get keys org-capture-templates) | ||
122 | (list description))) | ||
123 | |||
124 | ;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]] | ||
125 | (defun +org-define-capture-template (keys description &rest args) | ||
126 | "Define a capture template and necessary antecedents. | ||
127 | ARGS is a plist, which in addition to the additional options | ||
128 | `org-capture-templates' accepts, takes the following and places | ||
129 | them accordingly: :type, :target, and :template. Each of these | ||
130 | corresponds to the same field in `org-capture-templates's | ||
131 | docstring, which see. Likewise with KEYS and DESCRIPTION, which | ||
132 | are passed separately to the function. | ||
133 | |||
134 | This function will also create all the necessary intermediate | ||
135 | capture keys needed for `org-capture'; that is, if KEYS is | ||
136 | \"wcp\", entries for \"w\" and \"wc\" will both be ensured in | ||
137 | `org-capture-templates'." | ||
138 | (declare (indent 2)) | ||
139 | ;; Check for existence of parent groups | ||
140 | (when (> (length keys) 1) | ||
141 | (let ((expected (cl-loop for i from 1 to (1- (length keys)) | ||
142 | collect (substring 0 i) into keys | ||
143 | finally return keys))) | ||
144 | (cl-loop | ||
145 | for ek in expected | ||
146 | if (not (+org-capture--get ek org-capture-templates)) | ||
147 | do (+org-define-capture-templates-group ek (format "(Group %s)" ek))))) | ||
148 | (if (null args) | ||
149 | ;; Add the title | ||
150 | (+org-define-capture-templates-group keys description) | ||
151 | ;; Add the capture template. | ||
152 | (setf (+org-capture--get keys org-capture-templates) | ||
153 | (append (list (or (plist-get args :type) | ||
154 | +org-capture-default-type) | ||
155 | (or ( plist-get args :target) | ||
156 | +org-capture-default-target) | ||
157 | (or (plist-get args :template) | ||
158 | +org-capture-default-template)) | ||
159 | (cl-loop for (key val) on args by #'cddr | ||
160 | unless (member key '(:type :target :template)) | ||
161 | append (list key val)))))) | ||
162 | |||
163 | (provide '+org-capture) | ||
164 | ;;; +org-capture.el ends here | ||
diff --git a/lisp/+org-drawer-list.el b/lisp/+org-drawer-list.el deleted file mode 100644 index 5066d4d..0000000 --- a/lisp/+org-drawer-list.el +++ /dev/null | |||
@@ -1,47 +0,0 @@ | |||
1 | ;;; +org-drawer-list.el --- Add stuff to org drawers easy-style -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'org) | ||
8 | (require '+org) | ||
9 | (require 'ol) | ||
10 | (require 'org-drawer-list) | ||
11 | |||
12 | (defcustom +org-drawer-list-resources-drawer "RESOURCES" | ||
13 | "Where to add links with `+org-drawer-list-add-resource'.") | ||
14 | |||
15 | (defun +org-drawer-list-add-resource (url &optional title) | ||
16 | "Add URL to the resource drawer of the current tree. | ||
17 | The resource drawer is given by the variable | ||
18 | `+org-drawer-list-resources-drawer'. If optional TITLE is given, | ||
19 | format the list item as an Org link." | ||
20 | (interactive | ||
21 | (let* ((clipboard-url (if (string-match-p (rx (sequence bos | ||
22 | (or "http" | ||
23 | "gemini" | ||
24 | "gopher" | ||
25 | "tel" | ||
26 | "mailto"))) | ||
27 | (current-kill 0)) | ||
28 | (string-trim (current-kill 0)) | ||
29 | (read-string "Resource URL: "))) | ||
30 | (url-title (let ((clipboard-headings | ||
31 | (+org-insert--get-title-and-headings clipboard-url))) | ||
32 | (read-string "title (edit): " | ||
33 | (completing-read | ||
34 | "title: " clipboard-headings | ||
35 | nil nil nil nil (car clipboard-headings)))))) | ||
36 | (list clipboard-url url-title))) | ||
37 | (let (current-visible-mode visible-mode) | ||
38 | ;; XXX: This is not the "proper" way to fix the issue I was having --- I've | ||
39 | ;; isolated the bug to somewhere in `org-insert-item', but this fix works | ||
40 | ;; well enough™ for now. | ||
41 | (visible-mode +1) | ||
42 | (org-drawer-list-add +org-drawer-list-resources-drawer | ||
43 | (org-link-make-string url title)) | ||
44 | (visible-mode (if current-visible-mode +1 -1)))) | ||
45 | |||
46 | (provide '+org-drawer-list) | ||
47 | ;;; +org-drawer-list.el ends here | ||
diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el deleted file mode 100644 index 89b2708..0000000 --- a/lisp/+org-wc.el +++ /dev/null | |||
@@ -1,112 +0,0 @@ | |||
1 | ;;; +org-wc.el --- org-wc in the modeline -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'org-wc) | ||
8 | (require '+modeline) | ||
9 | (require 'cl-lib) | ||
10 | |||
11 | (defgroup +org-wc nil | ||
12 | "Extra fast word-counting in `org-mode'" | ||
13 | :group 'org-wc | ||
14 | :group 'org) | ||
15 | |||
16 | (defvar-local +org-wc-word-count nil | ||
17 | "Running total of words in this buffer.") | ||
18 | |||
19 | (defcustom +org-wc-update-after-funcs '(org-narrow-to-subtree | ||
20 | org-narrow-to-block | ||
21 | org-narrow-to-element | ||
22 | org-capture-narrow) | ||
23 | "Functions after which to update the word count." | ||
24 | :type '(repeat function)) | ||
25 | |||
26 | (defcustom +org-wc-deletion-idle-timer 0.25 | ||
27 | "Length of time, in seconds, to wait before updating word-count." | ||
28 | :type 'number) | ||
29 | |||
30 | (defcustom +org-wc-huge-change 5000 | ||
31 | "Number of characters that constitute a \"huge\" insertion." | ||
32 | :type 'number) | ||
33 | |||
34 | (defcustom +org-wc-huge-buffer 10000 | ||
35 | "Number of words past which we're not going to try to count." | ||
36 | :type 'number) | ||
37 | |||
38 | (defvar +org-wc-correction -5 | ||
39 | "Number to add to `+org-wc-word-count', for some reason? | ||
40 | `+org-wc-word-count' seems to consistently be off by 5. Thus | ||
41 | this correction. (At some point I should correct the underlying | ||
42 | code... probably).") | ||
43 | |||
44 | (defvar-local +org-wc-update-timer nil) | ||
45 | |||
46 | (defun +org-wc-delayed-update (&rest _) | ||
47 | (if +org-wc-update-timer | ||
48 | (setq +org-wc-update-timer nil) | ||
49 | (setq +org-wc-update-timer | ||
50 | (run-with-idle-timer +org-wc-deletion-idle-timer nil #'+org-wc-update)))) | ||
51 | |||
52 | (defun +org-wc-force-update () | ||
53 | (interactive) | ||
54 | (message "Counting words...") | ||
55 | (when (timerp +org-wc-update-timer) | ||
56 | (cancel-timer +org-wc-update-timer)) | ||
57 | (+org-wc-update) | ||
58 | (message "Counting words...done")) | ||
59 | |||
60 | (defun +org-wc-update (&rest _) ; Needs variadic parameters, since it's advice | ||
61 | (dlet ((+org-wc-counting t)) | ||
62 | (+org-wc-buffer) | ||
63 | (force-mode-line-update) | ||
64 | (setq +org-wc-update-timer nil))) | ||
65 | |||
66 | (defun +org-wc-changed (start end length) | ||
67 | (+org-wc-delayed-update)) | ||
68 | |||
69 | (defun +org-wc-buffer () | ||
70 | "Count the words in the buffer." | ||
71 | (when (and (derived-mode-p 'org-mode) | ||
72 | (not (eq +org-wc-word-count 'huge))) | ||
73 | (setq +org-wc-word-count | ||
74 | (cond | ||
75 | ((> (count-words (point-min) (point-max)) | ||
76 | +org-wc-huge-buffer) | ||
77 | 'huge) | ||
78 | (t (org-word-count-aux (point-min) (point-max))))))) | ||
79 | |||
80 | (defvar +org-wc-counting nil | ||
81 | "Are we currently counting?") | ||
82 | |||
83 | (defun +org-wc-recount-widen (&rest _) | ||
84 | (when (and (not +org-wc-counting)) | ||
85 | (+org-wc-update))) | ||
86 | |||
87 | (defun +org-wc-modeline () | ||
88 | (cond | ||
89 | ((eq +org-wc-word-count 'huge) "huge") | ||
90 | (+org-wc-word-count (format "%sw" (max 0 (+ +org-wc-word-count +org-wc-correction)))))) | ||
91 | |||
92 | (define-minor-mode +org-wc-mode | ||
93 | "Count words in `org-mode' buffers in the mode-line." | ||
94 | :lighter "" | ||
95 | :keymap (let ((map (make-sparse-keymap))) | ||
96 | (define-key map (kbd "C-c C-.") #'+org-wc-force-update) | ||
97 | map) | ||
98 | (if +org-wc-mode | ||
99 | (progn ; turn on | ||
100 | (+org-wc-buffer) | ||
101 | (add-hook 'after-change-functions #'+org-wc-delayed-update nil t) | ||
102 | (setq-local +modeline-position-function #'+org-wc-modeline) | ||
103 | (dolist (fn +org-wc-update-after-funcs) | ||
104 | (advice-add fn :after #'+org-wc-update))) | ||
105 | (progn ; turn off | ||
106 | (remove-hook 'after-change-functions #'+org-wc-delayed-update t) | ||
107 | (kill-local-variable '+modeline-position-function) | ||
108 | (dolist (fn +org-wc-update-after-funcs) | ||
109 | (advice-remove fn #'+org-wc-update))))) | ||
110 | |||
111 | (provide '+org-wc) | ||
112 | ;;; +org-wc.el ends here | ||
diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index dc0ce1b..0000000 --- a/lisp/+org.el +++ /dev/null | |||
@@ -1,816 +0,0 @@ | |||
1 | ;;; +org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'el-patch) | ||
6 | (require 'org) | ||
7 | (require 'org-element) | ||
8 | (require 'ox) | ||
9 | |||
10 | ;;; org-return-dwim - [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] | ||
11 | |||
12 | (defun +org-element-descendant-of (type element) | ||
13 | "Return non-nil if ELEMENT is a descendant of TYPE. | ||
14 | TYPE should be an element type, like `item' or `paragraph'. | ||
15 | ELEMENT should be a list like that returned by `org-element-context'." | ||
16 | ;; MAYBE: Use `org-element-lineage'. | ||
17 | (when-let* ((parent (org-element-property :parent element))) | ||
18 | (or (eq type (car parent)) | ||
19 | (+org-element-descendant-of type parent)))) | ||
20 | |||
21 | (defun +org-return-dwim (&optional prefix) | ||
22 | "A helpful replacement for `org-return'. With PREFIX, call `org-return'. | ||
23 | |||
24 | On headings, move point to position after entry content. In | ||
25 | lists, insert a new item or end the list, with checkbox if | ||
26 | appropriate. In tables, insert a new row or end the table." | ||
27 | (interactive "P") | ||
28 | ;; Auto-fill if enabled | ||
29 | (when auto-fill-function | ||
30 | (if (listp auto-fill-function) | ||
31 | (dolist (func auto-fill-function) | ||
32 | (funcall func)) | ||
33 | (funcall auto-fill-function))) | ||
34 | (if prefix | ||
35 | ;; Handle prefix args | ||
36 | (pcase prefix | ||
37 | ('(4) (newline)) | ||
38 | ('(16) (newline 2)) | ||
39 | ;; this is ... not ideal. but whatever. | ||
40 | (_ (newline prefix))) | ||
41 | (cond | ||
42 | ;; Act depending on context around point. | ||
43 | ((and org-return-follows-link | ||
44 | (eq 'link (car (org-element-context)))) | ||
45 | ;; Link: Open it. | ||
46 | (org-open-at-point-global)) | ||
47 | |||
48 | ((org-at-heading-p) | ||
49 | ;; Heading: Move to position after entry content. | ||
50 | ;; NOTE: This is probably the most interesting feature of this function. | ||
51 | (let ((heading-start (org-entry-beginning-position))) | ||
52 | (goto-char (org-entry-end-position)) | ||
53 | (cond ((and (org-at-heading-p) | ||
54 | (= heading-start (org-entry-beginning-position))) | ||
55 | ;; Entry ends on its heading; add newline after | ||
56 | (end-of-line) | ||
57 | (insert "\n\n")) | ||
58 | (t | ||
59 | ;; Entry ends after its heading; back up | ||
60 | (forward-line -1) | ||
61 | (end-of-line) | ||
62 | (when (org-at-heading-p) | ||
63 | ;; At the same heading | ||
64 | (forward-line) | ||
65 | (insert "\n") | ||
66 | (forward-line -1)) | ||
67 | (while (not | ||
68 | (looking-back | ||
69 | (rx (repeat 3 (seq (optional blank) "\n"))) | ||
70 | nil)) | ||
71 | (insert "\n")) | ||
72 | (forward-line -1))))) | ||
73 | |||
74 | ((org-at-item-checkbox-p) | ||
75 | ;; Checkbox: Insert new item with checkbox. | ||
76 | (org-insert-todo-heading nil)) | ||
77 | |||
78 | ((org-in-item-p) | ||
79 | ;; Plain list | ||
80 | (let* ((context (org-element-context)) | ||
81 | (first-item-p (eq 'plain-list (car context))) | ||
82 | (itemp (eq 'item (car context))) | ||
83 | (emptyp (or | ||
84 | ;; Empty list item (regular) | ||
85 | (eq (org-element-property :contents-begin context) | ||
86 | (org-element-property :contents-end context)) | ||
87 | ;; Empty list item (definition) | ||
88 | ;; This seems to work, with minimal testing. -- 2022-02-17 | ||
89 | (looking-at " *::"))) | ||
90 | (item-child-p | ||
91 | (+org-element-descendant-of 'item context))) | ||
92 | ;; The original function from unpackaged just tested the (or ...) test | ||
93 | ;; in this cond, in an if. However, that doesn't auto-end nested | ||
94 | ;; lists. So I made this form a cond and added the (and...) test in | ||
95 | ;; the first position, which is clunky (the delete-region... stuff | ||
96 | ;; comes twice) and might not be needed. More testing, obviously, but | ||
97 | ;; for now, it works well enough. | ||
98 | (cond ((and itemp emptyp) | ||
99 | (delete-region (line-beginning-position) (line-end-position)) | ||
100 | (insert "\n")) | ||
101 | ((or first-item-p | ||
102 | (and itemp (not emptyp)) | ||
103 | item-child-p) | ||
104 | (org-insert-item)) | ||
105 | (t (delete-region (line-beginning-position) (line-end-position)) | ||
106 | (insert "\n"))))) | ||
107 | |||
108 | ((when (fboundp 'org-inlinetask-in-task-p) | ||
109 | (org-inlinetask-in-task-p)) | ||
110 | ;; Inline task: Don't insert a new heading. | ||
111 | (org-return)) | ||
112 | |||
113 | ((org-at-table-p) | ||
114 | (cond ((save-excursion | ||
115 | (beginning-of-line) | ||
116 | ;; See `org-table-next-field'. | ||
117 | (cl-loop with end = (line-end-position) | ||
118 | for cell = (org-element-table-cell-parser) | ||
119 | always (equal (org-element-property :contents-begin cell) | ||
120 | (org-element-property :contents-end cell)) | ||
121 | while (re-search-forward "|" end t))) | ||
122 | ;; Empty row: end the table. | ||
123 | (delete-region (line-beginning-position) (line-end-position)) | ||
124 | (org-return)) | ||
125 | (t | ||
126 | ;; Non-empty row: call `org-return'. | ||
127 | (org-return)))) | ||
128 | (t | ||
129 | ;; All other cases: call `org-return'. | ||
130 | (org-return))))) | ||
131 | |||
132 | (defun +org-table-copy-down (n) | ||
133 | "Call `org-table-copy-down', or `org-return' outside of a table. | ||
134 | N is passed to the functions." | ||
135 | (interactive "p") | ||
136 | (if (org-table-check-inside-data-field 'noerror) | ||
137 | (org-table-copy-down n) | ||
138 | (+org-return-dwim n))) | ||
139 | |||
140 | ;;; org-fix-blank-lines - unpackaged.el | ||
141 | |||
142 | (defun +org-fix-blank-lines (&optional prefix) | ||
143 | "Ensure blank lines around headings. | ||
144 | Optional PREFIX argument operates on the entire buffer. | ||
145 | Drawers are included with their headings." | ||
146 | (interactive "P") | ||
147 | (let ((org-element-use-cache nil)) | ||
148 | (org-map-entries (lambda () | ||
149 | (let ((beg (org-entry-beginning-position)) | ||
150 | (end (org-entry-end-position))) | ||
151 | (org-with-wide-buffer | ||
152 | ;; `org-map-entries' narrows the buffer, which | ||
153 | ;; prevents us from seeing newlines before the | ||
154 | ;; current heading, so we do this part widened. | ||
155 | (while (not (looking-back "\n\n" nil)) | ||
156 | ;; Insert blank lines before heading. | ||
157 | (insert "\n"))) | ||
158 | |||
159 | ;; Insert blank lines before entry content | ||
160 | (forward-line) | ||
161 | (while (and (org-at-planning-p) | ||
162 | (< (point) (point-max))) | ||
163 | ;; Skip planning lines | ||
164 | (forward-line)) | ||
165 | (while (re-search-forward | ||
166 | org-drawer-regexp end t) | ||
167 | ;; Skip drawers. You might think that | ||
168 | ;; `org-at-drawer-p' would suffice, but for | ||
169 | ;; some reason it doesn't work correctly when | ||
170 | ;; operating on hidden text. This works, taken | ||
171 | ;; from `org-agenda-get-some-entry-text'. | ||
172 | (re-search-forward "^[ \t]*:END:.*\n?" end t) | ||
173 | (goto-char (match-end 0))) | ||
174 | (unless (or (= (point) (point-max)) | ||
175 | (org-at-heading-p) | ||
176 | (looking-at-p "\n")) | ||
177 | (insert "\n")))) | ||
178 | t | ||
179 | (if prefix | ||
180 | nil | ||
181 | 'tree)))) | ||
182 | |||
183 | ;;; org-count-words | ||
184 | |||
185 | (defun +org-count-words-stupidly (start end &optional limit) | ||
186 | "Count words between START and END, ignoring a lot. | ||
187 | |||
188 | Since this function is, for some reason, pricy, the optional | ||
189 | parameter LIMIT sets a word limit at which to stop counting. | ||
190 | Once the function hits that number, it'll return -LIMIT | ||
191 | instead of the true count." | ||
192 | (interactive (list nil nil)) | ||
193 | (cond ((not (called-interactively-p 'any)) | ||
194 | (let ((words 0) | ||
195 | (continue t)) | ||
196 | (save-excursion | ||
197 | (save-restriction | ||
198 | (narrow-to-region start end) | ||
199 | (goto-char (point-min)) | ||
200 | (while (and continue | ||
201 | (< (point) (point-max))) | ||
202 | (cond | ||
203 | ;; Ignore comments | ||
204 | ((or (org-at-comment-p) | ||
205 | (org-in-commented-heading-p)) | ||
206 | (forward-line)) | ||
207 | ;; Ignore headings | ||
208 | ((or (org-at-heading-p)) | ||
209 | (forward-line)) | ||
210 | ;; Ignore property and log drawers | ||
211 | ((or (looking-at org-drawer-regexp) | ||
212 | (looking-at org-clock-drawer-re)) | ||
213 | (search-forward ":END:" nil :noerror) | ||
214 | (forward-line)) | ||
215 | ;; Ignore DEADLINE and SCHEDULED keywords | ||
216 | ((or (looking-at org-deadline-regexp) | ||
217 | (looking-at org-scheduled-regexp) | ||
218 | (looking-at org-closed-time-regexp)) | ||
219 | (forward-line)) | ||
220 | ;; Ignore tables | ||
221 | ((org-at-table-p) (forward-line)) | ||
222 | ;; Ignore hyperlinks, but count the descriptions | ||
223 | ((looking-at org-link-bracket-re) | ||
224 | (when-let ((desc (match-string-no-properties 5))) | ||
225 | (save-match-data | ||
226 | (setq words (+ words | ||
227 | (length (remove "" | ||
228 | (org-split-string | ||
229 | desc "\\W"))))))) | ||
230 | (goto-char (match-end 0))) | ||
231 | ;; Ignore source blocks | ||
232 | ((org-in-src-block-p) (forward-line)) | ||
233 | ;; Ignore blank lines | ||
234 | ((looking-at "^$") | ||
235 | (forward-line)) | ||
236 | ;; Count everything else | ||
237 | (t | ||
238 | ;; ... unless it's in a few weird contexts | ||
239 | (let ((contexts (org-context))) | ||
240 | (cond ((or (assoc :todo-keyword contexts) | ||
241 | (assoc :priority contexts) | ||
242 | (assoc :keyword contexts) | ||
243 | (assoc :checkbox contexts)) | ||
244 | (forward-word-strictly)) | ||
245 | |||
246 | (t (setq words (1+ words)) | ||
247 | (if (and limit | ||
248 | (> words limit)) | ||
249 | (setq words (- limit) | ||
250 | continue nil)) | ||
251 | (forward-word-strictly))))))))) | ||
252 | words)) | ||
253 | ((use-region-p) | ||
254 | (message "%d words in region" | ||
255 | (+org-count-words-stupidly (region-beginning) | ||
256 | (region-end)))) | ||
257 | (t | ||
258 | (message "%d words in buffer" | ||
259 | (+org-count-words-stupidly (point-min) | ||
260 | (point-max)))))) | ||
261 | |||
262 | ;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ | ||
263 | |||
264 | (defun +org-insert--get-title-and-headings (url) | ||
265 | "Retrieve title and headings from URL. | ||
266 | Return as a list." | ||
267 | (with-current-buffer (url-retrieve-synchronously url) | ||
268 | (let ((dom (libxml-parse-html-region (point-min) (point-max)))) | ||
269 | (cl-remove-if | ||
270 | (lambda (i) (string= i "")) | ||
271 | (apply #'append (mapcar (lambda (tag) | ||
272 | (mapcar #'dom-text | ||
273 | (dom-by-tag dom tag))) | ||
274 | '(title h1 h2 h3 h4 h5 h6))))))) | ||
275 | |||
276 | (defun +org-insert-link-dwim (&optional interactivep) | ||
277 | "Like `org-insert-link' but with personal dwim preferences." | ||
278 | (interactive '(t)) | ||
279 | (let* ((point-in-link (org-in-regexp org-link-any-re 1)) | ||
280 | (clipboard-url (when (string-match-p | ||
281 | (rx (sequence bos | ||
282 | (or "http" | ||
283 | "gemini" | ||
284 | "gopher" | ||
285 | "tel" | ||
286 | "mailto"))) | ||
287 | (current-kill 0)) | ||
288 | (current-kill 0))) | ||
289 | (region-content (when (region-active-p) | ||
290 | (buffer-substring-no-properties (region-beginning) | ||
291 | (region-end)))) | ||
292 | (org-link (when (and clipboard-url (not point-in-link)) | ||
293 | (org-link-make-string | ||
294 | (string-trim clipboard-url) | ||
295 | (or region-content | ||
296 | (let ((clipboard-headings | ||
297 | (+org-insert--get-title-and-headings clipboard-url))) | ||
298 | (read-string "title (edit): " | ||
299 | (completing-read | ||
300 | "title: " clipboard-headings | ||
301 | nil nil nil nil (car clipboard-headings))))))))) | ||
302 | (if interactivep | ||
303 | (cond ((and region-content clipboard-url (not point-in-link)) | ||
304 | (delete-region (region-beginning) (region-end)) | ||
305 | (insert org-link)) | ||
306 | ((and clipboard-url (not point-in-link)) | ||
307 | (insert org-link)) | ||
308 | (t | ||
309 | (call-interactively 'org-insert-link))) | ||
310 | org-link))) | ||
311 | |||
312 | ;;; Navigate headings with widening | ||
313 | |||
314 | (defun +org-next-heading-widen (arg) | ||
315 | "Find the ARGth next org heading, widening if necessary." | ||
316 | (interactive "p") | ||
317 | (let ((current-point (point)) | ||
318 | (point-target (if (> arg 0) (point-max) (point-min)))) | ||
319 | (org-next-visible-heading arg) | ||
320 | (when (and (buffer-narrowed-p) | ||
321 | (= (point) point-target) | ||
322 | (or (and (> arg 0)) | ||
323 | (and (< arg 0) | ||
324 | (= (point) current-point)))) | ||
325 | (widen) | ||
326 | (org-next-visible-heading arg)))) | ||
327 | |||
328 | (defun +org-previous-heading-widen (arg) | ||
329 | "Find the ARGth previous org heading, widening if necessary." | ||
330 | (interactive "p") | ||
331 | (+org-next-heading-widen (- arg))) | ||
332 | |||
333 | ;;; Hooks & Advice | ||
334 | |||
335 | (defvar +org-before-save-prettify-buffer t | ||
336 | "Prettify org buffers before saving.") | ||
337 | |||
338 | (put '+org-before-save-prettify-buffer 'safe-local-variable #'booleanp) | ||
339 | |||
340 | (defun +org-before-save@prettify-buffer () | ||
341 | (when +org-before-save-prettify-buffer | ||
342 | (save-mark-and-excursion | ||
343 | (+org-unsmartify) | ||
344 | (+org-fix-blank-lines t) | ||
345 | (org-align-tags t) | ||
346 | (org-hide-drawer-all) | ||
347 | (when (buffer-narrowed-p) | ||
348 | (goto-char (point-min)) | ||
349 | (forward-line 1) | ||
350 | (org-narrow-to-subtree))))) | ||
351 | |||
352 | (defun +org-delete-backward-char (N) | ||
353 | "Keep tables aligned while deleting N characters backward. | ||
354 | When deleting backwards, in tables this function will insert | ||
355 | whitespace in front of the next \"|\" separator, to keep the | ||
356 | table aligned. The table will still be marked for re-alignment | ||
357 | if the field did fill the entire column, because, in this case | ||
358 | the deletion might narrow the column." | ||
359 | (interactive "p") | ||
360 | (save-match-data | ||
361 | (org-check-before-invisible-edit 'delete-backward) | ||
362 | (if (and (= N 1) | ||
363 | (not overwrite-mode) | ||
364 | (not (org-region-active-p)) | ||
365 | (not (eq (char-before) ?|)) | ||
366 | (save-excursion (skip-chars-backward " \t") (not (bolp))) | ||
367 | (looking-at-p ".*?|") | ||
368 | (org-at-table-p)) | ||
369 | (progn (forward-char -1) (org-delete-char 1)) | ||
370 | (backward-delete-char-untabify N) | ||
371 | (org-fix-tags-on-the-fly)))) | ||
372 | |||
373 | ;;; Smarter {super,sub}scripts | ||
374 | ;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/ | ||
375 | ;; I don't use this currently because I found out about | ||
376 | ;; `org-pretty-entities-include-sub-superscripts', which really does exactly | ||
377 | ;; what I wanted. | ||
378 | |||
379 | (defface +org-script-markers '((t (:inherit shadow))) | ||
380 | "Face to be used for sub/superscripts markers i.e., ^, _, {, }.") | ||
381 | |||
382 | ;; Hiding the super and subscript markers is extremely annoying | ||
383 | ;; since any remotely complex equation becomes a chore. And leaving | ||
384 | ;; it not raised is jarring to the eye. So this fontifies the | ||
385 | ;; buffer just like how auctex does -- use a muted colour to | ||
386 | ;; highlight the markup and raise the script. | ||
387 | (defun +org-raise-scripts (limit) | ||
388 | "Differences from `org-raise-scripts' are: | ||
389 | |||
390 | - It doesn't actually hide the markup used for super and subscript. | ||
391 | - It uses a custom face to highlight the markup: +org-script-markers. | ||
392 | - It doesn't require `org-pretty-entities' to be t." | ||
393 | (when (and org-pretty-entities-include-sub-superscripts | ||
394 | (re-search-forward | ||
395 | (if (eq org-use-sub-superscripts t) | ||
396 | org-match-substring-regexp | ||
397 | org-match-substring-with-braces-regexp) | ||
398 | limit t)) | ||
399 | (let* ((pos (point)) table-p comment-p | ||
400 | (mpos (match-beginning 3)) | ||
401 | (emph-p (get-text-property mpos 'org-emphasis)) | ||
402 | (link-p (get-text-property mpos 'mouse-face)) | ||
403 | (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) | ||
404 | (goto-char (point-at-bol)) | ||
405 | (setq table-p (looking-at-p org-table-dataline-regexp) | ||
406 | comment-p (looking-at-p "^[ \t]*#[ +]")) | ||
407 | (goto-char pos) | ||
408 | ;; Handle a_b^c | ||
409 | (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) | ||
410 | (unless (or comment-p emph-p link-p keyw-p) | ||
411 | (put-text-property (match-beginning 3) (match-end 0) | ||
412 | 'display | ||
413 | (if (equal (char-after (match-beginning 2)) ?^) | ||
414 | ;; (nth (if table-p 3 1) org-script-display) | ||
415 | (nth 3 org-script-display) | ||
416 | ;; (nth (if table-p 2 0) org-script-display) | ||
417 | (nth 2 org-script-display))) | ||
418 | (put-text-property (match-beginning 2) (match-end 2) | ||
419 | 'face '+org-script-markers) | ||
420 | (when (and (eq (char-after (match-beginning 3)) ?{) | ||
421 | (eq (char-before (match-end 3)) ?})) | ||
422 | (put-text-property (match-beginning 3) (1+ (match-beginning 3)) | ||
423 | 'face '+org-script-markers) | ||
424 | (put-text-property (1- (match-end 3)) (match-end 3) | ||
425 | 'face '+org-script-markers))) | ||
426 | t))) | ||
427 | |||
428 | ;; Extra link types | ||
429 | |||
430 | (defun +org-tel-open (number _) | ||
431 | "Notify the user of what phone NUMBER to call." | ||
432 | (message "Call: %s" number)) | ||
433 | |||
434 | (defun +org-sms-open (number _) | ||
435 | "Notify the user of what phone NUMBER to text." | ||
436 | (message "SMS: %s" number)) | ||
437 | |||
438 | ;; Make a horizontal rule! | ||
439 | |||
440 | (defun +org-horizontal-rule () | ||
441 | "Make a horizontal rule after the current line." | ||
442 | (interactive nil org-mode) | ||
443 | (unless (eq (line-beginning-position) (line-end-position)) | ||
444 | (end-of-line) | ||
445 | (newline)) | ||
446 | (dotimes (_ fill-column) | ||
447 | (insert "-"))) | ||
448 | |||
449 | ;; Follow links, DWIM style | ||
450 | |||
451 | (defun +org-open-at-point-dwim (&optional arg) | ||
452 | "Open thing at point, or if there isn't something, list things." | ||
453 | (interactive "P") | ||
454 | (save-excursion | ||
455 | (let* ((this-char-type (org-element-type (org-element-context))) | ||
456 | (prev-char-type (ignore-errors | ||
457 | (save-excursion | ||
458 | (backward-char) | ||
459 | (org-element-type (org-element-context))))) | ||
460 | (types '(citation citation-reference clock comment comment-block | ||
461 | footnote-definition footnote-reference headline | ||
462 | inline-src-block inlinetask keyword link | ||
463 | node-property planning src-block timestamp)) | ||
464 | (type this-char-type)) | ||
465 | (when (and (memq this-char-type types) (memq prev-char-type types)) | ||
466 | (backward-char) | ||
467 | (setq type prev-char-type)) ; what the fuckckckckck | ||
468 | ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, | ||
469 | ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since | ||
470 | ;; I really just want to open the list of URLs /most of the time/, I'm | ||
471 | ;; fixing it like this instead. | ||
472 | (unless (and (memq type types) | ||
473 | (ignore-errors (org-open-at-point arg) | ||
474 | t)) | ||
475 | (while (not | ||
476 | (progn | ||
477 | (org-back-to-heading) | ||
478 | (car (org-offer-links-in-entry (current-buffer) (point) 1)))) | ||
479 | (org-up-heading-all 1)) | ||
480 | (org-open-at-point arg))))) | ||
481 | |||
482 | ;;; Open local HTML files with `browse-url' | ||
483 | |||
484 | (defun +org-open-html (file-path link-string) | ||
485 | "Open FILE-PATH with `browse-url'. | ||
486 | This function is intended to use with `org-file-apps'. See the | ||
487 | documentation of that function for a description of the two | ||
488 | arguments here, FILE-PATH and LINK-STRING." | ||
489 | (message "Opening %s (%s)..." file-path link-string) | ||
490 | (browse-url file-path)) | ||
491 | |||
492 | (defun +org-insert-horizontal-rule (prefix) | ||
493 | "Insert a horizontal rule (-----) after the current line. | ||
494 | With PREFIX, insert before the current line." | ||
495 | (interactive "P") | ||
496 | (if prefix | ||
497 | (move-beginning-of-line nil) | ||
498 | (move-end-of-line nil) | ||
499 | (forward-line 1)) | ||
500 | (insert "-----\n")) | ||
501 | |||
502 | ;;; Make code snippets in org-mode easier to type | ||
503 | ;; http://mbork.pl/2022-01-17_Making_code_snippets_in_Org-mode_easier_to_type | ||
504 | |||
505 | (defun +org-insert-backtick () | ||
506 | "Insert a backtick using `org-self-insert-command'." | ||
507 | (interactive) | ||
508 | (setq last-command-event ?`) | ||
509 | (call-interactively #'org-self-insert-command)) | ||
510 | |||
511 | (defvar-local +org-insert-tilde-language nil | ||
512 | "Default language name in the current Org file. | ||
513 | If nil, `org-insert-tilde' after 2 tildes inserts an \"example\" | ||
514 | block. If a string, it inserts a \"src\" block with the given | ||
515 | language name.") | ||
516 | |||
517 | (defun +org-insert-tilde () | ||
518 | "Insert a tilde using `org-self-insert-command'." | ||
519 | (interactive) | ||
520 | (if (string= (buffer-substring-no-properties (- (point) 3) (point)) | ||
521 | "\n~~") | ||
522 | (progn (delete-char -2) | ||
523 | (if +org-insert-tilde-language | ||
524 | (insert (format "#+begin_src %s\n#+end_src" | ||
525 | +org-insert-tilde-language)) | ||
526 | (insert "#+begin_example\n#+end_example")) | ||
527 | (forward-line -1) | ||
528 | (if (string= +org-insert-tilde-language "") | ||
529 | (move-end-of-line nil) | ||
530 | ;;(org-edit-special) ; Useful really only with splits. | ||
531 | )) | ||
532 | (setq last-command-event ?~) | ||
533 | (call-interactively #'org-self-insert-command))) | ||
534 | |||
535 | ;;; Better org faces | ||
536 | ;; see `org-emphasis-alist' | ||
537 | |||
538 | (defface org-bold '((t (:weight bold))) | ||
539 | "Bold face in `org-mode' documents.") | ||
540 | |||
541 | (defface org-italic '((t (:slant italic))) | ||
542 | "Italic face in `org-mode' documents.") | ||
543 | |||
544 | (defface org-underline '((t (:underline t))) | ||
545 | "Underline face in `org-mode' documents.") | ||
546 | |||
547 | (defface org-strikethrough '((t (:strike-through t))) | ||
548 | "Strike-through face for `org-mode' documents.") | ||
549 | |||
550 | ;; `org-verbatim' and `org-code' are apparently already things, so we skip them | ||
551 | ;; here. | ||
552 | |||
553 | ;;; Copy org trees as HTML | ||
554 | |||
555 | ;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. | ||
556 | (defun +org-export-clip-to-html | ||
557 | (&optional async subtreep visible-only body-only ext-plist post-process) | ||
558 | "Export region to HTML, and copy it to the clipboard. | ||
559 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, | ||
560 | and POST-PROCESS are passed to `org-export-to-file'." | ||
561 | (interactive) ; XXX: hould this be interactive? | ||
562 | (message "Exporting Org to HTML...") | ||
563 | (let ((org-tmp-file "/tmp/org.html")) | ||
564 | (org-export-to-file 'html org-tmp-file | ||
565 | async subtreep visible-only body-only ext-plist post-process) | ||
566 | (start-process "xclip" "*xclip*" | ||
567 | "xclip" "-verbose" | ||
568 | "-i" org-tmp-file | ||
569 | "-t" "text/html" | ||
570 | "-selection" "clipboard")) | ||
571 | (message "Exporting Org to HTML...done.")) | ||
572 | |||
573 | ;; Specialized functions | ||
574 | (defun +org-export-clip-subtree-to-html () | ||
575 | "Export current subtree to HTML." | ||
576 | (interactive) | ||
577 | (+org-export-clip-to-html nil :subtree)) | ||
578 | |||
579 | ;;; Unsmartify quotes and dashes and stuff. | ||
580 | (defun +org-unsmartify () | ||
581 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." | ||
582 | (interactive) | ||
583 | (save-excursion | ||
584 | (goto-char (point-min)) | ||
585 | (while (re-search-forward "[“”‘’–—]" nil t) | ||
586 | (let ((replace (pcase (match-string 0) | ||
587 | ((or "“" "”") "\"") | ||
588 | ((or "‘" "’") "'") | ||
589 | ("–" "--") | ||
590 | ("—" "---")))) | ||
591 | (replace-match replace nil nil))))) | ||
592 | |||
593 | ;;; go forward and backward in the tree, ~ cleanly ~ | ||
594 | ;; https://stackoverflow.com/a/25201697/10756297 | ||
595 | |||
596 | (defun +org-show-next-heading-tidily () | ||
597 | "Show next entry, keeping other entries closed." | ||
598 | (interactive) | ||
599 | (if (save-excursion (end-of-line) (outline-invisible-p)) | ||
600 | (progn (org-show-entry) (show-children)) | ||
601 | (outline-next-heading) | ||
602 | (unless (and (bolp) (org-on-heading-p)) | ||
603 | (org-up-heading-safe) | ||
604 | (hide-subtree) | ||
605 | (user-error "Boundary reached")) | ||
606 | (org-overview) | ||
607 | (org-reveal t) | ||
608 | (org-show-entry) | ||
609 | (recenter-top-bottom) | ||
610 | (show-children) | ||
611 | (recenter-top-bottom 1))) | ||
612 | |||
613 | (defun +org-show-previous-heading-tidily () | ||
614 | "Show previous entry, keeping other entries closed." | ||
615 | (interactive) | ||
616 | (let ((pos (point))) | ||
617 | (outline-previous-heading) | ||
618 | (unless (and (< (point) pos) (bolp) (org-on-heading-p)) | ||
619 | (goto-char pos) | ||
620 | (hide-subtree) | ||
621 | (user-error "Boundary reached")) | ||
622 | (org-overview) | ||
623 | (org-reveal t) | ||
624 | (org-show-entry) | ||
625 | (recenter-top-bottom) | ||
626 | (show-children) | ||
627 | (recenter-top-bottom 1))) | ||
628 | |||
629 | ;;; Make `org-flag-region' (which folds subtrees) recognize | ||
630 | ;; [[https://teddit.net/r/orgmode/comments/u3du0v/how_to_make_orgcycle_respect_and_always_show_the/][from u/yantar92]] | ||
631 | |||
632 | ;; (advice-add 'org-flag-region :around #'org-flag-region@unfold-page-breaks) | ||
633 | (defun org-flag-region@unfold-page-breaks (oldfun from to flag &optional spec) | ||
634 | "ADVICE to unfold all the page-break lines inside a folded region." | ||
635 | (funcall oldfun from to flag spec) | ||
636 | (when (and flag (not (eq 'visible spec))) | ||
637 | (org-with-point-at from | ||
638 | (while (re-search-forward "\n\u000c\n" to t) | ||
639 | (org-flag-region (match-beginning 0) (match-end 0) t 'visible))))) | ||
640 | |||
641 | ;;; Emacs 28+: wrap on hyphens | ||
642 | ;; https://emacs.stackexchange.com/a/71342/37239 | ||
643 | |||
644 | (defcustom +org-category-table (let ((table (copy-category-table))) | ||
645 | (modify-category-entry ?- ?| table) | ||
646 | table) | ||
647 | "Character category table for `org-mode'." | ||
648 | :type 'sexp) | ||
649 | |||
650 | (defun +org-wrap-on-hyphens () | ||
651 | "Soft-wrap `org-mode' buffers on spaces and hyphens." | ||
652 | (set-category-table +org-category-table) | ||
653 | (setq-local word-wrap-by-category t)) | ||
654 | |||
655 | |||
656 | ;;; Inhibit hooks on `org-agenda' | ||
657 | ;; It's really annoying when I call `org-agenda' and five hundred Ispell | ||
658 | ;; processes are created because I have `flyspell-mode' in the hook. This mode | ||
659 | ;; inhibits those hooks when entering the agenda, but runs them when opening the | ||
660 | ;; actual buffer. | ||
661 | |||
662 | (defun +org-agenda-inhibit-hooks (fn &rest r) | ||
663 | "Advice to inhibit hooks when entering `org-agenda'." | ||
664 | (dlet ((org-mode-hook nil)) ; I'm not sure if `dlet' is strictly needed | ||
665 | (apply fn r))) | ||
666 | |||
667 | (defvar-local +org-hook-has-run-p nil | ||
668 | "Whether `org-mode-hook' has run in the current buffer.") | ||
669 | |||
670 | (defun +org-agenda-switch-run-hooks (&rest _) | ||
671 | "Advice to run `org-mode-hook' when entering org-mode. | ||
672 | This should only fire when switching to a buffer from `org-agenda'." | ||
673 | (unless +org-hook-has-run-p | ||
674 | (run-mode-hooks 'org-mode-hook) | ||
675 | (setq +org-hook-has-run-p t))) | ||
676 | |||
677 | (define-minor-mode +org-agenda-inhibit-hooks-mode | ||
678 | "Inhibit `org-mode-hook' when opening `org-agenda'." | ||
679 | :lighter "" | ||
680 | :global t | ||
681 | (if +org-agenda-inhibit-hooks-mode | ||
682 | (progn ; Enable | ||
683 | (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) | ||
684 | (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) | ||
685 | (progn ; Disable | ||
686 | (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) | ||
687 | (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) | ||
688 | |||
689 | |||
690 | ;;; "Fix" `org-align-tags' | ||
691 | |||
692 | (el-patch-defun org-align-tags (&optional all) | ||
693 | "Align tags in current entry. | ||
694 | When optional argument ALL is non-nil, align all tags in the | ||
695 | visible part of the buffer." | ||
696 | (let ((get-indent-column | ||
697 | (lambda () | ||
698 | (let ((offset (el-patch-swap | ||
699 | (if (bound-and-true-p org-indent-mode) | ||
700 | (* (1- org-indent-indentation-per-level) | ||
701 | (1- (org-current-level))) | ||
702 | 0) | ||
703 | 0))) | ||
704 | (+ org-tags-column | ||
705 | (if (> org-tags-column 0) (- offset) offset)))))) | ||
706 | (if (and (not all) (org-at-heading-p)) | ||
707 | (org--align-tags-here (funcall get-indent-column)) | ||
708 | (save-excursion | ||
709 | (if all | ||
710 | (progn | ||
711 | (goto-char (point-min)) | ||
712 | (while (re-search-forward org-tag-line-re nil t) | ||
713 | (org--align-tags-here (funcall get-indent-column)))) | ||
714 | (org-back-to-heading t) | ||
715 | (org--align-tags-here (funcall get-indent-column))))))) | ||
716 | |||
717 | ;;; Meta-return | ||
718 | |||
719 | (defun +org-meta-return (&optional arg) | ||
720 | "Insert a new line, or wrap a region in a table. | ||
721 | See `org-meta-return', but `+org-return-dwim' does most of the | ||
722 | stuff I would want out of that function already. | ||
723 | |||
724 | When called with a prefix ARG, will still unconditionally call | ||
725 | `org-insert-heading'." | ||
726 | (interactive "P") | ||
727 | (org-fold-check-before-invisible-edit 'insert) | ||
728 | (or (run-hook-with-args-until-success 'org-metareturn-hook) ; Allow customizations | ||
729 | (call-interactively (cond (arg #'org-insert-heading) | ||
730 | ((org-at-table-p) #'org-table-wrap-region) | ||
731 | (t #'org-return))))) | ||
732 | |||
733 | |||
734 | ;;; move org archives to a dedicated file | ||
735 | ;; (defun +org-archive-monthwise (archive-file) | ||
736 | ;; (if (file-exists-p archive-file) | ||
737 | ;; (with-current-buffer (find-file-noselect archive-file) | ||
738 | ;; (let ((dir (file-name-directory (file-truename archive-file))) | ||
739 | ;; (prog (make-progress-reporter (format "Archiving from %s..." archive-file))) | ||
740 | ;; (keep-going t)) | ||
741 | ;; (goto-char (point-min)) | ||
742 | ;; (while keep-going | ||
743 | ;; (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME") | ||
744 | ;; (org-get-deadline-time (point)))) | ||
745 | ;; (parsed-time (and time | ||
746 | ;; (org-parse-time-string time))) | ||
747 | ;; (refile-target (format "%s%02d-%02d.org" | ||
748 | ;; dir | ||
749 | ;; (decoded-time-year parsed-time) | ||
750 | ;; (decoded-time-month parsed-time))) | ||
751 | ;; (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n" | ||
752 | ;; (decoded-time-year parsed-time) | ||
753 | ;; (decoded-time-month parsed-time) | ||
754 | ;; (file-truename archive-file)))) | ||
755 | ;; (unless (file-exists-p refile-target) | ||
756 | ;; (with-current-buffer (find-file-noselect refile-target) | ||
757 | ;; (insert title-str) | ||
758 | ;; (save-buffer))) | ||
759 | ;; (org-refile nil nil (list "" | ||
760 | ;; refile-target | ||
761 | ;; nil | ||
762 | ;; 0))) | ||
763 | ;; (progress-reporter-update prog) | ||
764 | ;; (org-next-visible-heading 1) | ||
765 | ;; (when (>= (point) (point-max)) | ||
766 | ;; (setq keep-going nil))))) | ||
767 | ;; (message "Archive file %s does not exist!" archive-file))) | ||
768 | |||
769 | |||
770 | ;;; +org-toggle-view-emphasis | ||
771 | ;; I thought this function was already written somewhere... | ||
772 | (defun +org-toggle-view-emphasis () | ||
773 | "Toggle `org-hide-emphasis-markers' and redraw the buffer." | ||
774 | (interactive) | ||
775 | (setq-local org-hide-emphasis-markers (not org-hide-emphasis-markers)) | ||
776 | (font-lock-update)) | ||
777 | |||
778 | |||
779 | ;;; el-patch | ||
780 | |||
781 | (el-patch-defun org-format-outline-path (path &optional width prefix separator) | ||
782 | "Format the outline path PATH for display. | ||
783 | WIDTH is the maximum number of characters that is available. | ||
784 | PREFIX is a prefix to be included in the returned string, | ||
785 | such as the file name. | ||
786 | SEPARATOR is inserted between the different parts of the path, | ||
787 | the default is \"/\"." | ||
788 | (setq width (or width 79)) | ||
789 | (setq path (delq nil path)) | ||
790 | (unless (> width 0) | ||
791 | (user-error "Argument `width' must be positive")) | ||
792 | (setq separator (or separator "/")) | ||
793 | (let* ((org-odd-levels-only nil) | ||
794 | (fpath (concat | ||
795 | prefix (and prefix path separator) | ||
796 | (mapconcat | ||
797 | (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) | ||
798 | (cl-loop for head in path | ||
799 | for n from 0 | ||
800 | collect (el-patch-swap | ||
801 | (org-add-props | ||
802 | head nil 'face | ||
803 | (nth (% n org-n-level-faces) org-level-faces)) | ||
804 | head)) | ||
805 | separator)))) | ||
806 | (when (> (length fpath) width) | ||
807 | (if (< width 7) | ||
808 | ;; It's unlikely that `width' will be this small, but don't | ||
809 | ;; waste characters by adding ".." if it is. | ||
810 | (setq fpath (substring fpath 0 width)) | ||
811 | (setf (substring fpath (- width 2)) ".."))) | ||
812 | fpath)) | ||
813 | |||
814 | |||
815 | (provide '+org) | ||
816 | ;;; +org.el ends here | ||
diff --git a/lisp/+ox.el b/lisp/+ox.el deleted file mode 100644 index 8748a55..0000000 --- a/lisp/+ox.el +++ /dev/null | |||
@@ -1,29 +0,0 @@ | |||
1 | ;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'ox) | ||
8 | |||
9 | ;;; Run hooks before doing any exporting at all | ||
10 | |||
11 | (defcustom +org-export-pre-hook nil | ||
12 | "Functions to run /before/ `org-export-as' does anything. | ||
13 | These will run on the buffer about to be exported, NOT a copy." | ||
14 | :type 'hook) | ||
15 | |||
16 | (defun +org-export-pre-run-hooks (&rest _) | ||
17 | "Run hooks in `+org-export-pre-hook'." | ||
18 | (run-hooks '+org-export-pre-hook)) | ||
19 | |||
20 | (defun +org-export-pre-hooks-insinuate () | ||
21 | "Advise `org-export-as' to run `+org-export-pre-hook'." | ||
22 | (advice-add 'org-export-as :before #'+org-export-pre-run-hooks)) | ||
23 | |||
24 | (defun +org-export-pre-hooks-remove () | ||
25 | "Remove pre-hook advice on `org-export-as'." | ||
26 | (advice-remove 'org-export-as #'+org-export-pre-run-hooks)) | ||
27 | |||
28 | (provide '+ox) | ||
29 | ;;; +ox.el ends here | ||
diff --git a/lisp/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index 0c65328..0000000 --- a/lisp/+paredit.el +++ /dev/null | |||
@@ -1,26 +0,0 @@ | |||
1 | ;;; +paredit.el --- bespoke paredit stuffs -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require '+emacs) ; `+backward-kill-word-wrapper' | ||
8 | |||
9 | (defun +paredit--backward-kill-word (&optional n) | ||
10 | "Perform `paredit-backward-kill-word' N times." | ||
11 | (interactive "p") | ||
12 | (dotimes (_ (or n 1)) | ||
13 | (paredit-backward-kill-word))) | ||
14 | |||
15 | (defun +paredit-backward-kill-word (&optional arg) | ||
16 | "Kill a word backward using `paredit-backward-kill-word'. | ||
17 | Wrapped in `+backward-kill-word-wrapper', which see. | ||
18 | |||
19 | Prefix ARG means to just call `paredit-backward-kill-word'." | ||
20 | ;; Of course, `paredit-backward-kill-word' doesn't TAKE an argument ... :/// | ||
21 | ;; So I had to write the wrapper above. | ||
22 | (interactive) | ||
23 | (+backward-kill-word-wrapper #'+paredit--backward-kill-word arg)) | ||
24 | |||
25 | (provide '+paredit) | ||
26 | ;;; +paredit.el ends here | ||
diff --git a/lisp/+pdf-tools.el b/lisp/+pdf-tools.el deleted file mode 100644 index 9b15b27..0000000 --- a/lisp/+pdf-tools.el +++ /dev/null | |||
@@ -1,38 +0,0 @@ | |||
1 | ;;; +pdf-tools.el --- Extras for the excellent pdf-tools' -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | ;; XXX: The way I'm dispatching browsers here is /very/ down-and-dirty. It | ||
8 | ;; needs to be much improved. | ||
9 | |||
10 | (defun +pdf-view-open-all-pagelinks (&optional browse-url-func) | ||
11 | "Open all the links on this page of a PDF. | ||
12 | BROWSE-URL-FUNC overrides the default `browse-url'." | ||
13 | (interactive) | ||
14 | (let ((links (pdf-info-pagelinks (pdf-view-current-page))) | ||
15 | (browse-url-func (or browse-url-func #'browse-url)) | ||
16 | (seen)) | ||
17 | (dolist (link links) | ||
18 | (when-let* ((uri (alist-get 'uri link)) | ||
19 | (_ (not (member uri seen)))) | ||
20 | (push uri seen) | ||
21 | (funcall browse-url-func uri))))) | ||
22 | |||
23 | (defun +pdf-view-open-links-in-chrome () | ||
24 | "Open all links on this PDF page in Chrome. | ||
25 | See also `+pdf-view-open-all-pagelinks'." | ||
26 | (interactive) | ||
27 | (+pdf-view-open-all-pagelinks #'browse-url-chrome)) | ||
28 | |||
29 | (defun +pdf-view-position (&optional spacer) | ||
30 | "Return the page we're on for the modeline." | ||
31 | (when (derived-mode-p 'pdf-view-mode) | ||
32 | (format "%sp.%s/%s" | ||
33 | (or spacer (bound-and-true-p +modeline-default-spacer) " ") | ||
34 | (pdf-view-current-page) | ||
35 | (pdf-info-number-of-pages)))) | ||
36 | |||
37 | (provide '+pdf-tools) | ||
38 | ;;; +pdf-tools.el ends here | ||
diff --git a/lisp/+pulse.el b/lisp/+pulse.el deleted file mode 100644 index eefdd83..0000000 --- a/lisp/+pulse.el +++ /dev/null | |||
@@ -1,52 +0,0 @@ | |||
1 | ;;; +pulse.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'pulse) | ||
6 | |||
7 | (defgroup +pulse nil | ||
8 | "Extra customizations for `pulse'." | ||
9 | :group 'pulse | ||
10 | :prefix "+pulse-") | ||
11 | |||
12 | (defcustom +pulse-location-commands '(scroll-up-command | ||
13 | scroll-down-command | ||
14 | recenter-top-bottom | ||
15 | other-window | ||
16 | switch-to-buffer | ||
17 | redraw-frame) | ||
18 | "Commands to pulse the current line after. | ||
19 | Good for finding location." | ||
20 | :type '(repeat function)) | ||
21 | |||
22 | (defcustom +pulse-location-function '+pulse-line-current-window | ||
23 | "What function to call after `+pulse-location-commands'." | ||
24 | :type 'function) | ||
25 | |||
26 | ;; XXX: this doesn't work yet. I only want to pulse the line in the | ||
27 | ;; active window, so when I have the same buffer viewed in multiple | ||
28 | ;; windows I can still see where my cursor is. To see the issue, C-x | ||
29 | ;; 2 then C-x o a few times. | ||
30 | (defun +pulse-line-current-window (&rest _) | ||
31 | "Pulse the current line, but only if this window is active." | ||
32 | (pulse-momentary-highlight-one-line | ||
33 | (window-point (selected-window)))) | ||
34 | |||
35 | (defun +pulse--advice-remove (symbol where function &optional props) | ||
36 | "Remove advice SYMBOL from FUNCTION. | ||
37 | This uses the same args as `advice-add' for easy toggling. | ||
38 | WHERE and PROPS are discarded." | ||
39 | (ignore where props) | ||
40 | (advice-remove symbol function)) | ||
41 | |||
42 | (define-minor-mode +pulse-location-mode | ||
43 | "After moving locations, pulse where we are." | ||
44 | :global t | ||
45 | :keymap nil | ||
46 | (dolist (command +pulse-location-commands) | ||
47 | (funcall | ||
48 | (if +pulse-location-mode 'advice-add '+pulse--advice-remove) | ||
49 | command :after +pulse-location-function))) | ||
50 | |||
51 | (provide '+pulse) | ||
52 | ;;; +pulse.el ends here | ||
diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 7fc2bde..0000000 --- a/lisp/+scratch.el +++ /dev/null | |||
@@ -1,77 +0,0 @@ | |||
1 | ;;; +scratch.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | ;;(require 'scratch) | ||
6 | |||
7 | (defun +scratch-immortal () | ||
8 | "Bury, don't kill \"*scratch*\" buffer. | ||
9 | For `kill-buffer-query-functions'." | ||
10 | (if (or (eq (current-buffer) (get-buffer "*scratch*")) | ||
11 | (eq (current-buffer) (get-buffer "*text*"))) | ||
12 | (progn (bury-buffer) | ||
13 | nil) | ||
14 | t)) | ||
15 | |||
16 | (defun +scratch-buffer-setup () | ||
17 | "Add comment to `scratch' buffer and name it accordingly." | ||
18 | (let* ((mode (format "%s" major-mode)) | ||
19 | (string (concat "Scratch buffer for:" mode "\n\n"))) | ||
20 | (when scratch-buffer | ||
21 | (save-excursion | ||
22 | (insert string) | ||
23 | (goto-char (point-min)) | ||
24 | (comment-region (point-at-bol) (point-at-eol))) | ||
25 | (next-line 2)) | ||
26 | (rename-buffer (concat "*scratch<" mode ">*") t))) | ||
27 | |||
28 | (defun +scratch-fortune () | ||
29 | (let* ((fmt (if (executable-find "fmt") | ||
30 | (format "| fmt -%d -s" (- fill-column 2)) | ||
31 | "")) | ||
32 | (s (string-trim | ||
33 | (if (executable-find "fortune") | ||
34 | (shell-command-to-string (concat "fortune -s" fmt)) | ||
35 | "ABANDON ALL HOPE YE WHO ENTER HERE")))) | ||
36 | (concat (replace-regexp-in-string "^" ";; " s) | ||
37 | "\n\n"))) | ||
38 | |||
39 | ;; [[https://old.reddit.com/r/emacs/comments/ui1q41/weekly_tips_tricks_c_thread/i7ef4xg/][u/bhrgunatha]] | ||
40 | (defun +scratch-text-scratch () | ||
41 | "Create a \"*text*\" scratch buffer in Text mode." | ||
42 | (with-current-buffer (get-buffer-create "*text*") | ||
43 | (text-mode))) | ||
44 | |||
45 | (defcustom +scratch-buffers '("*text*" "*scratch*") | ||
46 | "Scratch buffers.") | ||
47 | |||
48 | (defvar +scratch-last-non-scratch-buffer nil | ||
49 | "Last buffer that wasn't a scratch buffer.") | ||
50 | |||
51 | (defun +scratch-toggle (buffer) | ||
52 | "Switch to BUFFER, or to the previous (non-scratch) buffer." | ||
53 | (if (or (null +scratch-last-non-scratch-buffer) | ||
54 | (not (member (buffer-name (current-buffer)) +scratch-buffers))) | ||
55 | ;; Switch to a scratch buffer | ||
56 | (progn | ||
57 | (setq +scratch-last-non-scratch-buffer (current-buffer)) | ||
58 | (switch-to-buffer buffer)) | ||
59 | ;; Switch away from scratch buffer ... | ||
60 | (if (equal (get-buffer-create buffer) (current-buffer)) | ||
61 | ;; to the original buffer | ||
62 | (switch-to-buffer +scratch-last-non-scratch-buffer) | ||
63 | ;; to another scratch | ||
64 | (switch-to-buffer buffer)))) | ||
65 | |||
66 | (defun +scratch-switch-to-scratch () | ||
67 | "Switch to scratch buffer." | ||
68 | (interactive) | ||
69 | (+scratch-toggle "*scratch*")) | ||
70 | |||
71 | (defun +scratch-switch-to-text () | ||
72 | "Switch to text buffer." | ||
73 | (interactive) | ||
74 | (+scratch-toggle "*text*")) | ||
75 | |||
76 | (provide '+scratch) | ||
77 | ;;; +scratch.el ends here | ||
diff --git a/lisp/+setup.el b/lisp/+setup.el deleted file mode 100644 index a08526a..0000000 --- a/lisp/+setup.el +++ /dev/null | |||
@@ -1,216 +0,0 @@ | |||
1 | ;;; +setup.el -- my `setup' commands -*- lexical-binding: t -*- | ||
2 | |||
3 | ;; Author: Case Duckworth <acdw@acdw.net> | ||
4 | |||
5 | ;; This file is NOT part of GNU Emacs. | ||
6 | |||
7 | ;;; License: | ||
8 | ;; Everyone is permitted to do whatever with this software, without | ||
9 | ;; limitation. This software comes without any warranty whatsoever, | ||
10 | ;; but with two pieces of advice: | ||
11 | ;; - Don't hurt yourself. | ||
12 | ;; - Make good choices. | ||
13 | |||
14 | ;;; Commentary: | ||
15 | |||
16 | ;; `setup', by Philip Kaludercic, is a wonderful package that works | ||
17 | ;; sort of like `use-package', but to my mind it's cleaner and easier | ||
18 | ;; to extend. These are my additions to the local macros provided by | ||
19 | ;; the package. | ||
20 | |||
21 | ;;; Code: | ||
22 | |||
23 | (require 'el-patch) | ||
24 | (require 'setup) | ||
25 | (require 'straight) | ||
26 | (require 'cl-lib) | ||
27 | |||
28 | (defun +setup-warn (message &rest args) | ||
29 | "Warn the user that something bad happened in `setup'." | ||
30 | (display-warning 'setup (format message args))) | ||
31 | |||
32 | (defun +setup-wrap-to-demote-errors (body name) | ||
33 | "Wrap BODY in a `with-demoted-errors' block. | ||
34 | This behavior is prevented if `setup-attributes' contains the | ||
35 | symbol `without-error-demotion'. | ||
36 | |||
37 | This function differs from `setup-wrap-to-demote-errors' in that | ||
38 | it includes the NAME of the setup form in the warning output." | ||
39 | (if (memq 'without-error-demotion setup-attributes) | ||
40 | body | ||
41 | `(with-demoted-errors ,(format "Error in setup form on line %d (%s): %%S" | ||
42 | (line-number-at-pos) | ||
43 | name) | ||
44 | ,body))) | ||
45 | |||
46 | |||
47 | ;;; New forms | ||
48 | |||
49 | (setup-define :quit | ||
50 | 'setup-quit | ||
51 | :documentation "Quit the current `setup' form. | ||
52 | Good for commenting.") | ||
53 | |||
54 | (setup-define :face | ||
55 | (lambda (face spec) | ||
56 | `(custom-set-faces (list ,face ,spec 'now "Customized by `setup'."))) | ||
57 | :documentation "Customize FACE with SPEC using `custom-set-faces'." | ||
58 | :repeatable t) | ||
59 | |||
60 | (setup-define :load-after | ||
61 | (lambda (&rest features) | ||
62 | (let ((body `(require ',(setup-get 'feature)))) | ||
63 | (dolist (feature (nreverse features)) | ||
64 | (setq body `(with-eval-after-load ',feature ,body))) | ||
65 | body)) | ||
66 | :documentation "Load the current feature after FEATURES.") | ||
67 | |||
68 | (setup-define :load-from | ||
69 | (lambda (path) | ||
70 | `(let ((path* (expand-file-name ,path))) | ||
71 | (if (file-exists-p path*) | ||
72 | (add-to-list 'load-path path*) | ||
73 | ,(setup-quit)))) | ||
74 | :documentation "Add PATH to load path. | ||
75 | This macro can be used as NAME, and it will replace itself with | ||
76 | the nondirectory part of PATH. | ||
77 | If PATH does not exist, abort the evaluation." | ||
78 | :shorthand (lambda (args) | ||
79 | (intern | ||
80 | (file-name-nondirectory | ||
81 | (directory-file-name (cadr args)))))) | ||
82 | |||
83 | (setup-define :needs | ||
84 | (lambda (executable) | ||
85 | `(unless (executable-find ,executable) | ||
86 | ,(setup-quit))) | ||
87 | :documentation "If EXECUTABLE is not in the path, stop here." | ||
88 | :repeatable 1) | ||
89 | |||
90 | |||
91 | ;;; Package integrations | ||
92 | |||
93 | ;;; Straight.el | ||
94 | |||
95 | (defun setup--straight-handle-arg (arg var) | ||
96 | (cond | ||
97 | ((and (boundp var) (symbol-value var)) t) | ||
98 | ((keywordp arg) (set var t)) | ||
99 | ((functionp arg) (set var nil) (funcall arg)) | ||
100 | ((listp arg) (set var nil) arg))) | ||
101 | |||
102 | (with-eval-after-load 'straight | ||
103 | (setup-define :straight | ||
104 | (lambda (recipe &rest predicates) | ||
105 | (let* ((skp (make-symbol "straight-keyword-p")) | ||
106 | (straight-use-p | ||
107 | (cl-mapcar | ||
108 | (lambda (f) (setup--straight-handle-arg f skp)) | ||
109 | predicates)) | ||
110 | (form `(unless (and ,@straight-use-p | ||
111 | (condition-case e | ||
112 | (straight-use-package ',recipe) | ||
113 | (error | ||
114 | (+setup-warn ":straight error: %S" | ||
115 | ',recipe) | ||
116 | ,(setup-quit)) | ||
117 | (:success t))) | ||
118 | ,(setup-quit)))) | ||
119 | ;; Keyword arguments --- :quit is special and should short-circuit | ||
120 | (if (memq :quit predicates) | ||
121 | (setq form `,(setup-quit)) | ||
122 | ;; Otherwise, handle the rest of them ... | ||
123 | (when-let ((after (cadr (memq :after predicates)))) | ||
124 | (setq form `(with-eval-after-load ,(if (eq after t) | ||
125 | (setup-get 'feature) | ||
126 | after) | ||
127 | ,form)))) | ||
128 | ;; Finally ... | ||
129 | form)) | ||
130 | :documentation "Install RECIPE with `straight-use-package'. | ||
131 | If PREDICATES are given, only install RECIPE if all of them return non-nil. | ||
132 | The following keyword arguments are also recognized: | ||
133 | - :quit --- immediately stop evaluating. Good for commenting. | ||
134 | - :after FEATURE --- only install RECIPE after FEATURE is loaded. | ||
135 | If FEATURE is t, install RECIPE after the current feature." | ||
136 | :repeatable nil | ||
137 | :indent 1 | ||
138 | :shorthand (lambda (sexp) | ||
139 | (let ((recipe (cadr sexp))) | ||
140 | (or (car-safe recipe) recipe))))) | ||
141 | |||
142 | ;;; Apheleia | ||
143 | |||
144 | (setup-define :apheleia | ||
145 | (lambda (name formatter &optional mode -pend) | ||
146 | (let* ((mode (or mode (setup-get 'mode))) | ||
147 | (current-formatters (and -pend | ||
148 | (alist-get mode apheleia-formatters)))) | ||
149 | `(with-eval-after-load 'apheleia | ||
150 | (setf (alist-get ',name apheleia-formatters) | ||
151 | ,formatter) | ||
152 | (setf (alist-get ',mode apheleia-mode-alist) | ||
153 | ',(pcase -pend | ||
154 | (:append (append (ensure-list current-formatters) | ||
155 | (list name))) | ||
156 | (:prepend (cons name (ensure-list current-formatters))) | ||
157 | ('nil name) | ||
158 | (_ (error "Improper `:apheleia' -PEND argument"))))))) | ||
159 | :documentation | ||
160 | "Register a formatter to `apheleia''s lists. | ||
161 | NAME is the name given to the formatter in `apheleia-formatters' | ||
162 | and `apheleia-mode-alist'. FORMATTER is the command paired with | ||
163 | NAME in `apheleia-formatters'. MODE is the mode or modes to add | ||
164 | NAME to in `apheleia-mode-alist'. If MODE is not given or nil, | ||
165 | use the setup form's MODE. Optional argument -PEND can be one of | ||
166 | `:append' or `:prepend', and if given will append or prepend the | ||
167 | given NAME to the current formatters for the MODE in | ||
168 | `apheleia-mode-alist', rather than replace them (the default). | ||
169 | |||
170 | Example: | ||
171 | (setup | ||
172 | (:apheleia isort (\"isort\" \"--stdout\" \"-\") | ||
173 | python-mode)) | ||
174 | ; => | ||
175 | (progn | ||
176 | (setf (alist-get 'isort apheleia-formatters) | ||
177 | '(\"isort\" \"--stdout\" \"-\")) | ||
178 | (setf (alist-get 'python-mode apheleia-mode-alist) | ||
179 | 'isort)) | ||
180 | |||
181 | This form cannot be repeated, and it cannot be used as HEAD.") | ||
182 | |||
183 | |||
184 | ;;; Redefines of `setup' forms | ||
185 | |||
186 | (setup-define :bind-into | ||
187 | (lambda (feature-or-map &rest rest) | ||
188 | (cl-loop for f/m in (ensure-list feature-or-map) | ||
189 | collect (if (string-match-p "-map\\'" (symbol-name f/m)) | ||
190 | `(:with-map ,f/m (:bind ,@rest)) | ||
191 | `(:with-feature ,f/m (:bind ,@rest))) | ||
192 | into forms | ||
193 | finally return `(progn ,@forms))) | ||
194 | :documentation "Bind into keys into the map(s) of FEATURE-OR-MAP. | ||
195 | FEATURE-OR-MAP can be a feature or map name or a list of them. | ||
196 | The arguments REST are handled as by `:bind'." | ||
197 | :debug '(sexp &rest form sexp) | ||
198 | :indent 1) | ||
199 | |||
200 | (setup-define :require | ||
201 | (lambda (&rest features) | ||
202 | (require 'cl-lib) | ||
203 | (if features | ||
204 | `(progn ,@(cl-loop for feature in features collect | ||
205 | `(unless (require ',feature nil t) | ||
206 | ,(setup-quit)))) | ||
207 | `(unless (require ',(setup-get 'feature) nil t) | ||
208 | ,(setup-quit)))) | ||
209 | :documentation "Try to require FEATURE, or stop evaluating body. | ||
210 | This macro can be used as NAME, and it will replace itself with | ||
211 | the first FEATURE." | ||
212 | :repeatable nil | ||
213 | :shorthand #'cadr) | ||
214 | |||
215 | (provide '+setup) | ||
216 | ;;; +setup.el ends here | ||
diff --git a/lisp/+shr.el b/lisp/+shr.el deleted file mode 100644 index af4bf5b..0000000 --- a/lisp/+shr.el +++ /dev/null | |||
@@ -1,51 +0,0 @@ | |||
1 | ;;; +shr.el --- SHR extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | ;;; [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/shr-heading.el][shr-heading]], by oantolin | ||
8 | |||
9 | (defun +shr-heading-next (&optional arg) | ||
10 | "Move forward by ARG headings (any h1-h4). | ||
11 | If ARG is negative move backwards, ARG defaults to 1." | ||
12 | (interactive "p") | ||
13 | (unless arg (setq arg 1)) | ||
14 | (catch 'return | ||
15 | (dotimes (_ (abs arg)) | ||
16 | (when (> arg 0) (end-of-line)) | ||
17 | (if-let ((match | ||
18 | (funcall (if (> arg 0) | ||
19 | #'text-property-search-forward | ||
20 | #'text-property-search-backward) | ||
21 | 'face '(shr-h1 shr-h2 shr-h3 shr-h4) | ||
22 | (lambda (tags face) | ||
23 | (cl-loop for x in (if (consp face) face (list face)) | ||
24 | thereis (memq x tags)))))) | ||
25 | (goto-char | ||
26 | (if (> arg 0) (prop-match-beginning match) (prop-match-end match))) | ||
27 | (throw 'return nil)) | ||
28 | (when (< arg 0) (beginning-of-line))) | ||
29 | (beginning-of-line) | ||
30 | (point))) | ||
31 | |||
32 | (defun +shr-heading-previous (&optional arg) | ||
33 | "Move backward by ARG headings (any h1-h4). | ||
34 | If ARG is negative move forwards instead, ARG defaults to 1." | ||
35 | (interactive "p") | ||
36 | (+shr-heading-next (- (or arg 1)))) | ||
37 | |||
38 | (defun +shr-heading--line-at-point () | ||
39 | "Return the current line." | ||
40 | (buffer-substring (line-beginning-position) (line-end-position))) | ||
41 | |||
42 | (defun +shr-heading-setup-imenu () | ||
43 | "Setup imenu for h1-h4 headings in eww buffer. | ||
44 | Add this function to appropriate major mode hooks such as | ||
45 | `eww-mode-hook' or `elfeed-show-mode-hook'." | ||
46 | (setq-local | ||
47 | imenu-prev-index-position-function #'+shr-heading-previous | ||
48 | imenu-extract-index-name-function #'+shr-heading--line-at-point)) | ||
49 | |||
50 | (provide '+shr) | ||
51 | ;;; +shr.el ends here | ||
diff --git a/lisp/+slack.el b/lisp/+slack.el deleted file mode 100644 index cdf2747..0000000 --- a/lisp/+slack.el +++ /dev/null | |||
@@ -1,27 +0,0 @@ | |||
1 | ;;; +slack.el --- Slack customizations and extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'slack) | ||
8 | |||
9 | (defgroup +slack nil | ||
10 | "Extra slack customizations." | ||
11 | :group 'slack | ||
12 | :prefix "+slack-") | ||
13 | |||
14 | (defcustom +slack-teams nil | ||
15 | "Teams to register using `slack-register-team'. | ||
16 | This is a list of plists that are passed directly to | ||
17 | `slack-register-team'." | ||
18 | ;;TODO: type | ||
19 | ) | ||
20 | |||
21 | (defun +slack-register-teams () | ||
22 | "Register teams in `+slack-teams'." | ||
23 | (dolist (team +slack-teams) | ||
24 | (apply #'slack-register-team team))) | ||
25 | |||
26 | (provide '+slack) | ||
27 | ;;; +slack.el ends here | ||
diff --git a/lisp/+sly.el b/lisp/+sly.el deleted file mode 100644 index 8d8fd6a..0000000 --- a/lisp/+sly.el +++ /dev/null | |||
@@ -1,18 +0,0 @@ | |||
1 | ;;; +sly.el --- Sly customizations -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'sly) | ||
8 | |||
9 | (defun sly-mrepl-return-at-end () | ||
10 | (interactive) | ||
11 | (if (<= (point-max) (point)) | ||
12 | (sly-mrepl-return) | ||
13 | (if (bound-and-true-p paredit-mode) | ||
14 | (paredit-newline) | ||
15 | (electric-newline-and-maybe-indent)))) | ||
16 | |||
17 | (provide '+sly) | ||
18 | ;;; +sly.el ends here | ||
diff --git a/lisp/+straight.el b/lisp/+straight.el deleted file mode 100644 index cba6c96..0000000 --- a/lisp/+straight.el +++ /dev/null | |||
@@ -1,42 +0,0 @@ | |||
1 | ;;; +straight.el --- Straight.el extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (defun +straight-update-package (package &optional recursive) | ||
8 | "Update PACKAGE using straight. | ||
9 | This pulls, rebuilds, and loads the updated PACKAGE." | ||
10 | (interactive (list (straight--select-package "Update package" | ||
11 | #'straight--installed-p) | ||
12 | current-prefix-arg)) | ||
13 | (+with-message (format "Pulling package `%s'%s" package | ||
14 | (if recursive " and deps" "")) | ||
15 | (funcall (if recursive | ||
16 | #'straight-pull-package-and-deps | ||
17 | #'straight-pull-package) | ||
18 | package | ||
19 | :from-upstream)) | ||
20 | (+with-message (format "Rebuilding package `%s'%s" package | ||
21 | (if recursive " and deps" "")) | ||
22 | (straight-rebuild-package package recursive)) | ||
23 | (+with-message (format "Loading package `%s'%s" package | ||
24 | (if recursive " and deps" "")) | ||
25 | (ignore-errors (load-library (symbol-name package))) | ||
26 | (when recursive | ||
27 | (dolist (dep (straight--get-transitive-dependencies package)) | ||
28 | (ignore-errors (load-library (symbol-name package))))))) | ||
29 | |||
30 | (defun +straight-update-all (from-upstream) | ||
31 | "Update all installed packages using straight. | ||
32 | This pulls and rebuilds all packages at once. It does not reload | ||
33 | all of them, for reasons that should be obvious. | ||
34 | |||
35 | With a prefix argument, it also pulls the packages FROM-UPSTREAM." | ||
36 | (interactive "P") | ||
37 | (straight-pull-recipe-repositories) | ||
38 | (straight-pull-all from-upstream) | ||
39 | (straight-rebuild-all)) | ||
40 | |||
41 | (provide '+straight) | ||
42 | ;;; +straight.el ends here | ||
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el deleted file mode 100644 index 6c9debd..0000000 --- a/lisp/+tab-bar.el +++ /dev/null | |||
@@ -1,394 +0,0 @@ | |||
1 | ;;; +tab-bar.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; Emacs 28 comes with an easy-to-use `tab-bar-format' option, but I still use | ||
6 | ;; Emacs 27 on my Windows machine. Thus, the code in this file. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (require 'acdw) | ||
11 | (require 'tab-bar) | ||
12 | |||
13 | (defface +tab-bar-extra | ||
14 | '((t :inherit (tab-bar font-lock-comment-face))) | ||
15 | "Tab bar face for extra information, like the menu-bar and time." | ||
16 | :group 'basic-faces) | ||
17 | |||
18 | |||
19 | ;; Common | ||
20 | |||
21 | (defun +tab-bar-space (&optional n) | ||
22 | "Display a space N characters long, or 1." | ||
23 | `((space menu-item ,(+string-repeat (or n 1) " ") ignore))) | ||
24 | |||
25 | (defun +tab-bar-misc-info () | ||
26 | "Display `mode-line-misc-info', formatted for the tab-bar." | ||
27 | `((misc-info menu-item ,(string-trim-right | ||
28 | (format-mode-line mode-line-misc-info)) | ||
29 | ignore))) | ||
30 | |||
31 | (defcustom +tracking-hide-when-org-clocking nil | ||
32 | "Hide the `tracking-mode' information when clocked in." | ||
33 | :type 'boolean) | ||
34 | |||
35 | (defun format-mode-line-unescaping (construct) | ||
36 | "Return a mode-line construct as a string, but unescape `%'s." | ||
37 | (format-mode-line | ||
38 | (cond ((listp construct) | ||
39 | (cl-loop for item in construct | ||
40 | collect (cond ((stringp item) | ||
41 | (string-replace "%" "%%" item)) | ||
42 | ((and (listp item) (eq :propertize (car item))) | ||
43 | (format-mode-line-unescaping item)) | ||
44 | (t item)))) | ||
45 | ((stringp construct) (string-replace "%" "%%" construct)) | ||
46 | (t construct)))) | ||
47 | |||
48 | (defun +tab-bar-tracking-mode () | ||
49 | "Display `tracking-mode-line-buffers' in the tab-bar." | ||
50 | ;; TODO: write something to convert a mode-line construct to a tab-bar | ||
51 | ;; construct. | ||
52 | (when (and (bound-and-true-p tracking-mode) | ||
53 | (not (and +tracking-hide-when-org-clocking | ||
54 | (bound-and-true-p org-clock-current-task)))) | ||
55 | (cons (when (> (length tracking-mode-line-buffers) 0) | ||
56 | '(track-mode-line-separator menu-item " " ignore)) | ||
57 | (cl-loop for i from 0 below (length tracking-mode-line-buffers) | ||
58 | as item = (nth i tracking-mode-line-buffers) | ||
59 | collect (append (list (intern (format "tracking-mode-line-%s" i)) | ||
60 | 'menu-item | ||
61 | (string-trim (format-mode-line-unescaping item))) | ||
62 | (if-let ((keymap (plist-get item 'keymap))) | ||
63 | (list (alist-get 'down-mouse-1 (cdadr keymap))) | ||
64 | (list #'ignore)) | ||
65 | (when-let ((help (plist-get item 'help-echo))) | ||
66 | (list :help help))))))) | ||
67 | |||
68 | (defun +tab-bar-timer () | ||
69 | "Display `+timer-string' in the tab-bar." | ||
70 | (when (> (length (bound-and-true-p +timer-string)) 0) | ||
71 | `((timer-string menu-item | ||
72 | ,(concat " " +timer-string) | ||
73 | (lambda (ev) | ||
74 | (interactive "e") | ||
75 | (cond ((not +timer-timer) nil) | ||
76 | ((equal +timer-string +timer-running-string) | ||
77 | (popup-menu | ||
78 | '("Running timer" | ||
79 | ["Cancel timer" +timer-cancel t]) | ||
80 | ev)) | ||
81 | (t (setq +timer-string "")))))))) | ||
82 | |||
83 | (defun +tab-bar-date () | ||
84 | "Display `display-time-string' in the tab-bar." | ||
85 | (when display-time-mode | ||
86 | `((date-time-string menu-item | ||
87 | ,(substring-no-properties (concat " " (string-trim display-time-string))) | ||
88 | (lambda (ev) | ||
89 | (interactive "e") | ||
90 | (popup-menu | ||
91 | (append '("Timer") | ||
92 | (let (r) | ||
93 | (dolist (time '(3 5 10)) | ||
94 | (push (vector (format "Timer for %d minutes" time) | ||
95 | `(lambda () (interactive) | ||
96 | (+timer ,time)) | ||
97 | :active t) | ||
98 | r)) | ||
99 | (nreverse r)) | ||
100 | '(["Timer for ..." +timer t])) | ||
101 | ev)) | ||
102 | :help (discord-date-string))))) | ||
103 | |||
104 | (defun +tab-bar-notmuch-count () | ||
105 | "Display a notmuch count in the tab-bar." | ||
106 | (when (and (executable-find "notmuch") | ||
107 | (featurep 'notmuch)) | ||
108 | (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches))) | ||
109 | (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) | ||
110 | (next-count (plist-get next :count))) | ||
111 | (when (and next-count (> next-count 0)) | ||
112 | `((notmuch-count menu-item | ||
113 | ,(format " |%s|" next-count) | ||
114 | ignore | ||
115 | :help ,(format "%s mails requiring attention." next-count))))))) | ||
116 | |||
117 | (defun +tab-bar-org-clock () | ||
118 | "Display `org-mode-line-string' in the tab-bar." | ||
119 | (when (and (fboundp 'org-clocking-p) | ||
120 | (org-clocking-p)) | ||
121 | ;; org-mode-line-string | ||
122 | `((org-clocking menu-item | ||
123 | ,org-mode-line-string | ||
124 | (lambda (ev) | ||
125 | (interactive "e") | ||
126 | (let ((menu (make-sparse-keymap | ||
127 | (or org-clock-current-task "Org-Clock")))) | ||
128 | (map-keymap (lambda (key binding) | ||
129 | (when (consp binding) | ||
130 | (define-key-after menu (vector key) | ||
131 | (copy-sequence binding)))) | ||
132 | (org-clock-menu)) | ||
133 | (message "%S" ev) | ||
134 | (popup-menu menu ev))) | ||
135 | :help ,(or (replace-regexp-in-string | ||
136 | (rx "[[" (group (* (not "]"))) | ||
137 | "][" (group (* (not "]"))) | ||
138 | "]]") | ||
139 | "\\2" | ||
140 | org-clock-current-task) | ||
141 | "Org-Clock"))))) | ||
142 | |||
143 | (defcustom +tab-bar-emms-max-length 24 | ||
144 | "Maximum length of `+tab-bar-emms'." | ||
145 | :type 'number) | ||
146 | |||
147 | (defun +tab-bar-emms () | ||
148 | "Display EMMS now playing information." | ||
149 | (when (and (bound-and-true-p emms-mode-line-mode) | ||
150 | emms-player-playing-p) | ||
151 | (let ((now-playing (+string-truncate (emms-mode-line-playlist-current) | ||
152 | (- +tab-bar-emms-max-length 2)))) | ||
153 | `(emms-now-playing menu-item | ||
154 | ,(concat "{" now-playing "}" " ") | ||
155 | emms-pause | ||
156 | ( :help ,(emms-mode-line-playlist-current)))))) | ||
157 | |||
158 | (defun +tab-bar-bongo () | ||
159 | "Display Bongo now playing information." | ||
160 | (when-let ((modep (bound-and-true-p bongo-mode-line-indicator-mode)) | ||
161 | (buf (cl-some (lambda (b) | ||
162 | (with-current-buffer b | ||
163 | (when-let* ((modep (derived-mode-p 'bongo-playlist-mode)) | ||
164 | (bongo-playlist-buffer b) | ||
165 | (playingp (bongo-playing-p))) | ||
166 | b))) | ||
167 | (buffer-list)))) | ||
168 | `((bongo-now-playing menu-item | ||
169 | ,(concat "{" | ||
170 | (let ((bongo-field-separator "")) | ||
171 | (+string-truncate (replace-regexp-in-string | ||
172 | "\\(.*\\)\\(.*\\)\\(.*\\)" | ||
173 | "\\1: \\3" | ||
174 | (bongo-formatted-infoset)) | ||
175 | ;; This isn't right | ||
176 | (- (min 50 (/ (frame-width) 3 )) 2))) | ||
177 | "}") | ||
178 | (lambda () (interactive) | ||
179 | (let ((bongo-playlist-buffer | ||
180 | ;; XXX: I'm sure this is terribly inefficient | ||
181 | (cl-some (lambda (b) | ||
182 | (with-current-buffer b | ||
183 | (when-let* ((modep (derived-mode-p | ||
184 | 'bongo-playlist-mode)) | ||
185 | (bongo-playlist-buffer b) | ||
186 | (playingp (bongo-playing-p))) | ||
187 | b))) | ||
188 | (buffer-list)))) | ||
189 | (with-bongo-playlist-buffer | ||
190 | (bongo-pause/resume)))) | ||
191 | :help ,(funcall bongo-header-line-function))))) | ||
192 | |||
193 | (defvar +tab-bar-show-original nil | ||
194 | "Original value of `tab-bar-show'.") | ||
195 | |||
196 | (defun +tab-bar-basename () | ||
197 | "Generate the tab name from the basename of the buffer of the | ||
198 | selected window." | ||
199 | (let* ((tab-file-name (buffer-file-name (window-buffer | ||
200 | (minibuffer-selected-window))))) | ||
201 | (concat " " | ||
202 | (if tab-file-name | ||
203 | (file-name-nondirectory tab-file-name) | ||
204 | (+tab-bar-tab-name-truncated-left))))) | ||
205 | |||
206 | ;;; FIXME this doesn't work... | ||
207 | ;; (defvar +tab-bar-tab-min-width 8 | ||
208 | ;; "Minimum width of a tab on the tab bar.") | ||
209 | |||
210 | ;; (defvar +tab-bar-tab-max-width 24 | ||
211 | ;; "Maximum width of a tab on the tab bar.") | ||
212 | |||
213 | ;; (defun +tab-bar-fluid-calculate-width () | ||
214 | ;; "Calculate the width of each tab in the tab-bar." | ||
215 | ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) | ||
216 | ;; (tab-bar-avail-width (frame-width)) | ||
217 | ;; (tab-bar-tab-count (length (tab-bar-tabs))) | ||
218 | ;; (tab-bar-close-button-char-width 1) | ||
219 | ;; (tab-bar-add-tab-button-char-width 1) | ||
220 | ;; (tab-bar-total-width | ||
221 | ;; (length (mapconcat | ||
222 | ;; (lambda (el) | ||
223 | ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) | ||
224 | ;; (substring-no-properties (eval str)))) | ||
225 | ;; tab-bar-list))) | ||
226 | ;; (tab-bar-total-tab-width | ||
227 | ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) | ||
228 | ;; tab-bar-add-tab-button-char-width | ||
229 | ;; (length (mapconcat | ||
230 | ;; (lambda (el) | ||
231 | ;; (substring-no-properties (alist-get 'name el))) | ||
232 | ;; (tab-bar-tabs))))) | ||
233 | ;; (tab-bar-total-nontab-width (- tab-bar-total-width | ||
234 | ;; tab-bar-total-tab-width))) | ||
235 | ;; (min +tab-bar-tab-max-width | ||
236 | ;; (max +tab-bar-tab-min-width | ||
237 | ;; (/ (- tab-bar-avail-width | ||
238 | ;; tab-bar-total-tab-width | ||
239 | ;; tab-bar-total-nontab-width) | ||
240 | ;; tab-bar-tab-count))))) | ||
241 | |||
242 | ;; (defun +tab-bar-fluid-width () | ||
243 | ;; "Generate the tab name to fluidly fit in the given space." | ||
244 | ;; (let* ((tab-file-name (buffer-file-name (window-buffer | ||
245 | ;; (minibuffer-selected-window))))) | ||
246 | ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) | ||
247 | ;; (if tab-file-name | ||
248 | ;; (file-name-nondirectory tab-file-name) | ||
249 | ;; (+tab-bar-tab-name-truncated-left)) | ||
250 | ;; " "))) | ||
251 | |||
252 | (defun +tab-bar-tab-name-truncated-left () | ||
253 | "Generate the tab name from the buffer of the selected window. | ||
254 | This is just like `tab-bar-tab-name-truncated', but truncates the | ||
255 | name to the left." | ||
256 | (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window)))) | ||
257 | (ellipsis (cond | ||
258 | (tab-bar-tab-name-ellipsis) | ||
259 | ((char-displayable-p ?…) "…") | ||
260 | ("..."))) | ||
261 | (l-ell (length ellipsis)) | ||
262 | (l-name (length tab-name))) | ||
263 | (if (< (length tab-name) tab-bar-tab-name-truncated-max) | ||
264 | tab-name | ||
265 | (propertize (concat | ||
266 | (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max) | ||
267 | ellipsis) | ||
268 | (truncate-string-to-width tab-name l-name | ||
269 | (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell)))) | ||
270 | 'help-echo tab-name)))) | ||
271 | |||
272 | (defun +tab-bar-format-align-right () | ||
273 | "Align the rest of tab bar items to the right, pixel-wise." | ||
274 | ;; XXX: ideally, wouldn't require `shr' here | ||
275 | (require 'shr) ; `shr-string-pixel-width' | ||
276 | (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) | ||
277 | (rest (tab-bar-format-list rest)) | ||
278 | (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) | ||
279 | (hpos (shr-string-pixel-width rest)) | ||
280 | (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) | ||
281 | `((align-right menu-item ,str ignore)))) | ||
282 | |||
283 | |||
284 | ;;; Menu bar | ||
285 | ;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el | ||
286 | |||
287 | (defun +tab-bar-menu-bar (event) | ||
288 | "Pop up the same menu as displayed by the menu bar. | ||
289 | Used by `tab-bar-format-menu-bar'." | ||
290 | (interactive "e") | ||
291 | (let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t)))) | ||
292 | (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) | ||
293 | (map-keymap (lambda (key binding) | ||
294 | (when (consp binding) | ||
295 | (define-key-after menu (vector key) | ||
296 | (copy-sequence binding)))) | ||
297 | (menu-bar-keymap)) | ||
298 | (popup-menu menu event))) | ||
299 | |||
300 | (defcustom +tab-bar-menu-bar-icon " Emacs " | ||
301 | "The string to use for the tab-bar menu icon." | ||
302 | :type 'string) | ||
303 | |||
304 | (defun +tab-bar-format-menu-bar () | ||
305 | "Produce the Menu button for the tab bar that shows the menu bar." | ||
306 | `((menu-bar menu-item (propertize +tab-bar-menu-bar-icon 'face '+tab-bar-extra) | ||
307 | +tab-bar-menu-bar :help "Menu Bar"))) | ||
308 | |||
309 | |||
310 | ;;; Tab bar format tabs | ||
311 | |||
312 | (require 'el-patch) | ||
313 | (el-patch-feature tab-bar) | ||
314 | (with-eval-after-load 'tab-bar | ||
315 | (el-patch-defun tab-bar--format-tab (tab i) | ||
316 | "Format TAB using its index I and return the result as a keymap." | ||
317 | (append | ||
318 | (el-patch-remove | ||
319 | `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))) | ||
320 | (cond | ||
321 | ((eq (car tab) 'current-tab) | ||
322 | `((current-tab | ||
323 | menu-item | ||
324 | ,(funcall tab-bar-tab-name-format-function tab i) | ||
325 | ignore | ||
326 | :help "Current tab"))) | ||
327 | (t | ||
328 | `((,(intern (format "tab-%i" i)) | ||
329 | menu-item | ||
330 | ,(funcall tab-bar-tab-name-format-function tab i) | ||
331 | ,(alist-get 'binding tab) | ||
332 | :help "Click to visit tab")))) | ||
333 | (when (alist-get 'close-binding tab) | ||
334 | `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) | ||
335 | menu-item "" | ||
336 | ,(alist-get 'close-binding tab))))))) | ||
337 | |||
338 | |||
339 | ;; Emacs 27 | ||
340 | |||
341 | (defun +tab-bar-misc-info-27 (output &rest _) | ||
342 | "Display `mode-line-misc-info' in the `tab-bar' on Emacs 27. | ||
343 | This is :filter-return advice for `tab-bar-make-keymap-1'." | ||
344 | (let* ((reserve (length (format-mode-line mode-line-misc-info))) | ||
345 | (str (propertize " " | ||
346 | 'display `(space :align-to (- right (- 0 right-margin) | ||
347 | ,reserve))))) | ||
348 | (prog1 (append output | ||
349 | `((align-right menu-item ,str nil)) | ||
350 | (+tab-bar-misc-info))))) | ||
351 | |||
352 | |||
353 | ;; Emacs 28 | ||
354 | |||
355 | (defvar +tab-bar-format-original nil | ||
356 | "Original value of `tab-bar-format'.") | ||
357 | |||
358 | (defun +tab-bar-misc-info-28 () | ||
359 | "Display `mode-line-misc-info', right-aligned, on Emacs 28." | ||
360 | (append (unless (memq 'tab-bar-format-align-right tab-bar-format) | ||
361 | '(tab-bar-format-align-right)) | ||
362 | '(+tab-bar-misc-info))) | ||
363 | |||
364 | |||
365 | |||
366 | (define-minor-mode +tab-bar-misc-info-mode | ||
367 | "Show the `mode-line-misc-info' in the `tab-bar'." | ||
368 | :lighter "" | ||
369 | :global t | ||
370 | (if +tab-bar-misc-info-mode | ||
371 | (progn ; Enable | ||
372 | (setq +tab-bar-show-original tab-bar-show) | ||
373 | (cond | ||
374 | ((boundp 'tab-bar-format) ; Emacs 28 | ||
375 | (setq +tab-bar-format-original tab-bar-format) | ||
376 | (unless (memq '+tab-bar-misc-info tab-bar-format) | ||
377 | (setq tab-bar-format | ||
378 | (append tab-bar-format (+tab-bar-misc-info-28))))) | ||
379 | ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 | ||
380 | (advice-add 'tab-bar-make-keymap-1 :filter-return | ||
381 | '+tab-bar-misc-info-27))) | ||
382 | (setq tab-bar-show t)) | ||
383 | (progn ; Disable | ||
384 | (setq tab-bar-show +tab-bar-show-original) | ||
385 | (cond | ||
386 | ((boundp 'tab-bar-format) ; Emacs 28 | ||
387 | (setq tab-bar-format +tab-bar-format-original)) | ||
388 | ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 | ||
389 | (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) | ||
390 | |||
391 | |||
392 | |||
393 | (provide '+tab-bar) | ||
394 | ;;; +tab-bar.el ends here | ||
diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 655ebe1..0000000 --- a/lisp/+titlecase.el +++ /dev/null | |||
@@ -1,30 +0,0 @@ | |||
1 | ;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (defun +titlecase-sentence-style-dwim (&optional arg) | ||
8 | "Titlecase a sentence. | ||
9 | With prefix ARG, toggle the value of | ||
10 | `titlecase-downcase-sentences' before sentence-casing." | ||
11 | (interactive "P") | ||
12 | (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) | ||
13 | titlecase-downcase-sentences))) | ||
14 | (titlecase-dwim 'sentence))) | ||
15 | |||
16 | (defun +titlecase-org-headings () | ||
17 | (interactive) | ||
18 | (save-excursion | ||
19 | (goto-char (point-min)) | ||
20 | ;; See also `org-map-tree'. I'm not using that function because I want to | ||
21 | ;; skip the first headline. A better solution would be to patch | ||
22 | ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). | ||
23 | (let ((level (funcall outline-level))) | ||
24 | (while (and (progn (outline-next-heading) | ||
25 | (> (funcall outline-level) level)) | ||
26 | (not (eobp))) | ||
27 | (titlecase-line))))) | ||
28 | |||
29 | (provide '+titlecase) | ||
30 | ;;; +titlecase.el ends here | ||
diff --git a/lisp/+util.el b/lisp/+util.el deleted file mode 100644 index a87eae9..0000000 --- a/lisp/+util.el +++ /dev/null | |||
@@ -1,94 +0,0 @@ | |||
1 | ;;; +util.el --- utility whatevers -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; This file is going to be my version of like, subr.el -- lots of | ||
6 | ;; random shit that all goes in here. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (require 'cl-lib) | ||
11 | |||
12 | (defgroup +util nil | ||
13 | "Utility whatevers." | ||
14 | :group 'convenience) | ||
15 | |||
16 | ;;; STRINGS | ||
17 | |||
18 | (defcustom +string-default-alignment 'left | ||
19 | "Default alignment." | ||
20 | :type '(choice (const :tag "Left" 'left) | ||
21 | (const :tag "Right" 'right))) | ||
22 | |||
23 | ;; stolen from s.el | ||
24 | (defun +string-repeat (n s) | ||
25 | "Make a string of S repeated N times." | ||
26 | (declare (pure t) | ||
27 | (side-effect-free t)) | ||
28 | (let (ss) | ||
29 | (while (> n 0) | ||
30 | (setq ss (cons s ss) | ||
31 | n (1- n))) | ||
32 | (apply 'concat ss))) | ||
33 | |||
34 | (defun +string-truncate (s length &optional ellipsis alignment) | ||
35 | "Return S, shortened to LENGTH including ELLIPSIS and aligned to ALIGNMENT. | ||
36 | |||
37 | ELLIPSIS defaults to `truncate-string-ellipsis', or \"...\". | ||
38 | |||
39 | ALIGNMENT defaults to `+string-default-alignment'." | ||
40 | (declare (pure t) | ||
41 | (side-effect-free t)) | ||
42 | (let ((ellipsis (or ellipsis truncate-string-ellipsis "...")) | ||
43 | (alignment (or alignment +string-default-alignment))) | ||
44 | (if (> (length s) length) | ||
45 | (format "%s%s" | ||
46 | (substring s 0 (- length (length ellipsis))) | ||
47 | ellipsis) | ||
48 | s))) | ||
49 | |||
50 | (cl-defun +string-align (s len | ||
51 | &key | ||
52 | (before "") (after "") (fill " ") | ||
53 | (ellipsis (or truncate-string-ellipsis "...")) | ||
54 | (alignment +string-default-alignment)) | ||
55 | "Print S to fit in LEN characters. | ||
56 | Optional arguments BEFORE and AFTER specify strings to go on | ||
57 | either side of S. | ||
58 | |||
59 | FILL is the string to fill extra space with (default \" \"). | ||
60 | |||
61 | ELLIPSIS is the string to show when S is too long to fit (default | ||
62 | `truncate-string-ellipsis' or \"...\"). If nil, don't truncate | ||
63 | the string. | ||
64 | |||
65 | ALIGNMENT can be one of these: | ||
66 | - nil: align to `+string-default-alignment' | ||
67 | - `left': align left | ||
68 | - `right': align right" | ||
69 | (let* ((s-length (length s)) | ||
70 | (before-length (length before)) | ||
71 | (after-length (length after)) | ||
72 | (max-length (- len (+ before-length after-length))) | ||
73 | (left-over (max 0 (- max-length s-length))) | ||
74 | (filler (+string-repeat left-over fill))) | ||
75 | (format "%s%s%s%s%s" | ||
76 | before | ||
77 | (if (eq alignment 'left) "" filler) | ||
78 | (if ellipsis (+string-truncate s max-length ellipsis alignment) s) | ||
79 | (if (eq alignment 'right) "" filler) | ||
80 | after))) | ||
81 | |||
82 | ;;; COMMANDS | ||
83 | |||
84 | (defun +dos2unix (buffer) | ||
85 | "Replace \r\n with \n in BUFFER." | ||
86 | (interactive "*b") | ||
87 | (save-excursion | ||
88 | (with-current-buffer buffer | ||
89 | (goto-char (point-min)) | ||
90 | (while (search-forward (string ?\C-m ?\C-j) nil t) | ||
91 | (replace-match (string ?\C-j) nil t))))) | ||
92 | |||
93 | (provide '+util) | ||
94 | ;;; +util.el ends here | ||
diff --git a/lisp/+vertico.el b/lisp/+vertico.el deleted file mode 100644 index d4fb3a3..0000000 --- a/lisp/+vertico.el +++ /dev/null | |||
@@ -1,24 +0,0 @@ | |||
1 | ;;; +vertico.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | ;; https://old.reddit.com/r/emacs/comments/rbmfwk/weekly_tips_tricks_c_thread/hof7rz7/ | ||
6 | ;; Add this advice to `vertico-next'. | ||
7 | ;; Takes care of `vertico-previous' as well, since it calls `vertico-next'. | ||
8 | (defun +vertico-ding-wrap (origin &rest args) | ||
9 | "ADVICE to wrap `vertico-next': ding when wrapping." | ||
10 | (let ((beg-index vertico--index)) | ||
11 | (apply origin args) | ||
12 | (unless (eq 1 (abs (- beg-index vertico--index))) | ||
13 | (ding)))) | ||
14 | |||
15 | (defun +vertico-widen-or-complete () | ||
16 | (interactive) | ||
17 | (if (or vertico-unobtrusive-mode | ||
18 | vertico-flat-mode) | ||
19 | (progn (vertico-unobtrusive-mode -1) | ||
20 | (vertico-flat-mode -1)) | ||
21 | (call-interactively #'vertico-insert))) | ||
22 | |||
23 | (provide '+vertico) | ||
24 | ;;; +vertico.el ends here | ||
diff --git a/lisp/+vterm.el b/lisp/+vterm.el deleted file mode 100644 index 06c0028..0000000 --- a/lisp/+vterm.el +++ /dev/null | |||
@@ -1,19 +0,0 @@ | |||
1 | ;;; +vterm.el --- Vterm extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'vterm) | ||
8 | |||
9 | (defun +vterm-counsel-yank-pop-action (orig-fun &rest args) | ||
10 | (if (equal major-mode 'vterm-mode) | ||
11 | (let ((inhibit-read-only t) | ||
12 | (yank-undo-function (lambda (_start _end) (vterm-undo)))) | ||
13 | (cl-letf (((symbol-function 'insert-for-yank) | ||
14 | (lambda (str) (vterm-send-string str t)))) | ||
15 | (apply orig-fun args))) | ||
16 | (apply orig-fun args))) | ||
17 | |||
18 | (provide '+vterm) | ||
19 | ;;; +vterm.el ends here | ||
diff --git a/lisp/+window.el b/lisp/+window.el deleted file mode 100644 index 52b3712..0000000 --- a/lisp/+window.el +++ /dev/null | |||
@@ -1,130 +0,0 @@ | |||
1 | ;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; Do I want to propose this change in the Emacs ML? | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'window) | ||
10 | |||
11 | ;;; Split windows based on `window-total-width', not `window-width' | ||
12 | ;; I have to just redefine these functions because the check is really deep in | ||
13 | ;; there. | ||
14 | |||
15 | (defun window-splittable-p (window &optional horizontal) | ||
16 | "Return non-nil if `split-window-sensibly' may split WINDOW. | ||
17 | Optional argument HORIZONTAL nil or omitted means check whether | ||
18 | `split-window-sensibly' may split WINDOW vertically. HORIZONTAL | ||
19 | non-nil means check whether WINDOW may be split horizontally. | ||
20 | |||
21 | WINDOW may be split vertically when the following conditions | ||
22 | hold: | ||
23 | - `window-size-fixed' is either nil or equals `width' for the | ||
24 | buffer of WINDOW. | ||
25 | - `split-height-threshold' is an integer and WINDOW is at least as | ||
26 | high as `split-height-threshold'. | ||
27 | - When WINDOW is split evenly, the emanating windows are at least | ||
28 | `window-min-height' lines tall and can accommodate at least one | ||
29 | line plus - if WINDOW has one - a mode line. | ||
30 | |||
31 | WINDOW may be split horizontally when the following conditions | ||
32 | hold: | ||
33 | - `window-size-fixed' is either nil or equals `height' for the | ||
34 | buffer of WINDOW. | ||
35 | - `split-width-threshold' is an integer and WINDOW is at least as | ||
36 | wide as `split-width-threshold'. | ||
37 | - When WINDOW is split evenly, the emanating windows are at least | ||
38 | `window-min-width' or two (whichever is larger) columns wide." | ||
39 | (when (and (window-live-p window) | ||
40 | (not (window-parameter window 'window-side))) | ||
41 | (with-current-buffer (window-buffer window) | ||
42 | (if horizontal | ||
43 | ;; A window can be split horizontally when its width is not | ||
44 | ;; fixed, it is at least `split-width-threshold' columns wide | ||
45 | ;; and at least twice as wide as `window-min-width' and 2 (the | ||
46 | ;; latter value is hardcoded). | ||
47 | (and (memq window-size-fixed '(nil height)) | ||
48 | ;; Testing `window-full-width-p' here hardly makes any | ||
49 | ;; sense nowadays. This can be done more intuitively by | ||
50 | ;; setting up `split-width-threshold' appropriately. | ||
51 | (numberp split-width-threshold) | ||
52 | (>= (window-total-width window) | ||
53 | (max split-width-threshold | ||
54 | (* 2 (max window-min-width 2))))) | ||
55 | ;; A window can be split vertically when its height is not | ||
56 | ;; fixed, it is at least `split-height-threshold' lines high, | ||
57 | ;; and it is at least twice as high as `window-min-height' and 2 | ||
58 | ;; if it has a mode line or 1. | ||
59 | (and (memq window-size-fixed '(nil width)) | ||
60 | (numberp split-height-threshold) | ||
61 | (>= (window-height window) | ||
62 | (max split-height-threshold | ||
63 | (* 2 (max window-min-height | ||
64 | (if mode-line-format 2 1)))))))))) | ||
65 | |||
66 | (defun split-window-sensibly (&optional window) | ||
67 | "Split WINDOW in a way suitable for `display-buffer'. | ||
68 | WINDOW defaults to the currently selected window. | ||
69 | If `split-height-threshold' specifies an integer, WINDOW is at | ||
70 | least `split-height-threshold' lines tall and can be split | ||
71 | vertically, split WINDOW into two windows one above the other and | ||
72 | return the lower window. Otherwise, if `split-width-threshold' | ||
73 | specifies an integer, WINDOW is at least `split-width-threshold' | ||
74 | columns wide and can be split horizontally, split WINDOW into two | ||
75 | windows side by side and return the window on the right. If this | ||
76 | can't be done either and WINDOW is the only window on its frame, | ||
77 | try to split WINDOW vertically disregarding any value specified | ||
78 | by `split-height-threshold'. If that succeeds, return the lower | ||
79 | window. Return nil otherwise. | ||
80 | |||
81 | By default `display-buffer' routines call this function to split | ||
82 | the largest or least recently used window. To change the default | ||
83 | customize the option `split-window-preferred-function'. | ||
84 | |||
85 | You can enforce this function to not split WINDOW horizontally, | ||
86 | by setting (or binding) the variable `split-width-threshold' to | ||
87 | nil. If, in addition, you set `split-height-threshold' to zero, | ||
88 | chances increase that this function does split WINDOW vertically. | ||
89 | |||
90 | In order to not split WINDOW vertically, set (or bind) the | ||
91 | variable `split-height-threshold' to nil. Additionally, you can | ||
92 | set `split-width-threshold' to zero to make a horizontal split | ||
93 | more likely to occur. | ||
94 | |||
95 | Have a look at the function `window-splittable-p' if you want to | ||
96 | know how `split-window-sensibly' determines whether WINDOW can be | ||
97 | split." | ||
98 | (let ((window (or window (selected-window)))) | ||
99 | (or (and (window-splittable-p window) | ||
100 | ;; Split window vertically. | ||
101 | (with-selected-window window | ||
102 | (split-window-below))) | ||
103 | (and (window-splittable-p window t) | ||
104 | ;; Split window horizontally. | ||
105 | (with-selected-window window | ||
106 | (split-window-right))) | ||
107 | (and | ||
108 | ;; If WINDOW is the only usable window on its frame (it is | ||
109 | ;; the only one or, not being the only one, all the other | ||
110 | ;; ones are dedicated) and is not the minibuffer window, try | ||
111 | ;; to split it vertically disregarding the value of | ||
112 | ;; `split-height-threshold'. | ||
113 | (let ((frame (window-frame window))) | ||
114 | (or | ||
115 | (eq window (frame-root-window frame)) | ||
116 | (catch 'done | ||
117 | (walk-window-tree (lambda (w) | ||
118 | (unless (or (eq w window) | ||
119 | (window-dedicated-p w)) | ||
120 | (throw 'done nil))) | ||
121 | frame nil 'nomini) | ||
122 | t))) | ||
123 | (not (window-minibuffer-p window)) | ||
124 | (let ((split-height-threshold 0)) | ||
125 | (when (window-splittable-p window) | ||
126 | (with-selected-window window | ||
127 | (split-window-below)))))))) | ||
128 | |||
129 | (provide '+window) | ||
130 | ;;; +window.el ends here | ||
diff --git a/lisp/+xkcd.el b/lisp/+xkcd.el deleted file mode 100644 index 6780b90..0000000 --- a/lisp/+xkcd.el +++ /dev/null | |||
@@ -1,16 +0,0 @@ | |||
1 | ;;; +xkcd.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'xkcd) | ||
8 | |||
9 | (defun +xkcd-get-from-url (url &rest _) | ||
10 | "Open XKCD from URL." | ||
11 | (if (string-match "xkcd\\.com/\\([0-9]+\\)" url) | ||
12 | (xkcd-get (string-to-number (match-string 1 url))) | ||
13 | (funcall +browse-url-browser-function url))) | ||
14 | |||
15 | (provide '+xkcd) | ||
16 | ;;; +xkcd.el ends here | ||
diff --git a/lisp/+ytdious.el b/lisp/+ytdious.el deleted file mode 100644 index 6124149..0000000 --- a/lisp/+ytdious.el +++ /dev/null | |||
@@ -1,21 +0,0 @@ | |||
1 | ;;; +ytdious.el --- Ytdious customizations -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; https://github.com/spiderbit/ytdious | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (defun +ytdious-watch () | ||
10 | "Stream video at point in mpv." | ||
11 | (interactive) | ||
12 | (let* ((video (ytdious-get-current-video)) | ||
13 | (id (ytdious-video-id-fun video))) | ||
14 | (start-process "ytdious mpv" nil | ||
15 | "mpv" | ||
16 | (concat "https://www.youtube.com/watch?v=" id)) | ||
17 | "--ytdl-format=bestvideo[height<=?720]+bestaudio/best") | ||
18 | (message "Starting streaming...")) | ||
19 | |||
20 | (provide '+ytdious) | ||
21 | ;;; +ytdious.el ends here | ||
diff --git a/lisp/+zzz-to-char.el b/lisp/+zzz-to-char.el deleted file mode 100644 index b3f27f7..0000000 --- a/lisp/+zzz-to-char.el +++ /dev/null | |||
@@ -1,16 +0,0 @@ | |||
1 | ;;; +zzz-to-char.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (defun +zzz-to-char (prefix) | ||
10 | "Call `zzz-to-char' or `zzz-up-to-char' with PREFIX arg." | ||
11 | (interactive "P") | ||
12 | (call-interactively | ||
13 | (if prefix #'zzz-up-to-char #'zzz-to-char))) | ||
14 | |||
15 | (provide '+zzz-to-char) | ||
16 | ;;; +zzz-to-char.el ends here | ||
diff --git a/lisp/acdw.el b/lisp/acdw.el index 99ab733..1c6f826 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -1,28 +1,10 @@ | |||
1 | ;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*- | 1 | ;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- |
2 | 2 | ;; by C. Duckworth <acdw@acdw.net> | |
3 | ;;; Commentary: | 3 | (provide 'acdw) |
4 | |||
5 | ;; What's that saying about how the hardest things in computer science | ||
6 | ;; are naming and off-by-one errors? Well, the naming one I know very | ||
7 | ;; well. I've been trying to figure out a good way to prefix my | ||
8 | ;; bespoke functions, other stuff I found online, and various emacs | ||
9 | ;; lisp detritus for quite some time (I reckon at over a year, as of | ||
10 | ;; 2021-11-02). Finally, I found the answer in the writings of Daniel | ||
11 | ;; Mendler: I'll prefix everything with a `+' ! | ||
12 | |||
13 | ;; To that end, pretty much everything in lisp/ will have a filename | ||
14 | ;; like "+org.el", except of course this file, and maybe a few | ||
15 | ;; /actually original/ libraries I haven't had the wherewithal to | ||
16 | ;; package out properly yet. | ||
17 | |||
18 | ;; Is it perfect? No. Is it fine? Yes. Here it is. | ||
19 | |||
20 | ;;; Code: | ||
21 | 4 | ||
22 | (require 'diary-lib) | 5 | (require 'cl-lib) |
23 | (require 'solar) ; for +sunrise-sunset | ||
24 | 6 | ||
25 | ;;; Define a directory and an expanding function | 7 | ;;; Define both a directory and a function expanding to a file in that directory |
26 | 8 | ||
27 | (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) | 9 | (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) |
28 | "Define a variable and function NAME expanding to DIRECTORY. | 10 | "Define a variable and function NAME expanding to DIRECTORY. |
@@ -46,488 +28,91 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." | |||
46 | (make-directory (file-name-directory file-name) :parents)) | 28 | (make-directory (file-name-directory file-name) :parents)) |
47 | file-name)))) | 29 | file-name)))) |
48 | 30 | ||
49 | (defun +suppress-messages (oldfn &rest args) ; from pkal | 31 | ;;; Convenience macros |
50 | "Advice wrapper for suppressing `message'. | ||
51 | OLDFN is the wrapped function, that is passed the arguments | ||
52 | ARGS." | ||
53 | (let ((msg (current-message))) | ||
54 | (prog1 | ||
55 | (let ((inhibit-message t)) | ||
56 | (apply oldfn args)) | ||
57 | (when msg | ||
58 | (message "%s" msg))))) | ||
59 | 32 | ||
60 | (defun +ensure-after-init (function) | 33 | (defun eval-after-init (fn) |
61 | "Ensure FUNCTION runs after init, or now if already initialized. | 34 | "Evaluate FN after inititation, or now if Emacs is initialized. |
62 | If Emacs is already started, run FUNCTION. Otherwise, add it to | 35 | FN is called with no arguments." |
63 | `after-init-hook'. FUNCTION is called with no arguments." | ||
64 | (if after-init-time | 36 | (if after-init-time |
65 | (funcall function) | 37 | (funcall fn) |
66 | (add-hook 'after-init-hook function))) | 38 | (add-hook 'after-init-hook fn))) |
67 | 39 | ||
68 | (defmacro +with-ensure-after-init (&rest body) | 40 | (defmacro eval-after (features &rest body) |
69 | "Ensure BODY forms run after init. | 41 | "Evaluate BODY, but only after loading FEATURES. |
70 | Convenience macro wrapper around `+ensure-after-init'." | 42 | FEATURES can be an atom or a list; as an atom it works like |
71 | (declare (indent 0) (debug (def-body))) | 43 | `with-eval-after-load'. The special feature `init' will evaluate |
72 | `(+ensure-after-init (lambda () ,@body))) | 44 | BODY after Emacs is finished initializing." |
73 | 45 | (declare (indent 1) | |
74 | (defun +remember-prefix-arg (p-arg P-arg) | 46 | (debug (form def-body))) |
75 | "Display prefix ARG, in \"p\" and \"P\" `interactive' types. | 47 | (if (eq features 'init) |
76 | I keep forgetting how they differ." | 48 | `(eval-after-init (lambda () ,@body)) |
77 | (interactive "p\nP") | 49 | (unless (listp features) |
78 | (message "p: %S P: %S" p-arg P-arg)) | 50 | (setq features (list features))) |
79 | 51 | (if (null features) | |
80 | (defmacro +defvar (var value &rest _) | 52 | (macroexp-progn body) |
81 | "Quick way to `setq' a variable from a `defvar' form." | 53 | (let* ((this (car features)) |
82 | (declare (doc-string 3) (indent 2)) | 54 | (rest (cdr features))) |
83 | `(setq ,var ,value)) | 55 | `(with-eval-after-load ',this |
84 | 56 | (eval-after ,rest ,@body)))))) | |
85 | (defmacro +with-message (message &rest body) | 57 | |
86 | "Execute BODY, with MESSAGE. | 58 | ;;; Convenience functions |
87 | If body executes without errors, MESSAGE...Done will be displayed." | 59 | |
88 | (declare (indent 1)) | 60 | (defun define-keys (maps &rest keydefs) |
89 | (let ((msg (gensym))) | 61 | "Define KEYDEFS in MAPS. |
90 | `(let ((,msg ,message)) | 62 | Convenience wrapper around `define-key'." |
91 | (condition-case e | 63 | (unless (zerop (mod (length keydefs) 2)) |
92 | (progn (message "%s..." ,msg) | 64 | (user-error "Wrong number of arguments: %S" (length keydefs))) |
93 | ,@body) | 65 | (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) |
94 | (:success (message "%s...done" ,msg)) | 66 | (list maps) |
95 | (t (signal (car e) (cdr e))))))) | 67 | maps)) |
96 | 68 | (cl-loop for (key def) on keydefs by #'cddr | |
97 | (defun +mapc-some-buffers (func &optional predicate-or-modes) | 69 | do (let ((key (if (stringp key) (kbd key) key))) |
98 | "Perform FUNC on all buffers satisfied by PREDICATE-OR-MODES. | 70 | (define-key (if (symbolp map) |
99 | By default, act on all buffers. | 71 | (symbol-value map) |
100 | 72 | map) | |
101 | Both PREDICATE-OR-MODES and FUNC are called with no arguments, | 73 | key def))))) |
102 | but within a `with-current-buffer' form on the currently-active | 74 | |
103 | buffer. | 75 | (defmacro setq-local-hook (hook &rest args) |
104 | 76 | "Run `setq-local' on ARGS when running HOOK." | |
105 | As a special case, if PREDICATE-OR-MODES is a list, it will be | ||
106 | interpreted as a list of major modes. In this case, FUNC will | ||
107 | only be called on buffers derived from one of the modes in | ||
108 | PREDICATE-OR-MODES." | ||
109 | (let ((pred (or predicate-or-modes t))) | ||
110 | (dolist (buf (buffer-list)) | ||
111 | (with-current-buffer buf | ||
112 | (when (cond ((functionp pred) | ||
113 | (funcall pred)) | ||
114 | ((listp pred) | ||
115 | (apply #'derived-mode-p pred)) | ||
116 | (t pred)) | ||
117 | (funcall func)))))) | ||
118 | |||
119 | ;; https://github.com/cstby/emacs.d/blob/main/init.el#L67 | ||
120 | (defun +clean-empty-lines (&optional begin end) | ||
121 | "Remove duplicate empty lines from BEGIN to END. | ||
122 | Called interactively, this function acts on the region, if | ||
123 | active, or else the entire buffer." | ||
124 | (interactive "*r") | ||
125 | (unless (region-active-p) | ||
126 | (setq begin (point-min) | ||
127 | end (save-excursion | ||
128 | (goto-char (point-max)) | ||
129 | (skip-chars-backward "\n[:space:]") | ||
130 | (point)))) | ||
131 | (save-excursion | ||
132 | (save-restriction | ||
133 | (narrow-to-region begin end) | ||
134 | (goto-char (point-min)) | ||
135 | (while (re-search-forward "\n\n\n+" nil :move) | ||
136 | (replace-match "\n\n")) | ||
137 | ;; Insert a newline at the end. | ||
138 | (goto-char (point-max)) | ||
139 | (unless (or (buffer-narrowed-p) | ||
140 | (= (line-beginning-position) (line-end-position))) | ||
141 | (insert "\n"))))) | ||
142 | |||
143 | (defcustom +open-paragraph-ignore-modes '(special-mode lui-mode comint-mode) | ||
144 | "Modes in which `+open-paragraph' makes no sense." | ||
145 | :type '(repeat function)) | ||
146 | |||
147 | (defun +open-paragraph (&optional arg) | ||
148 | "Open a paragraph after paragraph at point. | ||
149 | A paragraph is defined as continguous non-empty lines of text | ||
150 | surrounded by empty lines, so opening a paragraph means to make | ||
151 | three blank lines, then place the point on the second one. | ||
152 | |||
153 | Called with prefix ARG, open a paragraph before point." | ||
154 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
155 | (interactive "*P") | ||
156 | ;; TODO: add `+open-paragraph-ignore-modes' | ||
157 | (unless (apply #'derived-mode-p +open-paragraph-ignore-modes) | ||
158 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
159 | ;; that's weird with org, and I'm guessing other modes too. | ||
160 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
161 | (while (and (not (looking-at "^$")) | ||
162 | (= 0 (forward-line (if arg -1 +1))))) | ||
163 | (newline) | ||
164 | (when arg (newline) (forward-line -2)) | ||
165 | (delete-blank-lines) | ||
166 | (newline 2) | ||
167 | (previous-line))) | ||
168 | |||
169 | (defun +split-window-then (&optional where arg) | ||
170 | "Split the window into a new buffer. | ||
171 | With non-nil ARG (\\[universal-argument] interactively), don't | ||
172 | prompt for a buffer to switch to. This function will split the | ||
173 | window using `split-window-sensibly', or open the new window in | ||
174 | the direction specified by WHERE. WHERE is ignored when called | ||
175 | interactively; if you want specific splitting, use | ||
176 | `+split-window-right-then' or `+split-window-below-then'." | ||
177 | (interactive "i\nP") | ||
178 | ;; TODO: Canceling at the switching phase leaves the point in the other | ||
179 | ;; window. Ideally, the user would see this as one action, meaning a cancel | ||
180 | ;; would return to the original window. | ||
181 | (pcase where | ||
182 | ;; These directions are 'backward' to the OG Emacs split-window commands, | ||
183 | ;; because by default Emacs leaves the cursor in the original window. Most | ||
184 | ;; users probably expect a switch to the new window, at least I do. | ||
185 | ((or 'right :right) (split-window-right) (other-window 1)) | ||
186 | ((or 'left :left) (split-window-right)) | ||
187 | ((or 'below :below) (split-window-below) (other-window 1)) | ||
188 | ((or 'above :above) (split-window-below)) | ||
189 | ((pred null) | ||
190 | (or (split-window-sensibly) | ||
191 | (if (< (window-height) (window-width)) | ||
192 | (split-window-below) | ||
193 | (split-window-right))) | ||
194 | (other-window 1)) | ||
195 | (_ (user-error "Unknown WHERE paramater: %s" where))) | ||
196 | (unless arg | ||
197 | (condition-case nil | ||
198 | (call-interactively | ||
199 | (pcase (read-char "(B)uffer or (F)ile?") | ||
200 | (?b (if (fboundp #'consult-buffer) | ||
201 | #'consult-buffer | ||
202 | #'switch-to-buffer)) | ||
203 | (?f #'find-file) | ||
204 | (_ #'ignore))) | ||
205 | (quit (delete-window))))) | ||
206 | |||
207 | (defun +split-window-right-then (&optional arg) | ||
208 | "Split window right, then prompt for a new buffer. | ||
209 | With optional ARG (\\[universal-argument]), just split." | ||
210 | (interactive "P") | ||
211 | (+split-window-then :right arg)) | ||
212 | |||
213 | (defun +split-window-below-then (&optional arg) | ||
214 | "Split window below, then prompt for a new buffer. | ||
215 | With optional ARG (\\[universal-argument]), just split." | ||
216 | (interactive "P") | ||
217 | (+split-window-then :below arg)) | ||
218 | |||
219 | (defun +bytes (number unit) | ||
220 | "Convert NUMBER UNITs to bytes. | ||
221 | UNIT can be one of :kb, :mb, :gb, :tb, :pb, :eb, :zb, :yb; :kib, :mib, :gib, | ||
222 | :tib, :pib, :eib, :zib, :yib." | ||
223 | (* number (pcase unit | ||
224 | ;; Base 10 units | ||
225 | (:kb 1000) | ||
226 | (:mb (* 1000 1000)) | ||
227 | (:gb (* 1000 1000 1000)) | ||
228 | (:tb (* 1000 1000 1000 1000)) | ||
229 | (:pb (* 1000 1000 1000 1000 1000)) | ||
230 | (:eb (* 1000 1000 1000 1000 1000 1000)) | ||
231 | (:zb (* 1000 1000 1000 1000 1000 1000 1000)) | ||
232 | (:yb (* 1000 1000 1000 1000 1000 1000 1000 1000)) | ||
233 | ;; Base 2 units | ||
234 | (:kib 1024) | ||
235 | (:mib (* 1024 1024)) | ||
236 | (:gib (* 1024 1024 1024)) | ||
237 | (:tib (* 1024 1024 1024 1024)) | ||
238 | (:pib (* 1024 1024 1024 1024 1024)) | ||
239 | (:eib (* 1024 1024 1024 1024 1024 1024)) | ||
240 | (:zib (* 1024 1024 1024 1024 1024 1024 1024)) | ||
241 | (:yib (* 1024 1024 1024 1024 1024 1024 1024 1024))))) | ||
242 | |||
243 | ;;; Font lock TODO keywords | ||
244 | |||
245 | (defcustom font-lock-todo-keywords '("TODO" "XXX" "FIXME" "BUG") | ||
246 | "Keywords to highlight with `font-lock-todo-face'.") | ||
247 | |||
248 | (defface font-lock-todo-face '((t :inherit font-lock-comment-face | ||
249 | :background "yellow")) | ||
250 | ;; TODO: XXX: FIXME: BUG: testing :) | ||
251 | "Face for TODO keywords.") | ||
252 | |||
253 | (defun font-lock-todo-insinuate () | ||
254 | (let ((keyword-regexp | ||
255 | (rx bow (group (eval (let ((lst '(or))) | ||
256 | (dolist (kw font-lock-todo-keywords) | ||
257 | (push kw lst)) | ||
258 | (nreverse lst)))) | ||
259 | ":"))) | ||
260 | (font-lock-add-keywords | ||
261 | nil | ||
262 | `((,keyword-regexp 1 'font-lock-todo-face prepend))))) | ||
263 | |||
264 | ;; I don't use this much but I always forget the exact implementation, so this | ||
265 | ;; is more to remember than anything else. | ||
266 | (defmacro setc (&rest vars-and-vals) | ||
267 | "Set VARS-AND-VALS by customizing them or using set-default. | ||
268 | Use like `setq'." | ||
269 | `(progn ,@(cl-loop for (var val) on vars-and-vals by #'cddr | ||
270 | if (null val) return (user-error "Not enough arguments") | ||
271 | collecting `(funcall (or (get ',var 'custom-get) | ||
272 | #'set-default) | ||
273 | ',var ',val) | ||
274 | into ret | ||
275 | finally return ret))) | ||
276 | |||
277 | (defun +set-faces (specs) | ||
278 | "Set fonts to SPECS. | ||
279 | Specs is an alist: its cars are faces and its cdrs are the plist | ||
280 | passed to `set-face-attribute'. Note that the FRAME argument is | ||
281 | always nil; this function is mostly intended for use in init." | ||
282 | (dolist (spec specs) | ||
283 | (apply #'set-face-attribute (car spec) nil (cdr spec)))) | ||
284 | |||
285 | (defcustom chat-functions '(+irc | ||
286 | jabber-connect-all | ||
287 | ;; slack-start | ||
288 | ) | ||
289 | "Functions to start when calling `chat'." | ||
290 | :type '(repeat function) | ||
291 | :group 'applications) | ||
292 | |||
293 | (defun +string-repeat (n str) | ||
294 | "Repeat STR N times." | ||
295 | (let ((r "")) | ||
296 | (dotimes (_ n) | ||
297 | (setq r (concat r str))) | ||
298 | r)) | ||
299 | |||
300 | ;; (defun chat-disconnect () | ||
301 | ;; "Disconnect from all chats." | ||
302 | ;; (interactive) | ||
303 | ;; (+with-progress "Quitting circe..." | ||
304 | ;; (ignore-errors | ||
305 | ;; (circe-command-GQUIT "peace love bread") | ||
306 | ;; (cancel-timer (irc-connection-get conn :flood-timer)))) | ||
307 | ;; (+with-progress "Quitting jabber..." | ||
308 | ;; (ignore-errors | ||
309 | ;; (jabber-disconnect))) | ||
310 | ;; (when (boundp '+slack-teams) | ||
311 | ;; (+with-progress "Quitting-slack..." | ||
312 | ;; (dolist (team +slack-teams) | ||
313 | ;; (ignore-errors | ||
314 | ;; (slack-team-disconnect team))) | ||
315 | ;; (ignore-errors (slack-ws-close)))) | ||
316 | ;; (+with-progress "Killing buffers..." | ||
317 | ;; (ignore-errors | ||
318 | ;; (+mapc-some-buffers (lambda () "Remove the buffer from tracking and kill it unconditionally." | ||
319 | ;; (let ((kill-buffer-query-functions nil)) | ||
320 | ;; (tracking-remove-buffer (current-buffer)) | ||
321 | ;; (kill-buffer))) | ||
322 | ;; (lambda () "Return t if derived from the following modes." | ||
323 | ;; (derived-mode-p 'lui-mode | ||
324 | ;; 'jabber-chat-mode | ||
325 | ;; 'jabber-roster-mode | ||
326 | ;; 'jabber-browse-mode | ||
327 | ;; 'slack-mode)))))) | ||
328 | |||
329 | ;; I can never remember all the damn chat things I run, so this just does all of em. | ||
330 | ;; (defun chat (&optional arg) | ||
331 | ;; "Initiate all chat functions. | ||
332 | ;; With optional ARG, kill all chat-related buffers first." | ||
333 | ;; (interactive "P") | ||
334 | ;; (when arg (chat-disconnect)) | ||
335 | ;; (dolist-with-progress-reporter (fn chat-functions) | ||
336 | ;; "Connecting to chat..." | ||
337 | ;; (call-interactively fn))) | ||
338 | |||
339 | (defun +forward-paragraph (arg) | ||
340 | "Move forward ARG (simple) paragraphs. | ||
341 | A paragraph here is simply defined: it's a block of buffer that's | ||
342 | separated from others by two newlines." | ||
343 | (interactive "p") | ||
344 | (let ((direction (/ arg (abs arg)))) | ||
345 | (forward-line direction) | ||
346 | (while (not (or (bobp) | ||
347 | (eobp) | ||
348 | (= arg 0))) | ||
349 | (if (looking-at "^[ \f\t]*$") | ||
350 | (setq arg (- arg direction)) | ||
351 | (forward-line direction))))) | ||
352 | |||
353 | (defun +backward-paragraph (arg) | ||
354 | "Move backward ARG (simple) paragraphs. | ||
355 | See `+forward-paragraph' for the behavior." | ||
356 | (interactive "p") | ||
357 | (+forward-paragraph (- arg))) | ||
358 | |||
359 | (defun +concat (&rest strings) | ||
360 | "Concat STRINGS separated by SEPARATOR. | ||
361 | Each item in STRINGS is either a string or a list or strings, | ||
362 | which is concatenated without any separator. | ||
363 | |||
364 | SEPARATOR defaults to the newline (\\n)." | ||
365 | (let (ret | ||
366 | ;; I don't know why a `cl-defun' with | ||
367 | ;; (&rest strings &key (separator "\n")) doesn't work | ||
368 | (separator (or (cl-loop for i from 0 upto (length strings) | ||
369 | if (eq (nth i strings) :separator) | ||
370 | return (nth (1+ i) strings)) | ||
371 | "\n"))) | ||
372 | (while strings | ||
373 | (let ((string (pop strings))) | ||
374 | (cond ((eq string :separator) (pop strings)) | ||
375 | ((listp string) (push (apply #'concat string) ret)) | ||
376 | ((stringp string) (push string ret))))) | ||
377 | (mapconcat #'identity (nreverse ret) separator))) | ||
378 | |||
379 | (defun +file-string (file) | ||
380 | "Fetch the contents of FILE and return its string." | ||
381 | (with-current-buffer (find-file-noselect file) | ||
382 | (buffer-string))) | ||
383 | |||
384 | (defmacro +with-progress (pr-args &rest body) | ||
385 | "Perform BODY wrapped in a progress reporter. | ||
386 | PR-ARGS is the list of arguments to pass to | ||
387 | `make-progress-reporter'; it can be a single string for the | ||
388 | message, as well. If you want to use a formatted string, wrap | ||
389 | the `format' call in a list." | ||
390 | (declare (indent 1)) | 77 | (declare (indent 1)) |
391 | (let ((reporter (gensym)) | 78 | (let ((fn (intern (format "%s-setq-local" hook)))) |
392 | (pr-args (if (listp pr-args) pr-args (list pr-args)))) | 79 | (when (and (fboundp fn) |
393 | `(let ((,reporter (make-progress-reporter ,@pr-args))) | 80 | (functionp fn)) |
394 | (prog1 (progn ,@body) | 81 | (setq args (append (function-get fn 'setq-local-hook-settings) args))) |
395 | (progress-reporter-done ,reporter))))) | 82 | (unless (and (< 0 (length args)) |
396 | 83 | (zerop (mod (length args) 2))) | |
397 | (defmacro +with-eval-after-loads (features &rest body) | 84 | (user-error "Wrong number of arguments: %S" (length args))) |
398 | "Execute BODY after all FEATURES are loaded." | 85 | `(progn |
399 | (declare (indent 1) (debug (form def-body))) | 86 | (defun ,fn () |
400 | (unless (listp features) | 87 | ,(format "Set local variables after `%s'." hook) |
401 | (setq features (list features))) | 88 | (setq-local ,@args)) |
402 | (if (null features) | 89 | (function-put ',fn 'setq-local-hook-settings ',args) |
403 | (macroexp-progn body) | 90 | (add-hook ',hook #',fn)))) |
404 | (let* ((this (car features)) | 91 | |
405 | (rest (cdr features))) | 92 | (unless (fboundp 'ensure-list) |
406 | `(with-eval-after-load ',this | 93 | ;; Just in case we're using an old version of Emacs. |
407 | (+with-eval-after-loads ,rest ,@body))))) | 94 | (defun ensure-list (object) |
408 | 95 | "Return OBJECT as a list. | |
409 | (defun +scratch-buffer (&optional nomode) | 96 | If OBJECT is already a list, return OBJECT itself. If it's |
410 | "Create a new scratch buffer and switch to it. | 97 | not a list, return a one-element list containing OBJECT." |
411 | If the region is active, paste its contents into the scratch | 98 | (if (listp object) |
412 | buffer. The scratch buffer inherits the mode of the current | 99 | object |
413 | buffer unless NOMODE is non-nil. When called interactively, | 100 | (list object)))) |
414 | NOMODE will be set when called with \\[universal-argument]." | 101 | |
415 | (interactive "P") | 102 | (defun add-to-list* (lists &rest things) |
416 | (let* ((mode major-mode) | 103 | "Add THINGS to LISTS. |
417 | (bufname (generate-new-buffer-name (format "*scratch (%s)*" mode))) | 104 | LISTS can be one list variable or a list. |
418 | (paste (and (region-active-p) | 105 | Each thing of THINGS can be either a variablel (the thing), or a list of the form |
419 | (prog1 | 106 | (ELEMENT &optional APPEND COMPARE-FN), which is passed to |
420 | (buffer-substring (mark t) (point)) | 107 | `add-to-list'." |
421 | (deactivate-mark))))) | 108 | (dolist (l (ensure-list lists)) |
422 | (when (and (not nomode) | 109 | (dolist (thing things) |
423 | (bound-and-true-p ess-dialect)) ; Not sure what `ess-dialect' is | 110 | (apply #'add-to-list l (ensure-list thing))))) |
424 | (setq mode (intern-soft (concat ess-dialect "-mode")))) | 111 | |
425 | ;; Set up buffer | 112 | (defun add-hook* (hooks &rest functions) |
426 | (switch-to-buffer (get-buffer-create bufname)) | 113 | "Add FUNCTIONS to HOOKS. |
427 | (when (and (not nomode) mode) | 114 | Each function in FUNCTIONS can be a singleton or a list of the |
428 | (ignore-errors (funcall mode))) | 115 | form (FUNCTION &optional DEPTH LOCAL)." |
429 | (insert (format "%s Scratch buffer for %s%s\n\n" | 116 | (dolist (hook (ensure-list hooks)) |
430 | comment-start mode comment-end)) | 117 | (dolist (fn functions) |
431 | (when paste (insert paste)) | 118 | (apply #'add-hook hook (ensure-list fn))))) |
432 | (get-buffer bufname))) | ||
433 | |||
434 | (defun +indent-rigidly (arg &optional interactive) | ||
435 | "Indent all lines in the region, or the current line. | ||
436 | This calls `indent-rigidly' and passes ARG to it." | ||
437 | (interactive "P\np") | ||
438 | (unless (region-active-p) | ||
439 | (push-mark) | ||
440 | (push-mark (line-beginning-position) nil t) | ||
441 | (goto-char (line-end-position))) | ||
442 | (call-interactively #'indent-rigidly)) | ||
443 | |||
444 | (defun +sort-lines (reverse beg end) | ||
445 | "Sort lines in region, ignoring leading whitespace. | ||
446 | REVERSE non-nil means descending order; interactively, REVERSE is | ||
447 | the prefix argument, and BEG and END are the region. The | ||
448 | variable `sort-fold-case' determines whether case affects the | ||
449 | sort order." | ||
450 | (interactive "P\nr") | ||
451 | (save-excursion | ||
452 | (save-restriction | ||
453 | (narrow-to-region beg end) | ||
454 | (goto-char (point-min)) | ||
455 | (let ((inhibit-field-text-motion t)) | ||
456 | (sort-subr reverse | ||
457 | #'forward-line | ||
458 | #'end-of-line | ||
459 | #'beginning-of-line-text))))) | ||
460 | |||
461 | (defun +crm-indicator (args) | ||
462 | "AROUND advice for `completing-read-multiple'." | ||
463 | ;; [[https://github.com/minad/vertico/blob/8ab2cddf3a1fb8799611b1d35118bf579aaf3154/README.org][from vertico's README]] | ||
464 | (cons (format "[CRM%s] %s" | ||
465 | (replace-regexp-in-string | ||
466 | "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" | ||
467 | crm-separator) | ||
468 | (car args)) | ||
469 | (cdr args))) | ||
470 | |||
471 | |||
472 | ;;; Timers! | ||
473 | ;; inspired by [[https://git.sr.ht/~protesilaos/tmr/tree/main/item/tmr.el][prot's tmr.el package]] | ||
474 | |||
475 | (defvar +timer-string nil) | ||
476 | (defvar +timer-timer nil) | ||
477 | |||
478 | (defcustom +timer-running-string "⏰" | ||
479 | "What to display when the timer is running." | ||
480 | :type 'string) | ||
481 | (defcustom +timer-done-string "❗" | ||
482 | "What to display when the timer is done." | ||
483 | :type 'string) | ||
484 | |||
485 | (defun +timer (time) | ||
486 | "Set a timer for TIME." | ||
487 | (interactive (list (read-string "Set a timer for how long? "))) | ||
488 | (let ((secs (cond ((natnump time) (* time 60)) | ||
489 | ((and (stringp time) | ||
490 | (string-match-p "[0-9]\\'" time)) | ||
491 | (* (string-to-number time) 60)) | ||
492 | (t (let ((secs 0) | ||
493 | (time time)) | ||
494 | (save-match-data | ||
495 | (while (string-match "\\([0-9.]+\\)\\([hms]\\)" time) | ||
496 | (cl-incf secs | ||
497 | (* (string-to-number (match-string 1 time)) | ||
498 | (pcase (match-string 2 time) | ||
499 | ("h" 3600) | ||
500 | ("m" 60) | ||
501 | ("s" 1)))) | ||
502 | (setq time (substring time (match-end 0))))) | ||
503 | secs))))) | ||
504 | (message "Setting timer for \"%s\" (%S seconds)..." time secs) | ||
505 | (setq +timer-string +timer-running-string) | ||
506 | (setq +timer-timer (run-with-timer secs nil | ||
507 | (lambda () | ||
508 | (message "%S-second timer DONE!" secs) | ||
509 | (setq +timer-string +timer-done-string) | ||
510 | (let ((visible-bell t) | ||
511 | (ring-bell-function nil)) | ||
512 | (ding)) | ||
513 | (ding)))))) | ||
514 | |||
515 | (defun +timer-cancel () | ||
516 | "Cancel the running timer." | ||
517 | (interactive) | ||
518 | (cond ((not +timer-timer) | ||
519 | (message "No timer found!")) | ||
520 | (t | ||
521 | (cancel-timer +timer-timer) | ||
522 | (message "Timer canceled."))) | ||
523 | (setq +timer-string nil)) | ||
524 | |||
525 | |||
526 | |||
527 | (defun +switch-to-last-buffer () | ||
528 | "Switch to the last-used buffer in this window." | ||
529 | (interactive) | ||
530 | (switch-to-buffer nil)) | ||
531 | |||
532 | (provide 'acdw) | ||
533 | ;;; acdw.el ends here | ||
diff --git a/lisp/dawn.el b/lisp/dawn.el deleted file mode 100644 index a184a84..0000000 --- a/lisp/dawn.el +++ /dev/null | |||
@@ -1,74 +0,0 @@ | |||
1 | ;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; There is also circadian.el, but it doesn't quite work for me. | ||
6 | ;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also | ||
7 | ;; somewhere else (which I've forgotten) and my own brain :) | ||
8 | |||
9 | ;;; Code: | ||
10 | |||
11 | (require 'calendar) | ||
12 | (require 'cl-lib) | ||
13 | (require 'solar) | ||
14 | |||
15 | (defvar dawn--dawn-timer nil | ||
16 | "Timer for dawn-command.") | ||
17 | |||
18 | (defvar dawn--dusk-timer nil | ||
19 | "Timer for dusk-command.") | ||
20 | |||
21 | (defvar dawn--reset-timer nil | ||
22 | "Timer to reset dawn at midnight.") | ||
23 | |||
24 | (defun dawn-encode-time (f) | ||
25 | "Encode fractional time F." | ||
26 | (let ((hhmm (cl-floor f)) | ||
27 | (date (cdddr (decode-time)))) | ||
28 | (encode-time | ||
29 | (append (list 0 | ||
30 | (round (* 60 (cadr hhmm))) | ||
31 | (car hhmm) | ||
32 | ) | ||
33 | date)))) | ||
34 | |||
35 | (defun dawn-midnight () | ||
36 | "Return the time of the /next/ midnight." | ||
37 | (let ((date (cdddr (decode-time)))) | ||
38 | (encode-time | ||
39 | (append (list 0 0 0 (1+ (car date))) (cdr date))))) | ||
40 | |||
41 | (defun dawn-sunrise () | ||
42 | "Return the time of today's sunrise." | ||
43 | (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date))))) | ||
44 | |||
45 | (defun dawn-sunset () | ||
46 | "Return the time of today's sunset." | ||
47 | (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) | ||
48 | |||
49 | (defun dawn-schedule (dawn-command dusk-command) | ||
50 | "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. | ||
51 | RESET is an argument for internal use." | ||
52 | (let ((dawn (dawn-sunrise)) | ||
53 | (dusk (dawn-sunset))) | ||
54 | (cond | ||
55 | ((time-less-p nil dawn) | ||
56 | ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule | ||
57 | ;; DAWN-COMMAND and DUSK-COMMAND for later. | ||
58 | (funcall dusk-command) | ||
59 | (run-at-time dawn nil dawn-command) | ||
60 | (run-at-time dusk nil dusk-command)) | ||
61 | ((time-less-p nil dusk) | ||
62 | ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule | ||
63 | ;; DUSK-COMMAND. | ||
64 | (funcall dawn-command) | ||
65 | (run-at-time dusk nil dusk-command)) | ||
66 | (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. | ||
67 | (funcall dusk-command))) | ||
68 | ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. | ||
69 | ;(unless reset) | ||
70 | (run-at-time (dawn-midnight) nil | ||
71 | #'dawn-schedule dawn-command dusk-command))) | ||
72 | |||
73 | (provide 'dawn) | ||
74 | ;;; dawn.el ends here | ||
diff --git a/lisp/elephant.el b/lisp/elephant.el deleted file mode 100644 index 3cae17a..0000000 --- a/lisp/elephant.el +++ /dev/null | |||
@@ -1,58 +0,0 @@ | |||
1 | ;;; elephant.el --- Remember variables and modes -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (defmacro elephant-remember (alist) | ||
6 | "Setup a closure remembering symbols to apply with | ||
7 | `remember-reset'. The variables will be renamed using TEMPLATE. | ||
8 | ALIST contains cells of the form (SYMBOL . NEW-VALUE), where | ||
9 | SYMBOL is a variable or mode name, and its value is what to set | ||
10 | after `remember-set'." | ||
11 | (unless lexical-binding | ||
12 | (user-error "`elephant' requires lexical binding.")) | ||
13 | |||
14 | (let* ((template (format "elephant--%s-%%s" (gensym))) | ||
15 | (reset-fn (intern (format template "reset")))) | ||
16 | (cl-destructuring-bind (let-list fn-set-list fn-reset-list) | ||
17 | (cl-loop | ||
18 | for (sym . val) in (if (symbolp alist) (symbol-value alist) alist) | ||
19 | as rem = (intern (format template sym)) | ||
20 | |||
21 | collect (list rem sym) | ||
22 | into let-list | ||
23 | |||
24 | collect (cond ((eq val 'enable) | ||
25 | `(,sym +1)) | ||
26 | ((eq val 'disable) | ||
27 | `(,sym -1)) | ||
28 | (t `(setq-local ,sym ,val))) | ||
29 | into fn-set-list | ||
30 | |||
31 | collect (cond ((memq val '(enable disable)) | ||
32 | `(progn (,sym (if ,rem +1 -1)) | ||
33 | (fmakunbound ',rem))) | ||
34 | (t `(progn (setq-local ,sym ,rem) | ||
35 | (makunbound ',rem)))) | ||
36 | into fn-reset-list | ||
37 | |||
38 | finally return (list let-list | ||
39 | fn-set-list | ||
40 | fn-reset-list)) | ||
41 | `(progn | ||
42 | (defvar-local ,reset-fn nil | ||
43 | "Function to recall values from `elephant-remember'.") | ||
44 | (let ,let-list | ||
45 | (setf (symbol-function ',reset-fn) | ||
46 | (lambda () | ||
47 | ,@fn-reset-list | ||
48 | (redraw-display) | ||
49 | (fmakunbound ',reset-fn)))) | ||
50 | ,@fn-set-list | ||
51 | ',reset-fn)))) | ||
52 | |||
53 | (defun elephant-forget () | ||
54 | "Forget all symbols generated by `elephant-remember'." | ||
55 | ) | ||
56 | |||
57 | (provide 'elephant) | ||
58 | ;;; elephant.el ends here | ||
diff --git a/lisp/find-script.el b/lisp/find-script.el deleted file mode 100644 index 9e3633a..0000000 --- a/lisp/find-script.el +++ /dev/null | |||
@@ -1,36 +0,0 @@ | |||
1 | ;;; find-script.el --- Find a script in $PATH -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; This package makes it easier to find a script to edit in $PATH. The initial | ||
6 | ;; `rehash-exes' is slow, but it's stored in `*exes*' as a caching mechanism. | ||
7 | ;; However, I'm sure it could be improved. | ||
8 | |||
9 | ;; In addition, `*exes*' currently contains /all/ executables in $PATH, which | ||
10 | ;; ... maybe only the ones stored in some text format should be shown. | ||
11 | |||
12 | ;;; Code: | ||
13 | |||
14 | (defvar *exes* nil | ||
15 | "All the exectuables in $PATH. | ||
16 | Run `rehash-exes' to refresh this variable.") | ||
17 | |||
18 | (defun rehash-exes () | ||
19 | "List all the executables in $PATH. | ||
20 | Also sets `*exes*' parameter." | ||
21 | (setq *exes* | ||
22 | (cl-loop for dir in exec-path | ||
23 | append (file-expand-wildcards (concat dir "*")) | ||
24 | into exes | ||
25 | finally return exes))) | ||
26 | |||
27 | ;;;###autoload | ||
28 | (defun find-script (script) | ||
29 | "Find a file in $PATH." | ||
30 | (interactive | ||
31 | (list (let ((exes (or *exes* (rehash-exes)))) | ||
32 | (completing-read "Script> " exes nil t)))) | ||
33 | (find-file script)) | ||
34 | |||
35 | (provide 'find-script) | ||
36 | ;;; find-script.el ends here | ||
diff --git a/lisp/gdrive.el b/lisp/gdrive.el deleted file mode 100644 index 41a3660..0000000 --- a/lisp/gdrive.el +++ /dev/null | |||
@@ -1,130 +0,0 @@ | |||
1 | ;;; gdrive.el --- Gdrive integration -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;; Author: Case Duckworth <case@bob> | ||
6 | ;; Keywords: convenience, data, docs | ||
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 | ;; [[https://github.com/prasmussen/gdrive][gdrive]] is a Go program to interface with Google Drive. This library connects | ||
24 | ;; that to Emacs. | ||
25 | |||
26 | ;;; Code: | ||
27 | |||
28 | (require 'cl-lib) | ||
29 | |||
30 | (defgroup gdrive nil | ||
31 | "Customizations for Emacs's gdrive module." | ||
32 | :group 'applications | ||
33 | :prefix "gdrive-") | ||
34 | |||
35 | (defcustom gdrive-bin (executable-find "gdrive") | ||
36 | "Where gdrive binary is located." | ||
37 | :type 'string) | ||
38 | |||
39 | (defcustom gdrive-buffer "*gdrive*" | ||
40 | "Default buffer for gdrive output." | ||
41 | :type 'string) | ||
42 | |||
43 | ;;; Global flags | ||
44 | |||
45 | ;;;; -c, --config <configDir> | ||
46 | ;;;;; Application path, default: /Users/<user>/.gdrive | ||
47 | (defcustom gdrive-config-dir nil | ||
48 | "Application path.") | ||
49 | |||
50 | ;;;; --refresh-token <refreshToken> | ||
51 | ;;;;; Oauth refresh token used to get access token (for advanced users) | ||
52 | (defcustom gdrive-refresh-token nil | ||
53 | "Oauth refresh token used to get access token. | ||
54 | (For advanced users).") | ||
55 | |||
56 | ;;;; --access-token <accessToken> | ||
57 | ;;;;; Oauth access token, only recommended for short-lived requests because of | ||
58 | ;;;;; short lifetime (for advanced users) | ||
59 | (defcustom gdrive-access-token nil | ||
60 | "Oauth access token. | ||
61 | Only recommended for short-lived requests because of short | ||
62 | lifetime (for advanced users).") | ||
63 | |||
64 | ;;;; --service-account <accountFile> | ||
65 | ;;;;; Oauth service account filename, used for server to server communication | ||
66 | ;;;;; without user interaction (file is relative to config dir) | ||
67 | (defcustom gdrive-service-account nil | ||
68 | "Oauth service account filename. | ||
69 | Used for server to server communication without user | ||
70 | interaction (file is relative to config dir).") | ||
71 | |||
72 | (defun gdrive--global-arguments () | ||
73 | "Build global arguments for gdrive." | ||
74 | (append | ||
75 | (when gdrive-config-dir (list "--config" gdrive-config-dir)) | ||
76 | (when gdrive-refresh-token (list "--refresh-token" gdrive-refresh-token)) | ||
77 | (when gdrive-access-token (list "--access-token" gdrive-access-token)) | ||
78 | (when gdrive-service-account (list "--service-account" gdrive-service-account)))) | ||
79 | |||
80 | ;;; List files | ||
81 | ;; gdrive [global] list [options] | ||
82 | ;;;; -m, --max <maxFiles> | ||
83 | ;;;; Max files to list, default: 30 | ||
84 | ;;;; -q, --query <query> | ||
85 | ;;;;; Default query: "trashed = false and 'me' in owners". See https://developers.google.com/drive/search-parameters | ||
86 | ;;;; --order <sortOrder> | ||
87 | ;;;;; Sort order. See https://godoc.org/google.golang.org/api/drive/v3#FilesListCall.OrderBy | ||
88 | ;;;; --name-width <nameWidth> | ||
89 | ;;;;; Width of name column, default: 40, minimum: 9, use 0 for full width | ||
90 | ;; NOTE: gdrive-list will pass 0 for this argument. | ||
91 | ;;;; --absolute Show absolute path to file (will only show path from first parent) | ||
92 | ;;;; --no-header Dont print the header | ||
93 | ;; NOTE: gdrive-list will always pass this argument. | ||
94 | ;;;; --bytes Size in bytes | ||
95 | (cl-defun gdrive-list (&key max query order absolute no-header bytes) | ||
96 | "Run the \"gdrive list\" command. | ||
97 | MAX is the max files to list; it defaults to 30. QUERY is the | ||
98 | query to pass; the default is \"trashed = false and 'me' in | ||
99 | owners\"." | ||
100 | (gdrive--run (append (gdrive--global-arguments) | ||
101 | (list "list") | ||
102 | (when max (list "--max" max)) | ||
103 | (when query (list "--query" query)) | ||
104 | (when order (list "--order" order)) | ||
105 | (list "--name-width" "0") | ||
106 | (when absolute (list "--absolute")) | ||
107 | (when no-header (list "--no-header")) | ||
108 | (when bytes (list "--bytes"))))) | ||
109 | |||
110 | |||
111 | (defmacro gdrive-query) | ||
112 | |||
113 | |||
114 | (defun gdrive--build-command-name (command) | ||
115 | "INTERNAL: Build a string name for COMMAND." | ||
116 | (concat "gdrive-" (car command))) | ||
117 | |||
118 | (defun gdrive--run (command &optional buffer) | ||
119 | "Run 'gdrive COMMAND', collecting results in BUFFER. | ||
120 | COMMAND, if not a list, will be made a list and appended to | ||
121 | `gdrive-bin'. | ||
122 | BUFFER defaults to `gdrive-buffer'." | ||
123 | (let ((command (if (listp command) command (list command))) | ||
124 | (buffer (or buffer gdrive-buffer))) | ||
125 | (make-process :name (gdrive--build-command-name command) | ||
126 | :buffer buffer | ||
127 | :command (cons gdrive-bin command)))) | ||
128 | |||
129 | (provide 'gdrive) | ||
130 | ;;; gdrive.el ends here | ||
diff --git a/lisp/hide-cursor-mode.el b/lisp/hide-cursor-mode.el deleted file mode 100644 index 6325d81..0000000 --- a/lisp/hide-cursor-mode.el +++ /dev/null | |||
@@ -1,116 +0,0 @@ | |||
1 | ;;; hide-cursor-mode.el --- Hide the cursor and scroll-lock -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; From Karthik: https://karthinks.com/software/more-less-emacs/ | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (defvar-local hide-cursor--original nil) | ||
10 | |||
11 | (progn | ||
12 | (progn :autoload-end | ||
13 | (defvar-local hide-cursor-mode nil "Non-nil if Hide-Cursor mode is enabled. | ||
14 | Use the command `hide-cursor-mode' to change this variable.")) | ||
15 | (defun hide-cursor-mode | ||
16 | (&optional arg) | ||
17 | "Hide or show the cursor. | ||
18 | |||
19 | This is a minor mode. If called interactively, toggle the | ||
20 | `Hide-Cursor mode' mode. If the prefix argument is positive, | ||
21 | enable the mode, and if it is zero or negative, disable the mode. | ||
22 | |||
23 | If called from Lisp, toggle the mode if ARG is `toggle'. Enable | ||
24 | the mode if ARG is nil, omitted, or is a positive number. | ||
25 | Disable the mode if ARG is a negative number. | ||
26 | |||
27 | To check whether the minor mode is enabled in the current buffer, | ||
28 | evaluate `hide-cursor-mode'. | ||
29 | |||
30 | The mode's hook is called both when the mode is enabled and when | ||
31 | it is disabled. | ||
32 | |||
33 | When the cursor is hidden `scroll-lock-mode' is enabled, so that | ||
34 | the buffer works like a pager." | ||
35 | (interactive | ||
36 | (list | ||
37 | (if current-prefix-arg | ||
38 | (prefix-numeric-value current-prefix-arg) | ||
39 | 'toggle))) | ||
40 | (let | ||
41 | ((last-message | ||
42 | (current-message))) | ||
43 | (setq hide-cursor-mode | ||
44 | (cond | ||
45 | ((eq arg 'toggle) | ||
46 | (not hide-cursor-mode)) | ||
47 | ((and | ||
48 | (numberp arg) | ||
49 | (< arg 1)) | ||
50 | nil) | ||
51 | (t t))) | ||
52 | (when | ||
53 | (boundp 'local-minor-modes) | ||
54 | (setq local-minor-modes | ||
55 | (delq 'hide-cursor-mode local-minor-modes)) | ||
56 | (when hide-cursor-mode | ||
57 | (push 'hide-cursor-mode local-minor-modes))) | ||
58 | (if hide-cursor-mode | ||
59 | (progn | ||
60 | (scroll-lock-mode 1) | ||
61 | (setq-local hide-cursor--original cursor-type) | ||
62 | (setq-local cursor-type nil)) | ||
63 | (scroll-lock-mode -1) | ||
64 | (setq-local cursor-type | ||
65 | (or hide-cursor--original t))) | ||
66 | (run-hooks 'hide-cursor-mode-hook | ||
67 | (if hide-cursor-mode 'hide-cursor-mode-on-hook 'hide-cursor-mode-off-hook)) | ||
68 | (if | ||
69 | (called-interactively-p 'any) | ||
70 | (progn nil | ||
71 | (unless | ||
72 | (and | ||
73 | (current-message) | ||
74 | (not | ||
75 | (equal last-message | ||
76 | (current-message)))) | ||
77 | (let | ||
78 | ((local " in current buffer")) | ||
79 | (message "Hide-Cursor mode %sabled%s" | ||
80 | (if hide-cursor-mode "en" "dis") | ||
81 | local)))))) | ||
82 | (force-mode-line-update) | ||
83 | hide-cursor-mode) | ||
84 | :autoload-end | ||
85 | (defvar hide-cursor-mode-hook nil) | ||
86 | (unless | ||
87 | (get 'hide-cursor-mode-hook 'variable-documentation) | ||
88 | (put 'hide-cursor-mode-hook 'variable-documentation "Hook run after entering or leaving `hide-cursor-mode'. | ||
89 | No problems result if this variable is not bound. | ||
90 | `add-hook' automatically binds it. (This is true for all hook variables.)")) | ||
91 | (put 'hide-cursor-mode-hook 'custom-type 'hook) | ||
92 | (put 'hide-cursor-mode-hook 'standard-value | ||
93 | (list nil)) | ||
94 | (defvar hide-cursor-mode-map | ||
95 | (let | ||
96 | ((m | ||
97 | (let | ||
98 | ((map | ||
99 | (make-sparse-keymap))) | ||
100 | (define-key map | ||
101 | [f7] | ||
102 | (function hide-cursor-mode)) | ||
103 | map))) | ||
104 | (cond | ||
105 | ((keymapp m) | ||
106 | m) | ||
107 | ((listp m) | ||
108 | (easy-mmode-define-keymap m)) | ||
109 | (t | ||
110 | (error "Invalid keymap %S" m)))) | ||
111 | "Keymap for `hide-cursor-mode'.") | ||
112 | (with-no-warnings | ||
113 | (add-minor-mode 'hide-cursor-mode '"H" hide-cursor-mode-map nil nil))) | ||
114 | |||
115 | (provide 'hide-cursor-mode) | ||
116 | ;;; hide-cursor-mode.el ends here | ||
diff --git a/lisp/long-s-mode.el b/lisp/long-s-mode.el deleted file mode 100644 index 784cb7d..0000000 --- a/lisp/long-s-mode.el +++ /dev/null | |||
@@ -1,67 +0,0 @@ | |||
1 | ;;; long-s-mode.el --- Proper typography for Emacs -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; from Catie on #emacs | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (define-minor-mode long-s-mode | ||
10 | "Minor mode for inserting 'ſ' characters") | ||
11 | |||
12 | (defconst +long-s+ ?ſ) | ||
13 | (defconst +short-s+ ?s) | ||
14 | |||
15 | (defun long-s-p (char) | ||
16 | (char-equal char +long-s+)) | ||
17 | |||
18 | (defun short-s-p (char) | ||
19 | (or (char-equal char +short-s+))) | ||
20 | |||
21 | (defun s-char-p (char) | ||
22 | (or (long-s-p char) | ||
23 | (short-s-p char))) | ||
24 | |||
25 | (defun alpha-char-p (char) | ||
26 | (memq (get-char-code-property char 'general-category) | ||
27 | '(Ll Lu Lo Lt Lm Mn Mc Me Nl))) | ||
28 | |||
29 | (defun long-s-insert-short-s () | ||
30 | (interactive) | ||
31 | (if (long-s-p (preceding-char)) | ||
32 | (insert-char +short-s+) | ||
33 | (insert-char +long-s+))) | ||
34 | |||
35 | (defun long-s-insert-space () | ||
36 | (interactive) | ||
37 | (if (long-s-p (preceding-char)) | ||
38 | (progn (delete-backward-char 1) | ||
39 | (insert-char +short-s+)) | ||
40 | (save-excursion | ||
41 | (while (not (alpha-char-p (preceding-char))) | ||
42 | (backward-char)) | ||
43 | (when (long-s-p (preceding-char)) | ||
44 | (delete-backward-char 1) | ||
45 | (insert-char +short-s+)))) | ||
46 | (insert-char ?\ )) | ||
47 | |||
48 | (defvar long-s-mode-map | ||
49 | (let ((map (make-sparse-keymap))) | ||
50 | (set-keymap-parent map (current-global-map)) | ||
51 | (define-key map (kbd "s") #'long-s-insert-short-s) | ||
52 | (define-key map (kbd "SPC") #'long-s-insert-space) | ||
53 | map)) | ||
54 | |||
55 | (setq long-s-mode-map | ||
56 | (let ((map (make-sparse-keymap))) | ||
57 | (define-key map (kbd "s") #'long-s-insert-short-s) | ||
58 | (define-key map (kbd "SPC") #'long-s-insert-space) | ||
59 | map)) | ||
60 | |||
61 | (unless (seq-some #'(lambda (x) (eq (car x) 'long-s-mode)) | ||
62 | minor-mode-map-alist) | ||
63 | (push (cons 'long-s-mode long-s-mode-map) | ||
64 | minor-mode-map-alist)) | ||
65 | |||
66 | (provide 'long-s-mode) | ||
67 | ;;; long-s-mode.el ends here | ||
diff --git a/lisp/private.el b/lisp/private.el deleted file mode 100644 index 4f6115e..0000000 --- a/lisp/private.el +++ /dev/null | |||
@@ -1,23 +0,0 @@ | |||
1 | ;;; private.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'acdw) | ||
8 | |||
9 | (defgroup private nil | ||
10 | "Private things are private. Shhhhh....") | ||
11 | |||
12 | ;; Private directory | ||
13 | |||
14 | (+define-dir private/ (sync/ "emacs/private") | ||
15 | "Private secretive secrets inside.") | ||
16 | (add-to-list 'load-path private/) | ||
17 | |||
18 | ;; Load random private stuff | ||
19 | |||
20 | (require '_acdw) | ||
21 | |||
22 | (provide 'private) | ||
23 | ;;; private.el ends here | ||
diff --git a/lisp/reading.el b/lisp/reading.el deleted file mode 100644 index a0d22f4..0000000 --- a/lisp/reading.el +++ /dev/null | |||
@@ -1,85 +0,0 @@ | |||
1 | ;;; reading.el --- minor mode for reading -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (defgroup reading nil | ||
6 | "Group for Reading mode customizations." | ||
7 | :prefix "reading-" | ||
8 | :group 'convenience) | ||
9 | |||
10 | (defcustom reading-vars '((indicate-empty-lines . nil) | ||
11 | (indicate-buffer-boundaries . nil)) | ||
12 | "Alist of variables to set in function `reading-mode'. | ||
13 | The car of each cell is the variable name, and the cdr is the | ||
14 | value to set it to." | ||
15 | :type '(alist :key-type variable | ||
16 | :value-type sexp)) | ||
17 | |||
18 | (defcustom reading-modes '((display-fill-column-indicator-mode . -1) | ||
19 | (blink-cursor-mode . -1)) | ||
20 | "Alist of modes to set in function `reading-mode'. | ||
21 | The car of each cell is the function name, and the cdr is the | ||
22 | value to call it with." | ||
23 | :type '(alist :key-type function | ||
24 | :value-type sexp)) | ||
25 | |||
26 | ;;; Internal | ||
27 | |||
28 | (defvar reading--remembered-template "reading--remembered-%s-value" | ||
29 | "The template passed to `format' for remembered modes and variables.") | ||
30 | |||
31 | (defun reading--remember (things func) | ||
32 | "Apply FUNC to THINGS, remembering their previous value for later." | ||
33 | (declare (indent 1)) | ||
34 | (unless (listp things) | ||
35 | (setq things (list things))) | ||
36 | (dolist (thing things) | ||
37 | (set (make-local-variable | ||
38 | (intern (format reading--remembered-template thing))) | ||
39 | (and (boundp thing) | ||
40 | (symbol-value thing))) | ||
41 | (funcall func thing))) | ||
42 | |||
43 | (defun reading--recall (things func) | ||
44 | "Recall previously remembered THINGS by applying FUNC to them. | ||
45 | FUNC should be a function with the signature (THING REMEMBERED-SETTING)." | ||
46 | (declare (indent 1)) | ||
47 | (unless (listp things) | ||
48 | (setq things (list things))) | ||
49 | (dolist (thing things) | ||
50 | (with-demoted-errors "reading--recall: %S" | ||
51 | (let ((value (symbol-value | ||
52 | (intern | ||
53 | (format reading--remembered-template thing))))) | ||
54 | (funcall func thing value))))) | ||
55 | |||
56 | ;;; Mode | ||
57 | |||
58 | ;;;###autoload | ||
59 | (defvar reading-mode-map (make-sparse-keymap) | ||
60 | "Keymap for `reading-mode'.") | ||
61 | |||
62 | ;;;###autoload | ||
63 | (define-minor-mode reading-mode | ||
64 | "A mode for reading." | ||
65 | :lighter " Read" | ||
66 | (if reading-mode | ||
67 | ;; turn on | ||
68 | (progn | ||
69 | (reading--remember (mapcar #'car reading-vars) | ||
70 | (lambda (var) | ||
71 | (set (make-local-variable var) | ||
72 | (cdr (assoc var reading-vars))))) | ||
73 | (reading--remember (mapcar #'car reading-modes) | ||
74 | (lambda (mode) | ||
75 | (funcall mode (cdr (assoc mode reading-modes)))))) | ||
76 | ;; turn off | ||
77 | (reading--recall (mapcar #'car reading-vars) | ||
78 | (lambda (var orig-val) | ||
79 | (set (make-local-variable var) orig-val))) | ||
80 | (reading--recall (mapcar #'car reading-modes) | ||
81 | (lambda (mode orig-setting) | ||
82 | (funcall mode (if orig-setting +1 -1)))))) | ||
83 | |||
84 | (provide 'reading) | ||
85 | ;;; reading.el ends here | ||
diff --git a/lisp/system.el b/lisp/system.el deleted file mode 100644 index 73cd80b..0000000 --- a/lisp/system.el +++ /dev/null | |||
@@ -1,179 +0,0 @@ | |||
1 | ;;; system.el --- Load system-dependendant settings -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; When using Emacs on multiple computers, some variables and functions need | ||
6 | ;; different definitions. This library is built to assist in working with | ||
7 | ;; different system configurations for Emacs. | ||
8 | |||
9 | ;;; TODO: | ||
10 | |||
11 | ;; machine.el | ||
12 | ;; machine-case to switch on machine | ||
13 | ;; | ||
14 | |||
15 | ;;; Code: | ||
16 | |||
17 | (require 'cl-lib) | ||
18 | |||
19 | (defgroup system nil | ||
20 | "System-specific configurations." | ||
21 | :group 'emacs | ||
22 | :prefix "system-") | ||
23 | |||
24 | ;;; Settings | ||
25 | |||
26 | (defcustom system-load-directory (locate-user-emacs-file "systems" | ||
27 | "~/.emacs-systems") | ||
28 | "The directory where system-specific configurations live." | ||
29 | :type 'file) | ||
30 | |||
31 | ;; These `defcustom's are best-guess defaults. | ||
32 | |||
33 | (defcustom system-default-font (cond | ||
34 | ((memq system-type '(ms-dos windows-nt)) | ||
35 | "Consolas") | ||
36 | (t "monospace")) | ||
37 | "The font used for the `default' face. | ||
38 | Set this in your system files." | ||
39 | :type 'string) | ||
40 | |||
41 | (defcustom system-default-height 100 | ||
42 | "The height used for the `default' face. | ||
43 | Set this in your system files." | ||
44 | :type 'number) | ||
45 | |||
46 | (defcustom system-variable-pitch-font (cond | ||
47 | ((memq system-type '(ms-dos windows-nt)) | ||
48 | "Arial") | ||
49 | (t "sans-serif")) | ||
50 | "The font used for the `variable-pitch' face. | ||
51 | Set this in your system files." | ||
52 | :type 'string) | ||
53 | |||
54 | (defcustom system-variable-pitch-height 1.0 | ||
55 | "The height used for the `variable-pitch' face. | ||
56 | A floating-point number is recommended, since that makes it | ||
57 | relative to the `default' face height. | ||
58 | |||
59 | Set this in your system files." | ||
60 | :type 'number) | ||
61 | |||
62 | (defcustom system-files-order '(:type :name :user) | ||
63 | "The order to load `system-files' in. | ||
64 | The elements of this list correspond to the keys in | ||
65 | `system-system'." | ||
66 | :type '(list (const :tag "System type" :type) | ||
67 | (const :tag "System name" :name) | ||
68 | (const :tag "Current user" :user))) | ||
69 | |||
70 | ;;; Variables | ||
71 | |||
72 | (defvar system-system nil | ||
73 | "Plist of systems that Emacs is in. | ||
74 | The keys are as follows: | ||
75 | |||
76 | - :name - `system-name' | ||
77 | - :type - `system-type' | ||
78 | - :user - `user-login-name' | ||
79 | |||
80 | Each value is made safe to be a file name by passing through | ||
81 | `system--safe'. | ||
82 | |||
83 | Do not edit this by hand. Instead, call `system-get-systems'.") | ||
84 | |||
85 | (defvar system-files nil | ||
86 | "List of files to load for system-specific configuration. | ||
87 | Do not edit this by hand. Instead, call `system-get-system-files'.") | ||
88 | |||
89 | |||
90 | ;;; Functions | ||
91 | |||
92 | (defun system--warn (message &rest args) | ||
93 | "Display a system-file warning message. | ||
94 | This function is like `warn', except it uses a `system' type." | ||
95 | (display-warning 'system (apply #'format-message message args))) | ||
96 | |||
97 | (defun system--safe (str) | ||
98 | "Make STR safe for a file name." | ||
99 | (let ((bad-char-regexp )) | ||
100 | (downcase (string-trim | ||
101 | (replace-regexp-in-string "[#%&{}\$!'\":@<>*?/ \r\n\t+`|=]+" | ||
102 | "-" str) | ||
103 | "-" "-")))) | ||
104 | |||
105 | (defun system-get-systems () | ||
106 | "Determine the current system(s). | ||
107 | This system updates `system-system', which see." | ||
108 | ;; Add system-name | ||
109 | (setf (plist-get system-system :name) | ||
110 | (intern (system--safe (system-name)))) | ||
111 | ;; Add system-type | ||
112 | (setf (plist-get system-system :type) | ||
113 | (intern (system--safe (symbol-name system-type)))) | ||
114 | ;; Add current user | ||
115 | (setf (plist-get system-system :user) | ||
116 | ;; Use `user-real-login-name' in case Emacs gets called under su. | ||
117 | (intern (system--safe (user-real-login-name)))) | ||
118 | system-system) | ||
119 | |||
120 | (defun system-get-files () | ||
121 | "Determine the current systems' load-files. | ||
122 | The system load-files should live in `system-load-directory', and | ||
123 | named using either the raw name given by the values of | ||
124 | `system-system', or that name prepended with the type, e.g., | ||
125 | \"name-bob.el\", for a system named \"bob\". | ||
126 | |||
127 | The second form of file-name is to work around name collisions, | ||
128 | e.g. if a there's a user named \"bob\" and a system named | ||
129 | \"bob\". | ||
130 | |||
131 | This function updates `system-files'." | ||
132 | ;; Get systems | ||
133 | (system-get-systems) | ||
134 | ;; Re-set `system-files' | ||
135 | (setq system-files nil) | ||
136 | |||
137 | (let (ret) | ||
138 | (dolist (key (reverse system-files-order)) | ||
139 | (let* ((val (plist-get system-system key)) | ||
140 | (key-val (intern (system--safe (format "%s-%s" key val))))) | ||
141 | (push (list key-val val) ret))) | ||
142 | |||
143 | ;; Update `system-files'. | ||
144 | (setq system-files ret))) | ||
145 | |||
146 | ;;;###autoload | ||
147 | (defun system-settings-load (&optional error nomessage) | ||
148 | "Load system settings from `system-files'. | ||
149 | Each list in `system-files' will be considered item-by-item; the | ||
150 | first found file in each will be loaded. | ||
151 | |||
152 | ERROR determines how to deal with errors: if nil, warn the user | ||
153 | when no system-files can be found or when the system being used | ||
154 | cannot be determined. If t, these warnings are elevated to | ||
155 | errors. Any other value ignores the warnings completely. | ||
156 | |||
157 | NOMESSAGE is passed directly to `load'." | ||
158 | (system-get-files) | ||
159 | (if system-files | ||
160 | (let (files-loaded) | ||
161 | (dolist (ss system-files) | ||
162 | (catch :done | ||
163 | (dolist (s ss) | ||
164 | (let ((fn (expand-file-name (format "%s" s) | ||
165 | system-load-directory))) | ||
166 | (when (load fn t nomessage) | ||
167 | (push fn files-loaded) | ||
168 | (throw :done nil)))))) | ||
169 | (unless files-loaded | ||
170 | (cond ((eq error t) (error "Error loading system-files.") | ||
171 | (null error) (system--warn "Couldn't load system-files.")))) | ||
172 | files-loaded) | ||
173 | (funcall (cond ((eq error t) #'error) | ||
174 | ((null error) #'system--warn) | ||
175 | (t #'ignore)) | ||
176 | "Couldn't determine the system being used."))) | ||
177 | |||
178 | (provide 'system) | ||
179 | ;;; system.el ends here | ||
diff --git a/lisp/user-save.el b/lisp/user-save.el deleted file mode 100644 index 674abac..0000000 --- a/lisp/user-save.el +++ /dev/null | |||
@@ -1,137 +0,0 @@ | |||
1 | ;;; user-save.el --- Do things when explicitly saving files -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2021--2022 Case Duckworth <acdw@acdw.net> | ||
4 | ;; URL: ... | ||
5 | ;; Version: 0.1.0 | ||
6 | ;; Package-Requires: ((emacs "24.3")) | ||
7 | ;; Keywords: files | ||
8 | |||
9 | ;;; Commentary: | ||
10 | |||
11 | ;; Because `super-save-mode' automatically saves every time we move away from a | ||
12 | ;; buffer, it tends to run a lot of `before-save-hook's that don't need to be | ||
13 | ;; run that often. For that reason, I'm writing a mode where C-x C-s saves | ||
14 | ;; /and/ runs all the "real" before-save-hooks, so that super-save won't | ||
15 | ;; automatically do things like format the buffer all the time. | ||
16 | |||
17 | ;;; Code: | ||
18 | |||
19 | (require 'cl-lib) | ||
20 | |||
21 | (defgroup user-save nil | ||
22 | "Group for `user-save-mode' customizations." | ||
23 | :group 'files | ||
24 | :prefix "user-save-") | ||
25 | |||
26 | (defcustom user-save-hook-into-kill-emacs nil | ||
27 | "Add a hook to perform `user-save' to `kill-emacs-hook'. | ||
28 | This option is only useful is `user-save-mode' is active when | ||
29 | Emacs is killed." | ||
30 | :type 'boolean) | ||
31 | |||
32 | (defcustom user-save-inhibit-modes '(special-mode) | ||
33 | "List of modes to inhibit `user-save-mode' from activation in." | ||
34 | :type '(repeat symbol)) | ||
35 | |||
36 | (defcustom user-save-inhibit-predicates '(user-save-non-file-buffer-p) | ||
37 | "List of predicates to inhibit `user-save-mode' from activation. | ||
38 | Each predicate will be called with no arguments, and if it | ||
39 | returns t, will inhibit `user-save-mode' from activating." | ||
40 | :type '(repeat function)) | ||
41 | |||
42 | (defcustom user-save-before-save-hook nil | ||
43 | "Hook to run before the user, not Emacs, saves the buffer." | ||
44 | :type 'hook) | ||
45 | |||
46 | (defcustom user-save-after-save-hook nil | ||
47 | "Hook to run after the user, not Emacs, saves the buffer." | ||
48 | :type 'hook) | ||
49 | |||
50 | (defvar user-save-mode-map (let ((map (make-sparse-keymap))) | ||
51 | (define-key map (kbd "C-x C-s") #'user-save-buffer) | ||
52 | (define-key map (kbd "C-x s") #'user-save-some-buffers) | ||
53 | map) | ||
54 | "Keymap for `user-save-mode'. | ||
55 | This map shadows the default map for `save-buffer'.") | ||
56 | |||
57 | (defun user-save-run-hooks (which &rest _) | ||
58 | "Run the hooks in one of the user-save-hooks. | ||
59 | If WHICH is `'before', run `user-save-before-save-hook'; | ||
60 | if it's `after', run `user-save-after-save-hook'. | ||
61 | This does /not/ also save the buffer." | ||
62 | (with-demoted-errors "User-save-hook error: %S" | ||
63 | (run-hooks (intern (format "user-save-%s-save-hook" which))))) | ||
64 | |||
65 | (defun user-save-non-file-buffer-p (&optional buffer-or-name) | ||
66 | "Return whether BUFFER-OR-NAME is a non-file buffer. | ||
67 | BUFFER-OR-NAME, if omitted, defaults to the current buffer." | ||
68 | (with-current-buffer (or buffer-or-name (current-buffer)) | ||
69 | (not (buffer-file-name)))) | ||
70 | |||
71 | (defun user-save-buffer (&optional arg) | ||
72 | "Save current buffer in visited file if modified. | ||
73 | This function is precisely the same as `save-buffer', but with | ||
74 | one modification: it also runs functions in `user-save-hook'. | ||
75 | This means that if you have some functionality in Emacs to | ||
76 | automatically save buffers periodically, but have hooks you want | ||
77 | to automatically run when the buffer saves that are | ||
78 | computationally expensive or just aren't something you want to | ||
79 | run all the time, put them in `user-save-hook'. | ||
80 | |||
81 | ARG is passed directly to `save-buffer'." | ||
82 | (interactive '(called-interactively)) | ||
83 | (message "User-Saving the buffer...") | ||
84 | (user-save-run-hooks 'before) | ||
85 | (save-buffer arg) | ||
86 | (user-save-run-hooks 'after) | ||
87 | (message "User-Saving the buffer...Done.")) | ||
88 | |||
89 | (defun user-save-some-buffers (&optional pred) | ||
90 | "Save some buffers as though the user saved them. | ||
91 | This function does not ask the user about each buffer, but PRED | ||
92 | is used in almost the same way as `save-some-buffers': if it's | ||
93 | nil or t, it will save all file-visiting modified buffers; if | ||
94 | it's a zero-argument function, that will be called to determine | ||
95 | whether the buffer needs to be saved." | ||
96 | ;; This could maybe be much better. | ||
97 | (interactive "P") | ||
98 | (unless pred (setq pred save-some-buffers-default-predicate)) | ||
99 | (dolist (buf (buffer-list)) | ||
100 | (with-current-buffer buf | ||
101 | (when (and (buffer-modified-p) | ||
102 | (buffer-file-name) | ||
103 | (or (null pred) | ||
104 | (if (functionp pred) (funcall pred) pred))) | ||
105 | (user-save-buffer))))) | ||
106 | |||
107 | ;;;###autoload | ||
108 | (define-minor-mode user-save-mode | ||
109 | "Mode to enable an an extra user-save hook." | ||
110 | :lighter " US" | ||
111 | :keymap user-save-mode-map) | ||
112 | |||
113 | ;;;###autoload | ||
114 | (defun user-save-mode-disable () | ||
115 | "Turn off `user-save-mode' in the current buffer." | ||
116 | (user-save-mode -1)) | ||
117 | |||
118 | ;;;###autoload | ||
119 | (defun user-save-mode-in-some-buffers () | ||
120 | "Enable `user-save-mode', but only in some buffers. | ||
121 | The mode will not be enabled in buffers derived from modes in | ||
122 | `user-save-inhibit-modes', those for which | ||
123 | `user-save-inhibit-predicates' return t, or in the minibuffer." | ||
124 | (unless (or (minibufferp) | ||
125 | (cl-some #'derived-mode-p user-save-inhibit-modes) | ||
126 | (run-hook-with-args-until-failure 'user-save-inhibit-predicates)) | ||
127 | (user-save-mode +1))) | ||
128 | |||
129 | ;;;###autoload | ||
130 | (define-globalized-minor-mode user-save-global-mode user-save-mode user-save-mode-in-some-buffers | ||
131 | (if user-save-global-mode | ||
132 | (when user-save-hook-into-kill-emacs | ||
133 | (add-hook 'kill-emacs-hook #'user-save-some-buffers)) | ||
134 | (remove-hook 'kill-emacs-hook #'user-save-some-buffers))) | ||
135 | |||
136 | (provide 'user-save) | ||
137 | ;;; user-save.el ends here | ||
diff --git a/lisp/yoke.el b/lisp/yoke.el new file mode 100644 index 0000000..2673e5e --- /dev/null +++ b/lisp/yoke.el | |||
@@ -0,0 +1,125 @@ | |||
1 | ;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*- | ||
2 | ;; by C. Duckworth <acdw@acdw.net> | ||
3 | (provide 'yoke) | ||
4 | (require 'cl-lib) | ||
5 | |||
6 | (defgroup yoke nil | ||
7 | "Customizations for yoke, a package manager thing." | ||
8 | :group 'applications | ||
9 | :prefix "yoke-") | ||
10 | |||
11 | (defcustom yoke-dir (locate-user-emacs-file "yoke") | ||
12 | "Where yoke packages live." | ||
13 | :type 'file) | ||
14 | |||
15 | (defun yoke-repo-local-p (repo) | ||
16 | (string-match-p (rx bos (or "." "~" "/")) repo)) | ||
17 | |||
18 | (defun yoke-repo-dir (pkg repo) | ||
19 | (if (yoke-repo-local-p repo) | ||
20 | (expand-file-name repo) | ||
21 | (expand-file-name (format "%s" pkg) yoke-dir))) | ||
22 | |||
23 | (defun yoke-git (repo &optional dir) | ||
24 | "Git REPO from the internet and put it into `yoke-dir'. | ||
25 | If DIR is passed, clone there; otherwise just clone. Return the | ||
26 | directory created." | ||
27 | (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo)))) | ||
28 | (unless (or (yoke-repo-local-p repo) (file-exists-p dir)) | ||
29 | (message "Downloading %S..." repo) | ||
30 | (call-process "git" nil (get-buffer-create "*yoke*") nil | ||
31 | "clone" repo dir) | ||
32 | (message "Downloading %S... done" repo)) | ||
33 | dir)) | ||
34 | |||
35 | (defun yoke-lasso (pkg repo) | ||
36 | "Add PKG to `load-path' so it can be used. | ||
37 | If PKG is not installed, install it from REPO. Packages will be | ||
38 | installed to `yoke-dir'." | ||
39 | (let* ((dir (yoke-repo-dir pkg repo))) | ||
40 | (yoke-git repo dir) | ||
41 | (cond | ||
42 | ((file-exists-p dir) | ||
43 | (add-to-list 'load-path dir) | ||
44 | ;; This bit is stolen from `straight'. | ||
45 | (eval-and-compile (require 'autoload)) | ||
46 | (let ((generated-autoload-file | ||
47 | (expand-file-name (format "%s-autoloads.el" pkg) dir)) | ||
48 | (backup-inhibited t) | ||
49 | (version-control 'never) | ||
50 | (message-log-max nil) | ||
51 | (inhibit-message t)) | ||
52 | (unless (file-exists-p generated-autoload-file) | ||
53 | (let ((find-file-hook nil) | ||
54 | (write-file-functions nil) | ||
55 | (debug-on-error nil) | ||
56 | (left-margin 0)) | ||
57 | (if (fboundp 'make-directory-autoloads) | ||
58 | (make-directory-autoloads dir generated-autoload-file) | ||
59 | (and (fboundp 'update-directory-autoloads) | ||
60 | (update-directory-autoloads dir))))) | ||
61 | (when-let ((buf (find-buffer-visiting generated-autoload-file))) | ||
62 | (kill-buffer buf)) | ||
63 | (load generated-autoload-file :noerror :nomessage))) | ||
64 | (t (user-error "Directory \"%s\" doesn't exist." dir))) | ||
65 | dir)) | ||
66 | |||
67 | (defun yoke-get (key args) | ||
68 | "Get KEY's value from ARGS, or return nil. | ||
69 | Similar-ish to `plist-get', but works on non-proper plists." | ||
70 | (cond | ||
71 | ((null args) nil) | ||
72 | ((eq key (car args)) (cadr args)) | ||
73 | (t (yoke-get key (cdr args))))) | ||
74 | |||
75 | (defmacro when1 (test &rest body) | ||
76 | "Like `when', but return the value of the test." | ||
77 | (declare (indent 1)) | ||
78 | (let ((g (gensym))) | ||
79 | `(let ((,g ,test)) | ||
80 | (when ,g | ||
81 | ,@body | ||
82 | ,g)))) | ||
83 | |||
84 | (defun delete2 (list &rest elems) | ||
85 | "Delete ELEM and the next item from LIST." | ||
86 | (let ((r nil)) | ||
87 | (while (consp list) | ||
88 | (if (member (car list) elems) | ||
89 | (setq list (cdr list)) | ||
90 | (setq r (cons (car list) r))) | ||
91 | (setq list (cdr list))) | ||
92 | (reverse r))) | ||
93 | |||
94 | (defun yoke-pkg-name (pkg) | ||
95 | (intern (format "yoke:%s" pkg))) | ||
96 | |||
97 | (cl-defmacro yoke (pkg | ||
98 | &optional repo | ||
99 | &body body | ||
100 | &key | ||
101 | requires ; :requires ((PKG REPO)...) | ||
102 | dest ; :dest DESTINATION | ||
103 | (when t whenp) ; :when PREDICATE | ||
104 | (unless nil unlessp) ; :unless PREDICATE | ||
105 | &allow-other-keys) | ||
106 | "Yoke a PKG into your Emacs session." | ||
107 | (declare (indent defun)) | ||
108 | (let ((name (yoke-pkg-name pkg))) | ||
109 | `(cl-block ,name | ||
110 | (condition-case e | ||
111 | (let ((*yoke-name* ',name) | ||
112 | (*yoke-repo* ,repo) | ||
113 | (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo)))) | ||
114 | ,@(list (cond | ||
115 | ((and whenp unlessp) | ||
116 | `(when (or (not ,when) ,unless) | ||
117 | (cl-return-from ,name nil))) | ||
118 | (whenp `(unless ,when (cl-return-from ,name nil))) | ||
119 | (unlessp `(when ,unless (cl-return-from ,name nil))))) | ||
120 | ,@(cl-loop for (pkg repo) in requires | ||
121 | collect `(or (yoke-lasso ',pkg ,repo) | ||
122 | (cl-return-from ,name nil))) | ||
123 | ,@(when repo `((yoke-lasso ',pkg ,repo))) | ||
124 | ,@(delete2 body :requires :when :unless)) | ||
125 | (t (message "%s: %S" ',name e)))))) | ||