From 1d2487b1fc5f0648deb80507be8c713d4482fd8d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 11:12:49 -0500 Subject: * lisp/emacs-lisp/edebug.el: Misc cleanups. Move all definitions under the `edebug-` prefix. (edebug-get-spec): Rename from `get-edebug-spec`. (edebug-move-cursor): Use `cl-callf`. (edebug-spec-p): Remove unused function. (def-edebug-spec, edebug-spec-list, edebug-spec): Remove unused specs (nothing in there gets instrumented anyway). (edebug-tracing): Use `declare`. (edebug-cancel-on-entry): Rename from `cancel-edebug-on-entry`. (edebug-global-prefix): Rename from `global-edebug-prefix`. (edebug-global-map): Rename from `global-edebug-map`. * lisp/emacs-lisp/pcase.el (pcase-PAT): Remove `let`. (let): Use `declare` instead. (pcase--edebug-match-macro): Use new name `edebug-get-spec`. --- lisp/emacs-lisp/edebug.el | 101 ++++++++++++++++++++++------------------------ 1 file changed, 48 insertions(+), 53 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 0733dcec27b..04a4829c5e6 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -244,19 +244,22 @@ If the result is non-nil, then break. Errors are ignored." ;;; Form spec utilities. -(defun get-edebug-spec (symbol) +(defun edebug-get-spec (symbol) + "Return the Edebug spec of a given Lisp expression's head SYMBOL. +The argument is usually a symbol, but it doesn't have to be." ;; Get the spec of symbol resolving all indirection. (let ((spec nil) (indirect symbol)) (while - (progn - (and (symbolp indirect) - (setq indirect - (function-get indirect 'edebug-form-spec 'macro)))) + (and (symbolp indirect) + (setq indirect + (function-get indirect 'edebug-form-spec 'macro))) ;; (edebug-trace "indirection: %s" edebug-form-spec) (setq spec indirect)) spec)) +(define-obsolete-function-alias 'get-edebug-spec #'edebug-get-spec "28.1") + ;;;###autoload (defun edebug-basic-spec (spec) "Return t if SPEC uses only extant spec symbols. @@ -961,6 +964,18 @@ circular objects. Let `read' read everything else." ;;; Cursors for traversal of list and vector elements with offsets. +;; Edebug's instrumentation is based on parsing the sexps, which come with +;; auxiliary position information. Instead of keeping the position +;; information together with the sexps, it is kept in a "parallel +;; tree" of offsets. +;; +;; An "edebug cursor" is a pair of a *list of sexps* (called the +;; "expressions") together with a matching list of offsets. +;; When we're parsing the content of a list, the +;; `edebug-cursor-expressions' is simply the list but when parsing +;; a vector, the `edebug-cursor-expressions' is a list formed of the +;; elements of the vector. + (defvar edebug-dotted-spec nil "Set to t when matching after the dot in a dotted spec list.") @@ -1015,8 +1030,8 @@ circular objects. Let `read' read everything else." ;; The following test should always fail. (if (edebug-empty-cursor cursor) (edebug-no-match cursor "Not enough arguments.")) - (setcar cursor (cdr (car cursor))) - (setcdr cursor (cdr (cdr cursor))) + (cl-callf cdr (car cursor)) + (cl-callf cdr (cdr cursor)) cursor) @@ -1153,7 +1168,7 @@ purpose by adding an entry to this alist, and setting (eq 'symbol (progn (forward-char 1) (edebug-next-token-class)))) ;; Find out if this is a defining form from first symbol (setq def-kind (read (current-buffer)) - spec (and (symbolp def-kind) (get-edebug-spec def-kind)) + spec (and (symbolp def-kind) (edebug-get-spec def-kind)) defining-form-p (and (listp spec) (eq '&define (car spec))) ;; This is incorrect in general!! But OK most of the time. @@ -1502,7 +1517,7 @@ contains a circular object." (if (eq 'quote (car form)) form (let* ((head (car form)) - (spec (and (symbolp head) (get-edebug-spec head))) + (spec (and (symbolp head) (edebug-get-spec head))) (new-cursor (edebug-new-cursor form offset))) ;; Find out if this is a defining form from first symbol. ;; An indirect spec would not work here, yet. @@ -1542,7 +1557,7 @@ contains a circular object." (defsubst edebug-list-form-args (head cursor) ;; Process the arguments of a list form given that head of form is a symbol. ;; Helper for edebug-list-form - (let ((spec (get-edebug-spec head))) + (let ((spec (edebug-get-spec head))) (cond ;; Treat cl-macrolet bindings like macros with no spec. ((member head edebug--cl-macrolet-defs) @@ -1645,7 +1660,7 @@ contains a circular object." edebug-error-point (edebug-gate edebug-gate) ;; locally bound to limit effect ) - (edebug-match-specs cursor specs 'edebug-match-specs))) + (edebug-match-specs cursor specs #'edebug-match-specs))) (defun edebug-match-one-spec (cursor spec) @@ -1741,11 +1756,16 @@ contains a circular object." (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. )) + ;; FIXME: We abuse `edebug-form-spec' here. It's normally used to store the + ;; specs for a given sexp's head, but here we use it to keep the + ;; function implementing of a given "core spec". (put (car pair) 'edebug-form-spec (cdr pair))) (defun edebug-match-symbol (cursor symbol) ;; Match a symbol spec. - (let* ((spec (get-edebug-spec symbol))) + ;; FIXME: We abuse `edebug-get-spec' here, passing it a *spec* rather than + ;; the head element of a source sexp. + (let* ((spec (edebug-get-spec symbol))) (cond (spec (if (consp spec) @@ -2000,7 +2020,7 @@ contains a circular object." cursor "Expected lambda expression")) (offset (edebug-top-offset cursor)) (head (and (consp sexp) (car sexp))) - (spec (and (symbolp head) (get-edebug-spec head))) + (spec (and (symbolp head) (edebug-get-spec head))) (edebug-inside-func nil)) ;; Find out if this is a defining form from first symbol. (if (and (consp spec) (eq '&define (car spec))) @@ -2145,37 +2165,6 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;;;; Edebug Form Specs ;;; ========================================================== -;;;;* Spec for def-edebug-spec -;;; Out of date. - -(defun edebug-spec-p (object) - "Return non-nil if OBJECT is a symbol with an edebug-form-spec property." - (and (symbolp object) - (get object 'edebug-form-spec))) - -(def-edebug-spec def-edebug-spec - ;; Top level is different from lower levels. - (&define :name edebug-spec name - &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec))) - -(def-edebug-spec edebug-spec-list - ;; A list must have something in it, or it is nil, a symbolp - ((edebug-spec . [&or nil edebug-spec]))) - -(def-edebug-spec edebug-spec - (&or - edebug-spec-list - (vector &rest edebug-spec) ; matches a vector - ("vector" &rest edebug-spec) ; matches a vector spec - ("quote" symbolp) - stringp - [edebug-lambda-list-keywordp &rest edebug-spec] - [keywordp gate edebug-spec] - edebug-spec-p ;; Including all the special ones e.g. form. - symbolp;; a predicate - )) - - ;;;* Emacs special forms and some functions. ;; quote expects only one argument, although it allows any number. @@ -2485,11 +2474,10 @@ STATUS should be a list returned by `edebug-var-status'." (edebug-print-trace-after (format "%s result: %s" function edebug-result))))) -(def-edebug-spec edebug-tracing (form body)) - (defmacro edebug-tracing (msg &rest body) "Print MSG in *edebug-trace* before and after evaluating BODY. The result of BODY is also printed." + (declare (debug (form body))) `(let ((edebug-stack-depth (1+ edebug-stack-depth)) edebug-result) (edebug-print-trace-before ,msg) @@ -3601,7 +3589,10 @@ canceled the first time the function is entered." ;; Could store this in the edebug data instead. (put function 'edebug-on-entry (if flag 'temp t))) -(defalias 'edebug-cancel-edebug-on-entry #'cancel-edebug-on-entry) +(define-obsolete-function-alias 'edebug-cancel-edebug-on-entry + #'edebug-cancel-on-entry "28.1") +(define-obsolete-function-alias 'cancel-edebug-on-entry + #'edebug-cancel-on-entry "28.1") (defun edebug--edebug-on-entry-functions () (let ((functions nil)) @@ -3613,7 +3604,7 @@ canceled the first time the function is entered." obarray) functions)) -(defun cancel-edebug-on-entry (function) +(defun edebug-cancel-on-entry (function) "Cause Edebug to not stop when FUNCTION is called. The removes the effect of `edebug-on-entry'. If FUNCTION is is nil, remove `edebug-on-entry' on all functions." @@ -3937,10 +3928,14 @@ be installed in `emacs-lisp-mode-map'.") ;; Autoloading these global bindings doesn't make sense because ;; they cannot be used anyway unless Edebug is already loaded and active. -(defvar global-edebug-prefix "\^XX" +(define-obsolete-variable-alias 'global-edebug-prefix + 'edebug-global-prefix "28.1") +(defvar edebug-global-prefix "\^XX" "Prefix key for global edebug commands, available from any buffer.") -(defvar global-edebug-map +(define-obsolete-variable-alias 'global-edebug-map + 'edebug-global-map "28.1") +(defvar edebug-global-map (let ((map (make-sparse-keymap))) (define-key map " " 'edebug-step-mode) @@ -3973,9 +3968,9 @@ be installed in `emacs-lisp-mode-map'.") map) "Global map of edebug commands, available from any buffer.") -(when global-edebug-prefix - (global-unset-key global-edebug-prefix) - (global-set-key global-edebug-prefix global-edebug-map)) +(when edebug-global-prefix + (global-unset-key edebug-global-prefix) + (global-set-key edebug-global-prefix edebug-global-map)) (defun edebug-help () -- cgit v1.2.3 From c7b35ea3060b90ed68a933eed29e85dd2d567e3e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 12:17:40 -0500 Subject: * lisp/emacs-lisp/edebug.el (edebug--handle-&-spec-op) <&lookup>: New method * doc/lispref/edebug.texi (Specification List): Document it. * lisp/emacs-lisp/pcase.el (pcase-PAT): Use it. (pcase-MACRO): Remove Edebug element. (pcase--get-edebug-spec): New function. (pcase--edebug-match-macro): Remove function. --- doc/lispref/edebug.texi | 11 +++++++++++ etc/NEWS | 15 +++++++++------ lisp/emacs-lisp/edebug.el | 17 +++++++++++++++++ lisp/emacs-lisp/pcase.el | 40 +++++++++++++--------------------------- 4 files changed, 50 insertions(+), 33 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 569545d83f1..693d0e0630a 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1370,6 +1370,17 @@ is primarily used to generate more specific syntax error messages. See edebug-spec; it aborts the instrumentation, displaying the message in the minibuffer. +@item &lookup +Selects a specification based on the code being instrumented. +It takes the form @code{&lookup @var{spec} @var{fun} @var{args...}} +and means that Edebug will first match @var{spec} against the code and +then match the rest against the specification returned by calling +@var{fun} with the concatenation of @var{args...} and the code that +matched @code{spec}. For example @code{(&lookup symbolp +pcase--get-edebug-spec)} matches sexps whose first element is +a symbol and whose subsequent elements must obey the spec associated +with that head symbol according to @code{pcase--get-edebug-spec}. + @item @var{other-symbol} @cindex indirect specifications Any other symbol in a specification list may be a predicate or an diff --git a/etc/NEWS b/etc/NEWS index 228b773cb27..fe626fec7ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -938,14 +938,17 @@ To customize obsolete user options, use 'customize-option' or --- *** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. +*** Edebug specification lists can use some new keywords: + ++++ +**** '&lookup SPEC FUN ARGS...' lets FUN compute the specs to use + +++ -*** Edebug specification lists can use the new keyword '&error', which -unconditionally aborts the current edebug instrumentation with the -supplied error message. +**** '&error MSG' unconditionally aborts the current edebug instrumentation. -*** Edebug specification lists can use the new keyword ':unique', -which appends a unique suffix to the Edebug name of the current -definition. ++++ +**** ':unique STRING' appends STRING to the Edebug name of the current +definition to (hopefully) make it more unique. ** ElDoc diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 04a4829c5e6..782299454ea 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -55,6 +55,7 @@ (require 'backtrace) (require 'macroexp) (require 'cl-lib) +(require 'seq) (eval-when-compile (require 'pcase)) ;;; Options @@ -1866,6 +1867,22 @@ contains a circular object." (apply #'edebug-no-match cursor "Expected one of" original-specs)) )) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &lookup)) cursor specs) + "Compute the specs for `&lookup SPEC FUN ARGS...'. +Extracts the head of the data by matching it against SPEC, +and then matches the rest against the output of (FUN ARGS... HEAD)." + (pcase-let* + ((`(,spec ,fun . ,args) specs) + (exps (edebug-cursor-expressions cursor)) + (instrumented-head (edebug-match-one-spec cursor (or spec 'sexp))) + (consumed (- (length exps) + (length (edebug-cursor-expressions cursor)))) + (newspecs (apply fun (append args (seq-subseq exps 0 consumed))))) + (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) + ;; FIXME: What'd be the difference if we used `edebug-match-sublist', + ;; which is what `edebug-list-form-args' uses for the similar purpose + ;; when matching "normal" forms? + (append instrumented-head (edebug-match cursor newspecs)))) (cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs) ;; If any specs match, then fail diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7a88bdf8de5..d6c96c1ec82 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -62,45 +62,32 @@ (defvar pcase--dontwarn-upats '(pcase--dontcare)) -(def-edebug-spec - pcase-PAT - (&or symbolp - ("or" &rest pcase-PAT) - ("and" &rest pcase-PAT) - ("guard" form) - ("pred" pcase-FUN) - ("app" pcase-FUN pcase-PAT) - pcase-MACRO +(def-edebug-spec pcase-PAT + (&or (&lookup symbolp pcase--get-edebug-spec) sexp)) -(def-edebug-spec - pcase-FUN +(def-edebug-spec pcase-FUN (&or lambda-expr ;; Punt on macros/special forms. (functionp &rest form) sexp)) -;; See bug#24717 -(put 'pcase-MACRO 'edebug-form-spec #'pcase--edebug-match-macro) - ;; Only called from edebug. (declare-function edebug-get-spec "edebug" (symbol)) -(declare-function edebug-match "edebug" (cursor specs)) +(defun pcase--get-edebug-spec (head) + (or (alist-get head '((quote sexp) + (or &rest pcase-PAT) + (and &rest pcase-PAT) + (guard form) + (pred &or ("not" pcase-FUN) pcase-FUN) + (app pcase-FUN pcase-PAT))) + (let ((me (pcase--get-macroexpander head))) + (and me (symbolp me) (edebug-get-spec me))))) (defun pcase--get-macroexpander (s) "Return the macroexpander for pcase pattern head S, or nil" (get s 'pcase-macroexpander)) -(defun pcase--edebug-match-macro (cursor) - (let (specs) - (mapatoms - (lambda (s) - (let ((m (pcase--get-macroexpander s))) - (when (and m (edebug-get-spec m)) - (push (cons (symbol-name s) (edebug-get-spec m)) - specs))))) - (edebug-match cursor (cons '&or specs)))) - ;;;###autoload (defmacro pcase (exp &rest cases) ;; FIXME: Add some "global pattern" to wrap every case? @@ -938,8 +925,7 @@ Otherwise, it defers to REST which is a list of branches of the form (t (error "Unknown pattern `%S'" upat))))) (t (error "Incorrect MATCH %S" (car matches))))) -(def-edebug-spec - pcase-QPAT +(def-edebug-spec pcase-QPAT ;; Cf. edebug spec for `backquote-form' in edebug.el. (&or ("," pcase-PAT) (pcase-QPAT [&rest [¬ ","] pcase-QPAT] -- cgit v1.2.3 From d1be48fdedabb451d5c6cf315fd5f09a632e771f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 19:28:25 -0500 Subject: Edebug: Overload `edebug-form-spec` even less The `edebug-form-spec` symbol property was used both to map forms's head symbol to the corresponding spec, and to map spec element names to their expansion. This lead to name conflicts which break instrumentation of examples such as (cl-flet ((gate (x) x)) (gate 4)) because of the Edebug spec element `gate`. So introduce a new symbol property `edebug-elem-spec`. * lisp/subr.el (def-edebug-elem-spec): New function. * lisp/emacs-lisp/edebug.el (edebug--get-elem-spec): New function. (edebug-match-symbol): Use it. (Core Edebug elems): Put them on `edebug-elem-spec` instead of `edebug-form-spec`. (ELisp special forms): Set their `edebug-form-spec` via dolist. (Other non-core Edebug elems): Use `def-edebug-elem-spec`. (edebug-\`): Use `declare`. * lisp/emacs-lisp/pcase.el (pcase-PAT, pcase-FUN, pcase-QPAT): * lisp/skeleton.el (skeleton-edebug-spec): * lisp/emacs-lisp/cl-macs.el: Use `def-edebug-elem-spec`. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests--conflicting-internal-names): New test. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-cl-flet1): New test case. * doc/lispref/edebug.texi (Specification List): Add `def-edebug-elem-spec`. (Specification Examples): Use it. * doc/lispref/loading.texi (Hooks for Loading): Avoid the use of `def-edebug-spec` in example (better use `debug` declaration). --- doc/lispref/edebug.texi | 41 ++-- doc/lispref/loading.texi | 2 +- etc/NEWS | 7 + lisp/emacs-lisp/cl-macs.el | 170 ++++++++-------- lisp/emacs-lisp/edebug.el | 224 ++++++++++----------- lisp/emacs-lisp/pcase.el | 27 ++- lisp/skeleton.el | 8 +- lisp/subr.el | 17 +- .../edebug-resources/edebug-test-code.el | 10 + test/lisp/emacs-lisp/edebug-tests.el | 5 + 10 files changed, 273 insertions(+), 238 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 693d0e0630a..99d55c7ab95 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1203,7 +1203,7 @@ define Edebug specifications for special forms implemented in C. @defmac def-edebug-spec macro specification Specify which expressions of a call to macro @var{macro} are forms to be -evaluated. @var{specification} should be the edebug specification. +evaluated. @var{specification} should be the Edebug specification. Neither argument is evaluated. The @var{macro} argument can actually be any symbol, not just a macro @@ -1389,8 +1389,13 @@ indirect specification. If the symbol has an Edebug specification, this @dfn{indirect specification} should be either a list specification that is used in place of the symbol, or a function that is called to process the -arguments. The specification may be defined with @code{def-edebug-spec} -just as for macros. See the @code{defun} example. +arguments. The specification may be defined with +@code{def-edebug-elem-spec}: + +@defun def-edebug-elem-spec element specification +Define the @var{specification} to use in place of the symbol @var{element}. +@var{specification} has to be a list. +@end defun Otherwise, the symbol should be a predicate. The predicate is called with the argument, and if the predicate returns @code{nil}, the @@ -1568,14 +1573,14 @@ specification for @code{defmacro} is very similar to that for [&optional ("interactive" interactive)] def-body)) -(def-edebug-spec lambda-list - (([&rest arg] - [&optional ["&optional" arg &rest arg]] - &optional ["&rest" arg] - ))) +(def-edebug-elem-spec 'lambda-list + '(([&rest arg] + [&optional ["&optional" arg &rest arg]] + &optional ["&rest" arg] + ))) -(def-edebug-spec interactive - (&optional &or stringp def-form)) ; @r{Notice: @code{def-form}} +(def-edebug-elem-spec 'interactive + '(&optional &or stringp def-form)) ; @r{Notice: @code{def-form}} @end smallexample The specification for backquote below illustrates how to match @@ -1588,11 +1593,11 @@ could fail.) @smallexample (def-edebug-spec \` (backquote-form)) ; @r{Alias just for clarity.} -(def-edebug-spec backquote-form - (&or ([&or "," ",@@"] &or ("quote" backquote-form) form) - (backquote-form . [&or nil backquote-form]) - (vector &rest backquote-form) - sexp)) +(def-edebug-elem-spec 'backquote-form + '(&or ([&or "," ",@@"] &or ("quote" backquote-form) form) + (backquote-form . [&or nil backquote-form]) + (vector &rest backquote-form) + sexp)) @end smallexample @@ -1635,10 +1640,10 @@ option. @xref{Instrumenting}. @defopt edebug-eval-macro-args When this is non-@code{nil}, all macro arguments will be instrumented -in the generated code. For any macro, an @code{edebug-form-spec} +in the generated code. For any macro, the @code{debug} declaration overrides this option. So to specify exceptions for macros that have -some arguments evaluated and some not, use @code{def-edebug-spec} to -specify an @code{edebug-form-spec}. +some arguments evaluated and some not, use the @code{debug} declaration +specify an Edebug form specification. @end defopt @defopt edebug-save-windows diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 22f0dde593a..33f37331947 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1125,7 +1125,7 @@ You don't need to give a directory or extension in the file name @var{library}. Normally, you just give a bare file name, like this: @example -(with-eval-after-load "edebug" (def-edebug-spec c-point t)) +(with-eval-after-load "js" (define-key js-mode-map "\C-c\C-c" 'js-eval)) @end example To restrict which files can trigger the evaluation, include a diff --git a/etc/NEWS b/etc/NEWS index fe626fec7ec..464b955ee74 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -938,6 +938,13 @@ To customize obsolete user options, use 'customize-option' or --- *** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. ++++ +*** New function 'def-edebug-elem-spec' to define Edebug spec elements. +These used to be defined with 'def-edebug-spec' thus conflating the +two name spaces, which lead to name collisions. +The use of 'def-edebug-spec' to define Edebug spec elements is +declared obsolete. + *** Edebug specification lists can use some new keywords: +++ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c312afe55b9..5967e0d084f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -186,14 +186,14 @@ The name is made by appending a number to PREFIX, default \"T\"." ;;; Program structure. -(def-edebug-spec cl-declarations - (&rest ("cl-declare" &rest sexp))) +(def-edebug-elem-spec 'cl-declarations + '(&rest ("cl-declare" &rest sexp))) -(def-edebug-spec cl-declarations-or-string - (&or lambda-doc cl-declarations)) +(def-edebug-elem-spec 'cl-declarations-or-string + '(&or lambda-doc cl-declarations)) -(def-edebug-spec cl-lambda-list - (([&rest cl-lambda-arg] +(def-edebug-elem-spec 'cl-lambda-list + '(([&rest cl-lambda-arg] [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] [&optional ["&rest" cl-lambda-arg]] [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] @@ -202,27 +202,27 @@ The name is made by appending a number to PREFIX, default \"T\"." &or (cl-lambda-arg &optional def-form) arg]] . [&or arg nil]))) -(def-edebug-spec cl-&optional-arg - (&or (cl-lambda-arg &optional def-form arg) arg)) +(def-edebug-elem-spec 'cl-&optional-arg + '(&or (cl-lambda-arg &optional def-form arg) arg)) -(def-edebug-spec cl-&key-arg - (&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg)) +(def-edebug-elem-spec 'cl-&key-arg + '(&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg)) -(def-edebug-spec cl-lambda-arg - (&or arg cl-lambda-list1)) +(def-edebug-elem-spec 'cl-lambda-arg + '(&or arg cl-lambda-list1)) -(def-edebug-spec cl-lambda-list1 - (([&optional ["&whole" arg]] ;; only allowed at lower levels - [&rest cl-lambda-arg] - [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] - [&optional ["&rest" cl-lambda-arg]] - [&optional ["&key" cl-&key-arg &rest cl-&key-arg - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-lambda-arg &optional def-form) arg]] - . [&or arg nil]))) +(def-edebug-elem-spec 'cl-lambda-list1 + '(([&optional ["&whole" arg]] ;; only allowed at lower levels + [&rest cl-lambda-arg] + [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] + [&optional ["&rest" cl-lambda-arg]] + [&optional ["&key" cl-&key-arg &rest cl-&key-arg + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (cl-lambda-arg &optional def-form) arg]] + . [&or arg nil]))) -(def-edebug-spec cl-type-spec sexp) +(def-edebug-elem-spec 'cl-type-spec '(sexp)) (defconst cl--lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) @@ -390,39 +390,39 @@ and BODY is implicitly surrounded by (cl-block NAME ...). ;; Note that &environment is only allowed as first or last items in the ;; top level list. -(def-edebug-spec cl-macro-list - (([&optional "&environment" arg] - [&rest cl-macro-arg] - [&optional ["&optional" &rest - &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] - [&optional [[&or "&rest" "&body"] cl-macro-arg]] - [&optional ["&key" [&rest - [&or ([&or (symbolp cl-macro-arg) arg] - &optional def-form cl-macro-arg) - arg]] - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-macro-arg &optional def-form) arg]] - [&optional "&environment" arg] - ))) - -(def-edebug-spec cl-macro-arg - (&or arg cl-macro-list1)) - -(def-edebug-spec cl-macro-list1 - (([&optional "&whole" arg] ;; only allowed at lower levels - [&rest cl-macro-arg] - [&optional ["&optional" &rest - &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] - [&optional [[&or "&rest" "&body"] cl-macro-arg]] - [&optional ["&key" [&rest - [&or ([&or (symbolp cl-macro-arg) arg] - &optional def-form cl-macro-arg) - arg]] - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-macro-arg &optional def-form) arg]] - . [&or arg nil]))) +(def-edebug-elem-spec 'cl-macro-list + '(([&optional "&environment" arg] + [&rest cl-macro-arg] + [&optional ["&optional" &rest + &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] + [&optional [[&or "&rest" "&body"] cl-macro-arg]] + [&optional ["&key" [&rest + [&or ([&or (symbolp cl-macro-arg) arg] + &optional def-form cl-macro-arg) + arg]] + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (cl-macro-arg &optional def-form) arg]] + [&optional "&environment" arg] + ))) + +(def-edebug-elem-spec 'cl-macro-arg + '(&or arg cl-macro-list1)) + +(def-edebug-elem-spec 'cl-macro-list1 + '(([&optional "&whole" arg] ;; only allowed at lower levels + [&rest cl-macro-arg] + [&optional ["&optional" &rest + &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] + [&optional [[&or "&rest" "&body"] cl-macro-arg]] + [&optional ["&key" [&rest + [&or ([&or (symbolp cl-macro-arg) arg] + &optional def-form cl-macro-arg) + arg]] + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (cl-macro-arg &optional def-form) arg]] + . [&or arg nil]))) ;;;###autoload (defmacro cl-defmacro (name args &rest body) @@ -452,19 +452,19 @@ more details. (indent 2)) `(defmacro ,name ,@(cl--transform-lambda (cons args body) name))) -(def-edebug-spec cl-lambda-expr - (&define ("lambda" cl-lambda-list - cl-declarations-or-string - [&optional ("interactive" interactive)] - def-body))) +(def-edebug-elem-spec 'cl-lambda-expr + '(&define ("lambda" cl-lambda-list + cl-declarations-or-string + [&optional ("interactive" interactive)] + def-body))) ;; Redefine function-form to also match cl-function -(def-edebug-spec function-form +(def-edebug-elem-spec 'function-form ;; form at the end could also handle "function", ;; but recognize it specially to avoid wrapping function forms. - (&or ([&or "quote" "function"] &or symbolp lambda-expr) - ("cl-function" cl-function) - form)) + '(&or ([&or "quote" "function"] &or symbolp lambda-expr) + ("cl-function" cl-function) + form)) ;;;###autoload (defmacro cl-function (func) @@ -1051,20 +1051,20 @@ For more details, see Info node `(cl)Loop Facility'. ;; [&rest loop-clause] ;; )) -;; (def-edebug-spec loop-with -;; ("with" loop-var +;; (def-edebug-elem-spec 'loop-with +;; '("with" loop-var ;; loop-type-spec ;; [&optional ["=" form]] ;; &rest ["and" loop-var ;; loop-type-spec ;; [&optional ["=" form]]])) -;; (def-edebug-spec loop-for-as -;; ([&or "for" "as"] loop-for-as-subclause +;; (def-edebug-elem-spec 'loop-for-as +;; '([&or "for" "as"] loop-for-as-subclause ;; &rest ["and" loop-for-as-subclause])) -;; (def-edebug-spec loop-for-as-subclause -;; (loop-var +;; (def-edebug-elem-spec 'loop-for-as-subclause +;; '(loop-var ;; loop-type-spec ;; &or ;; [[&or "in" "on" "in-ref" "across-ref"] @@ -1124,19 +1124,19 @@ For more details, see Info node `(cl)Loop Facility'. ;; [&optional ["by" form]] ;; ])) -;; (def-edebug-spec loop-initial-final -;; (&or ["initially" +;; (def-edebug-elem-spec 'loop-initial-final +;; '(&or ["initially" ;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this. ;; &rest loop-non-atomic-expr] ;; ["finally" &or ;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr] ;; ["return" form]])) -;; (def-edebug-spec loop-and-clause -;; (loop-clause &rest ["and" loop-clause])) +;; (def-edebug-elem-spec 'loop-and-clause +;; '(loop-clause &rest ["and" loop-clause])) -;; (def-edebug-spec loop-clause -;; (&or +;; (def-edebug-elem-spec 'loop-clause +;; '(&or ;; [[&or "while" "until" "always" "never" "thereis"] form] ;; [[&or "collect" "collecting" @@ -1163,10 +1163,10 @@ For more details, see Info node `(cl)Loop Facility'. ;; loop-initial-final ;; )) -;; (def-edebug-spec loop-non-atomic-expr -;; ([¬ atom] form)) +;; (def-edebug-elem-spec 'loop-non-atomic-expr +;; '([¬ atom] form)) -;; (def-edebug-spec loop-var +;; (def-edebug-elem-spec 'loop-var ;; ;; The symbolp must be last alternative to recognize e.g. (a b . c) ;; ;; loop-var => ;; ;; (loop-var . [&or nil loop-var]) @@ -1175,13 +1175,13 @@ For more details, see Info node `(cl)Loop Facility'. ;; ;; (symbolp . (symbolp . [&or nil loop-var])) ;; ;; (symbolp . (symbolp . loop-var)) ;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp) -;; (&or (loop-var . [&or nil loop-var]) [gate symbolp])) +;; '(&or (loop-var . [&or nil loop-var]) [gate symbolp])) -;; (def-edebug-spec loop-type-spec -;; (&optional ["of-type" loop-d-type-spec])) +;; (def-edebug-elem-spec 'loop-type-spec +;; '(&optional ["of-type" loop-d-type-spec])) -;; (def-edebug-spec loop-d-type-spec -;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)) +;; (def-edebug-elem-spec 'loop-d-type-spec +;; '(&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)) (defun cl--parse-loop-clause () ; uses loop-* (let ((word (pop cl--loop-args)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 782299454ea..47b45614e71 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -261,6 +261,14 @@ The argument is usually a symbol, but it doesn't have to be." (define-obsolete-function-alias 'get-edebug-spec #'edebug-get-spec "28.1") +(defun edebug--get-elem-spec (elem) + "Return the specs of the Edebug element ELEM, if any. +ELEM has to be a symbol." + (or (get elem 'edebug-elem-spec) + ;; For backward compatibility, we also allow the use of + ;; a form's name as a shorthand to refer to its spec. + (edebug-get-spec elem))) + ;;;###autoload (defun edebug-basic-spec (spec) "Return t if SPEC uses only extant spec symbols. @@ -1757,16 +1765,11 @@ contains a circular object." (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. )) - ;; FIXME: We abuse `edebug-form-spec' here. It's normally used to store the - ;; specs for a given sexp's head, but here we use it to keep the - ;; function implementing of a given "core spec". - (put (car pair) 'edebug-form-spec (cdr pair))) + (put (car pair) 'edebug-elem-spec (cdr pair))) (defun edebug-match-symbol (cursor symbol) ;; Match a symbol spec. - ;; FIXME: We abuse `edebug-get-spec' here, passing it a *spec* rather than - ;; the head element of a source sexp. - (let* ((spec (edebug-get-spec symbol))) + (let* ((spec (edebug--get-elem-spec symbol))) (cond (spec (if (consp spec) @@ -2184,112 +2187,114 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;;;* Emacs special forms and some functions. -;; quote expects only one argument, although it allows any number. -(def-edebug-spec quote sexp) - -;; The standard defining forms. -(def-edebug-spec defconst defvar) -(def-edebug-spec defvar (symbolp &optional form stringp)) - -(def-edebug-spec defun - (&define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] - [&optional ("interactive" interactive)] - def-body)) -(def-edebug-spec defmacro - ;; FIXME: Improve `declare' so we can Edebug gv-expander and - ;; gv-setter declarations. - (&define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] def-body)) - -(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list. +(pcase-dolist + (`(,name ,spec) + + '((quote (sexp)) ;quote expects only one arg, tho it allows any number. + + ;; The standard defining forms. + (defvar (symbolp &optional form stringp)) + (defconst defvar) + + ;; Contrary to macros, special forms default to assuming that all args + ;; are normal forms, so we don't need to do anything about those + ;; special forms: + ;;(save-current-buffer t) + ;;(save-excursion t) + ;;... + ;;(progn t) + + ;; `defun' and `defmacro' are not special forms (any more), but it's + ;; more convenient to define their Edebug spec here. + (defun ( &define name lambda-list lambda-doc + [&optional ("declare" &rest sexp)] + [&optional ("interactive" &optional &or stringp def-form)] + def-body)) + + ;; FIXME: Improve `declare' so we can Edebug gv-expander and + ;; gv-setter declarations. + (defmacro ( &define name lambda-list lambda-doc + [&optional ("declare" &rest sexp)] + def-body)) + + ;; function expects a symbol or a lambda or macro expression + ;; A macro is allowed by Emacs. + (function (&or symbolp lambda-expr)) + + ;; FIXME? The manual uses this form (maybe that's just + ;; for illustration purposes?): + ;; (let ((&rest &or symbolp (gate symbolp &optional form)) body)) + (let ((&rest &or (symbolp &optional form) symbolp) body)) + (let* let) + + (setq (&rest symbolp form)) + (cond (&rest (&rest form))) + + (condition-case ( symbolp form + &rest ([&or symbolp (&rest symbolp)] body))) + + (\` (backquote-form)) + + ;; Assume immediate quote in unquotes mean backquote at next + ;; higher level. + (\, (&or ("quote" edebug-\`) def-form)) + (\,@ (&define ;; so (,@ form) is never wrapped. + &or ("quote" edebug-\`) def-form)) + )) + (put name 'edebug-form-spec spec)) -(def-edebug-spec lambda-list - (([&rest arg] - [&optional ["&optional" arg &rest arg]] - &optional ["&rest" arg] - ))) +(def-edebug-elem-spec 'lambda-list + '(([&rest arg] + [&optional ["&optional" arg &rest arg]] + &optional ["&rest" arg] + ))) -(def-edebug-spec lambda-doc - (&optional [&or stringp - (&define ":documentation" def-form)])) +(def-edebug-elem-spec 'arglist '(lambda-list)) ;; deprecated - use lambda-list. -(def-edebug-spec interactive - (&optional &or stringp def-form)) +(def-edebug-elem-spec 'lambda-doc + '(&optional [&or stringp + (&define ":documentation" def-form)])) ;; A function-form is for an argument that may be a function or a form. ;; This specially recognizes anonymous functions quoted with quote. -(def-edebug-spec function-form +(def-edebug-elem-spec 'function-form ;Deprecated, use `form'! ;; form at the end could also handle "function", ;; but recognize it specially to avoid wrapping function forms. - (&or ([&or "quote" "function"] &or symbolp lambda-expr) form)) - -;; function expects a symbol or a lambda or macro expression -;; A macro is allowed by Emacs. -(def-edebug-spec function (&or symbolp lambda-expr)) - -;; A macro expression is a lambda expression with "macro" prepended. -(def-edebug-spec macro (&define "lambda" lambda-list def-body)) - -;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro]))) - -;; Standard functions that take function-forms arguments. - -;; FIXME? The manual uses this form (maybe that's just for illustration?): -;; (def-edebug-spec let -;; ((&rest &or symbolp (gate symbolp &optional form)) -;; body)) -(def-edebug-spec let - ((&rest &or (symbolp &optional form) symbolp) - body)) - -(def-edebug-spec let* let) - -(def-edebug-spec setq (&rest symbolp form)) - -(def-edebug-spec cond (&rest (&rest form))) - -(def-edebug-spec condition-case - (symbolp - form - &rest ([&or symbolp (&rest symbolp)] body))) - - -(def-edebug-spec \` (backquote-form)) + '(&or ([&or "quote" "function"] &or symbolp lambda-expr) form)) ;; Supports quotes inside backquotes, ;; but only at the top level inside unquotes. -(def-edebug-spec backquote-form - (&or - ;; Disallow instrumentation of , and ,@ inside a nested backquote, since - ;; these are likely to be forms generated by a macro being debugged. - ("`" nested-backquote-form) - ([&or "," ",@"] &or ("quote" backquote-form) form) - ;; The simple version: - ;; (backquote-form &rest backquote-form) - ;; doesn't handle (a . ,b). The straightforward fix: - ;; (backquote-form . [&or nil backquote-form]) - ;; uses up too much stack space. - ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it. - (backquote-form [&rest [¬ ","] backquote-form] - . [&or nil backquote-form]) - ;; If you use dotted forms in backquotes, replace the previous line - ;; with the following. This takes quite a bit more stack space, however. - ;; (backquote-form . [&or nil backquote-form]) - (vector &rest backquote-form) - sexp)) - -(def-edebug-spec nested-backquote-form - (&or - ("`" &error "Triply nested backquotes (without commas \"between\" them) \ +(def-edebug-elem-spec 'backquote-form + '(&or + ;; Disallow instrumentation of , and ,@ inside a nested backquote, since + ;; these are likely to be forms generated by a macro being debugged. + ("`" nested-backquote-form) + ([&or "," ",@"] &or ("quote" backquote-form) form) + ;; The simple version: + ;; (backquote-form &rest backquote-form) + ;; doesn't handle (a . ,b). The straightforward fix: + ;; (backquote-form . [&or nil backquote-form]) + ;; uses up too much stack space. + ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it. + (backquote-form [&rest [¬ ","] backquote-form] + . [&or nil backquote-form]) + ;; If you use dotted forms in backquotes, replace the previous line + ;; with the following. This takes quite a bit more stack space, however. + ;; (backquote-form . [&or nil backquote-form]) + (vector &rest backquote-form) + sexp)) + +(def-edebug-elem-spec 'nested-backquote-form + '(&or + ("`" &error "Triply nested backquotes (without commas \"between\" them) \ are too difficult to instrument") - ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or - ;; (\,@ ...) matched on the next line. - ([&or "," ",@"] backquote-form) - (nested-backquote-form [&rest [¬ "," ",@"] nested-backquote-form] - . [&or nil nested-backquote-form]) - (vector &rest nested-backquote-form) - sexp)) + ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or + ;; (\,@ ...) matched on the next line. + ([&or "," ",@"] backquote-form) + (nested-backquote-form [&rest [¬ "," ",@"] nested-backquote-form] + . [&or nil nested-backquote-form]) + (vector &rest nested-backquote-form) + sexp)) ;; Special version of backquote that instruments backquoted forms ;; destined to be evaluated, usually as the result of a @@ -2304,20 +2309,9 @@ are too difficult to instrument") ;; ,@ might have some problems. -(defalias 'edebug-\` '\`) ;; same macro as regular backquote. -(def-edebug-spec edebug-\` (def-form)) - -;; Assume immediate quote in unquotes mean backquote at next higher level. -(def-edebug-spec \, (&or ("quote" edebug-\`) def-form)) -(def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped. - &or ("quote" edebug-\`) def-form)) - -;; New byte compiler. - -(def-edebug-spec save-selected-window t) -(def-edebug-spec save-current-buffer t) - -;; Anything else? +(defmacro edebug-\` (exp) + (declare (debug (def-form))) + (list '\` exp)) ;;; The debugger itself diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index d6c96c1ec82..5d428ac846a 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -62,15 +62,14 @@ (defvar pcase--dontwarn-upats '(pcase--dontcare)) -(def-edebug-spec pcase-PAT - (&or (&lookup symbolp pcase--get-edebug-spec) - sexp)) +(def-edebug-elem-spec 'pcase-PAT + '(&or (&lookup symbolp pcase--get-edebug-spec) sexp)) -(def-edebug-spec pcase-FUN - (&or lambda-expr - ;; Punt on macros/special forms. - (functionp &rest form) - sexp)) +(def-edebug-elem-spec 'pcase-FUN + '(&or lambda-expr + ;; Punt on macros/special forms. + (functionp &rest form) + sexp)) ;; Only called from edebug. (declare-function edebug-get-spec "edebug" (symbol)) @@ -925,13 +924,13 @@ Otherwise, it defers to REST which is a list of branches of the form (t (error "Unknown pattern `%S'" upat))))) (t (error "Incorrect MATCH %S" (car matches))))) -(def-edebug-spec pcase-QPAT +(def-edebug-elem-spec 'pcase-QPAT ;; Cf. edebug spec for `backquote-form' in edebug.el. - (&or ("," pcase-PAT) - (pcase-QPAT [&rest [¬ ","] pcase-QPAT] - . [&or nil pcase-QPAT]) - (vector &rest pcase-QPAT) - sexp)) + '(&or ("," pcase-PAT) + (pcase-QPAT [&rest [¬ ","] pcase-QPAT] + . [&or nil pcase-QPAT]) + (vector &rest pcase-QPAT) + sexp)) (pcase-defmacro \` (qpat) "Backquote-style pcase patterns: \\=`QPAT diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 48491e43cae..8a50fbef643 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -104,10 +104,10 @@ are integer buffer positions in the reverse order of the insertion order.") (defvar skeleton-point) (defvar skeleton-regions) -(def-edebug-spec skeleton-edebug-spec - ([&or null stringp (stringp &rest stringp) [[¬ atom] sexp]] - &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:" - ("quote" def-form) skeleton-edebug-spec def-form)) +(def-edebug-elem-spec 'skeleton-edebug-spec + '([&or null stringp (stringp &rest stringp) [[¬ atom] sexp]] + &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:" + ("quote" def-form) skeleton-edebug-spec def-form)) ;;;###autoload (defmacro define-skeleton (command documentation &rest skeleton) "Define a user-configurable COMMAND that enters a statement skeleton. diff --git a/lisp/subr.el b/lisp/subr.el index 454ea54b6a4..70ee281fe6e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -82,7 +82,7 @@ Testcover will raise an error." form) (defmacro def-edebug-spec (symbol spec) - "Set the `edebug-form-spec' property of SYMBOL according to SPEC. + "Set the Edebug SPEC to use for sexps which have SYMBOL as head. Both SYMBOL and SPEC are unevaluated. The SPEC can be: 0 (instrument no arguments); t (instrument all arguments); a symbol (naming a function with an Edebug specification); or a list. @@ -91,6 +91,21 @@ Info node `(elisp)Specification List' for details." (declare (indent 1)) `(put (quote ,symbol) 'edebug-form-spec (quote ,spec))) +(defun def-edebug-elem-spec (name spec) + "Define a new Edebug spec element NAME as shorthand for SPEC. +The SPEC has to be a list or a symbol. +The elements of the list describe the argument types; see +Info node `(elisp)Specification List' for details. +If SPEC is a symbol it should name another pre-existing Edebug element." + (declare (indent 1)) + (when (string-match "\\`[&:]" (symbol-name name)) + ;; & and : have special meaning in spec element names. + (error "Edebug spec name cannot start with '&' or ':'")) + (unless (consp spec) + (error "Edebug spec has to be a list: %S" spec)) + (put name 'edebug-elem-spec spec)) + + (defmacro lambda (&rest cdr) "Return an anonymous function. Under dynamic binding, a call of the form (lambda ARGS DOCSTRING diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index f8ca39c8c6e..d77df3c3c51 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -137,5 +137,15 @@ ,(cons func args)))) (wrap + 1 x))) +(defun edebug-test-code-cl-flet1 () + (cl-flet + ;; This `&rest' sexp head should not collide with + ;; the Edebug spec elem of the same name. + ((f (&rest x) x) + (gate (x) (+ x 5))) + ;; This call to `gate' shouldn't collide with the Edebug spec elem + ;; of the same name. + (message "Hi %s" (gate 7)))) + (provide 'edebug-test-code) ;;; edebug-test-code.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 6a6080df3c8..c11bfcf0012 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -954,6 +954,11 @@ primary ones (Bug#42671)." (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) +(ert-deftest edebug-tests--conflicting-internal-names () + "Check conflicts between form's head symbols and Edebug spec elements." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "cl-flet1" '(10) t))) + (ert-deftest edebug-tests-cl-flet () "Check that Edebug can instrument `cl-flet' forms without name clashes (Bug#41853)." -- cgit v1.2.3 From ca0842347e5437bcaeeded4a7fd55e0e48ed4bad Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Feb 2021 22:53:38 -0500 Subject: Edebug: Make it possible to debug `gv-expander`s in `declare` Arrange for declarations to be able to specify their own specs via the `edebug-declaration-spec` property. * lisp/emacs-lisp/edebug.el: (edebug--get-declare-spec): New function. (def-declarations): New spec element. (defun, defmacro): Use it in their spec. * lisp/emacs-lisp/gv.el (gv-expander, gv-setter): Set `edebug-declaration-spec`. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-gv-expander): New test. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-use-gv-expander): New test case. --- lisp/emacs-lisp/edebug.el | 12 ++++++++---- lisp/emacs-lisp/gv.el | 5 +++++ test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el | 6 ++++++ test/lisp/emacs-lisp/edebug-tests.el | 11 +++++++++++ 4 files changed, 30 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 47b45614e71..394f47090ca 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2207,14 +2207,12 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;; `defun' and `defmacro' are not special forms (any more), but it's ;; more convenient to define their Edebug spec here. (defun ( &define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] + [&optional ("declare" def-declarations)] [&optional ("interactive" &optional &or stringp def-form)] def-body)) - ;; FIXME: Improve `declare' so we can Edebug gv-expander and - ;; gv-setter declarations. (defmacro ( &define name lambda-list lambda-doc - [&optional ("declare" &rest sexp)] + [&optional ("declare" def-declarations)] def-body)) ;; function expects a symbol or a lambda or macro expression @@ -2243,6 +2241,12 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." )) (put name 'edebug-form-spec spec)) +(defun edebug--get-declare-spec (head) + (get head 'edebug-declaration-spec)) + +(def-edebug-elem-spec 'def-declarations + '(&rest &or (&lookup symbolp edebug--get-declare-spec) sexp)) + (def-edebug-elem-spec 'lambda-list '(([&rest arg] [&optional ["&optional" arg &rest arg]] diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index c160aa1fd35..edacdf7f0c8 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -187,6 +187,11 @@ arguments as NAME. DO is a function as defined in `gv-get'." (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist)) +;;;###autoload +(let ((spec '(&or symbolp ("lambda" &define lambda-list def-body)))) + (put 'gv-expander 'edebug-declaration-spec spec) + (put 'gv-setter 'edebug-declaration-spec spec)) + ;; (defmacro gv-define-expand (name expander) ;; "Use EXPANDER to handle NAME as a generalized var. ;; NAME is a symbol: the name of a function, macro, or special form. diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index d77df3c3c51..835d3781d09 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -147,5 +147,11 @@ ;; of the same name. (message "Hi %s" (gate 7)))) +(defun edebug-test-code-use-gv-expander (x) + (declare (gv-expander + (lambda (do) + (funcall do `(car ,x) (lambda (v) `(setcar ,x ,v)))))) + (car x)) + (provide 'edebug-test-code) ;;; edebug-test-code.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index c11bfcf0012..dfe2cb32065 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -959,6 +959,17 @@ primary ones (Bug#42671)." (edebug-tests-with-normal-env (edebug-tests-setup-@ "cl-flet1" '(10) t))) +(ert-deftest edebug-tests-gv-expander () + "Edebug can instrument `gv-expander' expressions." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "use-gv-expander" nil t) + (should (equal + (catch 'text + (run-at-time 0 nil + (lambda () (throw 'text (buffer-substring (point) (+ (point) 5))))) + (eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3) t)) + "(func")))) + (ert-deftest edebug-tests-cl-flet () "Check that Edebug can instrument `cl-flet' forms without name clashes (Bug#41853)." -- cgit v1.2.3 From f65402f851c91523ca44450c609bee07d37b9036 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 10:41:45 -0500 Subject: (backtrace-goto-source-functions): Make it a normal abnormal hook * lisp/emacs-lisp/backtrace.el (backtrace-goto-source-functions): Don't mark it as buffer-local any more. (backtrace-goto-source): Use `run-hook-with-args-until-success`. * lisp/emacs-lisp/edebug.el (edebug-pop-to-backtrace): Clarify that the hook is only intended to be modified buffer-locally. --- lisp/emacs-lisp/backtrace.el | 8 +++----- lisp/emacs-lisp/edebug.el | 3 ++- 2 files changed, 5 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 3e1c3292650..ea70baa9532 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -190,7 +190,7 @@ This is commonly used to recompute `backtrace-frames'.") (defvar-local backtrace-print-function #'cl-prin1 "Function used to print values in the current Backtrace buffer.") -(defvar-local backtrace-goto-source-functions nil +(defvar backtrace-goto-source-functions nil "Abnormal hook used to jump to the source code for the current frame. Each hook function is called with no argument, and should return non-nil if it is able to switch to the buffer containing the @@ -638,10 +638,8 @@ content of the sexp." (source-available (plist-get (backtrace-frame-flags frame) :source-available))) (unless (and source-available - (catch 'done - (dolist (func backtrace-goto-source-functions) - (when (funcall func) - (throw 'done t))))) + (run-hook-with-args-until-success + 'backtrace-goto-source-functions)) (user-error "Source code location not known")))) (defun backtrace-help-follow-symbol (&optional pos) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 394f47090ca..cbf2d171a96 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4247,7 +4247,8 @@ This should be a list of `edebug---frame' objects.") (pop-to-buffer edebug-backtrace-buffer) (unless (derived-mode-p 'backtrace-mode) (backtrace-mode) - (add-hook 'backtrace-goto-source-functions #'edebug--backtrace-goto-source)) + (add-hook 'backtrace-goto-source-functions + #'edebug--backtrace-goto-source nil t)) (setq edebug-instrumented-backtrace-frames (backtrace-get-frames 'edebug-debugger :constructor #'edebug--make-frame) -- cgit v1.2.3 From 2007afd21b5f6c72a7a9c15fd7c4785331f2700f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 16:21:53 -0500 Subject: * lisp/emacs-lisp/edebug.el (edebug--handle-&-spec-op <&name>): New method (edebug--concat-name): New function. (edebug-match-name, edebug-match-cl-generic-method-qualifier) (edebug-match-cl-generic-method-args): Delete functions. * doc/lispref/edebug.texi (Specification List): Document it. * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Use `&name`. (cl-generic--method-qualifier-p): New predicate. (cl-defmethod): Use it and `&name`. * lisp/emacs-lisp/cl-macs.el (cl-defun, cl-iter-defun, cl-flet): * lisp/emacs-lisp/eieio-compat.el (defmethod): * lisp/emacs-lisp/gv.el (gv-define-setter): * lisp/emacs-lisp/ert.el (ert-deftest): Use `&name`. * lisp/erc/erc-backend.el (define-erc-response-handler): Use `declare` and `&name`. --- doc/lispref/edebug.texi | 28 +++++-------- etc/NEWS | 9 ++-- lisp/emacs-lisp/cl-generic.el | 36 ++++++++++------ lisp/emacs-lisp/cl-macs.el | 9 ++-- lisp/emacs-lisp/edebug.el | 92 ++++++++++++++++++++++++----------------- lisp/emacs-lisp/eieio-compat.el | 2 +- lisp/emacs-lisp/ert.el | 4 +- lisp/emacs-lisp/gv.el | 3 +- lisp/erc/erc-backend.el | 12 +++--- 9 files changed, 111 insertions(+), 84 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 99d55c7ab95..2412e844b70 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1444,29 +1444,23 @@ Here is a list of additional specifications that may appear only after @code{&define}. See the @code{defun} example. @table @code +@item &name +Extracts the name of the current defining form from the code. +It takes the form @code{&name [@var{prestring}] @var{spec} +[@var{poststring}] @var{fun} @var{args...}} and means that Edebug will +match @var{spec} against the code and then call @var{fun} with the +concatenation of the current name, @var{args...}, @var{prestring}, +the code that matched @code{spec}, and @var{poststring}. If @var{fun} +is absent, it defaults to a function that concatenates the arguments +(with an @code{@} between the previous name and the new). + @item name The argument, a symbol, is the name of the defining form. +Shorthand for @code{[&name symbolp]}. A defining form is not required to have a name field; and it may have multiple name fields. -@item :name -This construct does not actually match an argument. The element -following @code{:name} should be a symbol; it is used as an additional -name component for the definition. You can use this to add a unique, -static component to the name of the definition. It may be used more -than once. - -@item :unique -This construct is like @code{:name}, but generates unique names. It -does not match an argument. The element following @code{:unique} -should be a string; it is used as the prefix for an additional name -component for the definition. You can use this to add a unique, -dynamic component to the name of the definition. This is useful for -macros that can define the same symbol multiple times in different -scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may -be used more than once. - @item arg The argument, a symbol, is the name of an argument of the defining form. However, lambda-list keywords (symbols starting with @samp{&}) diff --git a/etc/NEWS b/etc/NEWS index aead8c6f781..de26c0172b1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -936,7 +936,11 @@ To customize obsolete user options, use 'customize-option' or ** Edebug --- -*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. +*** Obsoletions +**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. + ++++ +**** The Edebug spec operator ':name NAME' is obsolete. +++ *** New function 'def-edebug-elem-spec' to define Edebug spec elements. @@ -954,8 +958,7 @@ declared obsolete. **** '&error MSG' unconditionally aborts the current edebug instrumentation. +++ -**** ':unique STRING' appends STRING to the Edebug name of the current -definition to (hopefully) make it more unique. +**** '&name SPEC FUN' extracts the current name from the code matching SPEC. ** ElDoc diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 8e36dbe4a36..229608395eb 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -206,22 +206,29 @@ DEFAULT-BODY, if present, is used as the body of a default method. \(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" (declare (indent 2) (doc-string 3) (debug - (&define [&or name ("setf" name :name setf)] listp - lambda-doc + (&define [&name sexp] ;Allow (setf ...) additionally to symbols. + listp lambda-doc [&rest [&or ("declare" &rest sexp) (":argument-precedence-order" &rest sexp) (&define ":method" - ;; FIXME: The `:unique' + ;; FIXME: The `gensym' ;; construct works around ;; Bug#42672. We'd rather want ;; names like those generated by ;; `cl-defmethod', but that ;; requires larger changes to ;; Edebug. - :unique "cl-generic-:method@" - [&rest cl-generic-method-qualifier] - cl-generic-method-args lambda-doc + [&name "cl-generic-:method@" []] + [&name [] gensym] ;Make it unique! + [&name + [[&rest cl-generic--method-qualifier-p] + ;; FIXME: We don't actually want the + ;; argument's names to be considered + ;; part of the name of the defined + ;; function. + listp]] ;Formal args + lambda-doc def-body)]] def-body))) (let* ((doc (if (stringp (car-safe options-and-methods)) @@ -398,6 +405,9 @@ the specializer used will be the one returned by BODY." (let ((combined-doc (buffer-string))) (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) +(defun cl-generic--method-qualifier-p (x) + (not (listp x))) + ;;;###autoload (defmacro cl-defmethod (name args &rest body) "Define a new method for generic function NAME. @@ -440,15 +450,17 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (declare (doc-string 3) (indent defun) (debug (&define ; this means we are defining something - [&or name ("setf" name :name setf)] - ;; ^^ This is the methods symbol - [ &rest cl-generic-method-qualifier ] - ;; Multiple qualifiers are allowed. - cl-generic-method-args ; arguments + [&name [sexp ;Allow (setf ...) additionally to symbols. + ;; Multiple qualifiers are allowed. + [&rest cl-generic--method-qualifier-p] + ;; FIXME: We don't actually want the argument's names + ;; to be considered part of the name of the + ;; defined function. + listp]] ; arguments lambda-doc ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil)) - (while (not (listp args)) + (while (cl-generic--method-qualifier-p args) (push args qualifiers) (setq args (pop body))) (when (eq 'setf (car-safe name)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 5967e0d084f..e2faf6df534 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -358,7 +358,7 @@ more details. \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug ;; Same as defun but use cl-lambda-list. - (&define [&or name ("setf" :name setf name)] + (&define [&name sexp] ;Allow (setf ...) additionally to symbols. cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] @@ -376,7 +376,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug ;; Same as iter-defun but use cl-lambda-list. - (&define [&or name ("setf" :name setf name)] + (&define [&name sexp] ;Allow (setf ...) additionally to symbols. cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] @@ -2016,8 +2016,9 @@ info node `(cl) Function Bindings' for details. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug ((&rest [&or (&define name :unique "cl-flet@" form) - (&define name :unique "cl-flet@" + (debug ((&rest [&or (symbolp form) + (&define [&name symbolp "@cl-flet@"] + [&name [] gensym] ;Make it unique! cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index cbf2d171a96..867161e0280 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1748,16 +1748,12 @@ contains a circular object." (dolist (pair '((form . edebug-match-form) (sexp . edebug-match-sexp) (body . edebug-match-body) - (name . edebug-match-name) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) ;; Less frequently used: ;; (function . edebug-match-function) (lambda-expr . edebug-match-lambda-expr) - (cl-generic-method-qualifier - . edebug-match-cl-generic-method-qualifier) - (cl-generic-method-args . edebug-match-cl-generic-method-args) (cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-name . edebug-match-cl-macrolet-name) (cl-macrolet-body . edebug-match-cl-macrolet-body) @@ -2056,19 +2052,61 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." ))) -(defun edebug-match-name (cursor) - ;; Set the edebug-def-name bound in edebug-defining-form. - (let ((name (edebug-top-element-required cursor "Expected name"))) - ;; Maybe strings and numbers could be used. - (if (not (symbolp name)) - (edebug-no-match cursor "Symbol expected for name of definition")) - (setq edebug-def-name - (if edebug-def-name - ;; Construct a new name by appending to previous name. - (intern (format "%s@%s" edebug-def-name name)) - name)) - (edebug-move-cursor cursor) - (list name))) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs) + "Compute the name for `&name SPEC FUN` spec operator. + +The full syntax of that operator is: + &name [PRESTRING] SPEC [POSTSTRING] FUN ARGS... + +Extracts the head of the data by matching it against SPEC, +and then get the new name to use by calling + (FUN ARGS... OLDNAME [PRESTRING] HEAD [POSTSTRING]) +FUN should return either a string or a symbol. +FUN can be missing in which case it defaults to concatenating +the new name to the end of the old with an \"@\" char between the two. +PRESTRING and POSTSTRING are optional strings that get prepended +or appended to the actual name." + (pcase-let* + ((`(,spec ,fun . ,args) specs) + (prestrings (when (stringp spec) + (prog1 (list spec) (setq spec fun fun (pop args))))) + (poststrings (when (stringp fun) + (prog1 (list fun) (setq fun (pop args))))) + (exps (edebug-cursor-expressions cursor)) + (instrumented (edebug-match-one-spec cursor spec)) + (consumed (- (length exps) + (length (edebug-cursor-expressions cursor)))) + (newname (apply (or fun #'edebug--concat-name) + `(,@args ,edebug-def-name + ,@prestrings + ,@(seq-subseq exps 0 consumed) + ,@poststrings)))) + (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) + (setq edebug-def-name (if (stringp newname) (intern newname) newname)) + instrumented)) + +(defun edebug--concat-name (oldname &rest newnames) + (let ((newname (if (null (cdr newnames)) + (car newnames) + ;; Put spaces between each name, but not for the + ;; leading and trailing strings, if any. + (let (beg mid end) + (dolist (name newnames) + (if (stringp name) + (push name (if mid end beg)) + (when end (setq mid (nconc end mid) end nil)) + (push name mid))) + (apply #'concat `(,@(nreverse beg) + ,(mapconcat (lambda (x) (format "%s" x)) + (nreverse mid) " ") + ,@(nreverse end))))))) + (if (null oldname) + (if (or (stringp newname) (symbolp newname)) + newname + (format "%s" newname)) + (format "%s@%s" edebug-def-name newname)))) + +(def-edebug-elem-spec 'name '(&name symbolp)) (cl-defgeneric edebug--handle-:-spec-op (op cursor spec) "Handle :foo spec operators. @@ -2094,26 +2132,6 @@ SPEC is the symbol name prefix for `gensym'." suffix))) nil) -(defun edebug-match-cl-generic-method-qualifier (cursor) - "Match a QUALIFIER for `cl-defmethod' at CURSOR." - (let ((args (edebug-top-element-required cursor "Expected qualifier"))) - ;; Like in CLOS spec, we support any non-list values. - (unless (atom args) (edebug-no-match cursor "Atom expected")) - ;; Append the arguments to `edebug-def-name' (Bug#42671). - (setq edebug-def-name (intern (format "%s %s" edebug-def-name args))) - (edebug-move-cursor cursor) - (list args))) - -(defun edebug-match-cl-generic-method-args (cursor) - (let ((args (edebug-top-element-required cursor "Expected arguments"))) - (if (not (consp args)) - (edebug-no-match cursor "List expected")) - ;; Append the arguments to edebug-def-name. - (setq edebug-def-name - (intern (format "%s %s" edebug-def-name args))) - (edebug-move-cursor cursor) - (list args))) - (defvar edebug--cl-macrolet-defs nil "List of symbols found within the bindings of enclosing `cl-macrolet' forms.") (defvar edebug--current-cl-macrolet-defs nil diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index db97d4ca4e8..6d84839c341 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -105,7 +105,7 @@ Summary: (declare (doc-string 3) (obsolete cl-defmethod "25.1") (debug (&define ; this means we are defining something - [&or name ("setf" name :name setf)] + [&name sexp] ;Allow (setf ...) additionally to symbols. ;; ^^ This is the methods symbol [ &optional symbolp ] ; this is key :before etc cl-generic-method-args ; arguments diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index fdbf95319ff..e08fa7ac7b3 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -196,8 +196,8 @@ it has to be wrapped in `(eval (quote ...))'. \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \ [:tags \\='(TAG...)] BODY...)" - (declare (debug (&define :name test - name sexp [&optional stringp] + (declare (debug (&define [&name "test@" symbolp] + sexp [&optional stringp] [&rest keywordp sexp] def-body)) (doc-string 3) (indent 2)) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index edacdf7f0c8..3200b1c3494 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -229,7 +229,8 @@ The first arg in ARGLIST (the one that receives VAL) receives an expression which can do arbitrary things, whereas the other arguments are all guaranteed to be pure and copyable. Example use: (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))" - (declare (indent 2) (debug (&define name :name gv-setter sexp def-body))) + (declare (indent 2) + (debug (&define [&name symbolp "@gv-setter"] sexp def-body))) `(gv-define-expander ,name (lambda (do &rest args) (declare-function diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 6f1193cbb2b..73c2b56b02e 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1079,14 +1079,12 @@ Finds hooks by looking in the `erc-server-responses' hash table." (erc-display-message parsed 'notice proc line))) -(put 'define-erc-response-handler 'edebug-form-spec - '(&define :name erc-response-handler - (name &rest name) - &optional sexp sexp def-body)) - (cl-defmacro define-erc-response-handler ((name &rest aliases) - &optional extra-fn-doc extra-var-doc - &rest fn-body) + &optional extra-fn-doc extra-var-doc + &rest fn-body) + (declare (debug (&define [&name "erc-response-handler@" + (symbolp &rest symbolp)] + &optional sexp sexp def-body))) "Define an ERC handler hook/function pair. NAME is the response name as sent by the server (see the IRC RFC for meanings). -- cgit v1.2.3 From 39a401ddae154b94e4c0e9c8ced1b27d9dc56daa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 17:50:31 -0500 Subject: * lisp/emacs-lisp/edebug.el (edebug-match-lambda-expr): Delete function (lambda-expr): Define with `def-edebug-elem-spec` instead. (edebug--handle-&-spec-op): Remove left over code. (interactive): Re-add mistakenly removed spec elem. * doc/lispref/edebug.texi (Specification List): Remove `function-form`. --- doc/lispref/edebug.texi | 10 +--------- etc/NEWS | 4 +++- lisp/emacs-lisp/edebug.el | 36 ++++++++---------------------------- 3 files changed, 12 insertions(+), 38 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 2412e844b70..46f5cb9026a 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1290,14 +1290,6 @@ Short for @code{&rest form}. See @code{&rest} below. If your macro wraps its body of code with @code{lambda} before it is evaluated, use @code{def-body} instead. See @code{def-body} below. -@item function-form -A function form: either a quoted function symbol, a quoted lambda -expression, or a form (that should evaluate to a function symbol or -lambda expression). This is useful when an argument that's a lambda -expression might be quoted with @code{quote} rather than -@code{function}, since it instruments the body of the lambda expression -either way. - @item lambda-expr A lambda expression with no quoting. @@ -1452,7 +1444,7 @@ match @var{spec} against the code and then call @var{fun} with the concatenation of the current name, @var{args...}, @var{prestring}, the code that matched @code{spec}, and @var{poststring}. If @var{fun} is absent, it defaults to a function that concatenates the arguments -(with an @code{@} between the previous name and the new). +(with an @code{@@} between the previous name and the new). @item name The argument, a symbol, is the name of the defining form. diff --git a/etc/NEWS b/etc/NEWS index de26c0172b1..d865aa7c746 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -940,7 +940,9 @@ To customize obsolete user options, use 'customize-option' or **** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. +++ -**** The Edebug spec operator ':name NAME' is obsolete. +**** The spec operator ':name NAME' is obsolete, use '&name' instead. ++++ +**** The spec element 'function-form' is obsolete, use 'form' instead. +++ *** New function 'def-edebug-elem-spec' to define Edebug spec elements. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 867161e0280..1cc95f7ac8c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1753,7 +1753,6 @@ contains a circular object." (def-form . edebug-match-def-form) ;; Less frequently used: ;; (function . edebug-match-function) - (lambda-expr . edebug-match-lambda-expr) (cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-name . edebug-match-cl-macrolet-name) (cl-macrolet-body . edebug-match-cl-macrolet-body) @@ -1873,7 +1872,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." (pcase-let* ((`(,spec ,fun . ,args) specs) (exps (edebug-cursor-expressions cursor)) - (instrumented-head (edebug-match-one-spec cursor (or spec 'sexp))) + (instrumented-head (edebug-match-one-spec cursor spec)) (consumed (- (length exps) (length (edebug-cursor-expressions cursor)))) (newspecs (apply fun (append args (seq-subseq exps 0 consumed))))) @@ -2026,32 +2025,6 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." offsets) specs)) -(defun edebug-match-lambda-expr (cursor) - ;; The expression must be a function. - ;; This will match any list form that begins with a symbol - ;; that has an edebug-form-spec beginning with &define. In - ;; practice, only lambda expressions should be used. - ;; I could add a &lambda specification to avoid confusion. - (let* ((sexp (edebug-top-element-required - cursor "Expected lambda expression")) - (offset (edebug-top-offset cursor)) - (head (and (consp sexp) (car sexp))) - (spec (and (symbolp head) (edebug-get-spec head))) - (edebug-inside-func nil)) - ;; Find out if this is a defining form from first symbol. - (if (and (consp spec) (eq '&define (car spec))) - (prog1 - (list - (edebug-defining-form - (edebug-new-cursor sexp offset) - (car offset);; before the sexp - (edebug-after-offset cursor) - (cons (symbol-name head) (cdr spec)))) - (edebug-move-cursor cursor)) - (edebug-no-match cursor "Expected lambda expression") - ))) - - (cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs) "Compute the name for `&name SPEC FUN` spec operator. @@ -2271,12 +2244,19 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." &optional ["&rest" arg] ))) +(def-edebug-elem-spec 'lambda-expr + '(("lambda" &define lambda-list lambda-doc + [&optional ("interactive" interactive)] + def-body))) + (def-edebug-elem-spec 'arglist '(lambda-list)) ;; deprecated - use lambda-list. (def-edebug-elem-spec 'lambda-doc '(&optional [&or stringp (&define ":documentation" def-form)])) +(def-edebug-elem-spec 'interactive '(&optional &or stringp def-form)) + ;; A function-form is for an argument that may be a function or a form. ;; This specially recognizes anonymous functions quoted with quote. (def-edebug-elem-spec 'function-form ;Deprecated, use `form'! -- cgit v1.2.3 From 2d9ff601ab5fc7187f0466f22c6c5e9451bce04f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 19:22:17 -0500 Subject: * lisp/emacs-lisp/edebug.el: Fix `called-interactively-p` And get rid of the old special-case handling of `interactive-p`, which is now redundant. (edebug--called-interactively-skip): Fix lexical-binding case, and adjust to some formerly missed call patterns. (edebug-def-interactive, edebug-interactive-p): Remove vars. (edebug-interactive-p-name, edebug-wrap-def-body) (edebug-make-enter-wrapper): Remove functions. (edebug-list-form): Don't special-case `interactive-p`. --- lisp/emacs-lisp/edebug.el | 70 ++++++++--------------------------------------- 1 file changed, 12 insertions(+), 58 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1cc95f7ac8c..76fb19023a0 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1235,54 +1235,11 @@ purpose by adding an entry to this alist, and setting (funcall edebug-after-instrumentation-function result)))) (defvar edebug-def-args) ; args of defining form. -(defvar edebug-def-interactive) ; is it an emacs interactive function? (defvar edebug-inside-func) ;; whether code is inside function context. ;; Currently def-form sets this to nil; def-body sets it to t. (defvar edebug--cl-macrolet-defs) ;; Fully defined below. -(defun edebug-interactive-p-name () - ;; Return a unique symbol for the variable used to store the - ;; status of interactive-p for this function. - (intern (format "edebug-%s-interactive-p" edebug-def-name))) - - -(defun edebug-wrap-def-body (forms) - "Wrap the FORMS of a definition body." - (if edebug-def-interactive - `(let ((,(edebug-interactive-p-name) - (called-interactively-p 'interactive))) - ,(edebug-make-enter-wrapper forms)) - (edebug-make-enter-wrapper forms))) - - -(defun edebug-make-enter-wrapper (forms) - ;; Generate the enter wrapper for some forms of a definition. - ;; This is not to be used for the body of other forms, e.g. `while', - ;; since it wraps the list of forms with a call to `edebug-enter'. - ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. - ;; Do this after parsing since that may find a name. - (when (string-match-p (rx bos "edebug-anon" (+ digit) eos) - (symbol-name edebug-old-def-name)) - ;; FIXME: Due to Bug#42701, we reset an anonymous name so that - ;; backtracking doesn't generate duplicate definitions. It would - ;; be better to not define wrappers in the case of a non-matching - ;; specification branch to begin with. - (setq edebug-old-def-name nil)) - (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) - `(edebug-enter - (quote ,edebug-def-name) - ,(if edebug-inside-func - `(list - ;; Doesn't work with more than one def-body!! - ;; But the list will just be reversed. - ,@(nreverse edebug-def-args)) - 'nil) - (function (lambda () ,@forms)) - )) - - (defvar edebug-form-begin-marker) ; the mark for def being instrumented (defvar edebug-offset-index) ; the next available offset index. @@ -1404,7 +1361,6 @@ contains a circular object." (edebug-old-def-name (edebug--form-data-name form-data-entry)) edebug-def-name edebug-def-args - edebug-def-interactive edebug-inside-func;; whether wrapped code executes inside a function. ) @@ -1610,11 +1566,6 @@ contains a circular object." ((symbolp head) (cond ((null head) nil) ; () is valid. - ((eq head 'interactive-p) - ;; Special case: replace (interactive-p) with variable - (setq edebug-def-interactive 'check-it) - (edebug-move-cursor cursor) - (edebug-interactive-p-name)) (t (cons head (edebug-list-form-args head (edebug-move-cursor cursor)))))) @@ -2170,7 +2121,7 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." ;; This happens to handle bug#20281, tho maybe a better fix would be to ;; improve the `defun' spec. (when forms - (list (edebug-wrap-def-body forms))))) + (list (edebug-make-enter-wrapper forms))))) ;;;; Edebug Form Specs @@ -2922,7 +2873,6 @@ See `edebug-behavior-alist' for implementations.") (defvar edebug-outside-match-data) ; match data outside of edebug (defvar edebug-backtrace-buffer) ; each recursive edit gets its own (defvar edebug-inside-windows) -(defvar edebug-interactive-p) (defvar edebug-mode-map) ; will be defined fully later. @@ -2938,7 +2888,6 @@ See `edebug-behavior-alist' for implementations.") ;;(edebug-number-of-recursions (1+ edebug-number-of-recursions)) (edebug-recursion-depth (recursion-depth)) edebug-entered ; bind locally to nil - (edebug-interactive-p nil) ; again non-interactive edebug-backtrace-buffer ; each recursive edit gets its own ;; The window configuration may be saved and restored ;; during a recursive-edit @@ -4588,13 +4537,18 @@ With prefix argument, make it a temporary breakpoint." (add-hook 'called-interactively-p-functions #'edebug--called-interactively-skip) (defun edebug--called-interactively-skip (i frame1 frame2) - (when (and (eq (car-safe (nth 1 frame1)) 'lambda) - (eq (nth 1 (nth 1 frame1)) '()) - (eq (nth 1 frame2) 'edebug-enter)) + (when (and (memq (car-safe (nth 1 frame1)) '(lambda closure)) + ;; Lambda value with no arguments. + (null (nth (if (eq (car-safe (nth 1 frame1)) 'lambda) 1 2) + (nth 1 frame1))) + (memq (nth 1 frame2) '(edebug-enter edebug-default-enter))) ;; `edebug-enter' calls itself on its first invocation. - (if (eq (nth 1 (backtrace-frame i 'called-interactively-p)) - 'edebug-enter) - 2 1))) + (let ((s 1)) + (while (memq (nth 1 (backtrace-frame i 'called-interactively-p)) + '(edebug-enter edebug-default-enter)) + (cl-incf s) + (cl-incf i)) + s))) ;; Finally, hook edebug into the rest of Emacs. ;; There are probably some other things that could go here. -- cgit v1.2.3 From 103039b06c2c9a917fc796d2a4afda8433e37473 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Feb 2021 19:24:33 -0500 Subject: * lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): Reinstate. Removed by accident. --- lisp/emacs-lisp/edebug.el | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 76fb19023a0..8fadeba6c9a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1240,6 +1240,33 @@ purpose by adding an entry to this alist, and setting (defvar edebug--cl-macrolet-defs) ;; Fully defined below. +(defun edebug-make-enter-wrapper (forms) + ;; Generate the enter wrapper for some forms of a definition. + ;; This is not to be used for the body of other forms, e.g. `while', + ;; since it wraps the list of forms with a call to `edebug-enter'. + ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. + ;; Do this after parsing since that may find a name. + (when (string-match-p (rx bos "edebug-anon" (+ digit) eos) + (symbol-name edebug-old-def-name)) + ;; FIXME: Due to Bug#42701, we reset an anonymous name so that + ;; backtracking doesn't generate duplicate definitions. It would + ;; be better to not define wrappers in the case of a non-matching + ;; specification branch to begin with. + (setq edebug-old-def-name nil)) + (setq edebug-def-name + (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) + `(edebug-enter + (quote ,edebug-def-name) + ,(if edebug-inside-func + `(list + ;; Doesn't work with more than one def-body!! + ;; But the list will just be reversed. + ,@(nreverse edebug-def-args)) + 'nil) + (function (lambda () ,@forms)) + )) + + (defvar edebug-form-begin-marker) ; the mark for def being instrumented (defvar edebug-offset-index) ; the next available offset index. -- cgit v1.2.3 From b939f7ad359807e846831a9854e0d94260d9f084 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Feb 2021 21:13:35 -0500 Subject: * Edebug: Generalize `&lookup`, use it for `cl-macrolet` and `cl-generic` This allows the use of (declare (debug ...)) in the lexical macros defined with `cl-macrolet`. It also fixes the names used by Edebug for the methods of `cl-generic` so it doesn't need to use gensym and so they don't include the formal arg names any more. * lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op): Rename from `edebug--handle-&-spec-op`. (edebug--match-&-spec-op <&interpose>): Rename from `&lookup` and generalize so it can let-bind dynamic variables around the rest of the parse. (edebug-lexical-macro-ctx): Rename from `edebug--cl-macrolet-defs` and make it into an alist. (edebug-list-form-args): Use the specs from `edebug-lexical-macro-ctx` when available. (edebug--current-cl-macrolet-defs): Delete var. (edebug-match-cl-macrolet-expr, edebug-match-cl-macrolet-name) (edebug-match-cl-macrolet-body): Delete functions. (def-declarations): Use new `&interpose`. (edebug--match-declare-arg): Rename from `edebug--get-declare-spec` and adjust to new calling convention. * lisp/subr.el (def-edebug-elem-spec): Fix docstring. (eval-after-load): Use `declare`. * lisp/emacs-lisp/cl-generic.el: Fix Edebug names so we don't need gensym any more and we only include the specializers but not the formal arg names. (cl--generic-edebug-name): New var. (cl--generic-edebug-remember-name, cl--generic-edebug-make-name): New funs. (cl-defgeneric, cl-defmethod): Use them. * lisp/emacs-lisp/cl-macs.el: Add support for `debug` declarations in `cl-macrolet`. (cl-declarations-or-string): Fix use of `lambda-doc` and allow use of `declare`. (edebug-lexical-macro-ctx): Declare var. (cl--edebug-macrolet-interposer): New function. (cl-macrolet): Use it to pass the right `lexical-macro-ctx` to the body. * lisp/emacs-lisp/pcase.el (pcase-PAT): Use new `&interpose`. (pcase--edebug-match-pat-args): Rename from `pcase--get-edebug-spec` and adjust to new calling convention. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-defgeneric/edebug/method): Adjust to the new names. * test/lisp/emacs-lisp/edebug-tests.el (edebug-cl-defmethod-qualifier) (edebug-tests-cl-flet): Adjust to the new names. * doc/lispref/edebug.texi (Specification List): Document &interpose. --- doc/lispref/edebug.texi | 22 ++-- etc/NEWS | 5 +- lisp/emacs-lisp/cl-generic.el | 76 ++++++----- lisp/emacs-lisp/cl-macs.el | 24 +++- lisp/emacs-lisp/edebug.el | 114 ++++++---------- lisp/emacs-lisp/pcase.el | 8 +- lisp/subr.el | 143 ++++++++++----------- test/lisp/emacs-lisp/cl-generic-tests.el | 12 +- .../edebug-resources/edebug-test-code.el | 4 +- test/lisp/emacs-lisp/edebug-tests.el | 24 ++-- 10 files changed, 218 insertions(+), 214 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 46f5cb9026a..3868f675ead 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1362,16 +1362,20 @@ is primarily used to generate more specific syntax error messages. See edebug-spec; it aborts the instrumentation, displaying the message in the minibuffer. -@item &lookup -Selects a specification based on the code being instrumented. -It takes the form @code{&lookup @var{spec} @var{fun} @var{args...}} +@item &interpose +Lets a function control the parsing of the remaining code. +It takes the form @code{&interpose @var{spec} @var{fun} @var{args...}} and means that Edebug will first match @var{spec} against the code and -then match the rest against the specification returned by calling -@var{fun} with the concatenation of @var{args...} and the code that -matched @code{spec}. For example @code{(&lookup symbolp -pcase--get-edebug-spec)} matches sexps whose first element is -a symbol and whose subsequent elements must obey the spec associated -with that head symbol according to @code{pcase--get-edebug-spec}. +then call @var{fun} with the code that matched @code{spec}, a parsing +function var{pf}, and finally @var{args...}. The parsing +function expects a single argument indicating the specification list +to use to parse the remaining code. It should be called exactly once +and returns the instrumented code that @var{fun} is expected to return. +For example @code{(&interpose symbolp pcase--match-pat-args)} matches +sexps whose first element is a symbol and then lets +@code{pcase--match-pat-args} lookup the specs associated +with that head symbol according to @code{pcase--match-pat-args} and +pass them to the var{pf} it received as argument. @item @var{other-symbol} @cindex indirect specifications diff --git a/etc/NEWS b/etc/NEWS index 33434d598ab..1adfb8c5bb1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -959,7 +959,10 @@ declared obsolete. *** Edebug specification lists can use some new keywords: +++ -**** '&lookup SPEC FUN ARGS...' lets FUN compute the specs to use +**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC. +More specifically, FUN is called with 'HEAD PF ARGS..' where +PF is a parsing function that expects a single argument (the specs to +use) and HEAD is the code that matched SPEC. +++ **** '&error MSG' unconditionally aborts the current edebug instrumentation. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 229608395eb..279b9d137c9 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -189,6 +189,32 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG (setf (cl--generic name) (setq generic (cl--generic-make name)))) generic)) +(defvar cl--generic-edebug-name nil) + +(defun cl--generic-edebug-remember-name (name pf &rest specs) + ;; Remember the name in `cl-defgeneric' so we can use it when building + ;; the names of its `:methods'. + (let ((cl--generic-edebug-name (car name))) + (funcall pf specs))) + +(defun cl--generic-edebug-make-name (in:method _oldname &rest quals-and-args) + ;; The name to use in Edebug for a method: use the generic + ;; function's name plus all its qualifiers and finish with + ;; its specializers. + (pcase-let* + ((basename (if in:method cl--generic-edebug-name (pop quals-and-args))) + (args (car (last quals-and-args))) + (`(,spec-args . ,_) (cl--generic-split-args args)) + (specializers (mapcar (lambda (spec-arg) + (if (eq '&context (car-safe (car spec-arg))) + spec-arg (cdr spec-arg))) + spec-args))) + (format "%s %s" + (mapconcat (lambda (sexp) (format "%s" sexp)) + (cons basename (butlast quals-and-args)) + " ") + specializers))) + ;;;###autoload (defmacro cl-defgeneric (name args &rest options-and-methods) "Create a generic function NAME. @@ -206,31 +232,22 @@ DEFAULT-BODY, if present, is used as the body of a default method. \(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" (declare (indent 2) (doc-string 3) (debug - (&define [&name sexp] ;Allow (setf ...) additionally to symbols. - listp lambda-doc - [&rest [&or - ("declare" &rest sexp) - (":argument-precedence-order" &rest sexp) - (&define ":method" - ;; FIXME: The `gensym' - ;; construct works around - ;; Bug#42672. We'd rather want - ;; names like those generated by - ;; `cl-defmethod', but that - ;; requires larger changes to - ;; Edebug. - [&name "cl-generic-:method@" []] - [&name [] gensym] ;Make it unique! - [&name - [[&rest cl-generic--method-qualifier-p] - ;; FIXME: We don't actually want the - ;; argument's names to be considered - ;; part of the name of the defined - ;; function. - listp]] ;Formal args - lambda-doc - def-body)]] - def-body))) + (&define + &interpose + [&name sexp] ;Allow (setf ...) additionally to symbols. + cl--generic-edebug-remember-name + listp lambda-doc + [&rest [&or + ("declare" &rest sexp) + (":argument-precedence-order" &rest sexp) + (&define ":method" + [&name + [[&rest cl-generic--method-qualifier-p] + listp] ;Formal args + cl--generic-edebug-make-name in:method] + lambda-doc + def-body)]] + def-body))) (let* ((doc (if (stringp (car-safe options-and-methods)) (pop options-and-methods))) (declarations nil) @@ -451,12 +468,9 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (debug (&define ; this means we are defining something [&name [sexp ;Allow (setf ...) additionally to symbols. - ;; Multiple qualifiers are allowed. - [&rest cl-generic--method-qualifier-p] - ;; FIXME: We don't actually want the argument's names - ;; to be considered part of the name of the - ;; defined function. - listp]] ; arguments + [&rest cl-generic--method-qualifier-p] ;qualifiers + listp] ; arguments + cl--generic-edebug-make-name nil] lambda-doc ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index e2faf6df534..b9a8a3f1125 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -190,7 +190,7 @@ The name is made by appending a number to PREFIX, default \"T\"." '(&rest ("cl-declare" &rest sexp))) (def-edebug-elem-spec 'cl-declarations-or-string - '(&or lambda-doc cl-declarations)) + '(lambda-doc &or ("declare" def-declarations) cl-declarations)) (def-edebug-elem-spec 'cl-lambda-list '(([&rest cl-lambda-arg] @@ -2193,6 +2193,20 @@ details. (macroexp-progn body) newenv))))) +(defvar edebug-lexical-macro-ctx) + +(defun cl--edebug-macrolet-interposer (bindings pf &rest specs) + ;; (cl-assert (null (cdr bindings))) + (setq bindings (car bindings)) + (let ((edebug-lexical-macro-ctx + (nconc (mapcar (lambda (binding) + (cons (car binding) + (when (eq 'declare (car-safe (nth 2 binding))) + (nth 1 (assq 'debug (cdr (nth 2 binding))))))) + bindings) + edebug-lexical-macro-ctx))) + (funcall pf specs))) + ;; The following ought to have a better definition for use with newer ;; byte compilers. ;;;###autoload @@ -2202,7 +2216,13 @@ This is like `cl-flet', but for macros instead of functions. \(fn ((NAME ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug (cl-macrolet-expr))) + (debug (&interpose (&rest (&define [&name symbolp "@cl-macrolet@"] + [&name [] gensym] ;Make it unique! + cl-macro-list + cl-declarations-or-string + def-body)) + cl--edebug-macrolet-interposer + cl-declarations body))) (if (cdr bindings) `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body)) (if (null bindings) (macroexp-progn body) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8fadeba6c9a..efca7305fea 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1188,6 +1188,9 @@ purpose by adding an entry to this alist, and setting ;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms) (let ((result (cond + ;; IIUC, `&define' is treated specially here so as to avoid + ;; entering Edebug during the actual function's definition: + ;; we only want to enter Edebug later when the thing is called. (defining-form-p (if (or edebug-all-defs edebug-all-forms) ;; If it is a defining form and we are edebugging defs, @@ -1238,7 +1241,9 @@ purpose by adding an entry to this alist, and setting (defvar edebug-inside-func) ;; whether code is inside function context. ;; Currently def-form sets this to nil; def-body sets it to t. -(defvar edebug--cl-macrolet-defs) ;; Fully defined below. + +(defvar edebug-lexical-macro-ctx nil + "Alist mapping lexically scoped macro names to their debug spec.") (defun edebug-make-enter-wrapper (forms) ;; Generate the enter wrapper for some forms of a definition. @@ -1549,13 +1554,10 @@ contains a circular object." (defsubst edebug-list-form-args (head cursor) ;; Process the arguments of a list form given that head of form is a symbol. ;; Helper for edebug-list-form - (let ((spec (edebug-get-spec head))) + (let* ((lex-spec (assq head edebug-lexical-macro-ctx)) + (spec (if lex-spec (cdr lex-spec) + (edebug-get-spec head)))) (cond - ;; Treat cl-macrolet bindings like macros with no spec. - ((member head edebug--cl-macrolet-defs) - (if edebug-eval-macro-args - (edebug-forms cursor) - (edebug-sexps cursor))) (spec (cond ((consp spec) @@ -1569,7 +1571,7 @@ contains a circular object." ; but leave it in for compatibility. )) ;; No edebug-form-spec provided. - ((macrop head) + ((or lex-spec (macrop head)) (if edebug-eval-macro-args (edebug-forms cursor) (edebug-sexps cursor))) @@ -1689,7 +1691,7 @@ contains a circular object." (first-char (and (symbolp spec) (aref (symbol-name spec) 0))) (match (cond ((eq ?& first-char);; "&" symbols take all following specs. - (edebug--handle-&-spec-op spec cursor (cdr specs))) + (edebug--match-&-spec-op spec cursor (cdr specs))) ((eq ?: first-char);; ":" symbols take one following spec. (setq rest (cdr (cdr specs))) (edebug--handle-:-spec-op spec cursor (car (cdr specs)))) @@ -1731,9 +1733,6 @@ contains a circular object." (def-form . edebug-match-def-form) ;; Less frequently used: ;; (function . edebug-match-function) - (cl-macrolet-expr . edebug-match-cl-macrolet-expr) - (cl-macrolet-name . edebug-match-cl-macrolet-name) - (cl-macrolet-body . edebug-match-cl-macrolet-body) (place . edebug-match-place) (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. @@ -1781,7 +1780,7 @@ contains a circular object." (defsubst edebug-match-body (cursor) (edebug-forms cursor)) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs) ;; Keep matching until one spec fails. (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) @@ -1807,11 +1806,11 @@ contains a circular object." ;; Reuse the &optional handler with this as the remainder handler. (edebug-&optional-wrapper cursor specs remainder-handler)) -(cl-defgeneric edebug--handle-&-spec-op (op cursor specs) +(cl-defgeneric edebug--match-&-spec-op (op cursor specs) "Handle &foo spec operators. &foo spec operators operate on all the subsequent SPECS.") -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs) ;; Repeatedly use specs until failure. (let ((edebug-&rest specs) ;; remember these edebug-best-error @@ -1819,7 +1818,7 @@ contains a circular object." (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &or)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs) ;; Keep matching until one spec succeeds, and return its results. ;; If none match, fail. ;; This needs to be optimized since most specs spend time here. @@ -1843,40 +1842,48 @@ contains a circular object." (apply #'edebug-no-match cursor "Expected one of" original-specs)) )) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &lookup)) cursor specs) - "Compute the specs for `&lookup SPEC FUN ARGS...'. +(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs) + "Compute the specs for `&interpose SPEC FUN ARGS...'. Extracts the head of the data by matching it against SPEC, -and then matches the rest against the output of (FUN ARGS... HEAD)." +and then matches the rest by calling (FUN HEAD PF ARGS...) +where PF is the parsing function which FUN can call exactly once, +passing it the specs that it needs to match. +Note that HEAD will always be a list, since specs are defined to match +a sequence of elements." (pcase-let* ((`(,spec ,fun . ,args) specs) (exps (edebug-cursor-expressions cursor)) (instrumented-head (edebug-match-one-spec cursor spec)) (consumed (- (length exps) (length (edebug-cursor-expressions cursor)))) - (newspecs (apply fun (append args (seq-subseq exps 0 consumed))))) + (head (seq-subseq exps 0 consumed))) (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) - ;; FIXME: What'd be the difference if we used `edebug-match-sublist', - ;; which is what `edebug-list-form-args' uses for the similar purpose - ;; when matching "normal" forms? - (append instrumented-head (edebug-match cursor newspecs)))) - -(cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs) + (apply fun `(,head + ,(lambda (newspecs) + ;; FIXME: What'd be the difference if we used + ;; `edebug-match-sublist', which is what + ;; `edebug-list-form-args' uses for the similar purpose + ;; when matching "normal" forms? + (append instrumented-head (edebug-match cursor newspecs))) + ,@args)))) + +(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs) ;; If any specs match, then fail (if (null (catch 'no-match (let ((edebug-gate nil)) (save-excursion - (edebug--handle-&-spec-op '&or cursor specs))) + (edebug--match-&-spec-op '&or cursor specs))) nil)) ;; This means something matched, so it is a no match. (edebug-no-match cursor "Unexpected")) ;; This means nothing matched, so it is OK. nil) ;; So, return nothing -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &key)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs) ;; Following specs must look like ( ) ... ;; where is the name of a keyword, and spec is its spec. ;; This really doesn't save much over the expanded form and takes time. - (edebug--handle-&-spec-op + (edebug--match-&-spec-op '&rest cursor (cons '&or @@ -1885,7 +1892,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." (car (cdr pair)))) specs)))) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &error)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs) ;; Signal an error, using the following string in the spec as argument. (let ((error-string (car specs)) (edebug-error-point (edebug-before-offset cursor))) @@ -1989,7 +1996,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." (defun edebug-match-function (_cursor) (error "Use function-form instead of function in edebug spec")) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &define)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs) ;; Match a defining form. ;; Normally, &define is interpreted specially other places. ;; This should only be called inside of a spec list to match the remainder @@ -2003,7 +2010,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)." offsets) specs)) -(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs) +(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs) "Compute the name for `&name SPEC FUN` spec operator. The full syntax of that operator is: @@ -2083,43 +2090,6 @@ SPEC is the symbol name prefix for `gensym'." suffix))) nil) -(defvar edebug--cl-macrolet-defs nil - "List of symbols found within the bindings of enclosing `cl-macrolet' forms.") -(defvar edebug--current-cl-macrolet-defs nil - "List of symbols found within the bindings of the current `cl-macrolet' form.") - -(defun edebug-match-cl-macrolet-expr (cursor) - "Match a `cl-macrolet' form at CURSOR." - (let (edebug--current-cl-macrolet-defs) - (edebug-match cursor - '((&rest (&define cl-macrolet-name cl-macro-list - cl-declarations-or-string - def-body)) - cl-declarations cl-macrolet-body)))) - -(defun edebug-match-cl-macrolet-name (cursor) - "Match the name in a `cl-macrolet' binding at CURSOR. -Collect the names in `edebug--cl-macrolet-defs' where they -will be checked by `edebug-list-form-args' and treated as -macros without a spec." - (let ((name (edebug-top-element-required cursor "Expected name"))) - (when (not (symbolp name)) - (edebug-no-match cursor "Bad name:" name)) - ;; Change edebug-def-name to avoid conflicts with - ;; names at global scope. - (setq edebug-def-name (gensym "edebug-anon")) - (edebug-move-cursor cursor) - (push name edebug--current-cl-macrolet-defs) - (list name))) - -(defun edebug-match-cl-macrolet-body (cursor) - "Match the body of a `cl-macrolet' expression at CURSOR. -Put the definitions collected in `edebug--current-cl-macrolet-defs' -into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." - (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs - edebug--cl-macrolet-defs))) - (edebug-match-body cursor))) - (defun edebug-match-arg (cursor) ;; set the def-args bound in edebug-defining-form (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) @@ -2210,11 +2180,11 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." )) (put name 'edebug-form-spec spec)) -(defun edebug--get-declare-spec (head) - (get head 'edebug-declaration-spec)) +(defun edebug--match-declare-arg (head pf) + (funcall pf (get (car head) 'edebug-declaration-spec))) (def-edebug-elem-spec 'def-declarations - '(&rest &or (&lookup symbolp edebug--get-declare-spec) sexp)) + '(&rest &or (&interpose symbolp edebug--match-declare-arg) sexp)) (def-edebug-elem-spec 'lambda-list '(([&rest arg] diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 5d428ac846a..d3928fa5051 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -63,7 +63,7 @@ (defvar pcase--dontwarn-upats '(pcase--dontcare)) (def-edebug-elem-spec 'pcase-PAT - '(&or (&lookup symbolp pcase--get-edebug-spec) sexp)) + '(&or (&interpose symbolp pcase--edebug-match-pat-args) sexp)) (def-edebug-elem-spec 'pcase-FUN '(&or lambda-expr @@ -73,7 +73,9 @@ ;; Only called from edebug. (declare-function edebug-get-spec "edebug" (symbol)) -(defun pcase--get-edebug-spec (head) +(defun pcase--edebug-match-pat-args (head pf) + ;; (cl-assert (null (cdr head))) + (setq head (car head)) (or (alist-get head '((quote sexp) (or &rest pcase-PAT) (and &rest pcase-PAT) @@ -81,7 +83,7 @@ (pred &or ("not" pcase-FUN) pcase-FUN) (app pcase-FUN pcase-PAT))) (let ((me (pcase--get-macroexpander head))) - (and me (symbolp me) (edebug-get-spec me))))) + (funcall pf (and me (symbolp me) (edebug-get-spec me)))))) (defun pcase--get-macroexpander (s) "Return the macroexpander for pcase pattern head S, or nil" diff --git a/lisp/subr.el b/lisp/subr.el index d215bd29a91..490aec93f19 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -64,8 +64,8 @@ For more information, see Info node `(elisp)Declaring Functions'." ;;;; Basic Lisp macros. -(defalias 'not 'null) -(defalias 'sxhash 'sxhash-equal) +(defalias 'not #'null) +(defalias 'sxhash #'sxhash-equal) (defmacro noreturn (form) "Evaluate FORM, expecting it not to return. @@ -93,10 +93,7 @@ Info node `(elisp)Specification List' for details." (defun def-edebug-elem-spec (name spec) "Define a new Edebug spec element NAME as shorthand for SPEC. -The SPEC has to be a list or a symbol. -The elements of the list describe the argument types; see -Info node `(elisp)Specification List' for details. -If SPEC is a symbol it should name another pre-existing Edebug element." +The SPEC has to be a list." (declare (indent 1)) (when (string-match "\\`[&:]" (symbol-name name)) ;; & and : have special meaning in spec element names. @@ -788,7 +785,7 @@ If TEST is omitted or nil, `equal' is used." (let (found (tail alist) value) (while (and tail (not found)) (let ((elt (car tail))) - (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key) + (when (funcall (or test #'equal) (if (consp elt) (car elt) elt) key) (setq found t value (if (consp elt) (cdr elt) default)))) (setq tail (cdr tail))) value)) @@ -938,14 +935,14 @@ For an approximate inverse of this, see `key-description'." "Make MAP override all normally self-inserting keys to be undefined. Normally, as an exception, digits and minus-sign are set to make prefix args, but optional second arg NODIGITS non-nil treats them like other chars." - (define-key map [remap self-insert-command] 'undefined) + (define-key map [remap self-insert-command] #'undefined) (or nodigits (let (loop) - (define-key map "-" 'negative-argument) + (define-key map "-" #'negative-argument) ;; Make plain numbers do numeric args. (setq loop ?0) (while (<= loop ?9) - (define-key map (char-to-string loop) 'digit-argument) + (define-key map (char-to-string loop) #'digit-argument) (setq loop (1+ loop)))))) (defun make-composed-keymap (maps &optional parent) @@ -982,8 +979,8 @@ a menu, so this function is not useful for non-menu keymaps." (setq key (if (<= (length key) 1) (aref key 0) (setq keymap (lookup-key keymap - (apply 'vector - (butlast (mapcar 'identity key))))) + (apply #'vector + (butlast (mapcar #'identity key))))) (aref key (1- (length key))))) (let ((tail keymap) done inserted) (while (and (not done) tail) @@ -1111,7 +1108,7 @@ Subkeymaps may be modified but are not canonicalized." (push (cons key item) bindings))) map))) ;; Create the new map. - (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt)) + (setq map (funcall (if ranges #'make-keymap #'make-sparse-keymap) prompt)) (dolist (binding ranges) ;; Treat char-ranges specially. FIXME: need to merge as well. (define-key map (vector (car binding)) (cdr binding))) @@ -1750,29 +1747,29 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Alternate names for functions - these are not being phased out. -(defalias 'send-string 'process-send-string) -(defalias 'send-region 'process-send-region) -(defalias 'string= 'string-equal) -(defalias 'string< 'string-lessp) -(defalias 'string> 'string-greaterp) -(defalias 'move-marker 'set-marker) -(defalias 'rplaca 'setcar) -(defalias 'rplacd 'setcdr) -(defalias 'beep 'ding) ;preserve lingual purity -(defalias 'indent-to-column 'indent-to) -(defalias 'backward-delete-char 'delete-backward-char) +(defalias 'send-string #'process-send-string) +(defalias 'send-region #'process-send-region) +(defalias 'string= #'string-equal) +(defalias 'string< #'string-lessp) +(defalias 'string> #'string-greaterp) +(defalias 'move-marker #'set-marker) +(defalias 'rplaca #'setcar) +(defalias 'rplacd #'setcdr) +(defalias 'beep #'ding) ;preserve lingual purity +(defalias 'indent-to-column #'indent-to) +(defalias 'backward-delete-char #'delete-backward-char) (defalias 'search-forward-regexp (symbol-function 're-search-forward)) (defalias 'search-backward-regexp (symbol-function 're-search-backward)) -(defalias 'int-to-string 'number-to-string) -(defalias 'store-match-data 'set-match-data) -(defalias 'chmod 'set-file-modes) -(defalias 'mkdir 'make-directory) +(defalias 'int-to-string #'number-to-string) +(defalias 'store-match-data #'set-match-data) +(defalias 'chmod #'set-file-modes) +(defalias 'mkdir #'make-directory) ;; These are the XEmacs names: -(defalias 'point-at-eol 'line-end-position) -(defalias 'point-at-bol 'line-beginning-position) +(defalias 'point-at-eol #'line-end-position) +(defalias 'point-at-bol #'line-beginning-position) (define-obsolete-function-alias 'user-original-login-name - 'user-login-name "28.1") + #'user-login-name "28.1") ;;;; Hook manipulation functions. @@ -1886,7 +1883,7 @@ one will be removed." (if local "Buffer-local" "Global")) fn-alist nil t) - fn-alist nil nil 'string=))) + fn-alist nil nil #'string=))) (list hook function local))) (or (boundp hook) (set hook nil)) (or (default-boundp hook) (set-default hook nil)) @@ -2098,9 +2095,9 @@ can do the job." (if (cond ((null compare-fn) (member element (symbol-value list-var))) - ((eq compare-fn 'eq) + ((eq compare-fn #'eq) (memq element (symbol-value list-var))) - ((eq compare-fn 'eql) + ((eq compare-fn #'eql) (memql element (symbol-value list-var))) (t (let ((lst (symbol-value list-var))) @@ -2532,7 +2529,7 @@ program before the output is collected. If STATUS-HANDLER is NIL, an error is signalled if the program returns with a non-zero exit status." (with-temp-buffer - (let ((status (apply 'call-process program nil (current-buffer) nil args))) + (let ((status (apply #'call-process program nil (current-buffer) nil args))) (if status-handler (funcall status-handler status) (unless (eq status 0) @@ -2578,7 +2575,7 @@ process." (format "Buffer %S has a running process; kill it? " (buffer-name (current-buffer))))))) -(add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function) +(add-hook 'kill-buffer-query-functions #'process-kill-buffer-query-function) ;; process plist management @@ -2766,7 +2763,7 @@ by doing (clear-string STRING)." (use-local-map read-passwd-map) (setq-local inhibit-modification-hooks nil) ;bug#15501. (setq-local show-paren-mode nil) ;bug#16091. - (add-hook 'post-command-hook 'read-password--hide-password nil t)) + (add-hook 'post-command-hook #'read-password--hide-password nil t)) (unwind-protect (let ((enable-recursive-minibuffers t) (read-hide-char (or read-hide-char ?*))) @@ -2776,8 +2773,8 @@ by doing (clear-string STRING)." ;; Not sure why but it seems that there might be cases where the ;; minibuffer is not always properly reset later on, so undo ;; whatever we've done here (bug#11392). - (remove-hook 'after-change-functions 'read-password--hide-password - 'local) + (remove-hook 'after-change-functions + #'read-password--hide-password 'local) (kill-local-variable 'post-self-insert-hook) ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) @@ -2807,7 +2804,7 @@ This function is used by the `interactive' code letter `n'." prompt nil nil nil (or hist 'read-number-history) (when default (if (consp default) - (mapcar 'number-to-string (delq nil default)) + (mapcar #'number-to-string (delq nil default)) (number-to-string default)))))) (condition-case nil (setq n (cond @@ -2961,13 +2958,13 @@ If there is a natural number at point, use it as default." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (define-key map [remap self-insert-command] 'read-char-from-minibuffer-insert-char) + (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char) - (define-key map [remap recenter-top-bottom] 'minibuffer-recenter-top-bottom) - (define-key map [remap scroll-up-command] 'minibuffer-scroll-up-command) - (define-key map [remap scroll-down-command] 'minibuffer-scroll-down-command) - (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window) - (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down) + (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom) + (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command) + (define-key map [remap scroll-down-command] #'minibuffer-scroll-down-command) + (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) + (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) map) "Keymap for the `read-char-from-minibuffer' function.") @@ -3030,9 +3027,9 @@ There is no need to explicitly add `help-char' to CHARS; (help-form-show))))) (dolist (char chars) (define-key map (vector char) - 'read-char-from-minibuffer-insert-char)) + #'read-char-from-minibuffer-insert-char)) (define-key map [remap self-insert-command] - 'read-char-from-minibuffer-insert-other) + #'read-char-from-minibuffer-insert-other) (puthash (list help-form (cons help-char chars)) map read-char-from-minibuffer-map-hash) map)) @@ -3065,26 +3062,26 @@ There is no need to explicitly add `help-char' to CHARS; (set-keymap-parent map minibuffer-local-map) (dolist (symbol '(act act-and-show act-and-exit automatic)) - (define-key map (vector 'remap symbol) 'y-or-n-p-insert-y)) + (define-key map (vector 'remap symbol) #'y-or-n-p-insert-y)) - (define-key map [remap skip] 'y-or-n-p-insert-n) + (define-key map [remap skip] #'y-or-n-p-insert-n) (dolist (symbol '(backup undo undo-all edit edit-replacement delete-and-edit ignore self-insert-command)) - (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other)) + (define-key map (vector 'remap symbol) #'y-or-n-p-insert-other)) - (define-key map [remap recenter] 'minibuffer-recenter-top-bottom) - (define-key map [remap scroll-up] 'minibuffer-scroll-up-command) - (define-key map [remap scroll-down] 'minibuffer-scroll-down-command) - (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window) - (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down) + (define-key map [remap recenter] #'minibuffer-recenter-top-bottom) + (define-key map [remap scroll-up] #'minibuffer-scroll-up-command) + (define-key map [remap scroll-down] #'minibuffer-scroll-down-command) + (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) + (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) - (define-key map [escape] 'abort-recursive-edit) + (define-key map [escape] #'abort-recursive-edit) (dolist (symbol '(quit exit exit-prefix)) - (define-key map (vector 'remap symbol) 'abort-recursive-edit)) + (define-key map (vector 'remap symbol) #'abort-recursive-edit)) ;; FIXME: try catch-all instead of explicit bindings: - ;; (define-key map [remap t] 'y-or-n-p-insert-other) + ;; (define-key map [remap t] #'y-or-n-p-insert-other) map) "Keymap that defines additional bindings for `y-or-n-p' answers.") @@ -3381,7 +3378,7 @@ This finishes the change group by reverting all of its changes." ;; For compatibility. (define-obsolete-function-alias 'redraw-modeline - 'force-mode-line-update "24.3") + #'force-mode-line-update "24.3") (defun momentary-string-display (string pos &optional exit-char message) "Momentarily display STRING in the buffer at POS. @@ -3525,7 +3522,7 @@ When in a major mode that does not provide its own symbol at point exactly." (let ((tag (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default)))) + #'find-tag-default)))) (if tag (regexp-quote tag)))) (defun find-tag-default-as-symbol-regexp () @@ -3539,8 +3536,8 @@ symbol at point exactly." (if (and tag-regexp (eq (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default) - 'find-tag-default)) + #'find-tag-default) + #'find-tag-default)) (format "\\_<%s\\_>" tag-regexp) tag-regexp))) @@ -3874,7 +3871,7 @@ discouraged." (call-process shell-file-name infile buffer display shell-command-switch - (mapconcat 'identity (cons command args) " "))) + (mapconcat #'identity (cons command args) " "))) (defun process-file-shell-command (command &optional infile buffer display &rest args) @@ -3886,7 +3883,7 @@ Similar to `call-process-shell-command', but calls `process-file'." (with-connection-local-variables (process-file shell-file-name infile buffer display shell-command-switch - (mapconcat 'identity (cons command args) " ")))) + (mapconcat #'identity (cons command args) " ")))) (defun call-shell-region (start end command &optional delete buffer) "Send text from START to END as input to an inferior shell running COMMAND. @@ -4905,8 +4902,8 @@ FILE, a string, is described in the function `eval-after-load'." "" ;; Note: regexp-opt can't be used here, since we need to call ;; this before Emacs has been fully started. 2006-05-21 - (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) - "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") + (concat "\\(" (mapconcat #'regexp-quote load-suffixes "\\|") "\\)?")) + "\\(" (mapconcat #'regexp-quote jka-compr-load-suffixes "\\|") "\\)?\\'")) (defun load-history-filename-element (file-regexp) @@ -4922,7 +4919,6 @@ Return nil if there isn't one." load-elt (and loads (car loads))))) load-elt)) -(put 'eval-after-load 'lisp-indent-function 1) (defun eval-after-load (file form) "Arrange that if FILE is loaded, FORM will be run immediately afterwards. If FILE is already loaded, evaluate FORM right now. @@ -4957,7 +4953,8 @@ like `font-lock'. This function makes or adds to an entry on `after-load-alist'. See also `with-eval-after-load'." - (declare (compiler-macro + (declare (indent 1) + (compiler-macro (lambda (whole) (if (eq 'quote (car-safe form)) ;; Quote with lambda so the compiler can look inside. @@ -5064,7 +5061,7 @@ This function is called directly from the C code." "Display delayed warnings from `delayed-warnings-list'. Used from `delayed-warnings-hook' (which see)." (dolist (warning (nreverse delayed-warnings-list)) - (apply 'display-warning warning)) + (apply #'display-warning warning)) (setq delayed-warnings-list nil)) (defun collapse-delayed-warnings () @@ -5397,7 +5394,7 @@ The properties used on SYMBOL are `composefunc', `sendfunc', `abortfunc', and `hookvar'." (put symbol 'composefunc composefunc) (put symbol 'sendfunc sendfunc) - (put symbol 'abortfunc (or abortfunc 'kill-buffer)) + (put symbol 'abortfunc (or abortfunc #'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) @@ -5562,7 +5559,7 @@ To test whether a function can be called interactively, use (set symbol tail))))) (define-obsolete-function-alias - 'set-temporary-overlay-map 'set-transient-map "24.4") + 'set-temporary-overlay-map #'set-transient-map "24.4") (defun set-transient-map (map &optional keep-pred on-exit) "Set MAP as a temporary keymap taking precedence over other keymaps. @@ -6190,7 +6187,7 @@ returned list are in the same order as in TREE. ;; Technically, `flatten-list' is a misnomer, but we provide it here ;; for discoverability: -(defalias 'flatten-list 'flatten-tree) +(defalias 'flatten-list #'flatten-tree) ;; The initial anchoring is for better performance in searching matches. (defconst regexp-unmatchable "\\`a\\`" diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 4a01623cb88..9312fb44a1e 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -269,9 +269,7 @@ Edebug symbols (Bug#42672)." (when (memq name instrumented-names) (error "Duplicate definition of `%s'" name)) (push name instrumented-names) - (edebug-new-definition name))) - ;; Make generated symbols reproducible. - (gensym-counter 10000)) + (edebug-new-definition name)))) (eval-buffer) (should (equal (reverse instrumented-names) @@ -280,11 +278,11 @@ Edebug symbols (Bug#42672)." ;; FIXME: We'd rather have names such as ;; `cl-defgeneric/edebug/method/1 ((_ number))', but ;; that requires further changes to Edebug. - (list (intern "cl-generic-:method@10000 ((_ number))") - (intern "cl-generic-:method@10001 ((_ string))") - (intern "cl-generic-:method@10002 :around ((_ number))") + (list (intern "cl-defgeneric/edebug/method/1 (number)") + (intern "cl-defgeneric/edebug/method/1 (string)") + (intern "cl-defgeneric/edebug/method/1 :around (number)") 'cl-defgeneric/edebug/method/1 - (intern "cl-generic-:method@10003 ((_ number))") + (intern "cl-defgeneric/edebug/method/2 (number)") 'cl-defgeneric/edebug/method/2)))))) (provide 'cl-generic-tests) diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index 835d3781d09..9257f167d67 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -62,12 +62,12 @@ (defun edebug-test-code-format-vector-node (node) !start!(concat "[" - (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply! + (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply! "]")) (defun edebug-test-code-format-list-node (node) !start!(concat "{" - (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply! + (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply! "}")) (defun edebug-test-code-format-node (node) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index dfe2cb32065..d81376e45ec 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -951,8 +951,8 @@ primary ones (Bug#42671)." (should (equal defined-symbols - (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") - (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) + (list (intern "edebug-cl-defmethod-qualifier :around (number)") + (intern "edebug-cl-defmethod-qualifier (number)"))))))) (ert-deftest edebug-tests--conflicting-internal-names () "Check conflicts between form's head symbols and Edebug spec elements." @@ -992,23 +992,19 @@ clashes (Bug#41853)." ;; Make generated symbols reproducible. (gensym-counter 10000)) (eval-buffer) - (should (equal (reverse instrumented-names) + ;; Use `format' so as to throw away differences due to + ;; interned/uninterned symbols. + (should (equal (format "%s" (reverse instrumented-names)) ;; The outer definitions come after the inner ;; ones because their body ends later. - ;; FIXME: There are twice as many inner - ;; definitions as expected due to Bug#41988. - ;; Once that bug is fixed, remove the duplicates. ;; FIXME: We'd rather have names such as ;; `edebug-tests-cl-flet-1@inner@cl-flet@10000', ;; but that requires further changes to Edebug. - '(inner@cl-flet@10000 - inner@cl-flet@10001 - inner@cl-flet@10002 - inner@cl-flet@10003 - edebug-tests-cl-flet-1 - inner@cl-flet@10004 - inner@cl-flet@10005 - edebug-tests-cl-flet-2)))))) + (format "%s" '(inner@cl-flet@10000 + inner@cl-flet@10001 + edebug-tests-cl-flet-1 + inner@cl-flet@10002 + edebug-tests-cl-flet-2))))))) (ert-deftest edebug-tests-duplicate-symbol-backtrack () "Check that Edebug doesn't create duplicate symbols when -- cgit v1.2.3 From 54e577fbc1fb2e1189388ac290fe70d0f87b6c76 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Feb 2021 23:56:42 -0500 Subject: * lisp/emacs-lisp/edebug.el (edebug-&optional, edebug-&rest): Remove vars According to my tests, `edebug-&optional` never has any effect. And `edebug-&rest` can be replaced with a closure. (edebug-&rest-wrapper): Remove function. (edebug--match-&-spec-op): Use a closure to remember the `specs`. --- lisp/emacs-lisp/edebug.el | 59 +++++++++++++++++++---------------------------- 1 file changed, 24 insertions(+), 35 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index efca7305fea..7fae4d21d50 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1091,8 +1091,6 @@ circular objects. Let `read' read everything else." ;; This data is shared by all embedded definitions. (defvar edebug-top-window-data) -(defvar edebug-&optional) -(defvar edebug-&rest) (defvar edebug-gate nil) ;; whether no-match forces an error. (defvar edebug-def-name nil) ; name of definition, used by interactive-form @@ -1143,8 +1141,6 @@ purpose by adding an entry to this alist, and setting edebug-top-window-data edebug-def-name;; make sure it is locally nil ;; I don't like these here!! - edebug-&optional - edebug-&rest edebug-gate edebug-best-error edebug-error-point @@ -1512,6 +1508,9 @@ contains a circular object." ((consp form) ;; The first offset for a list form is for the list form itself. (if (eq 'quote (car form)) + ;; This makes sure we don't instrument 'foo + ;; which would cause the debugger to single-step + ;; the trivial evaluation of a constant. form (let* ((head (car form)) (spec (and (symbolp head) (edebug-get-spec head))) @@ -1584,10 +1583,7 @@ contains a circular object." ;; The after offset will be left in the cursor after processing the form. (let ((head (edebug-top-element-required cursor "Expected elements")) ;; Prevent backtracking whenever instrumenting. - (edebug-gate t) - ;; A list form is never optional because it matches anything. - (edebug-&optional nil) - (edebug-&rest nil)) + (edebug-gate t)) ;; Skip the first offset. (edebug-set-cursor cursor (edebug-cursor-expressions cursor) (cdr (edebug-cursor-offsets cursor))) @@ -1632,7 +1628,7 @@ contains a circular object." (setq edebug-error-point (or edebug-error-point (edebug-before-offset cursor)) edebug-best-error (or edebug-best-error args)) - (if (and edebug-gate (not edebug-&optional)) + (if edebug-gate (progn (if edebug-error-point (goto-char edebug-error-point)) @@ -1643,9 +1639,7 @@ contains a circular object." (defun edebug-match (cursor specs) ;; Top level spec matching function. ;; Used also at each lower level of specs. - (let (edebug-&optional - edebug-&rest - edebug-best-error + (let (edebug-best-error edebug-error-point (edebug-gate edebug-gate) ;; locally bound to limit effect ) @@ -1782,11 +1776,10 @@ contains a circular object." (cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs) ;; Keep matching until one spec fails. - (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) + (edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper)) (defun edebug-&optional-wrapper (cursor specs remainder-handler) (let (result - (edebug-&optional specs) (edebug-gate nil) (this-form (edebug-cursor-expressions cursor)) (this-offset (edebug-cursor-offsets cursor))) @@ -1801,21 +1794,21 @@ contains a circular object." nil))) -(defun edebug-&rest-wrapper (cursor specs remainder-handler) - (if (null specs) (setq specs edebug-&rest)) - ;; Reuse the &optional handler with this as the remainder handler. - (edebug-&optional-wrapper cursor specs remainder-handler)) - (cl-defgeneric edebug--match-&-spec-op (op cursor specs) "Handle &foo spec operators. &foo spec operators operate on all the subsequent SPECS.") (cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs) ;; Repeatedly use specs until failure. - (let ((edebug-&rest specs) ;; remember these - edebug-best-error + (let (edebug-best-error edebug-error-point) - (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) + ;; Reuse the &optional handler with this as the remainder handler. + (edebug-&optional-wrapper + cursor specs + (lambda (c s rh) + ;; `s' is the remaining spec to match. + ;; When it's nil, start over matching `specs'. + (edebug-&optional-wrapper c (or s specs) rh))))) (cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs) @@ -1961,19 +1954,15 @@ a sequence of elements." (defun edebug-match-sublist (cursor specs) ;; Match a sublist of specs. - (let (edebug-&optional - ;;edebug-best-error - ;;edebug-error-point - ) - (prog1 - ;; match with edebug-match-specs so edebug-best-error is not bound. - (edebug-match-specs cursor specs 'edebug-match-specs) - (if (not (edebug-empty-cursor cursor)) - (if edebug-best-error - (apply #'edebug-no-match cursor edebug-best-error) - ;; A failed &rest or &optional spec may leave some args. - (edebug-no-match cursor "Failed matching" specs) - ))))) + (prog1 + ;; match with edebug-match-specs so edebug-best-error is not bound. + (edebug-match-specs cursor specs 'edebug-match-specs) + (if (not (edebug-empty-cursor cursor)) + (if edebug-best-error + (apply #'edebug-no-match cursor edebug-best-error) + ;; A failed &rest or &optional spec may leave some args. + (edebug-no-match cursor "Failed matching" specs) + )))) (defun edebug-match-string (cursor spec) -- cgit v1.2.3 From 6735bb3d22dc64f3fe42e4a7f439ea9d62f75b5a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 17 Feb 2021 20:59:44 +0100 Subject: Adjust the edebug spec for `interactive' * lisp/emacs-lisp/edebug.el: Adjust the edebug spec for `interactive' for the new syntax. --- lisp/emacs-lisp/edebug.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/edebug.el') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 7fae4d21d50..45996945948 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2136,7 +2136,8 @@ SPEC is the symbol name prefix for `gensym'." ;; more convenient to define their Edebug spec here. (defun ( &define name lambda-list lambda-doc [&optional ("declare" def-declarations)] - [&optional ("interactive" &optional &or stringp def-form)] + [&optional ("interactive" &optional [&or stringp def-form] + &rest symbolp)] def-body)) (defmacro ( &define name lambda-list lambda-doc @@ -2192,7 +2193,8 @@ SPEC is the symbol name prefix for `gensym'." '(&optional [&or stringp (&define ":documentation" def-form)])) -(def-edebug-elem-spec 'interactive '(&optional &or stringp def-form)) +(def-edebug-elem-spec 'interactive '(&optional [&or stringp def-form] + &rest symbolp)) ;; A function-form is for an argument that may be a function or a form. ;; This specially recognizes anonymous functions quoted with quote. -- cgit v1.2.3