From adf815b61bfd850e948e60b743ce48b0ff42d901 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 21 Jan 2022 16:34:55 -0600 Subject: [PATCH] Two out of three ain't bad --- early-init.el | 4 +- init.el | 31 ++++++- lisp/+crux.el | 6 +- lisp/+elfeed.el | 7 +- lisp/acdw.el | 52 +---------- lisp/compat.el | 240 ++++++++++++++++++++++++++++++++++++++++++++++++ lisp/dawn.el | 74 +++++++++++++++ lisp/fibs.el | 37 -------- 8 files changed, 353 insertions(+), 98 deletions(-) create mode 100644 lisp/compat.el create mode 100644 lisp/dawn.el delete mode 100644 lisp/fibs.el 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 @@ (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)) diff --git a/init.el b/init.el index b930513..6940a12 100644 --- a/init.el +++ b/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 "" #'+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 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 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'. 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 @@ (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'.") 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 @@ ;;; 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 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 @@ +;;; 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-\" (the key named \"left\" with the hyper modifier) + \"M-RET\" (the \"return\" key with a meta modifier) + \"C-M-\" (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 . + (= (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 "". + (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 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 @@ +;;; 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 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 @@ -;;; 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