summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--early-init.el4
-rw-r--r--init.el30
-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
8 files changed, 352 insertions, 98 deletions
diff --git a/early-init.el b/early-init.el index 2569602..40edbe5 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 4eb05bd..93c5c1d 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)
@@ -589,7 +593,7 @@
589 593
590(setup scratch 594(setup scratch
591 (:require +scratch) 595 (:require +scratch)
592 (:option initial-major-mode #'lisp-interaction-mode 596 (:option initial-major-mode #'emacs-lisp-mode
593 initial-scratch-message 597 initial-scratch-message
594 ";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n") 598 ";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n")
595 (add-hook 'kill-buffer-query-functions #'+scratch-immortal)) 599 (add-hook 'kill-buffer-query-functions #'+scratch-immortal))
@@ -1087,7 +1091,8 @@ See also `crux-reopen-as-root-mode'."
1087 "&" #'+elfeed-show-browse-generic 1091 "&" #'+elfeed-show-browse-generic
1088 "RET" #'shr-browse-url) 1092 "RET" #'shr-browse-url)
1089 (:hook #'reading-mode) 1093 (:hook #'reading-mode)
1090 (:option +elfeed--update-first-time 60) 1094 (:option +elfeed--update-repeat (* 60 60) ; 1 hour
1095 +elfeed--update-first-time 60)
1091 (+elfeed-update-async-mode +1))) 1096 (+elfeed-update-async-mode +1)))
1092 1097
1093(setup (:straight elfeed-org) 1098(setup (:straight elfeed-org)
@@ -1355,6 +1360,14 @@ See also `crux-reopen-as-root-mode'."
1355 #'hl-line-mode 1360 #'hl-line-mode
1356 #'lin-mode)) 1361 #'lin-mode))
1357 1362
1363(setup (:straight md4rd)
1364 ;; `md4rd' is ... a bit janky, tbh. But I'm including this here so I have it.
1365 ;; TODO: enable opening Reddit links in md4rd
1366 (:also-load _md4rd)
1367 (defalias 'reddit 'md4rd "Browse Reddit.")
1368 (with-eval-after-load 'md4rd
1369 (run-with-timer 0 (* 60 59) 'md4rd-refresh-login)))
1370
1358(setup (:straight minions) 1371(setup (:straight minions)
1359 (minions-mode +1)) 1372 (minions-mode +1))
1360 1373
@@ -1369,11 +1382,12 @@ See also `crux-reopen-as-root-mode'."
1369 :host gitlab 1382 :host gitlab
1370 :repo "protesilaos/modus-themes")) 1383 :repo "protesilaos/modus-themes"))
1371 (require 'modus-themes (.etc "straight/build/modus-themes/modus-themes")) 1384 (require 'modus-themes (.etc "straight/build/modus-themes/modus-themes"))
1385 (:also-load dawn)
1372 (:option modus-themes-mixed-fonts t 1386 (:option modus-themes-mixed-fonts t
1373 modus-themes-bold-constructs t 1387 modus-themes-bold-constructs t
1374 modus-themes-italic-constructs t 1388 modus-themes-italic-constructs t
1375 modus-themes-headings '((t . (background)))) 1389 modus-themes-headings '((t . (background))))
1376 (+sunrise-sunset 'modus-themes-load-operandi 'modus-themes-load-vivendi)) 1390 (dawn-schedule #'modus-themes-load-operandi #'modus-themes-load-vivendi))
1377 1391
1378(setup (:straight mwim) 1392(setup (:straight mwim)
1379 (:require +mwim) 1393 (:require +mwim)
@@ -1384,7 +1398,7 @@ See also `crux-reopen-as-root-mode'."
1384 "C-e" #'+mwim-end-maybe)) 1398 "C-e" #'+mwim-end-maybe))
1385 1399
1386(setup (:straight orderless) 1400(setup (:straight orderless)
1387 (:also-load +orderless) 1401 (:require +orderless)
1388 (:option completion-styles '(substring orderless basic) 1402 (:option completion-styles '(substring orderless basic)
1389 completion-category-defaults nil 1403 completion-category-defaults nil
1390 completion-category-overrides 1404 completion-category-overrides
@@ -1452,6 +1466,8 @@ See also `crux-reopen-as-root-mode'."
1452 ;; Ensure we can build `pdf-tools' 1466 ;; Ensure we can build `pdf-tools'
1453 (or (executable-find "gcc") 1467 (or (executable-find "gcc")
1454 (executable-find "g++"))) 1468 (executable-find "g++")))
1469 (setf (alist-get "\\.pdf\\'" auto-mode-alist nil nil #'equal)
1470 #'pdf-view-modei)
1455 (pdf-tools-install t)) 1471 (pdf-tools-install t))
1456 1472
1457(setup (:straight (shell-command+ 1473(setup (:straight (shell-command+
@@ -1595,6 +1611,11 @@ See also `crux-reopen-as-root-mode'."
1595 undo-fu-session-compression (executable-find "gzip")) 1611 undo-fu-session-compression (executable-find "gzip"))
1596 (global-undo-fu-session-mode +1)) 1612 (global-undo-fu-session-mode +1))
1597 1613
1614(setup (:straight valign)
1615 (:option valign-fancy-bar t)
1616 (:hook-into org-mode
1617 markdown-mode))
1618
1598(setup (:straight (vertico 1619(setup (:straight (vertico
1599 :host github 1620 :host github
1600 :repo "minad/vertico" 1621 :repo "minad/vertico"
@@ -1629,6 +1650,7 @@ See also `crux-reopen-as-root-mode'."
1629 ;; This is applied /after/ the above, so default is at the end of 1650 ;; This is applied /after/ the above, so default is at the end of
1630 ;; this alist. 1651 ;; this alist.
1631 vertico-multiform-categories '((file buffer grid) 1652 vertico-multiform-categories '((file buffer grid)
1653 (bookmark)
1632 (t flat))) 1654 (t flat)))
1633 (dolist (buf-cmd '(consult-find 1655 (dolist (buf-cmd '(consult-find
1634 consult-yank-pop 1656 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
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 4a874c3..b2a578b 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-update.el"))) 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)
@@ -94,7 +95,7 @@
94 (lambda (a b) 95 (lambda (a b)
95 (advice-remove 'elfeed #'+elfeed--update-message) 96 (advice-remove 'elfeed #'+elfeed--update-message)
96 (setq +elfeed--update-running nil) 97 (setq +elfeed--update-running nil)
97 (message "[Elfeed] Background update %s." 98 (message update-message-format
98 (string-trim b)))))) 99 (string-trim b))))))
99 100
100(defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.") 101(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