about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-01-21 16:34:55 -0600
committerCase Duckworth2022-01-21 16:34:55 -0600
commitadf815b61bfd850e948e60b743ce48b0ff42d901 (patch)
tree124851afc4f05ed898fc5ee2e7c0cfdab25fc06f /lisp
parentFix mode-line-bell recipe (diff)
downloademacs-adf815b61bfd850e948e60b743ce48b0ff42d901.tar.gz
emacs-adf815b61bfd850e948e60b743ce48b0ff42d901.zip
Two out of three ain't bad
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+crux.el6
-rw-r--r--lisp/+elfeed.el7
-rw-r--r--lisp/acdw.el52
-rw-r--r--lisp/compat.el240
-rw-r--r--lisp/dawn.el74
-rw-r--r--lisp/fibs.el37
6 files changed, 323 insertions, 93 deletions
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
15passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if 15passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if
16one was." 16one 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.
60This 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.
72With RESET, this function will call itself with its own
73arguments. That's really only useful within this function
74itself."
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.
111If Emacs is already started, run FUNCTION. Otherwise, add it to 61If 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.
22KEY is a string that satisfies `key-valid-p'.
23
24If KEYMAP is nil, look up in the current keymaps. If non-nil, it
25should either be a keymap or a list of keymaps, and only these
26keymap(s) will be consulted.
27
28The binding is probably a symbol with a function definition.
29
30Normally, `keymap-lookup' ignores bindings for t, which act as
31default bindings, used when nothing else in the keymap applies;
32this makes it usable as a general function for probing keymaps.
33However, if the optional second argument ACCEPT-DEFAULT is
34non-nil, `keymap-lookup' does recognize the default bindings,
35just as `read-key-sequence' does.
36
37Like the normal command loop, `keymap-lookup' will remap the
38command resulting from looking up KEY by looking up the command
39in the current keymaps. However, if the optional third argument
40NO-REMAP is non-nil, `keymap-lookup' returns the unmapped
41command.
42
43If KEY is a key sequence initiated with the mouse, the used keymaps
44will depend on the clicked mouse position with regard to the buffer
45and possible local keymaps on strings.
46
47If the optional argument POSITION is non-nil, it specifies a mouse
48position as returned by `event-start' and `event-end', and the lookup
49occurs in the keymaps associated with it instead of KEY. It can also
50be a number or marker, in which case the keymap properties at the
51specified 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.
73A key is a string consisting of one or more key strokes.
74The key strokes are separated by single space characters.
75
76Each key stroke is either a single character, or the name of an
77event, surrounded by angle brackets. In addition, any key stroke
78may be preceded by one or more modifier keys. Finally, a limited
79number of characters have a special shorthand syntax.
80
81Here'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
91These are the characters that have shorthand syntax:
92NUL, RET, TAB, LFD, ESC, SPC, DEL.
93
94Modifiers have to be specified in this order:
95
96 A-C-H-M-S-s
97
98which 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.
138See `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.
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/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