From ce35760b19315b634e62e2c64988018189dcdbdc Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Feb 2021 09:03:27 +0100 Subject: ; Minor license statement fixes --- .../edebug-resources/edebug-test-code.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el') 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 a3010f9e354..f8ca39c8c6e 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -6,18 +6,18 @@ ;; This file is part of GNU Emacs. -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: -- 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 'test/lisp/emacs-lisp/edebug-resources/edebug-test-code.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 'test/lisp/emacs-lisp/edebug-resources/edebug-test-code.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 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 'test/lisp/emacs-lisp/edebug-resources/edebug-test-code.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