From 8c7871fec56b6c464bd06ba114225d7971c4699a Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 15 Nov 2022 19:51:52 -0600 Subject: meh --- lisp/acdw.el | 80 +++++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 49 insertions(+), 31 deletions(-) (limited to 'lisp/acdw.el') 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 -- cgit 1.4.1-21-gabe81