Two out of three ain't bad
This commit is contained in:
Case Duckworth
parent
04e917c834
commit
adf815b61b
|
|
@ -45,6 +45,7 @@
|
|||
|
||||
(push (locate-user-emacs-file "lisp") load-path)
|
||||
(require 'acdw)
|
||||
(require 'compat)
|
||||
|
||||
(+define-dir .etc (locate-user-emacs-file ".etc")
|
||||
"Directory for all of Emacs's various files.
|
||||
|
|
@ -146,7 +147,8 @@ See `no-littering' for examples.")
|
|||
(dolist (pkg '(el-patch
|
||||
no-littering
|
||||
setup
|
||||
straight)) ; already installed, but what the hell
|
||||
straight ; already installed, but what the hell
|
||||
))
|
||||
(straight-use-package pkg)
|
||||
(require pkg)
|
||||
(require (intern (format "+%s" pkg)) nil :noerror))
|
||||
|
|
|
|||
31
init.el
31
init.el
|
|
@ -143,6 +143,10 @@
|
|||
'("firefox"
|
||||
"chromium"
|
||||
"chrome"))
|
||||
browse-url-chrome-program (seq-some #'executable-find
|
||||
'("chromium"
|
||||
"chrome"
|
||||
"google-chrome-stable"))
|
||||
browse-url-generic-args (seq-some (lambda (e)
|
||||
(when (equal (executable-find (car e))
|
||||
browse-url-generic-program)
|
||||
|
|
@ -488,7 +492,7 @@
|
|||
org-tags-column (- (- fill-column (length org-ellipsis)))
|
||||
org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)"
|
||||
"|" "DONE(d!)")
|
||||
(sequence "|" "CANCELED(k!)")
|
||||
(sequence "|" "CANCELED(k@/!)")
|
||||
(sequence "MEETING(m)")))
|
||||
(:bind "RET" #'+org-return-dwim
|
||||
"<S-return>" #'+org-table-copy-down
|
||||
|
|
@ -595,7 +599,7 @@
|
|||
|
||||
(setup scratch
|
||||
(:require +scratch)
|
||||
(:option initial-major-mode #'lisp-interaction-mode
|
||||
(:option initial-major-mode #'emacs-lisp-mode
|
||||
initial-scratch-message
|
||||
";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n")
|
||||
(add-hook 'kill-buffer-query-functions #'+scratch-immortal))
|
||||
|
|
@ -1089,6 +1093,8 @@ See also `crux-reopen-as-root-mode'."
|
|||
"&" #'+elfeed-show-browse-generic
|
||||
"RET" #'shr-browse-url)
|
||||
(:hook #'reading-mode)
|
||||
(:option +elfeed--update-repeat (* 60 60) ; 1 hour
|
||||
+elfeed--update-first-time 60)
|
||||
(+elfeed-update-async-mode +1)))
|
||||
|
||||
(setup (:straight elfeed-org)
|
||||
|
|
@ -1350,6 +1356,14 @@ See also `crux-reopen-as-root-mode'."
|
|||
#'hl-line-mode
|
||||
#'lin-mode))
|
||||
|
||||
(setup (:straight md4rd)
|
||||
;; `md4rd' is ... a bit janky, tbh. But I'm including this here so I have it.
|
||||
;; TODO: enable opening Reddit links in md4rd
|
||||
(:also-load _md4rd)
|
||||
(defalias 'reddit 'md4rd "Browse Reddit.")
|
||||
(with-eval-after-load 'md4rd
|
||||
(run-with-timer 0 (* 60 59) 'md4rd-refresh-login)))
|
||||
|
||||
(setup (:straight minions)
|
||||
(minions-mode +1))
|
||||
|
||||
|
|
@ -1364,11 +1378,12 @@ See also `crux-reopen-as-root-mode'."
|
|||
:host gitlab
|
||||
:repo "protesilaos/modus-themes"))
|
||||
(require 'modus-themes (.etc "straight/build/modus-themes/modus-themes"))
|
||||
(:also-load dawn)
|
||||
(:option modus-themes-mixed-fonts t
|
||||
modus-themes-bold-constructs t
|
||||
modus-themes-italic-constructs t
|
||||
modus-themes-headings '((t . (background))))
|
||||
(+sunrise-sunset 'modus-themes-load-operandi 'modus-themes-load-vivendi))
|
||||
(dawn-schedule #'modus-themes-load-operandi #'modus-themes-load-vivendi))
|
||||
|
||||
(setup (:straight mwim)
|
||||
(:require +mwim)
|
||||
|
|
@ -1379,7 +1394,7 @@ See also `crux-reopen-as-root-mode'."
|
|||
"C-e" #'+mwim-end-maybe))
|
||||
|
||||
(setup (:straight orderless)
|
||||
(:also-load +orderless)
|
||||
(:require +orderless)
|
||||
(:option completion-styles '(substring orderless basic)
|
||||
completion-category-defaults nil
|
||||
completion-category-overrides
|
||||
|
|
@ -1447,6 +1462,8 @@ See also `crux-reopen-as-root-mode'."
|
|||
;; Ensure we can build `pdf-tools'
|
||||
(or (executable-find "gcc")
|
||||
(executable-find "g++")))
|
||||
(setf (alist-get "\\.pdf\\'" auto-mode-alist nil nil #'equal)
|
||||
#'pdf-view-modei)
|
||||
(pdf-tools-install t))
|
||||
|
||||
(setup (:straight (shell-command+
|
||||
|
|
@ -1590,6 +1607,11 @@ See also `crux-reopen-as-root-mode'."
|
|||
undo-fu-session-compression (executable-find "gzip"))
|
||||
(global-undo-fu-session-mode +1))
|
||||
|
||||
(setup (:straight valign)
|
||||
(:option valign-fancy-bar t)
|
||||
(:hook-into org-mode
|
||||
markdown-mode))
|
||||
|
||||
(setup (:straight (vertico
|
||||
:host github
|
||||
:repo "minad/vertico"
|
||||
|
|
@ -1624,6 +1646,7 @@ See also `crux-reopen-as-root-mode'."
|
|||
;; This is applied /after/ the above, so default is at the end of
|
||||
;; this alist.
|
||||
vertico-multiform-categories '((file buffer grid)
|
||||
(bookmark)
|
||||
(t flat)))
|
||||
(dolist (buf-cmd '(consult-find
|
||||
consult-yank-pop
|
||||
|
|
|
|||
|
|
@ -15,8 +15,10 @@ Copy from BEGIN to END using `kill-ring-save' if no argument was
|
|||
passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if
|
||||
one was."
|
||||
(interactive "r\nP")
|
||||
(call-interactively (if arg #'kill-ring-save
|
||||
#'crux-indent-rigidly-and-copy-to-clipboard)))
|
||||
(call-interactively (if arg
|
||||
#'crux-indent-rigidly-and-copy-to-clipboard
|
||||
#'kill-ring-save))
|
||||
(pulse-momentary-highlight-region begin end))
|
||||
|
||||
(defcustom +crux-default-date-format "%c"
|
||||
"Default date format to use for `+crux-insert-date-or-time'.
|
||||
|
|
|
|||
|
|
@ -40,8 +40,9 @@
|
|||
|
||||
(defun +elfeed-update-command ()
|
||||
(interactive)
|
||||
(let ((script (expand-file-name "~/.local/bin/elfeed")))
|
||||
(message "[Elfeed] Updating in the background.")
|
||||
(let ((script (expand-file-name "~/.local/bin/elfeed"))
|
||||
(update-message-format "[Elfeed] Updating in the background...%s"))
|
||||
(message update-message-format "")
|
||||
(setq +elfeed--update-running t)
|
||||
(elfeed-db-save)
|
||||
(advice-add 'elfeed :override #'+elfeed--update-message)
|
||||
|
|
@ -69,7 +70,7 @@
|
|||
(lambda (a b)
|
||||
(advice-remove 'elfeed #'+elfeed--update-message)
|
||||
(setq +elfeed--update-running nil)
|
||||
(message "[Elfeed] Background update %s."
|
||||
(message update-message-format
|
||||
(string-trim b))))))
|
||||
|
||||
(defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.")
|
||||
|
|
|
|||
52
lisp/acdw.el
52
lisp/acdw.el
|
|
@ -20,6 +20,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'diary-lib)
|
||||
(require 'solar) ; for +sunrise-sunset
|
||||
|
||||
;;; Define a directory and an expanding function
|
||||
|
||||
|
|
@ -55,57 +56,6 @@ ARGS."
|
|||
(when msg
|
||||
(message "%s" msg)))))
|
||||
|
||||
(defun +sunrise-sunset--encode (time)
|
||||
"Encode diary-style time string into a time.
|
||||
This is stolen from `run-at-time'."
|
||||
(let ((hhmm (diary-entry-time time))
|
||||
(now (decode-time)))
|
||||
(encode-time (list 0 (% hhmm 100) (/ hhmm 100)
|
||||
(decoded-time-day now)
|
||||
(decoded-time-month now)
|
||||
(decoded-time-year now)
|
||||
nil -1
|
||||
(decoded-time-zone now)))))
|
||||
|
||||
(defun +sunrise-sunset (sunrise-command sunset-command &optional reset)
|
||||
"Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset.
|
||||
With RESET, this function will call itself with its own
|
||||
arguments. That's really only useful within this function
|
||||
itself."
|
||||
(let* ((times-regex (rx (* nonl)
|
||||
(: (any ?s ?S) "unrise") " "
|
||||
(group (repeat 1 2 digit) ":"
|
||||
(repeat 1 2 digit)
|
||||
(: (any ?a ?A ?p ?P) (any ?m ?M)))
|
||||
(* nonl)
|
||||
(: (any ?s ?S) "unset") " "
|
||||
(group (repeat 1 2 digit) ":"
|
||||
(repeat 1 2 digit)
|
||||
(: (any ?a ?A ?p ?P) (any ?m ?M)))
|
||||
(* nonl)))
|
||||
(ss (+suppress-messages #'sunrise-sunset))
|
||||
(_m (string-match times-regex ss))
|
||||
(sunrise (match-string 1 ss))
|
||||
(sunset (match-string 2 ss))
|
||||
(sunrise-time (+sunrise-sunset--encode sunrise))
|
||||
(sunset-time (+sunrise-sunset--encode sunset)))
|
||||
(cond
|
||||
((time-less-p nil sunrise-time)
|
||||
;; If it isn't sunrise yet, it's still dark---and so we need to run the
|
||||
;; sunset-command.
|
||||
(funcall sunset-command)
|
||||
(run-at-time sunrise nil sunrise-command))
|
||||
((time-less-p nil sunset-time)
|
||||
;; If it isn't sunset yet, it's still light---so we need to run the
|
||||
;; sunrise-command.
|
||||
(funcall sunrise-command)
|
||||
(run-at-time sunset nil sunset-command))
|
||||
(t (run-at-time "12:00am" nil sunset-command)))
|
||||
;; Reset everything at midnight
|
||||
(unless reset
|
||||
(run-at-time "12:00am" (* 60 60 24)
|
||||
#'+sunrise-sunset sunrise-command sunset-command t))))
|
||||
|
||||
(defun +ensure-after-init (function)
|
||||
"Ensure FUNCTION runs after init, or now if already initialized.
|
||||
If Emacs is already started, run FUNCTION. Otherwise, add it to
|
||||
|
|
|
|||
|
|
@ -0,0 +1,240 @@
|
|||
;;; compat.el --- Thin backward-compatibility shim -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; I use different versionso of Emacs. Sometimes I have to copy-paste functions
|
||||
;; from newer Emacs to make my customizations work. This is that file.
|
||||
|
||||
;; This is probably ill-advised.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(unless (fboundp 'keymap--compile-check)
|
||||
(defun keymap--compile-check (&rest keys)
|
||||
(dolist (key keys)
|
||||
(when (or (vectorp key)
|
||||
(and (stringp key) (not (key-valid-p key))))
|
||||
(byte-compile-warn "Invalid `kbd' syntax: %S" key)))))
|
||||
|
||||
(unless (fboundp 'keymap-lookup)
|
||||
(defun keymap-lookup (keymap key &optional accept-default no-remap position)
|
||||
"Return the binding for command KEY.
|
||||
KEY is a string that satisfies `key-valid-p'.
|
||||
|
||||
If KEYMAP is nil, look up in the current keymaps. If non-nil, it
|
||||
should either be a keymap or a list of keymaps, and only these
|
||||
keymap(s) will be consulted.
|
||||
|
||||
The binding is probably a symbol with a function definition.
|
||||
|
||||
Normally, `keymap-lookup' ignores bindings for t, which act as
|
||||
default bindings, used when nothing else in the keymap applies;
|
||||
this makes it usable as a general function for probing keymaps.
|
||||
However, if the optional second argument ACCEPT-DEFAULT is
|
||||
non-nil, `keymap-lookup' does recognize the default bindings,
|
||||
just as `read-key-sequence' does.
|
||||
|
||||
Like the normal command loop, `keymap-lookup' will remap the
|
||||
command resulting from looking up KEY by looking up the command
|
||||
in the current keymaps. However, if the optional third argument
|
||||
NO-REMAP is non-nil, `keymap-lookup' returns the unmapped
|
||||
command.
|
||||
|
||||
If KEY is a key sequence initiated with the mouse, the used keymaps
|
||||
will depend on the clicked mouse position with regard to the buffer
|
||||
and possible local keymaps on strings.
|
||||
|
||||
If the optional argument POSITION is non-nil, it specifies a mouse
|
||||
position as returned by `event-start' and `event-end', and the lookup
|
||||
occurs in the keymaps associated with it instead of KEY. It can also
|
||||
be a number or marker, in which case the keymap properties at the
|
||||
specified buffer position instead of point are used."
|
||||
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
|
||||
(keymap--check key)
|
||||
(when (and keymap position)
|
||||
(error "Can't pass in both keymap and position"))
|
||||
(if keymap
|
||||
(let ((value (lookup-key keymap (key-parse key) accept-default)))
|
||||
(if (and (not no-remap)
|
||||
(symbolp value))
|
||||
(or (command-remapping value) value)
|
||||
value))
|
||||
(key-binding (kbd key) accept-default no-remap position))))
|
||||
|
||||
(unless (fboundp 'keymap--check)
|
||||
(defun keymap--check (key)
|
||||
"Signal an error if KEY doesn't have a valid syntax."
|
||||
(unless (key-valid-p key)
|
||||
(error "%S is not a valid key definition; see `key-valid-p'" key))))
|
||||
|
||||
(unless (fboundp 'key-valid-p)
|
||||
(defun key-valid-p (keys)
|
||||
"Say whether KEYS is a valid key.
|
||||
A key is a string consisting of one or more key strokes.
|
||||
The key strokes are separated by single space characters.
|
||||
|
||||
Each key stroke is either a single character, or the name of an
|
||||
event, surrounded by angle brackets. In addition, any key stroke
|
||||
may be preceded by one or more modifier keys. Finally, a limited
|
||||
number of characters have a special shorthand syntax.
|
||||
|
||||
Here's some example key sequences.
|
||||
|
||||
\"f\" (the key 'f')
|
||||
\"S o m\" (a three key sequence of the keys 'S', 'o' and 'm')
|
||||
\"C-c o\" (a two key sequence of the keys 'c' with the control modifier
|
||||
and then the key 'o')
|
||||
\"H-<left>\" (the key named \"left\" with the hyper modifier)
|
||||
\"M-RET\" (the \"return\" key with a meta modifier)
|
||||
\"C-M-<space>\" (the \"space\" key with both the control and meta modifiers)
|
||||
|
||||
These are the characters that have shorthand syntax:
|
||||
NUL, RET, TAB, LFD, ESC, SPC, DEL.
|
||||
|
||||
Modifiers have to be specified in this order:
|
||||
|
||||
A-C-H-M-S-s
|
||||
|
||||
which is
|
||||
|
||||
Alt-Control-Hyper-Meta-Shift-super"
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(and
|
||||
(stringp keys)
|
||||
(string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys)
|
||||
(save-match-data
|
||||
(catch 'exit
|
||||
(let ((prefixes
|
||||
"\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")
|
||||
(case-fold-search nil))
|
||||
(dolist (key (split-string keys " "))
|
||||
;; Every key might have these modifiers, and they should be
|
||||
;; in this order.
|
||||
(when (string-match (concat "\\`" prefixes) key)
|
||||
(setq key (substring key (match-end 0))))
|
||||
(unless (or (and (= (length key) 1)
|
||||
;; Don't accept control characters as keys.
|
||||
(not (< (aref key 0) ?\s))
|
||||
;; Don't accept Meta'd characters as keys.
|
||||
(or (multibyte-string-p key)
|
||||
(not (<= 127 (aref key 0) 255))))
|
||||
(and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key)
|
||||
;; Don't allow <M-C-down>.
|
||||
(= (progn
|
||||
(string-match
|
||||
(concat "\\`<" prefixes) key)
|
||||
(match-end 0))
|
||||
1))
|
||||
(string-match-p
|
||||
"\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'"
|
||||
key))
|
||||
;; Invalid.
|
||||
(throw 'exit nil)))
|
||||
t))))))
|
||||
|
||||
(unless (fboundp 'key-parse)
|
||||
(defun key-parse (keys)
|
||||
"Convert KEYS to the internal Emacs key representation.
|
||||
See `kbd' for a descripion of KEYS."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
;; A pure function is expected to preserve the match data.
|
||||
(save-match-data
|
||||
(let ((case-fold-search nil)
|
||||
(len (length keys)) ; We won't alter keys in the loop below.
|
||||
(pos 0)
|
||||
(res []))
|
||||
(while (and (< pos len)
|
||||
(string-match "[^ \t\n\f]+" keys pos))
|
||||
(let* ((word-beg (match-beginning 0))
|
||||
(word-end (match-end 0))
|
||||
(word (substring keys word-beg len))
|
||||
(times 1)
|
||||
key)
|
||||
;; Try to catch events of the form "<as df>".
|
||||
(if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
|
||||
(setq word (match-string 0 word)
|
||||
pos (+ word-beg (match-end 0)))
|
||||
(setq word (substring keys word-beg word-end)
|
||||
pos word-end))
|
||||
(when (string-match "\\([0-9]+\\)\\*." word)
|
||||
(setq times (string-to-number (substring word 0 (match-end 1))))
|
||||
(setq word (substring word (1+ (match-end 1)))))
|
||||
(cond ((string-match "^<<.+>>$" word)
|
||||
(setq key (vconcat (if (eq (key-binding [?\M-x])
|
||||
'execute-extended-command)
|
||||
[?\M-x]
|
||||
(or (car (where-is-internal
|
||||
'execute-extended-command))
|
||||
[?\M-x]))
|
||||
(substring word 2 -2) "\r")))
|
||||
((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
|
||||
(progn
|
||||
(setq word (concat (match-string 1 word)
|
||||
(match-string 3 word)))
|
||||
(not (string-match
|
||||
"\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
|
||||
word))))
|
||||
(setq key (list (intern word))))
|
||||
((or (equal word "REM") (string-match "^;;" word))
|
||||
(setq pos (string-match "$" keys pos)))
|
||||
(t
|
||||
(let ((orig-word word) (prefix 0) (bits 0))
|
||||
(while (string-match "^[ACHMsS]-." word)
|
||||
(setq bits (+ bits
|
||||
(cdr
|
||||
(assq (aref word 0)
|
||||
'((?A . ?\A-\^@) (?C . ?\C-\^@)
|
||||
(?H . ?\H-\^@) (?M . ?\M-\^@)
|
||||
(?s . ?\s-\^@) (?S . ?\S-\^@))))))
|
||||
(setq prefix (+ prefix 2))
|
||||
(setq word (substring word 2)))
|
||||
(when (string-match "^\\^.$" word)
|
||||
(setq bits (+ bits ?\C-\^@))
|
||||
(setq prefix (1+ prefix))
|
||||
(setq word (substring word 1)))
|
||||
(let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
|
||||
("LFD" . "\n") ("TAB" . "\t")
|
||||
("ESC" . "\e") ("SPC" . " ")
|
||||
("DEL" . "\177")))))
|
||||
(when found (setq word (cdr found))))
|
||||
(when (string-match "^\\\\[0-7]+$" word)
|
||||
(let ((n 0))
|
||||
(dolist (ch (cdr (string-to-list word)))
|
||||
(setq n (+ (* n 8) ch -48)))
|
||||
(setq word (vector n))))
|
||||
(cond ((= bits 0)
|
||||
(setq key word))
|
||||
((and (= bits ?\M-\^@) (stringp word)
|
||||
(string-match "^-?[0-9]+$" word))
|
||||
(setq key (mapcar (lambda (x) (+ x bits))
|
||||
(append word nil))))
|
||||
((/= (length word) 1)
|
||||
(error "%s must prefix a single character, not %s"
|
||||
(substring orig-word 0 prefix) word))
|
||||
((and (/= (logand bits ?\C-\^@) 0) (stringp word)
|
||||
;; We used to accept . and ? here,
|
||||
;; but . is simply wrong,
|
||||
;; and C-? is not used (we use DEL instead).
|
||||
(string-match "[@-_a-z]" word))
|
||||
(setq key (list (+ bits (- ?\C-\^@)
|
||||
(logand (aref word 0) 31)))))
|
||||
(t
|
||||
(setq key (list (+ bits (aref word 0)))))))))
|
||||
(when key
|
||||
(dolist (_ (number-sequence 1 times))
|
||||
(setq res (vconcat res key))))))
|
||||
(if (and (>= (length res) 4)
|
||||
(eq (aref res 0) ?\C-x)
|
||||
(eq (aref res 1) ?\()
|
||||
(eq (aref res (- (length res) 2)) ?\C-x)
|
||||
(eq (aref res (- (length res) 1)) ?\)))
|
||||
(apply #'vector (let ((lres (append res nil)))
|
||||
;; Remove the first and last two elements.
|
||||
(setq lres (cdr (cdr lres)))
|
||||
(nreverse lres)
|
||||
(setq lres (cdr (cdr lres)))
|
||||
(nreverse lres)))
|
||||
res)))))
|
||||
|
||||
(provide 'compat)
|
||||
;;; compat.el ends here
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; There is also circadian.el, but it doesn't quite work for me.
|
||||
;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
|
||||
;; somewhere else (which I've forgotten) and my own brain :)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'calendar)
|
||||
(require 'cl-lib)
|
||||
(require 'solar)
|
||||
|
||||
(defvar dawn--dawn-timer nil
|
||||
"Timer for dawn-command.")
|
||||
|
||||
(defvar dawn--dusk-timer nil
|
||||
"Timer for dusk-command.")
|
||||
|
||||
(defvar dawn--reset-timer nil
|
||||
"Timer to reset dawn at midnight.")
|
||||
|
||||
(defun dawn-encode-time (f)
|
||||
"Encode fractional time F."
|
||||
(let ((hhmm (cl-floor f))
|
||||
(date (cdddr (decode-time))))
|
||||
(encode-time
|
||||
(append (list 0
|
||||
(round (* 60 (cadr hhmm)))
|
||||
(car hhmm)
|
||||
)
|
||||
date))))
|
||||
|
||||
(defun dawn-midnight ()
|
||||
"Return the time of the /next/ midnight."
|
||||
(let ((date (cdddr (decode-time))))
|
||||
(encode-time
|
||||
(append (list 0 0 0 (1+ (car date))) (cdr date)))))
|
||||
|
||||
(defun dawn-sunrise ()
|
||||
"Return the time of today's sunrise."
|
||||
(dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
|
||||
|
||||
(defun dawn-sunset ()
|
||||
"Return the time of today's sunset."
|
||||
(dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
|
||||
|
||||
(defun dawn-schedule (dawn-command dusk-command)
|
||||
"Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
|
||||
RESET is an argument for internal use."
|
||||
(let ((dawn (dawn-sunrise))
|
||||
(dusk (dawn-sunset)))
|
||||
(cond
|
||||
((time-less-p nil dawn)
|
||||
;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule
|
||||
;; DAWN-COMMAND and DUSK-COMMAND for later.
|
||||
(funcall dusk-command)
|
||||
(run-at-time dawn nil dawn-command)
|
||||
(run-at-time dusk nil dusk-command))
|
||||
((time-less-p nil dusk)
|
||||
;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule
|
||||
;; DUSK-COMMAND.
|
||||
(funcall dawn-command)
|
||||
(run-at-time dusk nil dusk-command))
|
||||
(t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
|
||||
(funcall dusk-command)))
|
||||
;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
|
||||
;(unless reset)
|
||||
(run-at-time (dawn-midnight) nil
|
||||
#'dawn-schedule dawn-command dusk-command)))
|
||||
|
||||
(provide 'dawn)
|
||||
;;; dawn.el ends here
|
||||
37
lisp/fibs.el
37
lisp/fibs.el
|
|
@ -1,37 +0,0 @@
|
|||
;;; fibs.el --- Play backgammon with FIBS -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; fibs.com is one of the oldest backgammon servers out there, and it's
|
||||
;; accessible via telnet. This package provides a wrapper to enable you to play
|
||||
;; backgammon on fibs.com more easily than just opening a telnet session
|
||||
;; yourself.
|
||||
|
||||
;;; TODO:
|
||||
|
||||
;; - Automatically log in.
|
||||
;; - Add a `fibs-quit' function to kill the telnet server and buffer.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'telnet)
|
||||
|
||||
(defgroup fibs nil
|
||||
"Customizations for FIBS, the First Internet Backgammon Server."
|
||||
:group 'games)
|
||||
|
||||
(defcustom fibs-server "fibs.com"
|
||||
"The server to connect to FIBS with."
|
||||
:type 'string)
|
||||
|
||||
(defcustom fibs-port 4321
|
||||
"The port to connect to FIBS with."
|
||||
:type 'number)
|
||||
|
||||
;;;###autoload
|
||||
(defun fibs ()
|
||||
(interactive)
|
||||
(telnet fibs-server fibs-port))
|
||||
|
||||
(provide 'fibs)
|
||||
;;; fibs.el ends here
|
||||
Loading…
Reference in New Issue