mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-07 06:50:23 -08:00
* 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`.
This commit is contained in:
Stefan Monnier
parent
db237850ab
commit
1d2487b1fc
3 changed files with 65 additions and 69 deletions
|
|
@ -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 ()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue