diff options
-rw-r--r-- | early-init.el | 4 | ||||
-rw-r--r-- | init.el | 31 | ||||
-rw-r--r-- | lisp/+crux.el | 6 | ||||
-rw-r--r-- | lisp/+elfeed.el | 7 | ||||
-rw-r--r-- | lisp/acdw.el | 52 | ||||
-rw-r--r-- | lisp/compat.el | 240 | ||||
-rw-r--r-- | lisp/dawn.el | 74 | ||||
-rw-r--r-- | lisp/fibs.el | 37 |
8 files changed, 353 insertions, 98 deletions
diff --git a/early-init.el b/early-init.el index c379934..068770c 100644 --- a/early-init.el +++ b/early-init.el | |||
@@ -45,6 +45,7 @@ | |||
45 | 45 | ||
46 | (push (locate-user-emacs-file "lisp") load-path) | 46 | (push (locate-user-emacs-file "lisp") load-path) |
47 | (require 'acdw) | 47 | (require 'acdw) |
48 | (require 'compat) | ||
48 | 49 | ||
49 | (+define-dir .etc (locate-user-emacs-file ".etc") | 50 | (+define-dir .etc (locate-user-emacs-file ".etc") |
50 | "Directory for all of Emacs's various files. | 51 | "Directory for all of Emacs's various files. |
@@ -146,7 +147,8 @@ See `no-littering' for examples.") | |||
146 | (dolist (pkg '(el-patch | 147 | (dolist (pkg '(el-patch |
147 | no-littering | 148 | no-littering |
148 | setup | 149 | setup |
149 | straight)) ; already installed, but what the hell | 150 | straight ; already installed, but what the hell |
151 | )) | ||
150 | (straight-use-package pkg) | 152 | (straight-use-package pkg) |
151 | (require pkg) | 153 | (require pkg) |
152 | (require (intern (format "+%s" pkg)) nil :noerror)) | 154 | (require (intern (format "+%s" pkg)) nil :noerror)) |
diff --git a/init.el b/init.el index b930513..6940a12 100644 --- a/init.el +++ b/init.el | |||
@@ -143,6 +143,10 @@ | |||
143 | '("firefox" | 143 | '("firefox" |
144 | "chromium" | 144 | "chromium" |
145 | "chrome")) | 145 | "chrome")) |
146 | browse-url-chrome-program (seq-some #'executable-find | ||
147 | '("chromium" | ||
148 | "chrome" | ||
149 | "google-chrome-stable")) | ||
146 | browse-url-generic-args (seq-some (lambda (e) | 150 | browse-url-generic-args (seq-some (lambda (e) |
147 | (when (equal (executable-find (car e)) | 151 | (when (equal (executable-find (car e)) |
148 | browse-url-generic-program) | 152 | browse-url-generic-program) |
@@ -488,7 +492,7 @@ | |||
488 | org-tags-column (- (- fill-column (length org-ellipsis))) | 492 | org-tags-column (- (- fill-column (length org-ellipsis))) |
489 | org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" | 493 | org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" |
490 | "|" "DONE(d!)") | 494 | "|" "DONE(d!)") |
491 | (sequence "|" "CANCELED(k!)") | 495 | (sequence "|" "CANCELED(k@/!)") |
492 | (sequence "MEETING(m)"))) | 496 | (sequence "MEETING(m)"))) |
493 | (:bind "RET" #'+org-return-dwim | 497 | (:bind "RET" #'+org-return-dwim |
494 | "<S-return>" #'+org-table-copy-down | 498 | "<S-return>" #'+org-table-copy-down |
@@ -595,7 +599,7 @@ | |||
595 | 599 | ||
596 | (setup scratch | 600 | (setup scratch |
597 | (:require +scratch) | 601 | (:require +scratch) |
598 | (:option initial-major-mode #'lisp-interaction-mode | 602 | (:option initial-major-mode #'emacs-lisp-mode |
599 | initial-scratch-message | 603 | initial-scratch-message |
600 | ";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n") | 604 | ";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n") |
601 | (add-hook 'kill-buffer-query-functions #'+scratch-immortal)) | 605 | (add-hook 'kill-buffer-query-functions #'+scratch-immortal)) |
@@ -1089,6 +1093,8 @@ See also `crux-reopen-as-root-mode'." | |||
1089 | "&" #'+elfeed-show-browse-generic | 1093 | "&" #'+elfeed-show-browse-generic |
1090 | "RET" #'shr-browse-url) | 1094 | "RET" #'shr-browse-url) |
1091 | (:hook #'reading-mode) | 1095 | (:hook #'reading-mode) |
1096 | (:option +elfeed--update-repeat (* 60 60) ; 1 hour | ||
1097 | +elfeed--update-first-time 60) | ||
1092 | (+elfeed-update-async-mode +1))) | 1098 | (+elfeed-update-async-mode +1))) |
1093 | 1099 | ||
1094 | (setup (:straight elfeed-org) | 1100 | (setup (:straight elfeed-org) |
@@ -1350,6 +1356,14 @@ See also `crux-reopen-as-root-mode'." | |||
1350 | #'hl-line-mode | 1356 | #'hl-line-mode |
1351 | #'lin-mode)) | 1357 | #'lin-mode)) |
1352 | 1358 | ||
1359 | (setup (:straight md4rd) | ||
1360 | ;; `md4rd' is ... a bit janky, tbh. But I'm including this here so I have it. | ||
1361 | ;; TODO: enable opening Reddit links in md4rd | ||
1362 | (:also-load _md4rd) | ||
1363 | (defalias 'reddit 'md4rd "Browse Reddit.") | ||
1364 | (with-eval-after-load 'md4rd | ||
1365 | (run-with-timer 0 (* 60 59) 'md4rd-refresh-login))) | ||
1366 | |||
1353 | (setup (:straight minions) | 1367 | (setup (:straight minions) |
1354 | (minions-mode +1)) | 1368 | (minions-mode +1)) |
1355 | 1369 | ||
@@ -1364,11 +1378,12 @@ See also `crux-reopen-as-root-mode'." | |||
1364 | :host gitlab | 1378 | :host gitlab |
1365 | :repo "protesilaos/modus-themes")) | 1379 | :repo "protesilaos/modus-themes")) |
1366 | (require 'modus-themes (.etc "straight/build/modus-themes/modus-themes")) | 1380 | (require 'modus-themes (.etc "straight/build/modus-themes/modus-themes")) |
1381 | (:also-load dawn) | ||
1367 | (:option modus-themes-mixed-fonts t | 1382 | (:option modus-themes-mixed-fonts t |
1368 | modus-themes-bold-constructs t | 1383 | modus-themes-bold-constructs t |
1369 | modus-themes-italic-constructs t | 1384 | modus-themes-italic-constructs t |
1370 | modus-themes-headings '((t . (background)))) | 1385 | modus-themes-headings '((t . (background)))) |
1371 | (+sunrise-sunset 'modus-themes-load-operandi 'modus-themes-load-vivendi)) | 1386 | (dawn-schedule #'modus-themes-load-operandi #'modus-themes-load-vivendi)) |
1372 | 1387 | ||
1373 | (setup (:straight mwim) | 1388 | (setup (:straight mwim) |
1374 | (:require +mwim) | 1389 | (:require +mwim) |
@@ -1379,7 +1394,7 @@ See also `crux-reopen-as-root-mode'." | |||
1379 | "C-e" #'+mwim-end-maybe)) | 1394 | "C-e" #'+mwim-end-maybe)) |
1380 | 1395 | ||
1381 | (setup (:straight orderless) | 1396 | (setup (:straight orderless) |
1382 | (:also-load +orderless) | 1397 | (:require +orderless) |
1383 | (:option completion-styles '(substring orderless basic) | 1398 | (:option completion-styles '(substring orderless basic) |
1384 | completion-category-defaults nil | 1399 | completion-category-defaults nil |
1385 | completion-category-overrides | 1400 | completion-category-overrides |
@@ -1447,6 +1462,8 @@ See also `crux-reopen-as-root-mode'." | |||
1447 | ;; Ensure we can build `pdf-tools' | 1462 | ;; Ensure we can build `pdf-tools' |
1448 | (or (executable-find "gcc") | 1463 | (or (executable-find "gcc") |
1449 | (executable-find "g++"))) | 1464 | (executable-find "g++"))) |
1465 | (setf (alist-get "\\.pdf\\'" auto-mode-alist nil nil #'equal) | ||
1466 | #'pdf-view-modei) | ||
1450 | (pdf-tools-install t)) | 1467 | (pdf-tools-install t)) |
1451 | 1468 | ||
1452 | (setup (:straight (shell-command+ | 1469 | (setup (:straight (shell-command+ |
@@ -1590,6 +1607,11 @@ See also `crux-reopen-as-root-mode'." | |||
1590 | undo-fu-session-compression (executable-find "gzip")) | 1607 | undo-fu-session-compression (executable-find "gzip")) |
1591 | (global-undo-fu-session-mode +1)) | 1608 | (global-undo-fu-session-mode +1)) |
1592 | 1609 | ||
1610 | (setup (:straight valign) | ||
1611 | (:option valign-fancy-bar t) | ||
1612 | (:hook-into org-mode | ||
1613 | markdown-mode)) | ||
1614 | |||
1593 | (setup (:straight (vertico | 1615 | (setup (:straight (vertico |
1594 | :host github | 1616 | :host github |
1595 | :repo "minad/vertico" | 1617 | :repo "minad/vertico" |
@@ -1624,6 +1646,7 @@ See also `crux-reopen-as-root-mode'." | |||
1624 | ;; This is applied /after/ the above, so default is at the end of | 1646 | ;; This is applied /after/ the above, so default is at the end of |
1625 | ;; this alist. | 1647 | ;; this alist. |
1626 | vertico-multiform-categories '((file buffer grid) | 1648 | vertico-multiform-categories '((file buffer grid) |
1649 | (bookmark) | ||
1627 | (t flat))) | 1650 | (t flat))) |
1628 | (dolist (buf-cmd '(consult-find | 1651 | (dolist (buf-cmd '(consult-find |
1629 | consult-yank-pop | 1652 | consult-yank-pop |
diff --git a/lisp/+crux.el b/lisp/+crux.el index b87ec7e..45b4dee 100644 --- a/lisp/+crux.el +++ b/lisp/+crux.el | |||
@@ -15,8 +15,10 @@ Copy from BEGIN to END using `kill-ring-save' if no argument was | |||
15 | passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if | 15 | passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if |
16 | one was." | 16 | one was." |
17 | (interactive "r\nP") | 17 | (interactive "r\nP") |
18 | (call-interactively (if arg #'kill-ring-save | 18 | (call-interactively (if arg |
19 | #'crux-indent-rigidly-and-copy-to-clipboard))) | 19 | #'crux-indent-rigidly-and-copy-to-clipboard |
20 | #'kill-ring-save)) | ||
21 | (pulse-momentary-highlight-region begin end)) | ||
20 | 22 | ||
21 | (defcustom +crux-default-date-format "%c" | 23 | (defcustom +crux-default-date-format "%c" |
22 | "Default date format to use for `+crux-insert-date-or-time'. | 24 | "Default date format to use for `+crux-insert-date-or-time'. |
diff --git a/lisp/+elfeed.el b/lisp/+elfeed.el index ef93347..47ada47 100644 --- a/lisp/+elfeed.el +++ b/lisp/+elfeed.el | |||
@@ -40,8 +40,9 @@ | |||
40 | 40 | ||
41 | (defun +elfeed-update-command () | 41 | (defun +elfeed-update-command () |
42 | (interactive) | 42 | (interactive) |
43 | (let ((script (expand-file-name "~/.local/bin/elfeed"))) | 43 | (let ((script (expand-file-name "~/.local/bin/elfeed")) |
44 | (message "[Elfeed] Updating in the background.") | 44 | (update-message-format "[Elfeed] Updating in the background...%s")) |
45 | (message update-message-format "") | ||
45 | (setq +elfeed--update-running t) | 46 | (setq +elfeed--update-running t) |
46 | (elfeed-db-save) | 47 | (elfeed-db-save) |
47 | (advice-add 'elfeed :override #'+elfeed--update-message) | 48 | (advice-add 'elfeed :override #'+elfeed--update-message) |
@@ -69,7 +70,7 @@ | |||
69 | (lambda (a b) | 70 | (lambda (a b) |
70 | (advice-remove 'elfeed #'+elfeed--update-message) | 71 | (advice-remove 'elfeed #'+elfeed--update-message) |
71 | (setq +elfeed--update-running nil) | 72 | (setq +elfeed--update-running nil) |
72 | (message "[Elfeed] Background update %s." | 73 | (message update-message-format |
73 | (string-trim b)))))) | 74 | (string-trim b)))))) |
74 | 75 | ||
75 | (defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.") | 76 | (defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.") |
diff --git a/lisp/acdw.el b/lisp/acdw.el index 34d1bc4..4e5afb5 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -20,6 +20,7 @@ | |||
20 | ;;; Code: | 20 | ;;; Code: |
21 | 21 | ||
22 | (require 'diary-lib) | 22 | (require 'diary-lib) |
23 | (require 'solar) ; for +sunrise-sunset | ||
23 | 24 | ||
24 | ;;; Define a directory and an expanding function | 25 | ;;; Define a directory and an expanding function |
25 | 26 | ||
@@ -55,57 +56,6 @@ ARGS." | |||
55 | (when msg | 56 | (when msg |
56 | (message "%s" msg))))) | 57 | (message "%s" msg))))) |
57 | 58 | ||
58 | (defun +sunrise-sunset--encode (time) | ||
59 | "Encode diary-style time string into a time. | ||
60 | This is stolen from `run-at-time'." | ||
61 | (let ((hhmm (diary-entry-time time)) | ||
62 | (now (decode-time))) | ||
63 | (encode-time (list 0 (% hhmm 100) (/ hhmm 100) | ||
64 | (decoded-time-day now) | ||
65 | (decoded-time-month now) | ||
66 | (decoded-time-year now) | ||
67 | nil -1 | ||
68 | (decoded-time-zone now))))) | ||
69 | |||
70 | (defun +sunrise-sunset (sunrise-command sunset-command &optional reset) | ||
71 | "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset. | ||
72 | With RESET, this function will call itself with its own | ||
73 | arguments. That's really only useful within this function | ||
74 | itself." | ||
75 | (let* ((times-regex (rx (* nonl) | ||
76 | (: (any ?s ?S) "unrise") " " | ||
77 | (group (repeat 1 2 digit) ":" | ||
78 | (repeat 1 2 digit) | ||
79 | (: (any ?a ?A ?p ?P) (any ?m ?M))) | ||
80 | (* nonl) | ||
81 | (: (any ?s ?S) "unset") " " | ||
82 | (group (repeat 1 2 digit) ":" | ||
83 | (repeat 1 2 digit) | ||
84 | (: (any ?a ?A ?p ?P) (any ?m ?M))) | ||
85 | (* nonl))) | ||
86 | (ss (+suppress-messages #'sunrise-sunset)) | ||
87 | (_m (string-match times-regex ss)) | ||
88 | (sunrise (match-string 1 ss)) | ||
89 | (sunset (match-string 2 ss)) | ||
90 | (sunrise-time (+sunrise-sunset--encode sunrise)) | ||
91 | (sunset-time (+sunrise-sunset--encode sunset))) | ||
92 | (cond | ||
93 | ((time-less-p nil sunrise-time) | ||
94 | ;; If it isn't sunrise yet, it's still dark---and so we need to run the | ||
95 | ;; sunset-command. | ||
96 | (funcall sunset-command) | ||
97 | (run-at-time sunrise nil sunrise-command)) | ||
98 | ((time-less-p nil sunset-time) | ||
99 | ;; If it isn't sunset yet, it's still light---so we need to run the | ||
100 | ;; sunrise-command. | ||
101 | (funcall sunrise-command) | ||
102 | (run-at-time sunset nil sunset-command)) | ||
103 | (t (run-at-time "12:00am" nil sunset-command))) | ||
104 | ;; Reset everything at midnight | ||
105 | (unless reset | ||
106 | (run-at-time "12:00am" (* 60 60 24) | ||
107 | #'+sunrise-sunset sunrise-command sunset-command t)))) | ||
108 | |||
109 | (defun +ensure-after-init (function) | 59 | (defun +ensure-after-init (function) |
110 | "Ensure FUNCTION runs after init, or now if already initialized. | 60 | "Ensure FUNCTION runs after init, or now if already initialized. |
111 | If Emacs is already started, run FUNCTION. Otherwise, add it to | 61 | If Emacs is already started, run FUNCTION. Otherwise, add it to |
diff --git a/lisp/compat.el b/lisp/compat.el new file mode 100644 index 0000000..3107a0c --- /dev/null +++ b/lisp/compat.el | |||
@@ -0,0 +1,240 @@ | |||
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 | (unless (fboundp 'keymap--compile-check) | ||
13 | (defun keymap--compile-check (&rest keys) | ||
14 | (dolist (key keys) | ||
15 | (when (or (vectorp key) | ||
16 | (and (stringp key) (not (key-valid-p key)))) | ||
17 | (byte-compile-warn "Invalid `kbd' syntax: %S" key))))) | ||
18 | |||
19 | (unless (fboundp 'keymap-lookup) | ||
20 | (defun keymap-lookup (keymap key &optional accept-default no-remap position) | ||
21 | "Return the binding for command KEY. | ||
22 | KEY is a string that satisfies `key-valid-p'. | ||
23 | |||
24 | If KEYMAP is nil, look up in the current keymaps. If non-nil, it | ||
25 | should either be a keymap or a list of keymaps, and only these | ||
26 | keymap(s) will be consulted. | ||
27 | |||
28 | The binding is probably a symbol with a function definition. | ||
29 | |||
30 | Normally, `keymap-lookup' ignores bindings for t, which act as | ||
31 | default bindings, used when nothing else in the keymap applies; | ||
32 | this makes it usable as a general function for probing keymaps. | ||
33 | However, if the optional second argument ACCEPT-DEFAULT is | ||
34 | non-nil, `keymap-lookup' does recognize the default bindings, | ||
35 | just as `read-key-sequence' does. | ||
36 | |||
37 | Like the normal command loop, `keymap-lookup' will remap the | ||
38 | command resulting from looking up KEY by looking up the command | ||
39 | in the current keymaps. However, if the optional third argument | ||
40 | NO-REMAP is non-nil, `keymap-lookup' returns the unmapped | ||
41 | command. | ||
42 | |||
43 | If KEY is a key sequence initiated with the mouse, the used keymaps | ||
44 | will depend on the clicked mouse position with regard to the buffer | ||
45 | and possible local keymaps on strings. | ||
46 | |||
47 | If the optional argument POSITION is non-nil, it specifies a mouse | ||
48 | position as returned by `event-start' and `event-end', and the lookup | ||
49 | occurs in the keymaps associated with it instead of KEY. It can also | ||
50 | be a number or marker, in which case the keymap properties at the | ||
51 | specified buffer position instead of point are used." | ||
52 | (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) | ||
53 | (keymap--check key) | ||
54 | (when (and keymap position) | ||
55 | (error "Can't pass in both keymap and position")) | ||
56 | (if keymap | ||
57 | (let ((value (lookup-key keymap (key-parse key) accept-default))) | ||
58 | (if (and (not no-remap) | ||
59 | (symbolp value)) | ||
60 | (or (command-remapping value) value) | ||
61 | value)) | ||
62 | (key-binding (kbd key) accept-default no-remap position)))) | ||
63 | |||
64 | (unless (fboundp 'keymap--check) | ||
65 | (defun keymap--check (key) | ||
66 | "Signal an error if KEY doesn't have a valid syntax." | ||
67 | (unless (key-valid-p key) | ||
68 | (error "%S is not a valid key definition; see `key-valid-p'" key)))) | ||
69 | |||
70 | (unless (fboundp 'key-valid-p) | ||
71 | (defun key-valid-p (keys) | ||
72 | "Say whether KEYS is a valid key. | ||
73 | A key is a string consisting of one or more key strokes. | ||
74 | The key strokes are separated by single space characters. | ||
75 | |||
76 | Each key stroke is either a single character, or the name of an | ||
77 | event, surrounded by angle brackets. In addition, any key stroke | ||
78 | may be preceded by one or more modifier keys. Finally, a limited | ||
79 | number of characters have a special shorthand syntax. | ||
80 | |||
81 | Here's some example key sequences. | ||
82 | |||
83 | \"f\" (the key 'f') | ||
84 | \"S o m\" (a three key sequence of the keys 'S', 'o' and 'm') | ||
85 | \"C-c o\" (a two key sequence of the keys 'c' with the control modifier | ||
86 | and then the key 'o') | ||
87 | \"H-<left>\" (the key named \"left\" with the hyper modifier) | ||
88 | \"M-RET\" (the \"return\" key with a meta modifier) | ||
89 | \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers) | ||
90 | |||
91 | These are the characters that have shorthand syntax: | ||
92 | NUL, RET, TAB, LFD, ESC, SPC, DEL. | ||
93 | |||
94 | Modifiers have to be specified in this order: | ||
95 | |||
96 | A-C-H-M-S-s | ||
97 | |||
98 | which is | ||
99 | |||
100 | Alt-Control-Hyper-Meta-Shift-super" | ||
101 | (declare (pure t) (side-effect-free t)) | ||
102 | (and | ||
103 | (stringp keys) | ||
104 | (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) | ||
105 | (save-match-data | ||
106 | (catch 'exit | ||
107 | (let ((prefixes | ||
108 | "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?") | ||
109 | (case-fold-search nil)) | ||
110 | (dolist (key (split-string keys " ")) | ||
111 | ;; Every key might have these modifiers, and they should be | ||
112 | ;; in this order. | ||
113 | (when (string-match (concat "\\`" prefixes) key) | ||
114 | (setq key (substring key (match-end 0)))) | ||
115 | (unless (or (and (= (length key) 1) | ||
116 | ;; Don't accept control characters as keys. | ||
117 | (not (< (aref key 0) ?\s)) | ||
118 | ;; Don't accept Meta'd characters as keys. | ||
119 | (or (multibyte-string-p key) | ||
120 | (not (<= 127 (aref key 0) 255)))) | ||
121 | (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key) | ||
122 | ;; Don't allow <M-C-down>. | ||
123 | (= (progn | ||
124 | (string-match | ||
125 | (concat "\\`<" prefixes) key) | ||
126 | (match-end 0)) | ||
127 | 1)) | ||
128 | (string-match-p | ||
129 | "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" | ||
130 | key)) | ||
131 | ;; Invalid. | ||
132 | (throw 'exit nil))) | ||
133 | t)))))) | ||
134 | |||
135 | (unless (fboundp 'key-parse) | ||
136 | (defun key-parse (keys) | ||
137 | "Convert KEYS to the internal Emacs key representation. | ||
138 | See `kbd' for a descripion of KEYS." | ||
139 | (declare (pure t) (side-effect-free t)) | ||
140 | ;; A pure function is expected to preserve the match data. | ||
141 | (save-match-data | ||
142 | (let ((case-fold-search nil) | ||
143 | (len (length keys)) ; We won't alter keys in the loop below. | ||
144 | (pos 0) | ||
145 | (res [])) | ||
146 | (while (and (< pos len) | ||
147 | (string-match "[^ \t\n\f]+" keys pos)) | ||
148 | (let* ((word-beg (match-beginning 0)) | ||
149 | (word-end (match-end 0)) | ||
150 | (word (substring keys word-beg len)) | ||
151 | (times 1) | ||
152 | key) | ||
153 | ;; Try to catch events of the form "<as df>". | ||
154 | (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) | ||
155 | (setq word (match-string 0 word) | ||
156 | pos (+ word-beg (match-end 0))) | ||
157 | (setq word (substring keys word-beg word-end) | ||
158 | pos word-end)) | ||
159 | (when (string-match "\\([0-9]+\\)\\*." word) | ||
160 | (setq times (string-to-number (substring word 0 (match-end 1)))) | ||
161 | (setq word (substring word (1+ (match-end 1))))) | ||
162 | (cond ((string-match "^<<.+>>$" word) | ||
163 | (setq key (vconcat (if (eq (key-binding [?\M-x]) | ||
164 | 'execute-extended-command) | ||
165 | [?\M-x] | ||
166 | (or (car (where-is-internal | ||
167 | 'execute-extended-command)) | ||
168 | [?\M-x])) | ||
169 | (substring word 2 -2) "\r"))) | ||
170 | ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) | ||
171 | (progn | ||
172 | (setq word (concat (match-string 1 word) | ||
173 | (match-string 3 word))) | ||
174 | (not (string-match | ||
175 | "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" | ||
176 | word)))) | ||
177 | (setq key (list (intern word)))) | ||
178 | ((or (equal word "REM") (string-match "^;;" word)) | ||
179 | (setq pos (string-match "$" keys pos))) | ||
180 | (t | ||
181 | (let ((orig-word word) (prefix 0) (bits 0)) | ||
182 | (while (string-match "^[ACHMsS]-." word) | ||
183 | (setq bits (+ bits | ||
184 | (cdr | ||
185 | (assq (aref word 0) | ||
186 | '((?A . ?\A-\^@) (?C . ?\C-\^@) | ||
187 | (?H . ?\H-\^@) (?M . ?\M-\^@) | ||
188 | (?s . ?\s-\^@) (?S . ?\S-\^@)))))) | ||
189 | (setq prefix (+ prefix 2)) | ||
190 | (setq word (substring word 2))) | ||
191 | (when (string-match "^\\^.$" word) | ||
192 | (setq bits (+ bits ?\C-\^@)) | ||
193 | (setq prefix (1+ prefix)) | ||
194 | (setq word (substring word 1))) | ||
195 | (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") | ||
196 | ("LFD" . "\n") ("TAB" . "\t") | ||
197 | ("ESC" . "\e") ("SPC" . " ") | ||
198 | ("DEL" . "\177"))))) | ||
199 | (when found (setq word (cdr found)))) | ||
200 | (when (string-match "^\\\\[0-7]+$" word) | ||
201 | (let ((n 0)) | ||
202 | (dolist (ch (cdr (string-to-list word))) | ||
203 | (setq n (+ (* n 8) ch -48))) | ||
204 | (setq word (vector n)))) | ||
205 | (cond ((= bits 0) | ||
206 | (setq key word)) | ||
207 | ((and (= bits ?\M-\^@) (stringp word) | ||
208 | (string-match "^-?[0-9]+$" word)) | ||
209 | (setq key (mapcar (lambda (x) (+ x bits)) | ||
210 | (append word nil)))) | ||
211 | ((/= (length word) 1) | ||
212 | (error "%s must prefix a single character, not %s" | ||
213 | (substring orig-word 0 prefix) word)) | ||
214 | ((and (/= (logand bits ?\C-\^@) 0) (stringp word) | ||
215 | ;; We used to accept . and ? here, | ||
216 | ;; but . is simply wrong, | ||
217 | ;; and C-? is not used (we use DEL instead). | ||
218 | (string-match "[@-_a-z]" word)) | ||
219 | (setq key (list (+ bits (- ?\C-\^@) | ||
220 | (logand (aref word 0) 31))))) | ||
221 | (t | ||
222 | (setq key (list (+ bits (aref word 0))))))))) | ||
223 | (when key | ||
224 | (dolist (_ (number-sequence 1 times)) | ||
225 | (setq res (vconcat res key)))))) | ||
226 | (if (and (>= (length res) 4) | ||
227 | (eq (aref res 0) ?\C-x) | ||
228 | (eq (aref res 1) ?\() | ||
229 | (eq (aref res (- (length res) 2)) ?\C-x) | ||
230 | (eq (aref res (- (length res) 1)) ?\))) | ||
231 | (apply #'vector (let ((lres (append res nil))) | ||
232 | ;; Remove the first and last two elements. | ||
233 | (setq lres (cdr (cdr lres))) | ||
234 | (nreverse lres) | ||
235 | (setq lres (cdr (cdr lres))) | ||
236 | (nreverse lres))) | ||
237 | res))))) | ||
238 | |||
239 | (provide 'compat) | ||
240 | ;;; compat.el ends here | ||
diff --git a/lisp/dawn.el b/lisp/dawn.el new file mode 100644 index 0000000..a184a84 --- /dev/null +++ b/lisp/dawn.el | |||
@@ -0,0 +1,74 @@ | |||
1 | ;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; There is also circadian.el, but it doesn't quite work for me. | ||
6 | ;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also | ||
7 | ;; somewhere else (which I've forgotten) and my own brain :) | ||
8 | |||
9 | ;;; Code: | ||
10 | |||
11 | (require 'calendar) | ||
12 | (require 'cl-lib) | ||
13 | (require 'solar) | ||
14 | |||
15 | (defvar dawn--dawn-timer nil | ||
16 | "Timer for dawn-command.") | ||
17 | |||
18 | (defvar dawn--dusk-timer nil | ||
19 | "Timer for dusk-command.") | ||
20 | |||
21 | (defvar dawn--reset-timer nil | ||
22 | "Timer to reset dawn at midnight.") | ||
23 | |||
24 | (defun dawn-encode-time (f) | ||
25 | "Encode fractional time F." | ||
26 | (let ((hhmm (cl-floor f)) | ||
27 | (date (cdddr (decode-time)))) | ||
28 | (encode-time | ||
29 | (append (list 0 | ||
30 | (round (* 60 (cadr hhmm))) | ||
31 | (car hhmm) | ||
32 | ) | ||
33 | date)))) | ||
34 | |||
35 | (defun dawn-midnight () | ||
36 | "Return the time of the /next/ midnight." | ||
37 | (let ((date (cdddr (decode-time)))) | ||
38 | (encode-time | ||
39 | (append (list 0 0 0 (1+ (car date))) (cdr date))))) | ||
40 | |||
41 | (defun dawn-sunrise () | ||
42 | "Return the time of today's sunrise." | ||
43 | (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date))))) | ||
44 | |||
45 | (defun dawn-sunset () | ||
46 | "Return the time of today's sunset." | ||
47 | (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) | ||
48 | |||
49 | (defun dawn-schedule (dawn-command dusk-command) | ||
50 | "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. | ||
51 | RESET is an argument for internal use." | ||
52 | (let ((dawn (dawn-sunrise)) | ||
53 | (dusk (dawn-sunset))) | ||
54 | (cond | ||
55 | ((time-less-p nil dawn) | ||
56 | ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule | ||
57 | ;; DAWN-COMMAND and DUSK-COMMAND for later. | ||
58 | (funcall dusk-command) | ||
59 | (run-at-time dawn nil dawn-command) | ||
60 | (run-at-time dusk nil dusk-command)) | ||
61 | ((time-less-p nil dusk) | ||
62 | ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule | ||
63 | ;; DUSK-COMMAND. | ||
64 | (funcall dawn-command) | ||
65 | (run-at-time dusk nil dusk-command)) | ||
66 | (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. | ||
67 | (funcall dusk-command))) | ||
68 | ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. | ||
69 | ;(unless reset) | ||
70 | (run-at-time (dawn-midnight) nil | ||
71 | #'dawn-schedule dawn-command dusk-command))) | ||
72 | |||
73 | (provide 'dawn) | ||
74 | ;;; dawn.el ends here | ||
diff --git a/lisp/fibs.el b/lisp/fibs.el deleted file mode 100644 index 545c2a7..0000000 --- a/lisp/fibs.el +++ /dev/null | |||
@@ -1,37 +0,0 @@ | |||
1 | ;;; fibs.el --- Play backgammon with FIBS -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; fibs.com is one of the oldest backgammon servers out there, and it's | ||
6 | ;; accessible via telnet. This package provides a wrapper to enable you to play | ||
7 | ;; backgammon on fibs.com more easily than just opening a telnet session | ||
8 | ;; yourself. | ||
9 | |||
10 | ;;; TODO: | ||
11 | |||
12 | ;; - Automatically log in. | ||
13 | ;; - Add a `fibs-quit' function to kill the telnet server and buffer. | ||
14 | |||
15 | ;;; Code: | ||
16 | |||
17 | (require 'telnet) | ||
18 | |||
19 | (defgroup fibs nil | ||
20 | "Customizations for FIBS, the First Internet Backgammon Server." | ||
21 | :group 'games) | ||
22 | |||
23 | (defcustom fibs-server "fibs.com" | ||
24 | "The server to connect to FIBS with." | ||
25 | :type 'string) | ||
26 | |||
27 | (defcustom fibs-port 4321 | ||
28 | "The port to connect to FIBS with." | ||
29 | :type 'number) | ||
30 | |||
31 | ;;;###autoload | ||
32 | (defun fibs () | ||
33 | (interactive) | ||
34 | (telnet fibs-server fibs-port)) | ||
35 | |||
36 | (provide 'fibs) | ||
37 | ;;; fibs.el ends here | ||