Function: cl-once-only

cl-once-only is a macro defined in compat-29.el.

Signature

(cl-once-only NAMES &rest BODY)

Documentation

[Compatibility macro for cl-once-only, defined in Emacs 29.1. See (compat)
Emacs 29.1' for more details.]

Generate code to evaluate each of NAMES just once in BODY.

This macro helps with writing other macros. Each of names is either (NAME FORM) or NAME, which latter means (NAME NAME). During macroexpansion, each NAME is bound to an uninterned symbol. The expansion evaluates each FORM and binds it to the corresponding uninterned symbol.

For example, consider this macro:

    (defmacro my-cons (x) (cl-once-only (x) `(cons ,x ,x)))

The call (my-cons (pop y)) will expand to something like this:

    (let ((g1 (pop y))) (cons g1 g1))

The use of cl-once-only ensures that the pop is performed only once, as intended.

See also macroexp-let2.

Source Code

;; Defined in ~/.emacs.d/elpa/compat-30.1.0.1/compat-29.el
(compat-defmacro cl-once-only (names &rest body) ;; <compat-tests:cl-once-only>
  "Generate code to evaluate each of NAMES just once in BODY.

This macro helps with writing other macros.  Each of names is
either (NAME FORM) or NAME, which latter means (NAME NAME).
During macroexpansion, each NAME is bound to an uninterned
symbol.  The expansion evaluates each FORM and binds it to the
corresponding uninterned symbol.

For example, consider this macro:

    (defmacro my-cons (x)
      (cl-once-only (x)
        \\=`(cons ,x ,x)))

The call (my-cons (pop y)) will expand to something like this:

    (let ((g1 (pop y)))
      (cons g1 g1))

The use of `cl-once-only' ensures that the pop is performed only
once, as intended.

See also `macroexp-let2'."
  ;; No :feature since macro is autoloaded
  (declare (debug (sexp body)) (indent 1))
  (setq names (mapcar #'ensure-list names))
  (let ((our-gensyms (cl-loop for _ in names collect (gensym))))
    `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym)))
       `(let ,(list
               ,@(cl-loop for name in names for gensym in our-gensyms
                          for to-eval = (or (cadr name) (car name))
                          collect ``(,,gensym ,,to-eval)))
          ,(let ,(cl-loop for name in names for gensym in our-gensyms
                          collect `(,(car name) ,gensym))
             ,@body)))))