mirror of
https://github.com/vale981/ement.el
synced 2025-03-04 08:51:39 -05:00
213 lines
8.7 KiB
EmacsLisp
213 lines
8.7 KiB
EmacsLisp
;;; ement-macros.el --- Ement macros -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2022 Free Software Foundation, Inc.
|
|
|
|
;; Author: Adam Porter <adam@alphapapa.net>
|
|
;; Maintainer: Adam Porter <adam@alphapapa.net>
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
;;;; Requirements
|
|
|
|
(require 'map)
|
|
|
|
;;;; Debugging
|
|
|
|
(require 'warnings)
|
|
|
|
;; NOTE: Uncomment this form and `emacs-lisp-byte-compile-and-load' the file to enable
|
|
;; `ement-debug' messages. This is commented out by default because, even though the
|
|
;; messages are only displayed when `warning-minimum-log-level' is `:debug' at runtime, if
|
|
;; that is so at expansion time, the expanded macro calls format the message and check the
|
|
;; log level at runtime, which is not zero-cost.
|
|
|
|
;; (eval-and-compile
|
|
;; (setq-local warning-minimum-log-level nil)
|
|
;; (setq-local warning-minimum-log-level :debug))
|
|
|
|
(cl-defmacro ement-debug (&rest args)
|
|
"Display a debug warning showing the runtime value of ARGS.
|
|
The warning automatically includes the name of the containing
|
|
function, and it is only displayed if `warning-minimum-log-level'
|
|
is `:debug' at expansion time (otherwise the macro expands to a
|
|
call to `ignore' with ARGS and is eliminated by the
|
|
byte-compiler). When debugging, the form also returns nil so,
|
|
e.g. it may be used in a conditional in place of nil.
|
|
|
|
Each of ARGS may be a string, which is displayed as-is, or a
|
|
symbol, the value of which is displayed prefixed by its name, or
|
|
a Lisp form, which is displayed prefixed by its first symbol.
|
|
|
|
Before the actual ARGS arguments, you can write keyword
|
|
arguments, i.e. alternating keywords and values. The following
|
|
keywords are supported:
|
|
|
|
:buffer BUFFER Name of buffer to pass to `display-warning'.
|
|
:level LEVEL Level passed to `display-warning', which see.
|
|
Default is :debug."
|
|
;; TODO: Can we use a compiler macro to handle this more elegantly?
|
|
(pcase-let* ((fn-name (when byte-compile-current-buffer
|
|
(with-current-buffer byte-compile-current-buffer
|
|
;; This is a hack, but a nifty one.
|
|
(save-excursion
|
|
(beginning-of-defun)
|
|
(cl-second (read (current-buffer)))))))
|
|
(plist-args (cl-loop while (keywordp (car args))
|
|
collect (pop args)
|
|
collect (pop args)))
|
|
((map (:buffer buffer) (:level level)) plist-args)
|
|
(level (or level :debug))
|
|
(string (cl-loop for arg in args
|
|
concat (pcase arg
|
|
((pred stringp) "%S ")
|
|
((pred symbolp)
|
|
(concat (upcase (symbol-name arg)) ":%S "))
|
|
((pred listp)
|
|
(concat "(" (upcase (symbol-name (car arg)))
|
|
(pcase (length arg)
|
|
(1 ")")
|
|
(_ "...)"))
|
|
":%S "))))))
|
|
(if (eq :debug warning-minimum-log-level)
|
|
`(let ((fn-name ,(if fn-name
|
|
`',fn-name
|
|
;; In an interpreted function: use `backtrace-frame' to get the
|
|
;; function name (we have to use a little hackery to figure out
|
|
;; how far up the frame to look, but this seems to work).
|
|
`(cl-loop for frame in (backtrace-frames)
|
|
for fn = (cl-second frame)
|
|
when (not (or (subrp fn)
|
|
(special-form-p fn)
|
|
(eq 'backtrace-frames fn)))
|
|
return (make-symbol (format "%s [interpreted]" fn))))))
|
|
(display-warning fn-name (format ,string ,@args) ,level ,buffer)
|
|
nil)
|
|
`(ignore ,@args))))
|
|
|
|
;;;; Macros
|
|
|
|
(defmacro ement-alist (&rest pairs)
|
|
"Expand to an alist of the keys and values in PAIRS."
|
|
`(list ,@(cl-loop for (key value) on pairs by #'cddr
|
|
collect `(cons ,key ,value))))
|
|
|
|
;;;;; Anaphoric
|
|
|
|
;; We could just depend on dash.el and use --first, and anaphora.el (only
|
|
;; on MELPA, not ELPA) has aprog1, but in order to reduce dependencies...
|
|
|
|
(defmacro ement-afirst (form list)
|
|
;; Sometimes checkdoc is really annoying. If I use "FORM returns" or
|
|
;; "FORM evaluates", it complains, so I can't have a clean linting.
|
|
"Return the first element of LIST for which FORM is non-nil.
|
|
In FORM, `it' is bound to the element being tested."
|
|
(declare (indent 1))
|
|
`(cl-loop for it in ,list
|
|
;; Avoid the `when' clause's implicit binding of `it'.
|
|
do (when ,form
|
|
(cl-return it))))
|
|
|
|
(defmacro ement-aprog1 (first &rest body)
|
|
"Like `prog1', but FIRST's value is bound to `it' around BODY."
|
|
(declare (indent 1))
|
|
`(let ((it ,first))
|
|
,@body
|
|
it))
|
|
|
|
(defmacro ement-singly (place-form &rest body)
|
|
"If PLACE-FORM is nil, set it non-nil and eval BODY.
|
|
BODY should set PLACE-FORM to nil when BODY is eligible to run
|
|
again."
|
|
(declare (indent defun))
|
|
`(unless ,place-form
|
|
(setf ,place-form t)
|
|
,@body))
|
|
|
|
;;;;; Progress reporters
|
|
|
|
;; MAYBE: Submit a `with-progress-reporter' macro to Emacs.
|
|
|
|
(defalias 'ement-progress-update #'ignore
|
|
"By default, this function does nothing. But inside
|
|
`ement-with-progress-reporter', it's bound to a function that
|
|
updates the current progress reporter.")
|
|
|
|
(defmacro ement-with-progress-reporter (args &rest body)
|
|
"Eval BODY with a progress reporter according to ARGS.
|
|
ARGS is a plist of these values:
|
|
|
|
:when If specified, a form evaluated at runtime to determine
|
|
whether to make and update a progress reporter. If not
|
|
specified, the reporter is always made and updated.
|
|
|
|
:reporter A list of arguments passed to
|
|
`make-progress-reporter', which see.
|
|
|
|
Around BODY, the function `ement-progress-update' is set to a
|
|
function that calls `progress-reporter-update' on the progress
|
|
reporter (or if the :when form evaluates to nil, the function is
|
|
set to `ignore'). It optionally takes a VALUE argument, and
|
|
without one, it automatically updates the value from the
|
|
reporter's min-value to its max-value."
|
|
(declare (indent defun))
|
|
(pcase-let* ((progress-reporter-sym (gensym))
|
|
(progress-value-sym (gensym))
|
|
(start-time-sym (gensym))
|
|
((map (:when when-form) (:reporter reporter-args)) args)
|
|
(`(,_message ,min-value ,_max-value) reporter-args)
|
|
(update-fn `(cl-function
|
|
(lambda (&optional (value (cl-incf ,progress-value-sym)))
|
|
(ement-debug "Updating progress reporter to" value)
|
|
(progress-reporter-update ,progress-reporter-sym value)))))
|
|
`(let* ((,start-time-sym (current-time))
|
|
(,progress-value-sym (or ,min-value 0))
|
|
(,progress-reporter-sym ,(if when-form
|
|
`(when ,when-form
|
|
(make-progress-reporter ,@reporter-args))
|
|
`(make-progress-reporter ,@reporter-args))))
|
|
;; We use `cl-letf' rather than `cl-labels', because labels expand to lambdas and funcalls,
|
|
;; so other functions that call `ement-progress-update' wouldn't call this definition.
|
|
(cl-letf (((symbol-function 'ement-progress-update)
|
|
,(if when-form
|
|
`(if ,when-form
|
|
,update-fn
|
|
#'ignore)
|
|
update-fn)))
|
|
,@body
|
|
(ement-debug (format "Ement: Progress reporter done (took %.2f seconds)"
|
|
(float-time (time-subtract (current-time) ,start-time-sym))))))))
|
|
|
|
;;;; Variables
|
|
|
|
|
|
;;;; Customization
|
|
|
|
|
|
;;;; Commands
|
|
|
|
|
|
;;;; Functions
|
|
|
|
|
|
;;;; Footer
|
|
|
|
(provide 'ement-macros)
|
|
|
|
;;; ement-macros.el ends here
|