diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-macs.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 25 |
1 files changed, 25 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c51ed9d8770..37244f5c350 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1837,6 +1837,27 @@ Labels have lexical scope and dynamic extent." `(throw ',catch-tag ',label)))) ,@macroexpand-all-environment))))) +(defun cl--prog (binder bindings body) + (let (decls) + (while (eq 'declare (car-safe (car body))) + (push (pop body) decls)) + `(cl-block nil + (,binder ,bindings + ,@(nreverse decls) + (cl-tagbody . ,body))))) + +;;;###autoload +(defmacro cl-prog (bindings &rest body) + "Run BODY like a `cl-tagbody' after setting up the BINDINGS. +Shorthand for (cl-block nil (let BINDINGS (cl-tagbody BODY)))" + (cl--prog 'let bindings body)) + +;;;###autoload +(defmacro cl-prog* (bindings &rest body) + "Run BODY like a `cl-tagbody' after setting up the BINDINGS. +Shorthand for (cl-block nil (let* BINDINGS (cl-tagbody BODY)))" + (cl--prog 'let* bindings body)) + ;;;###autoload (defmacro cl-do-symbols (spec &rest body) "Loop over all symbols. @@ -2701,7 +2722,11 @@ non-nil value, that slot cannot be set via `setf'. (let ((accessor (intern (format "%s%s" conc-name slot)))) (push slot slots) (push (nth 1 desc) defaults) + ;; The arg "cl-x" is referenced by name in eg pred-form + ;; and pred-check, so changing it is not straightforward. (push `(cl-defsubst ,accessor (cl-x) + ,(format "Access slot \"%s\" of `%s' struct CL-X." + slot struct) (declare (side-effect-free t)) ,@(and pred-check (list `(or ,pred-check |