From 33c7ddb09e0eae0796686c64ffa022a181145cc1 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 4 Jan 2023 23:21:15 -0600 Subject: Restart ... again ... again --- lisp/acdw-macs.el | 293 ------------------------------------------------------ 1 file changed, 293 deletions(-) delete mode 100644 lisp/acdw-macs.el (limited to 'lisp/acdw-macs.el') diff --git a/lisp/acdw-macs.el b/lisp/acdw-macs.el deleted file mode 100644 index e2258fa..0000000 --- a/lisp/acdw-macs.el +++ /dev/null @@ -1,293 +0,0 @@ -;;; acdw-macs.el --- extra macros -*- lexical-binding: t; -*- - -(eval-when-compile - (require 'cl-lib) - (require 'tempo) - (declare-function derived-mode-abbrev-table-name "tempo")) - -;;; Extra functionality for `eval-after-load' - -(defun eval-after-init (thunk) - "Evaluate THUNK after Emacs initiation, or now if already initialized." - (if after-init-time - (funcall thunk) - (add-hook 'after-init-hook thunk))) - -(defmacro eval-after (prereqs &rest body) - "Evaluate body after PREREQS. -PREREQS can be a feature, a number, `t', or a list of those. - -Features are used as arguments to `eval-after-load'. Numbers are -used as arguments to `run-with-idle-timer'. `t' will ensure BODY -runs after Emacs's init time. - -When given a list of PREREQS, `eval-after' will nest each one -from left to right." - (declare (indent 1) (debug (form def-body))) - (setf prereqs (ensure-list prereqs)) - (if (null prereqs) - (macroexp-progn body) - (let* ((this (car prereqs)) - (form `((lambda () (eval-after ,(cdr prereqs) ,@body))))) - (cond - ((eq this :init) - (append '(eval-after-init) form)) - ((numberp this) - (append `(run-with-idle-timer ,this nil) form)) - ((symbolp this) - (append `(eval-after-load ',this) form)) - (:else (user-error "Eval-after: Bad prereq: %S" this)))))) - - -;;; Easier customization of options -;; At some point it might be nice to include more forms in the VAR slots, like -;; `setup's `:option' macro. - -(if (fboundp 'setopt) - ;; Emacs 29 introduces `setopt', which does basically the same thing as the - ;; macro below. Not exactly the same, of course---it uses `setopt--set' - ;; instead of `customize-set-variable'---but I'm going to trust the Emacs - ;; devs on this one. - (defalias 'setc 'setopt) - (defmacro setc (&rest args) - "Customize user options in a `setq'-like way." - (declare (debug setq)) - (unless (zerop (mod (length args) 2)) - (signal 'wrong-number-of-arguments `(evenp ,(length args)))) - (let (form defuns) - (while args - (let* ((var (pop args)) - (val (pop args))) - (when (memq (car-safe val) '(defun defmacro)) - (push val defuns) - (setq val `(function ,(cadr val)))) - (push `(customize-set-variable ',var ,val "Set by `setc'.") - form))) - `(progn ,@(append (nreverse defuns) (nreverse form)))))) - - -;;; Extra def- forms - -(defmacro defdir (name directory &optional docstring) - "Define a variable and a function NAME expanding to DIRECTORY. -DOCSTRING is applied to the variable; its default is DIRECTORY's -path." - (declare (indent 2) (doc-string 3)) - `(progn - (defvar ,name ,directory - ,(concat (or docstring (format "%s" directory)) "\n" - "Defined by `defdir'.")) - (defun ,name (file &optional mkdir) - ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" - "If MKDIR is non-nil, parent directories are created.\n" - "Defined by `defdir'.") - (let ((file-name (expand-file-name - (convert-standard-filename file) ,name))) - (when mkdir - (make-directory (file-name-directory file-name) :parents)) - file-name)))) - -(defmacro defkeys (maps &rest bindings) - "Define key BINDINGS in MAPS. -If MAPS is nil or t, bind to `current-global-map'. Otherwise, -bind each of BINDINGS to the map or list of maps provided. - -BINDINGS is a `setq'-style list of pairs of keys and definitions. -The key part of each binding can be a string, in which case it's -passed to `kbd', or a vector or anything else `define-key' -accepts in the KEY position. The definition part, likewise, can -be any form `define-key' accepts in that position, with this -addition: if the form is a `defun' form, it will be defined -before any keys are bound." - (declare (indent 1)) - (unless (cl-evenp (length bindings)) - (signal 'wrong-number-of-arguments `(evenp ,(length bindings)))) - `(progn - ,@(cl-loop - for map in (ensure-list maps) - for first-map-p = t then nil - append - (cl-loop - for (keys def) on bindings by #'cddr - for defp = (memq (car-safe def) '(defmap defun defmacro)) - if (and defp first-map-p) collect def into defuns - append - (cl-loop - for key in (ensure-list keys) - collect (list 'define-key - (if (memq map '(t nil)) - '(current-global-map) - (or (car-safe map) map)) - (if (stringp key) - `(kbd ,key) - key) - (if defp - (cl-case (car def) - ((defmap) (cadr def)) - ((defun defmacro) `#',(cadr def)) - (otherwise (error "Bad def type: %S" - (car def)))) - def))) - into keydefs - finally return - (let ((all (append defuns keydefs))) - (if-let ((after (plist-get (cdr-safe map) :after))) - `((eval-after ,after - ,@all)) - all)))))) - -(defmacro defmap (name docstring &rest bindings) - "Define a keymap named NAME, with BINDINGS." - (declare (indent 1) (doc-string 2)) - `(,(if (boundp name) 'setq 'defvar) ,name - ;;; ^ probably a terrible hack - (let ((map (make-sparse-keymap))) - (defkeys map ,@bindings) - map) - ,@(unless (boundp name) (list docstring)))) - -(defmacro defhook (hooks &rest body) - "Define a function to hook into HOOKS. -NAME and ARGS are passed to the generated `defun' form. -Each hook in HOOKS can be the name of a hook or a list of the form -(HOOK DEPTH LOCAL), where each argument is the same as in -`add-hook'." - (declare (indent 1)) - (let* ((name (or (plist-get body :name) - (intern (format "%s/h" - (mapconcat - (lambda (h) - (string-remove-suffix - "-hook" - (if (and (consp h) - (caddr h)) - (format "%s:local" (car h)) - (format "%s" (or (car-safe h) - h))))) - (ensure-list hooks) - "|"))))) - (args (or (plist-get body :args) nil)) - (doc (or (plist-get body :doc) nil)) - (forms ; (DEFUN . FUNCS) - (cl-loop for form in (delete2 body :name :args :doc) - if (eq (car form) 'function) - collect form into funcs - else collect form into defuns - finally return (cons defuns funcs))) - (defun-forms (car forms)) - (func-forms (cdr forms))) - `(progn - ,@(when defun-forms - `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) - ,@(cl-loop for hook in (ensure-list hooks) - for h = (or (car-safe hook) hook) - for ha = (cdr-safe hook) - if defun-forms - collect `(add-hook ',h #',name ,@ha) - append - (cl-loop for fn in func-forms - collect `(add-hook ',h ,fn ,@ha)))))) - -;; (autoload FUNCTION FILE &optional DOCSTRING INTERACTIVE TYPE) -(defmacro defautoload (file &rest fns) - "Autoload FNS from FILE. -Each of FNS can be an atom (function name) or a list of the -form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible -keys are `:doc' (docstring), `:interactive', and `:type', which are -used as the optional arguments to `autoload'. - -You can also pass `:interactive' and `:type' as keyword arguments -just after FILE, and they'll serve as the default for the -autoloaded FNS." - (declare (indent 1)) - (let ((interactive (plist-get fns :interactive)) - (type (plist-get fns :type)) - (fns (delete2 fns :interactive :type))) - `(progn - ,@(cl-loop for fn in fns - for name = (or (car-safe fn) fn) - for args = (cdr-safe fn) - collect - `(autoload ',name ,(format "%s" file) - ,(plist-get args :doc) - ,(or (plist-get args :interactive) - interactive) - ,(or (plist-get args :type) - type)))))) - - -;;; Miscellaneous - -(defmacro with-message (message &rest body) - "Display MESSAGE then execute BODY. -If BODY executes without errors, display MESSAGE...done." - (declare (indent 1)) - (let ((msym (gensym)) - (esym (gensym))) - `(let ((,msym ,message)) - (condition-case ,esym - (progn (message "%s..." ,msym) - ,@body) - (:success (message "%s...done" ,msym)) - (t (signal (car ,esym) (cdr ,esym))))))) - -(defmacro o (&rest fns) - "Compose FNS into a new function for one argument." - (if (null fns) - `(lambda (&rest args) args) - `(lambda (&rest args) - (apply - #',(car fns) - (ensure-list (apply (o ,@(cdr fns)) args)))))) - -(defmacro with-region-or-buffer (&rest funcs) - "Advise FUNCS with `advise-region-or-buffer'." - `(progn - ,@(cl-loop for fn in funcs - collect - `(advice-add ',fn :before #'advise-region-or-buffer)))) - -(defmacro with-region-or-line (&rest funcs) - "Advise FUNCS with `advise-region-or-line'." - `(progn - ,@(cl-loop for fn in funcs - collect - `(advice-add ',fn :before #'advise-region-or-line)))) - -(defmacro with-region-or-to-eol (&rest funcs) - "Advise FUNCS with `advise-region-or-to-eol'." - `(progn - ,@(cl-loop for fn in funcs - collect - `(advice-add ',fn :before #'advise-region-or-to-eol)))) - -(defmacro define-tempo (tag doc &rest elements) - "Define a template and add its tag to MODE's abbrev-table. -TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. -ABBREV, if given, is the abbrev string to use for template expansion -under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." - (declare (indent 1)) - (let* ((template (gensym)) - (tag (cond ((stringp tag) tag) - ((symbolp tag) (symbol-name tag)) - (t (user-error "TAG must be a string or symbol: %S" tag)))) - (mode (or (plist-get elements :mode) nil)) - (abbrev (or (plist-get elements :abbrev) tag)) - (taglist (or (plist-get elements :taglist) nil)) - (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) - (while (and tname (not (memq tname abbrev-table-name-list))) - (setq tname (and (get mode 'derived-mode-parent) - (derived-mode-abbrev-table-name - (get mode 'derived-mode-parent))))) - (or tname 'global-abbrev-table))) - (elements (delete2 elements :mode :abbrev :taglist))) - `(let ((,template (tempo-define-template ,tag - ',elements - ,(or abbrev tag) - ,doc - ,taglist))) - (define-abbrev ,table ,tag "" ,template :system t) - (put ,template 'no-self-insert t)))) - -(provide 'acdw-macs) -;;; acdw-macs.el ends here -- cgit 1.4.1-21-gabe81