From 8c7871fec56b6c464bd06ba114225d7971c4699a Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 15 Nov 2022 19:51:52 -0600 Subject: meh --- lisp/+emacs.el | 6 ++-- lisp/acdw.el | 80 +++++++++++++++++++++++++++++++--------------------- lisp/dawn.el | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/yoke.el | 88 ++++++++++++++++++++++++++++++++++++++++++++++------------ 4 files changed, 205 insertions(+), 53 deletions(-) create mode 100644 lisp/dawn.el (limited to 'lisp') diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 8817c19..870e4e2 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el @@ -108,12 +108,10 @@ Do this only if the buffer is not visiting a file." regexp-search-ring-max 200 save-interprogram-paste-before-kill t save-some-buffers-default-predicate #'+save-some-buffers-p - scroll-conservatively 101 - scroll-down-aggressively 0.01 - scroll-margin 2 + scroll-conservatively 25 + scroll-margin 0 scroll-preserve-screen-position 1 scroll-step 1 - scroll-up-aggressively 0.01 search-ring-max 200 search-ring-max 200 sentence-end-double-space t diff --git a/lisp/acdw.el b/lisp/acdw.el index 6e298b2..75e1755 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -1,7 +1,5 @@ ;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- ;; by C. Duckworth -(provide 'acdw) - (require 'cl-lib) ;;; Define both a directory and a function expanding to a file in that directory @@ -30,7 +28,6 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." ;;; Evaluating things after other things - (defun eval-after-init (fn) "Evaluate FN after inititation, or now if Emacs is initialized. FN is called with no arguments." @@ -78,12 +75,12 @@ Convenience wrapper around `define-key'." (unless (fboundp 'ensure-list) ;; Just in case we're using an old version of Emacs. (defun ensure-list (object) - "Return OBJECT as a list. + "Return OBJECT as a list. If OBJECT is already a list, return OBJECT itself. If it's not a list, return a one-element list containing OBJECT." - (if (listp object) - object - (list object)))) + (if (listp object) + object + (list object)))) (defun add-to-list* (lists &rest things) "Add THINGS to LISTS. @@ -130,8 +127,8 @@ without any separator." Each feature of FEATURES can also be a list of the arguments to pass to `require', which see." (condition-case e - (dolist (feature features) - (apply #'require (ensure-list feature))) + (dolist (feature features) + (apply #'require (ensure-list feature))) (:success (mapcar (lambda (f) (car (ensure-list f))) features)) (t (signal (car e) (cdr e))))) @@ -153,22 +150,33 @@ pass to `require', which see." (add-hook 'before-save-hook #',internal-name nil :local)) (add-hook ',hook #',external-name)))) -(defmacro setq-local-hook (hook &rest args) - "Run `setq-local' on ARGS when running HOOK." +(defmacro setq-local-hook (hooks &rest args) + "Run `setq-local' on ARGS when running HOOKs." + ;; FIXME: this is pretty messy, i think... + ;; The settings should be stored in an alist so that they can be deduplicated (declare (indent 1)) - (let ((fn (intern (format "%s-setq-local" hook)))) - (when (and (fboundp fn) - (functionp fn)) - (setf args (append (function-get fn 'setq-local-hook-settings) args))) - (unless (and (< 0 (length args)) - (zerop (mod (length args) 2))) - (user-error "Wrong number of arguments: %S" (length args))) - `(progn - (defun ,fn () - ,(format "Set local variables after `%s'." hook) - (setq-local ,@args)) - (function-put ',fn 'setq-local-hook-settings ',args) - (add-hook ',hook #',fn)))) + `(progn + ,@(cl-loop for hook in (ensure-list hooks) + collect + (let ((fn (intern (format "%s-setq-local" hook)))) + (when (and (fboundp fn) + (functionp fn)) + (setf args (append (function-get fn 'setq-local-hook-settings) args))) + (unless (and (< 0 (length args)) + (zerop (mod (length args) 2))) + (user-error "Wrong number of arguments: %S" (length args))) + `(progn + (defun ,fn () + ,(format "Set local variables after `%s'." hook) + (setq-local ,@args)) + (function-put ',fn 'setq-local-hook-settings ',args) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (derived-mode-p + ',(intern (replace-regexp-in-string + "-hook" "" (format "%s" hook)))) + (,fn)))) + (add-hook ',hook #',fn)))))) (defmacro with-message (message &rest body) "Execute BODY, with MESSAGE. @@ -182,6 +190,13 @@ If body executes without errors, MESSAGE...Done will be displayed." (:success (message "%s...done" ,msg)) (t (signal (car e) (cdr e))))))) +(defmacro either (&rest clauses) + "Return the first of CLAUSES that returns non-nil." + (let* ((this (gensym "either"))) + (unless (null clauses) + `(let* ((,this ,(car clauses))) + (if ,this ,this (either ,@(cdr clauses))))))) + ;; https://emacs.stackexchange.com/a/39324/37239 ;; XXX: This shit don't work rn (defun ignore-invisible-overlays (fn) @@ -189,13 +204,13 @@ If body executes without errors, MESSAGE...Done will be displayed." FN should return a point." (let ((overlay nil) (point nil)) - (setq point (and (funcall fn) (point))) - (setq overlay (car (overlays-at (point)))) - (while (and overlay (member 'invisible (overlay-properties overlay))) - (goto-char (overlay-end overlay)) - (setq point (and (funcall fn) (point))) - (setq overlay (car (overlays-at (point))))) - point)) + (setq point (and (funcall fn) (point))) + (setq overlay (car (overlays-at (point)))) + (while (and overlay (member 'invisible (overlay-properties overlay))) + (goto-char (overlay-end overlay)) + (setq point (and (funcall fn) (point))) + (setq overlay (car (overlays-at (point))))) + point)) ;;; Extras ;; Trying to avoid a whole install of crux ... @@ -217,3 +232,6 @@ When called with prefix ARG, unconditionally switch buffer." (if (or arg (one-window-p)) (switch-to-buffer (other-buffer) nil t) (other-window 1))) + +(provide 'acdw) +;;; acdw.el ends here diff --git a/lisp/dawn.el b/lisp/dawn.el new file mode 100644 index 0000000..806c422 --- /dev/null +++ b/lisp/dawn.el @@ -0,0 +1,84 @@ +;;; 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." + (when (or (null calendar-longitude) + (null calendar-latitude)) + (user-error "`dawn' won't work without setting %s!" + (cond ((and (null calendar-longitude) + (null calendar-latitude)) + "`calendar-longitude' and `calendar-latitude'") + ((null calendar-longitude) + "`calendar-longitude'") + ((null calendar-latitude) + "`calendar-latitude'")))) + (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/yoke.el b/lisp/yoke.el index 1e1bc60..f9c4d49 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el @@ -64,8 +64,8 @@ Execute BODY afterward. (url (cond ((consp package) (cdr package)) (:else nil))) (pname (intern (format "yoke:%s" pkg))) - (dirvar (gensym "yoke-dir-")) - ;; Keyword args + (dirvar '$yoke-dir) + ;; Keyword args --- TODO: Naming could probably be better. (after (plist-get body :after)) (depends (plist-get body :depends)) (whenp (plist-member body :when)) @@ -77,6 +77,7 @@ Execute BODY afterward. (autoload (cond ((plist-member body :autoload) (plist-get body :autoload)) (:else t))) + (pre (plist-get body :pre)) ;; Body (body (cl-loop for (this next) on body by #'cddr unless (keywordp this) @@ -102,12 +103,17 @@ Execute BODY afterward. `((when ,unless (cl-return-from ,pname (format "%s (abort) :unless %S" ',pname ',unless)))))) + ;; Evaluate `:pre' forms + ,@pre ;; Get prerequisite packages ,@(cl-loop for (pkg* . yoke-get-args) in depends collect `(or - (let ((dir (yoke-get ,@yoke-get-args - :dir ,(format "%s" pkg*)))) + (let* ((pkg-spec (yoke-get ,@yoke-get-args + :dir ,(format "%s" pkg*))) + (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) + "") + (car pkg-spec)))) (and dir ,@(if autoload `((yoke-generate-autoloads ',pkg* dir)) @@ -118,13 +124,16 @@ Execute BODY afterward. ',pkg*)))) ;; Download the package, generate autoloads ,@(when url - `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg)))) + `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) + (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) + "") + (car pkg-spec)))) ,@(when autoload `((yoke-generate-autoloads ',pkg ,dirvar))) (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) ;; Evaluate the body, optionally after the features in `:after' ,@(cond (after - `((eval-after ,after ,@body))) + `((yoke-eval-after ,after ,@body))) (:else body))) (:success ',package) (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) @@ -144,7 +153,7 @@ ARGS is a plist with the following possible keys: download URL." (let* ((dir (plist-get args :dir)) (load (plist-get args :load)) - (type (plist-get args :type)) + (type (or (plist-get args :type))) (path (cond ((eq type 'http) (yoke-get-http url dir)) ((or (eq type 'git) @@ -159,7 +168,7 @@ ARGS is a plist with the following possible keys: (cond ((file-exists-p path) (add-to-list 'load-path (expand-file-name (or load "") path)) - path) + (cons path args)) (:else (error "Directory \"%s\" doesn't exist." path) nil)))) @@ -178,7 +187,18 @@ If DIR isn't given, it's guessed from the final component of the URL's path and placed under `yoke-dir'." (let* ((dir (yoke-get--guess-directory url dir)) (basename (file-name-nondirectory url)) - (filename (expand-file-name basename dir))) + ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have + ;; a parameter (either dynamic var or passed in) that would give the + ;; name of the downloaded file. But that would take a bit of + ;; re-engineering, I think. So for now, it stays thus. + (filename (expand-file-name + (replace-regexp-in-string + (rx "-" (+ digit) ; major version + (+ (group "." (+ digit))) ; following version numbers + (group "." (+ (not space)))) ; extension + "\\2" + basename) + dir))) (cond ((file-exists-p filename) dir) (:else @@ -187,6 +207,8 @@ URL's path and placed under `yoke-dir'." (url-retrieve-synchronously url)) (condition-case e (progn + (goto-char (point-min)) + (delete-region (point) (+ 1 (re-search-forward "^$"))) (make-directory dir :parents) (write-file filename 1) (message "Downloading %s... Done" url)) @@ -264,7 +286,7 @@ BODY after Emacs is finished initializing." (rest (cdr features))) (cond ((eq this 'init) `(yoke--eval-after-init - (lambda () (eval-after ,rest ,@body)))) + (lambda () (yoke-eval-after ,rest ,@body)))) (:else `(with-eval-after-load ',this (yoke-eval-after ,rest ,@body))))))) @@ -277,21 +299,51 @@ BODY after Emacs is finished initializing." (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) (list (rx (: "(yoke" (+ space) (? "(") (group (+ (not (or "(" " " "\t" "\n")))) - (+ space) - (group (+ (not space))))) + (* any))) 1))) -(defun yoke-compile () +;;; Package maintenance + +(defvar yoke--all "*all*" + "Value that `yoke--prompt-for-package' uses for all packages.") + +(defun yoke--choose-packages (prompt &optional onep) + "Choose from all of yoke's installed packages." + (funcall (if onep #'completing-read #'completing-read-multiple) + prompt + (cons yoke--all yoke-dirs) + nil :require-match nil nil + (unless onep yoke--all))) + +(defun yoke--choices (&optional selections) + "Either the SELECTIONS given, or all of `yoke-dirs'. +If `yoke--all' is part of SELECTIONS, or if it's not given, +return the full list of `yoke-dirs'." + (cond ((or (null selections) + (member yoke--all selections)) + yoke-dirs) + (:else selections))) + +(defun yoke-compile (&rest packages) "Compile all elisp files in `yoke-dirs'." - (interactive) - (dolist (dir yoke-dirs) + (interactive (yoke--choose-packages "Compile packages: ")) + (dolist (dir (yoke--choices packages)) (byte-recompile-directory dir 0))) +(defun yoke-update-autoloads (&rest packages) + "Update the autoloads in PACKAGES' directories." + (interactive (yoke--choose-packages "Generate autoloads for packages: ")) + (dolist (dir (yoke--choices packages)) + (message "Generating autoloads for %s..." dir) + (yoke-generate-autoloads (file-name-nondirectory dir) dir) + (message "Generating autoloads for %s... Done" dir))) + (defun yoke-remove (dir) + "Remove DIR from `yoke-dir'." (interactive - (completing-read "Remove: " yoke-dirs - nil :require-match)) - (delete-file dir :trash)) + (list (completing-read "Remove: " yoke-dirs + nil :require-match))) + (delete-directory dir :recursive :trash)) (provide 'yoke) ;;; yoke.el ends here -- cgit 1.4.1-21-gabe81