summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+Info.el84
-rw-r--r--lisp/+ace-window.el40
-rw-r--r--lisp/+apheleia.el50
-rw-r--r--lisp/+avy.el97
-rw-r--r--lisp/+bongo.el60
-rw-r--r--lisp/+browse-url.el156
-rw-r--r--lisp/+burly.el63
-rw-r--r--lisp/+casing.el82
-rw-r--r--lisp/+chicken.el34
-rw-r--r--lisp/+circe.el285
-rw-r--r--lisp/+compat.el64
-rw-r--r--lisp/+compile.el20
-rw-r--r--lisp/+consult.el47
-rw-r--r--lisp/+crux.el58
-rw-r--r--lisp/+cus-edit.el80
-rw-r--r--lisp/+dired.el28
-rw-r--r--lisp/+ecomplete.el45
-rw-r--r--lisp/+elfeed.el185
-rw-r--r--lisp/+elisp.el18
-rw-r--r--lisp/+emacs.el434
-rw-r--r--lisp/+embark.el28
-rw-r--r--lisp/+emms.el46
-rw-r--r--lisp/+eshell.el126
-rw-r--r--lisp/+eww.el71
-rw-r--r--lisp/+expand-region.el24
-rw-r--r--lisp/+finger.el46
-rw-r--r--lisp/+flyspell-correct.el24
-rw-r--r--lisp/+god-mode.el17
-rw-r--r--lisp/+hideshow.el44
-rw-r--r--lisp/+init.el117
-rw-r--r--lisp/+ispell.el97
-rw-r--r--lisp/+jabber.el278
-rw-r--r--lisp/+key.el106
-rw-r--r--lisp/+kmacro.el70
-rw-r--r--lisp/+link-hint.el169
-rw-r--r--lisp/+lisp.el195
-rw-r--r--lisp/+message.el26
-rw-r--r--lisp/+minibuffer.el14
-rw-r--r--lisp/+modeline.el488
-rw-r--r--lisp/+mwim.el42
-rw-r--r--lisp/+notmuch.el97
-rw-r--r--lisp/+nyan-mode.el42
-rw-r--r--lisp/+orderless.el60
-rw-r--r--lisp/+org-attach.el29
-rw-r--r--lisp/+org-capture.el164
-rw-r--r--lisp/+org-drawer-list.el47
-rw-r--r--lisp/+org-wc.el112
-rw-r--r--lisp/+org.el816
-rw-r--r--lisp/+ox.el29
-rw-r--r--lisp/+paredit.el26
-rw-r--r--lisp/+pdf-tools.el38
-rw-r--r--lisp/+pulse.el52
-rw-r--r--lisp/+scratch.el77
-rw-r--r--lisp/+setup.el216
-rw-r--r--lisp/+shr.el51
-rw-r--r--lisp/+slack.el27
-rw-r--r--lisp/+sly.el18
-rw-r--r--lisp/+straight.el42
-rw-r--r--lisp/+tab-bar.el394
-rw-r--r--lisp/+titlecase.el30
-rw-r--r--lisp/+util.el94
-rw-r--r--lisp/+vertico.el24
-rw-r--r--lisp/+vterm.el19
-rw-r--r--lisp/+window.el130
-rw-r--r--lisp/+xkcd.el16
-rw-r--r--lisp/+ytdious.el21
-rw-r--r--lisp/+zzz-to-char.el16
-rw-r--r--lisp/acdw.el595
-rw-r--r--lisp/dawn.el74
-rw-r--r--lisp/elephant.el58
-rw-r--r--lisp/find-script.el36
-rw-r--r--lisp/gdrive.el130
-rw-r--r--lisp/hide-cursor-mode.el116
-rw-r--r--lisp/long-s-mode.el67
-rw-r--r--lisp/private.el23
-rw-r--r--lisp/reading.el85
-rw-r--r--lisp/system.el179
-rw-r--r--lisp/user-save.el137
-rw-r--r--lisp/yoke.el125
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.
11This is the same as `Info-copy-current-node-name', but with the
12arg 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.
32Switch 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'.
38Customize 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.
85Restore 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.
22This 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'.
16Set `browse-url-handlers', if they exist; else
17`browse-url-browser-function'. The reason for this switch is
18that the latter is deprecated in Emacs 28+.
19
20If HANDLERS is absent or nil, recompute handlers. This can be
21useful 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.
34Also create a `customize' setting in CUSTOM-GROUP for VIEWER's
35arguments. DEFAULT-ARGS specifies the default arguments that
36setting should have. PROMPT will be shown to user in the
37function's `interactive' spec, as an argument to
38`browse-url-interactive-arg'. The resulting function will be
39named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable
40\"NAME-args\".
41
42If 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'.
95This 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.
106This is an alist, the keys of which are regexen to match URLs
107against, and the values are how to transform them. Match capture
108data 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'.
116ARGS 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'.
134This can be used to \"redirect\" URLs, for example from an
135information silo to a more privacy-respecting one (e.g.,
136\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'.
137
138When 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.
19If ARG is passed, ask for the bookmark's name; otherwise, just
20use `+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.
28ARG 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.
36This 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.
46ARG 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.
57The 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.
10If the region is active, this function calls `upcase-region'.
11Otherwise, 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.
28If the region is active, this function calls `downcase-region'.
29Otherwise, 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.
46If the region is active, this function calls `capitalize-region'.
47Otherwise, 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
23https://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.
53When called with optional MESSAGE non-nil, or interactively, also
54message 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.
77Include nick unless NO-NICK is non-nil. If NO-NICK is a string,
78replace {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.
93For 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
150Connect to the given network specified by NETWORK-OR-SERVER.
151
152When this function is called, it collects options from the
153SERVER-OPTIONS argument, the user variable
154`circe-network-options', and the defaults found in
155`circe-network-defaults', in this order.
156
157If NETWORK-OR-SERVER is not found in any of these variables, the
158argument is assumed to be the host name for the server, and all
159relevant settings must be passed via SERVER-OPTIONS.
160
161All SERVER-OPTIONS are treated as variables by getting the string
162\"circe-\" prepended to their name. This variable is then set
163locally in the server buffer.
164
165See `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.
192This is an alist with cells of the structure (TAG . FN), so we
193can 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.
46This command also sets the visited file name. If the buffer
47isn't visiting any file, that's all it does.
48
49Interactively, 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'.
15Any 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.
14Copy from BEGIN to END using `kill-ring-save' if no argument was
15passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if
16one 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'.
25Should 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'.
30Should 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.
35Called without a prefix ARG, insert the time formatted by
36`+crux-default-date-format'. When called with \\[universal-argument],
37format the time with `+crux-alternate-date-format'. Otherwise,
38prompt 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.
49In `visual-line-mode', runs command `kill-visual-line'; in other
50modes, runs command `kill-line'. Passes ARG to command when
51provided. 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.
45Ignore all faces, and only load variables in
46`+customize-variable-allowlist'. All the optional
47variables---ERROR, NOMESSAGE, NOSUFFIX, MUST-SUFFIX---are
48passed on to `load'.
49
50NOTE: ERROR is the opposite of its value in `load' -- meaning
51that this function by default does /not/ error, but will if you
52pass 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.
36If 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'.
146Each hook is passed no arguments."
147 :type 'hook)
148
149(defun +elfeed-update-command-wrapper ()
150 "Run `+elfeed-update-command', but only sometimes.
151If any of the predicates in `+elfeed-update-proceed-hook' return
152nil, don't run `+elfeed-update-command'. If they all return
153non-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.
23Do 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'.
246That is, with a positive N, deletes newlines as well, leaving -N
247spaces. If N is negative, it will not delete newlines and leave
248N spaces. See docstring of `cycle-spacing' for the meaning of
249PRESERVE-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.
255If the current frame has no client, kill Emacs itself using
256`save-buffers-kill-emacs' after confirming with the user.
257
258With prefix ARG, silently save all file-visiting buffers, then
259kill 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.
270BACKWARD-KILL-WORD-FN is the function to call to kill a word
271backward. 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.
279If point is on at the beginning of a line, kill the previous new
280line. If the only thing before point on the current line is
281whitespace, kill that whitespace.
282
283With argument ARG: if ARG is a number, just call FN
284ARG 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'.
301ARG 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'.
319It 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.
339If 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
8any 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.
108If Eshell is already loaded in the session, immediately execute
109forms.
110
111I wrote this because Eshell doesn't properly do loading or
112something, 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.
14Otherwise, 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.
17This command uses `finger-X.500-host-regexps'
18and `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.
9With 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'.
20This 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.
27Sort based on the following heuristic: `setup' forms (the
28majority of my init.el) are sorted after everything else, and
29within that group, forms with a HEAD of `:require' are sorted
30first, and `:straight' HEADs are sorted last. All other forms
31are 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.
13Any keyword arguments to `cl-remove-duplicates' should come
14before the LISTS."
15 (let (cl-remove-duplicates-args)
16 (while (keywordp (car lists))
17 (push (pop lists) cl-remove-duplicates-args)
18 (push (pop lists) cl-remove-duplicates-args))
19 (apply #'cl-remove-duplicates (apply #'append lists)
20 (nreverse cl-remove-duplicates-args))))
21
22;;; Ispell in .dir-locals
23
24;; Let Emacs know a list of strings is safe
25(defun +ispell-safe-local-p (list)
26 (and (listp list)
27 (seq-every-p #'stringp list)))
28
29;; Can I instruct ispell to insert LocalWords in a different file?
30;; https://emacs.stackexchange.com/q/31396/2264
31
32;; How can I move all my file-local LocalWords to .dir-locals.el?
33;; https://emacs.stackexchange.com/q/31419
34
35;; Adapted from ispell.el:ispell-buffer-local-words
36(defun +ispell-buffer-local-words-list ()
37 (let (words)
38 (or ispell-buffer-local-name
39 (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.
56This function prompts the user to save .dir-locals.el, unless
57prefix ARG is non-nil; then it just saves them."
58 (interactive "P")
59 (unless (buffer-file-name)
60 (user-error "Buffer not attached to file"))
61 (hack-dir-local-variables)
62 (let ((print-level nil)
63 (print-length nil))
64 (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
65 ; where this came from
66 (+ispell-append-removing-duplicates
67 :test #'string=
68 ispell-buffer-session-localwords
69 (alist-get 'ispell-buffer-session-localwords
70 dir-local-variables-alist)
71 (alist-get 'ispell-buffer-session-localwords
72 file-local-variables-alist)
73 (+ispell-buffer-local-words-list)))))
74 (save-excursion
75 (add-dir-local-variable
76 major-mode
77 'ispell-buffer-session-localwords
78 (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.
27This 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.
76When a presence notification matches a pattern, display it with
77associated 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.
34If TYPES is not present, use `link-hint-types'.
35
36KEYWORD defines the link-hint type. It will be used to create a
37function for opening links of the form \"link-hint-openKEYWORD\".
38
39HANDLER is the function to open a link with.
40
41DOCSTRING is the macro's documentation.
42
43Keyword arguments are passed to `link-hint-define-type' prefixed
44with 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.
92If 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.
106If 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.
130Without a PREFIX, open using `browse-url-browser-function'; with
131a 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.
138Without a PREFIX, open using `browse-url-browser-function'; with
139a 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.
146Without a PREFIX, open using `browse-url-browser-function'; with
147a 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.
156If 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.
24Comments stay with the code below.
25
26Optional argument KEY-FN will determine where in each sexp to
27start sorting. e.g. (lambda (sexp) (symbol-name (car sexp)))
28
29Optional argument SORT-FN will determine how to sort two sexps'
30strings. It's passed to `sort'. By default, it sorts the sexps
31with `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.
145If already inside (or before) a comment, uncomment instead.
146With 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.
23All modeline elements take an optional argument, `spacer', which
24will default to this string.")
25
26;;; Combinators
27
28(defun +modeline-concat (segments &optional separator)
29 "Concatenate multiple functional modeline SEGMENTS.
30Each segment in SEGMENTS is a function returning a mode-line
31construct.
32
33Segments are separated using SEPARATOR, which defaults to
34`+modeline-default-spacer'. Only segments that evaluate to a
35non-zero-length string will be separated, for a cleaner look.
36
37This 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.
53When called with no arguments, insert `+modeline-default-spacer'.
54N will repeat SPACER N times, and defaults to 1. SPACER defaults
55to `+modeline-default-spacer', but can be any string. STRINGS
56should 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'.
77If > 0 and < 1, use that portion of the window's width. If > 1,
78use that many characters. If anything else, don't limit. If the
79buffer name is longer than the max length, it will be shortened
80and 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'.
138If the current mode is derived from the car of a cell, the face
139in 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.
183The CAR of each field is one of `readonly', `modified',
184`special', `ephemeral', or t, and the CDR is a string to display
185in 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.
191t is the fall-back, shown when nothing else in the alist applies.
192
193The 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.
367See `line-number-mode', `column-number-mode', and
368`file-percentage-mode'. If `+modeline-position-function' is set
369to 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.
19Will 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.
31Will 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.
31Without PREFIX argument, go to the first one in
32`notmuch-saved-searches'; with a PREFIX argument, prompt the user
33for which saved search to go to; with a double PREFIX
34argument (\\[universal-argument] \\[universal-argument]), prompt
35for 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.
73That is, apply the tag changes in `+notmuch-spam-tags' to it. If
74an optional prefix HAM argument is given, the message will be
75marked 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.
84This adds the tags in `+notmuch-spam-tags' to the message. With
85an optional HAM prefix argument, mark the messages as
86not-spam (\"ham\").
87
88This 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.
22Dispatchers are taken from `+orderless-dispatch-alist', and added
23to the following defaults:
24
25- regexp$ :: matches REGEXP at the end of the pattern.
26- .ext :: matches EXT (at end of pattern)
27
28Dispatch characters can be added at the beginning or ending of a
29segment 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.
12VISIT-DIR and METHOD are passed through unchanged.
13
14This 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'.
19This mode normalizes the filename passed to `org-attach-attach'
20so 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.
14LIST 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.
38LIST 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'.
50LIST is a symbol and defaults to `org-capture-templates' -- so
51this function sets values on a list that's structured as such.
52
53Thus, KEY is a string key. If it's longer than one character,
54this function will search LIST for each successive run of
55characters before the final, ensuring sub-lists exist of the
56form (CHARS DESCRIPTION).
57
58For example, if KEY is \"abc\", first a LIST item of the form (a
59DESCRIPTION), if non-existant, will be added to the list (with a
60default description), then an item of the
61form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST.
62
63VALUE is the template or group header required for
64`org-capture-templates', which see.
65
66SORT-AFTER, when set to t, will call
67`+org-capture-templates-sort' after setting, to ensure org can
68properly 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.
127ARGS is a plist, which in addition to the additional options
128`org-capture-templates' accepts, takes the following and places
129them accordingly: :type, :target, and :template. Each of these
130corresponds to the same field in `org-capture-templates's
131docstring, which see. Likewise with KEYS and DESCRIPTION, which
132are passed separately to the function.
133
134This function will also create all the necessary intermediate
135capture 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.
17The resource drawer is given by the variable
18`+org-drawer-list-resources-drawer'. If optional TITLE is given,
19format 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
41this correction. (At some point I should correct the underlying
42code... 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.
14TYPE should be an element type, like `item' or `paragraph'.
15ELEMENT 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
24On headings, move point to position after entry content. In
25lists, insert a new item or end the list, with checkbox if
26appropriate. 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.
134N 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.
144Optional PREFIX argument operates on the entire buffer.
145Drawers 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
188Since this function is, for some reason, pricy, the optional
189parameter LIMIT sets a word limit at which to stop counting.
190Once the function hits that number, it'll return -LIMIT
191instead 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.
266Return 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.
354When deleting backwards, in tables this function will insert
355whitespace in front of the next \"|\" separator, to keep the
356table aligned. The table will still be marked for re-alignment
357if the field did fill the entire column, because, in this case
358the 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'.
486This 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.
494With 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.
513If nil, `org-insert-tilde' after 2 tildes inserts an \"example\"
514block. If a string, it inserts a \"src\" block with the given
515language 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.
559Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
560and 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.
672This 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.
694When optional argument ALL is non-nil, align all tags in the
695visible 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.
721See `org-meta-return', but `+org-return-dwim' does most of the
722stuff I would want out of that function already.
723
724When 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.
783WIDTH is the maximum number of characters that is available.
784PREFIX is a prefix to be included in the returned string,
785such as the file name.
786SEPARATOR is inserted between the different parts of the path,
787the 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.
13These 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'.
17Wrapped in `+backward-kill-word-wrapper', which see.
18
19Prefix 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.
12BROWSE-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.
25See 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.
19Good 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.
37This uses the same args as `advice-add' for easy toggling.
38WHERE 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.
9For `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.
34This behavior is prevented if `setup-attributes' contains the
35symbol `without-error-demotion'.
36
37This function differs from `setup-wrap-to-demote-errors' in that
38it 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.
52Good 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.
75This macro can be used as NAME, and it will replace itself with
76the nondirectory part of PATH.
77If 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'.
131If PREDICATES are given, only install RECIPE if all of them return non-nil.
132The 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.
161NAME is the name given to the formatter in `apheleia-formatters'
162and `apheleia-mode-alist'. FORMATTER is the command paired with
163NAME in `apheleia-formatters'. MODE is the mode or modes to add
164NAME to in `apheleia-mode-alist'. If MODE is not given or nil,
165use the setup form's MODE. Optional argument -PEND can be one of
166`:append' or `:prepend', and if given will append or prepend the
167given NAME to the current formatters for the MODE in
168`apheleia-mode-alist', rather than replace them (the default).
169
170Example:
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
181This 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.
195FEATURE-OR-MAP can be a feature or map name or a list of them.
196The 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.
210This macro can be used as NAME, and it will replace itself with
211the 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).
11If 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).
34If 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.
44Add 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'.
16This 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.
9This 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.
32This pulls and rebuilds all packages at once. It does not reload
33all of them, for reasons that should be obvious.
34
35With 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.
254This is just like `tab-bar-tab-name-truncated', but truncates the
255name 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.
289Used 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.
343This 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.
9With 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
37ELLIPSIS defaults to `truncate-string-ellipsis', or \"...\".
38
39ALIGNMENT 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.
56Optional arguments BEFORE and AFTER specify strings to go on
57either side of S.
58
59FILL is the string to fill extra space with (default \" \").
60
61ELLIPSIS is the string to show when S is too long to fit (default
62`truncate-string-ellipsis' or \"...\"). If nil, don't truncate
63the string.
64
65ALIGNMENT 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.
17Optional argument HORIZONTAL nil or omitted means check whether
18`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
19non-nil means check whether WINDOW may be split horizontally.
20
21WINDOW may be split vertically when the following conditions
22hold:
23- `window-size-fixed' is either nil or equals `width' for the
24 buffer of WINDOW.
25- `split-height-threshold' is an integer and WINDOW is at least as
26 high as `split-height-threshold'.
27- When WINDOW is split evenly, the emanating windows are at least
28 `window-min-height' lines tall and can accommodate at least one
29 line plus - if WINDOW has one - a mode line.
30
31WINDOW may be split horizontally when the following conditions
32hold:
33- `window-size-fixed' is either nil or equals `height' for the
34 buffer of WINDOW.
35- `split-width-threshold' is an integer and WINDOW is at least as
36 wide as `split-width-threshold'.
37- When WINDOW is split evenly, the emanating windows are at least
38 `window-min-width' or two (whichever is larger) columns wide."
39 (when (and (window-live-p window)
40 (not (window-parameter window 'window-side)))
41 (with-current-buffer (window-buffer window)
42 (if horizontal
43 ;; A window can be split horizontally when its width is not
44 ;; fixed, it is at least `split-width-threshold' columns wide
45 ;; and at least twice as wide as `window-min-width' and 2 (the
46 ;; latter value is hardcoded).
47 (and (memq window-size-fixed '(nil height))
48 ;; Testing `window-full-width-p' here hardly makes any
49 ;; sense nowadays. This can be done more intuitively by
50 ;; setting up `split-width-threshold' appropriately.
51 (numberp split-width-threshold)
52 (>= (window-total-width window)
53 (max split-width-threshold
54 (* 2 (max window-min-width 2)))))
55 ;; A window can be split vertically when its height is not
56 ;; fixed, it is at least `split-height-threshold' lines high,
57 ;; and it is at least twice as high as `window-min-height' and 2
58 ;; if it has a mode line or 1.
59 (and (memq window-size-fixed '(nil width))
60 (numberp split-height-threshold)
61 (>= (window-height window)
62 (max split-height-threshold
63 (* 2 (max window-min-height
64 (if mode-line-format 2 1))))))))))
65
66(defun split-window-sensibly (&optional window)
67 "Split WINDOW in a way suitable for `display-buffer'.
68WINDOW defaults to the currently selected window.
69If `split-height-threshold' specifies an integer, WINDOW is at
70least `split-height-threshold' lines tall and can be split
71vertically, split WINDOW into two windows one above the other and
72return the lower window. Otherwise, if `split-width-threshold'
73specifies an integer, WINDOW is at least `split-width-threshold'
74columns wide and can be split horizontally, split WINDOW into two
75windows side by side and return the window on the right. If this
76can't be done either and WINDOW is the only window on its frame,
77try to split WINDOW vertically disregarding any value specified
78by `split-height-threshold'. If that succeeds, return the lower
79window. Return nil otherwise.
80
81By default `display-buffer' routines call this function to split
82the largest or least recently used window. To change the default
83customize the option `split-window-preferred-function'.
84
85You can enforce this function to not split WINDOW horizontally,
86by setting (or binding) the variable `split-width-threshold' to
87nil. If, in addition, you set `split-height-threshold' to zero,
88chances increase that this function does split WINDOW vertically.
89
90In order to not split WINDOW vertically, set (or bind) the
91variable `split-height-threshold' to nil. Additionally, you can
92set `split-width-threshold' to zero to make a horizontal split
93more likely to occur.
94
95Have a look at the function `window-splittable-p' if you want to
96know how `split-window-sensibly' determines whether WINDOW can be
97split."
98 (let ((window (or window (selected-window))))
99 (or (and (window-splittable-p window)
100 ;; Split window vertically.
101 (with-selected-window window
102 (split-window-below)))
103 (and (window-splittable-p window t)
104 ;; Split window horizontally.
105 (with-selected-window window
106 (split-window-right)))
107 (and
108 ;; If WINDOW is the only usable window on its frame (it is
109 ;; the only one or, not being the only one, all the other
110 ;; ones are dedicated) and is not the minibuffer window, try
111 ;; to split it vertically disregarding the value of
112 ;; `split-height-threshold'.
113 (let ((frame (window-frame window)))
114 (or
115 (eq window (frame-root-window frame))
116 (catch 'done
117 (walk-window-tree (lambda (w)
118 (unless (or (eq w window)
119 (window-dedicated-p w))
120 (throw 'done nil)))
121 frame nil 'nomini)
122 t)))
123 (not (window-minibuffer-p window))
124 (let ((split-height-threshold 0))
125 (when (window-splittable-p window)
126 (with-selected-window window
127 (split-window-below))))))))
128
129(provide '+window)
130;;; +window.el ends here
diff --git a/lisp/+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'.
51OLDFN is the wrapped function, that is passed the arguments
52ARGS."
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.
62If Emacs is already started, run FUNCTION. Otherwise, add it to 35FN 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.
70Convenience macro wrapper around `+ensure-after-init'." 42FEATURES 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))) 44BODY 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)
76I 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
87If 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)) 62Convenience 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)
99By default, act on all buffers. 71 (symbol-value map)
100 72 map)
101Both PREDICATE-OR-MODES and FUNC are called with no arguments, 73 key def)))))
102but within a `with-current-buffer' form on the currently-active 74
103buffer. 75(defmacro setq-local-hook (hook &rest args)
104 76 "Run `setq-local' on ARGS when running HOOK."
105As a special case, if PREDICATE-OR-MODES is a list, it will be
106interpreted as a list of major modes. In this case, FUNC will
107only be called on buffers derived from one of the modes in
108PREDICATE-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.
122Called interactively, this function acts on the region, if
123active, 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.
149A paragraph is defined as continguous non-empty lines of text
150surrounded by empty lines, so opening a paragraph means to make
151three blank lines, then place the point on the second one.
152
153Called 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.
171With non-nil ARG (\\[universal-argument] interactively), don't
172prompt for a buffer to switch to. This function will split the
173window using `split-window-sensibly', or open the new window in
174the direction specified by WHERE. WHERE is ignored when called
175interactively; 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.
209With 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.
215With 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.
221UNIT 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.
268Use 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.
279Specs is an alist: its cars are faces and its cdrs are the plist
280passed to `set-face-attribute'. Note that the FRAME argument is
281always 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.
341A paragraph here is simply defined: it's a block of buffer that's
342separated 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.
355See `+forward-paragraph' for the behavior."
356 (interactive "p")
357 (+forward-paragraph (- arg)))
358
359(defun +concat (&rest strings)
360 "Concat STRINGS separated by SEPARATOR.
361Each item in STRINGS is either a string or a list or strings,
362which is concatenated without any separator.
363
364SEPARATOR 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.
386PR-ARGS is the list of arguments to pass to
387`make-progress-reporter'; it can be a single string for the
388message, as well. If you want to use a formatted string, wrap
389the `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) 96If OBJECT is already a list, return OBJECT itself. If it's
410 "Create a new scratch buffer and switch to it. 97not a list, return a one-element list containing OBJECT."
411If the region is active, paste its contents into the scratch 98 (if (listp object)
412buffer. The scratch buffer inherits the mode of the current 99 object
413buffer unless NOMODE is non-nil. When called interactively, 100 (list object))))
414NOMODE 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))) 104LISTS can be one list variable or a list.
418 (paste (and (region-active-p) 105Each 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) 114Each function in FUNCTIONS can be a singleton or a list of the
428 (ignore-errors (funcall mode))) 115form (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.
436This 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.
446REVERSE non-nil means descending order; interactively, REVERSE is
447the prefix argument, and BEG and END are the region. The
448variable `sort-fold-case' determines whether case affects the
449sort 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.
51RESET 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.
8ALIST contains cells of the form (SYMBOL . NEW-VALUE), where
9SYMBOL is a variable or mode name, and its value is what to set
10after `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.
16Run `rehash-exes' to refresh this variable.")
17
18(defun rehash-exes ()
19 "List all the executables in $PATH.
20Also 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.
61Only recommended for short-lived requests because of short
62lifetime (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.
69Used for server to server communication without user
70interaction (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.
97MAX is the max files to list; it defaults to 30. QUERY is the
98query to pass; the default is \"trashed = false and 'me' in
99owners\"."
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.
120COMMAND, if not a list, will be made a list and appended to
121`gdrive-bin'.
122BUFFER 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.
14Use the command `hide-cursor-mode' to change this variable."))
15 (defun hide-cursor-mode
16 (&optional arg)
17 "Hide or show the cursor.
18
19This is a minor mode. If called interactively, toggle the
20`Hide-Cursor mode' mode. If the prefix argument is positive,
21enable the mode, and if it is zero or negative, disable the mode.
22
23If called from Lisp, toggle the mode if ARG is `toggle'. Enable
24the mode if ARG is nil, omitted, or is a positive number.
25Disable the mode if ARG is a negative number.
26
27To check whether the minor mode is enabled in the current buffer,
28evaluate `hide-cursor-mode'.
29
30The mode's hook is called both when the mode is enabled and when
31it is disabled.
32
33When the cursor is hidden `scroll-lock-mode' is enabled, so that
34the 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'.
89No 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'.
13The car of each cell is the variable name, and the cdr is the
14value 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'.
21The car of each cell is the function name, and the cdr is the
22value 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.
45FUNC 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.
38Set this in your system files."
39 :type 'string)
40
41(defcustom system-default-height 100
42 "The height used for the `default' face.
43Set 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.
51Set 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.
56A floating-point number is recommended, since that makes it
57relative to the `default' face height.
58
59Set 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.
64The 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.
74The keys are as follows:
75
76- :name - `system-name'
77- :type - `system-type'
78- :user - `user-login-name'
79
80Each value is made safe to be a file name by passing through
81`system--safe'.
82
83Do 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.
87Do 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.
94This 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).
107This 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.
122The system load-files should live in `system-load-directory', and
123named 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
127The second form of file-name is to work around name collisions,
128e.g. if a there's a user named \"bob\" and a system named
129\"bob\".
130
131This 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'.
149Each list in `system-files' will be considered item-by-item; the
150first found file in each will be loaded.
151
152ERROR determines how to deal with errors: if nil, warn the user
153when no system-files can be found or when the system being used
154cannot be determined. If t, these warnings are elevated to
155errors. Any other value ignores the warnings completely.
156
157NOMESSAGE 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'.
28This option is only useful is `user-save-mode' is active when
29Emacs 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.
38Each predicate will be called with no arguments, and if it
39returns 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'.
55This 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.
59If WHICH is `'before', run `user-save-before-save-hook';
60if it's `after', run `user-save-after-save-hook'.
61This 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.
67BUFFER-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.
73This function is precisely the same as `save-buffer', but with
74one modification: it also runs functions in `user-save-hook'.
75This means that if you have some functionality in Emacs to
76automatically save buffers periodically, but have hooks you want
77to automatically run when the buffer saves that are
78computationally expensive or just aren't something you want to
79run all the time, put them in `user-save-hook'.
80
81ARG 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.
91This function does not ask the user about each buffer, but PRED
92is used in almost the same way as `save-some-buffers': if it's
93nil or t, it will save all file-visiting modified buffers; if
94it's a zero-argument function, that will be called to determine
95whether 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.
121The 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'.
25If DIR is passed, clone there; otherwise just clone. Return the
26directory 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.
37If PKG is not installed, install it from REPO. Packages will be
38installed 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.
69Similar-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))))))