Merge branch 'main' of tildegit.org:acdw/emacs
This commit is contained in:
commit
3ec991d541
|
@ -45,6 +45,7 @@
|
||||||
|
|
||||||
(push (locate-user-emacs-file "lisp") load-path)
|
(push (locate-user-emacs-file "lisp") load-path)
|
||||||
(require 'acdw)
|
(require 'acdw)
|
||||||
|
(require 'compat)
|
||||||
|
|
||||||
(+define-dir .etc (locate-user-emacs-file ".etc")
|
(+define-dir .etc (locate-user-emacs-file ".etc")
|
||||||
"Directory for all of Emacs's various files.
|
"Directory for all of Emacs's various files.
|
||||||
|
@ -146,7 +147,8 @@ See `no-littering' for examples.")
|
||||||
(dolist (pkg '(el-patch
|
(dolist (pkg '(el-patch
|
||||||
no-littering
|
no-littering
|
||||||
setup
|
setup
|
||||||
straight)) ; already installed, but what the hell
|
straight ; already installed, but what the hell
|
||||||
|
))
|
||||||
(straight-use-package pkg)
|
(straight-use-package pkg)
|
||||||
(require pkg)
|
(require pkg)
|
||||||
(require (intern (format "+%s" pkg)) nil :noerror))
|
(require (intern (format "+%s" pkg)) nil :noerror))
|
||||||
|
|
30
init.el
30
init.el
|
@ -143,6 +143,10 @@
|
||||||
'("firefox"
|
'("firefox"
|
||||||
"chromium"
|
"chromium"
|
||||||
"chrome"))
|
"chrome"))
|
||||||
|
browse-url-chrome-program (seq-some #'executable-find
|
||||||
|
'("chromium"
|
||||||
|
"chrome"
|
||||||
|
"google-chrome-stable"))
|
||||||
browse-url-generic-args (seq-some (lambda (e)
|
browse-url-generic-args (seq-some (lambda (e)
|
||||||
(when (equal (executable-find (car e))
|
(when (equal (executable-find (car e))
|
||||||
browse-url-generic-program)
|
browse-url-generic-program)
|
||||||
|
@ -589,7 +593,7 @@
|
||||||
|
|
||||||
(setup scratch
|
(setup scratch
|
||||||
(:require +scratch)
|
(:require +scratch)
|
||||||
(:option initial-major-mode #'lisp-interaction-mode
|
(:option initial-major-mode #'emacs-lisp-mode
|
||||||
initial-scratch-message
|
initial-scratch-message
|
||||||
";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n")
|
";; ABANDON ALL HOPE YE WHO ENTER HERE\n\n")
|
||||||
(add-hook 'kill-buffer-query-functions #'+scratch-immortal))
|
(add-hook 'kill-buffer-query-functions #'+scratch-immortal))
|
||||||
|
@ -1087,7 +1091,8 @@ See also `crux-reopen-as-root-mode'."
|
||||||
"&" #'+elfeed-show-browse-generic
|
"&" #'+elfeed-show-browse-generic
|
||||||
"RET" #'shr-browse-url)
|
"RET" #'shr-browse-url)
|
||||||
(:hook #'reading-mode)
|
(:hook #'reading-mode)
|
||||||
(:option +elfeed--update-first-time 60)
|
(:option +elfeed--update-repeat (* 60 60) ; 1 hour
|
||||||
|
+elfeed--update-first-time 60)
|
||||||
(+elfeed-update-async-mode +1)))
|
(+elfeed-update-async-mode +1)))
|
||||||
|
|
||||||
(setup (:straight elfeed-org)
|
(setup (:straight elfeed-org)
|
||||||
|
@ -1355,6 +1360,14 @@ See also `crux-reopen-as-root-mode'."
|
||||||
#'hl-line-mode
|
#'hl-line-mode
|
||||||
#'lin-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)
|
(setup (:straight minions)
|
||||||
(minions-mode +1))
|
(minions-mode +1))
|
||||||
|
|
||||||
|
@ -1369,11 +1382,12 @@ See also `crux-reopen-as-root-mode'."
|
||||||
:host gitlab
|
:host gitlab
|
||||||
:repo "protesilaos/modus-themes"))
|
:repo "protesilaos/modus-themes"))
|
||||||
(require 'modus-themes (.etc "straight/build/modus-themes/modus-themes"))
|
(require 'modus-themes (.etc "straight/build/modus-themes/modus-themes"))
|
||||||
|
(:also-load dawn)
|
||||||
(:option modus-themes-mixed-fonts t
|
(:option modus-themes-mixed-fonts t
|
||||||
modus-themes-bold-constructs t
|
modus-themes-bold-constructs t
|
||||||
modus-themes-italic-constructs t
|
modus-themes-italic-constructs t
|
||||||
modus-themes-headings '((t . (background))))
|
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)
|
(setup (:straight mwim)
|
||||||
(:require +mwim)
|
(:require +mwim)
|
||||||
|
@ -1384,7 +1398,7 @@ See also `crux-reopen-as-root-mode'."
|
||||||
"C-e" #'+mwim-end-maybe))
|
"C-e" #'+mwim-end-maybe))
|
||||||
|
|
||||||
(setup (:straight orderless)
|
(setup (:straight orderless)
|
||||||
(:also-load +orderless)
|
(:require +orderless)
|
||||||
(:option completion-styles '(substring orderless basic)
|
(:option completion-styles '(substring orderless basic)
|
||||||
completion-category-defaults nil
|
completion-category-defaults nil
|
||||||
completion-category-overrides
|
completion-category-overrides
|
||||||
|
@ -1452,6 +1466,8 @@ See also `crux-reopen-as-root-mode'."
|
||||||
;; Ensure we can build `pdf-tools'
|
;; Ensure we can build `pdf-tools'
|
||||||
(or (executable-find "gcc")
|
(or (executable-find "gcc")
|
||||||
(executable-find "g++")))
|
(executable-find "g++")))
|
||||||
|
(setf (alist-get "\\.pdf\\'" auto-mode-alist nil nil #'equal)
|
||||||
|
#'pdf-view-modei)
|
||||||
(pdf-tools-install t))
|
(pdf-tools-install t))
|
||||||
|
|
||||||
(setup (:straight (shell-command+
|
(setup (:straight (shell-command+
|
||||||
|
@ -1595,6 +1611,11 @@ See also `crux-reopen-as-root-mode'."
|
||||||
undo-fu-session-compression (executable-find "gzip"))
|
undo-fu-session-compression (executable-find "gzip"))
|
||||||
(global-undo-fu-session-mode +1))
|
(global-undo-fu-session-mode +1))
|
||||||
|
|
||||||
|
(setup (:straight valign)
|
||||||
|
(:option valign-fancy-bar t)
|
||||||
|
(:hook-into org-mode
|
||||||
|
markdown-mode))
|
||||||
|
|
||||||
(setup (:straight (vertico
|
(setup (:straight (vertico
|
||||||
:host github
|
:host github
|
||||||
:repo "minad/vertico"
|
:repo "minad/vertico"
|
||||||
|
@ -1629,6 +1650,7 @@ See also `crux-reopen-as-root-mode'."
|
||||||
;; This is applied /after/ the above, so default is at the end of
|
;; This is applied /after/ the above, so default is at the end of
|
||||||
;; this alist.
|
;; this alist.
|
||||||
vertico-multiform-categories '((file buffer grid)
|
vertico-multiform-categories '((file buffer grid)
|
||||||
|
(bookmark)
|
||||||
(t flat)))
|
(t flat)))
|
||||||
(dolist (buf-cmd '(consult-find
|
(dolist (buf-cmd '(consult-find
|
||||||
consult-yank-pop
|
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
|
passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if
|
||||||
one was."
|
one was."
|
||||||
(interactive "r\nP")
|
(interactive "r\nP")
|
||||||
(call-interactively (if arg #'kill-ring-save
|
(call-interactively (if arg
|
||||||
#'crux-indent-rigidly-and-copy-to-clipboard)))
|
#'crux-indent-rigidly-and-copy-to-clipboard
|
||||||
|
#'kill-ring-save))
|
||||||
|
(pulse-momentary-highlight-region begin end))
|
||||||
|
|
||||||
(defcustom +crux-default-date-format "%c"
|
(defcustom +crux-default-date-format "%c"
|
||||||
"Default date format to use for `+crux-insert-date-or-time'.
|
"Default date format to use for `+crux-insert-date-or-time'.
|
||||||
|
|
|
@ -40,8 +40,9 @@
|
||||||
|
|
||||||
(defun +elfeed-update-command ()
|
(defun +elfeed-update-command ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((script (expand-file-name "~/.local/bin/elfeed-update.el")))
|
(let ((script (expand-file-name "~/.local/bin/elfeed"))
|
||||||
(message "[Elfeed] Updating in the background.")
|
(update-message-format "[Elfeed] Updating in the background...%s"))
|
||||||
|
(message update-message-format "")
|
||||||
(setq +elfeed--update-running t)
|
(setq +elfeed--update-running t)
|
||||||
(elfeed-db-save)
|
(elfeed-db-save)
|
||||||
(advice-add 'elfeed :override #'+elfeed--update-message)
|
(advice-add 'elfeed :override #'+elfeed--update-message)
|
||||||
|
@ -94,7 +95,7 @@
|
||||||
(lambda (a b)
|
(lambda (a b)
|
||||||
(advice-remove 'elfeed #'+elfeed--update-message)
|
(advice-remove 'elfeed #'+elfeed--update-message)
|
||||||
(setq +elfeed--update-running nil)
|
(setq +elfeed--update-running nil)
|
||||||
(message "[Elfeed] Background update %s."
|
(message update-message-format
|
||||||
(string-trim b))))))
|
(string-trim b))))))
|
||||||
|
|
||||||
(defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.")
|
(defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.")
|
||||||
|
|
52
lisp/acdw.el
52
lisp/acdw.el
|
@ -20,6 +20,7 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'diary-lib)
|
(require 'diary-lib)
|
||||||
|
(require 'solar) ; for +sunrise-sunset
|
||||||
|
|
||||||
;;; Define a directory and an expanding function
|
;;; Define a directory and an expanding function
|
||||||
|
|
||||||
|
@ -55,57 +56,6 @@ ARGS."
|
||||||
(when msg
|
(when msg
|
||||||
(message "%s" 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)
|
(defun +ensure-after-init (function)
|
||||||
"Ensure FUNCTION runs after init, or now if already initialized.
|
"Ensure FUNCTION runs after init, or now if already initialized.
|
||||||
If Emacs is already started, run FUNCTION. Otherwise, add it to
|
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