masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-16 00:40:06 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/edebug.el: Use nadvice.

Browse source 
(edebug-original-read): Remove.
(edebug--read): Rename from edebug-read and add `orig' arg.
(edebug-uninstall-read-eval-functions)
(edebug-install-read-eval-functions): Use nadvice.
(edebug-read-sexp, edebug-read-storing-offsets, edebug-read-symbol)
(edebug-read-and-maybe-wrap-form1, edebug-instrument-callee)
(edebug-read-string, edebug-read-function): Use just `read'.
(edebug-original-debug-on-entry): Remove.
(edebug--debug-on-entry): Rename from edebug-debug-on-entry and add
`orig' arg.
(debug-on-entry): Override with nadvice.
This commit is contained in:
Stefan Monnier 2014-07-20 21:56:54 -04:00
parent bb16bffbd2
commit 29b6ac245f
2 changed files with 40 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

13
lisp/ChangeLog
View file

@ -1,5 +1,18 @@
2014-07-21 Stefan Monnier <monnier@iro.umontreal.ca> 2014-07-21 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/edebug.el: Use nadvice.
(edebug-original-read): Remove.
(edebug--read): Rename from edebug-read and add `orig' arg.
(edebug-uninstall-read-eval-functions)
(edebug-install-read-eval-functions): Use nadvice.
(edebug-read-sexp, edebug-read-storing-offsets, edebug-read-symbol)
(edebug-read-and-maybe-wrap-form1, edebug-instrument-callee)
(edebug-read-string, edebug-read-function): Use just `read'.
(edebug-original-debug-on-entry): Remove.
(edebug--debug-on-entry): Rename from edebug-debug-on-entry and add
`orig' arg.
(debug-on-entry): Override with nadvice.
* mouse.el (tear-off-window): Rename from mouse-tear-off-window since * mouse.el (tear-off-window): Rename from mouse-tear-off-window since
it also makes sense to bind it to a non-mouse event. it also makes sense to bind it to a non-mouse event.

81
lisp/emacs-lisp/edebug.el
View file

@ -410,12 +410,7 @@ Return the result of the last expression in BODY."
;; read is redefined to maybe instrument forms. ;; read is redefined to maybe instrument forms.
;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs. ;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
;; Save the original read function (defun edebug--read (orig &optional stream)
(defalias 'edebug-original-read
(symbol-function (if (fboundp 'edebug-original-read)
'edebug-original-read 'read)))
(defun edebug-read (&optional stream)
"Read one Lisp expression as text from STREAM, return as Lisp object. "Read one Lisp expression as text from STREAM, return as Lisp object.
If STREAM is nil, use the value of `standard-input' (which see). If STREAM is nil, use the value of `standard-input' (which see).
STREAM or the value of `standard-input' may be: STREAM or the value of `standard-input' may be:
@ -433,10 +428,7 @@ the option `edebug-all-forms'."
(or stream (setq stream standard-input)) (or stream (setq stream standard-input))
(if (eq stream (current-buffer)) (if (eq stream (current-buffer))
(edebug-read-and-maybe-wrap-form) (edebug-read-and-maybe-wrap-form)
(edebug-original-read stream))) (funcall (or orig #'read) stream)))
(or (fboundp 'edebug-original-eval-defun)
(defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
(defvar edebug-result) ; The result of the function call returned by body. (defvar edebug-result) ; The result of the function call returned by body.
@ -567,16 +559,13 @@ already is one.)"
(defun edebug-install-read-eval-functions () (defun edebug-install-read-eval-functions ()
(interactive) (interactive)
;; Don't install if already installed. (add-function :around load-read-function #'edebug--read)
(unless load-read-function (advice-add 'eval-defun :override 'edebug-eval-defun))
(setq load-read-function 'edebug-read)
(defalias 'eval-defun 'edebug-eval-defun)))
(defun edebug-uninstall-read-eval-functions () (defun edebug-uninstall-read-eval-functions ()
(interactive) (interactive)
(setq load-read-function nil) (remove-function load-read-function #'edebug--read)
(defalias 'eval-defun (symbol-function 'edebug-original-eval-defun))) (advice-remove 'eval-defun 'edebug-eval-defun))
;;; Edebug internal data ;;; Edebug internal data
@ -721,8 +710,8 @@ Maybe clear the markers and delete the symbol's edebug property?"
(cond (cond
;; read goes one too far if a (possibly quoted) string or symbol ;; read goes one too far if a (possibly quoted) string or symbol
;; is immediately followed by non-whitespace. ;; is immediately followed by non-whitespace.
((eq class 'symbol) (edebug-original-read (current-buffer))) ((eq class 'symbol) (read (current-buffer)))
((eq class 'string) (edebug-original-read (current-buffer))) ((eq class 'string) (read (current-buffer)))
((eq class 'quote) (forward-char 1) ((eq class 'quote) (forward-char 1)
(list 'quote (edebug-read-sexp))) (list 'quote (edebug-read-sexp)))
((eq class 'backquote) ((eq class 'backquote)
@ -730,7 +719,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
((eq class 'comma) ((eq class 'comma)
(list '\, (edebug-read-sexp))) (list '\, (edebug-read-sexp)))
(t ; anything else, just read it. (t ; anything else, just read it.
(edebug-original-read (current-buffer)))))) (read (current-buffer))))))
;;; Offsets for reader ;;; Offsets for reader
@ -826,14 +815,11 @@ Maybe clear the markers and delete the symbol's edebug property?"
(funcall (funcall
(or (cdr (assq (edebug-next-token-class) edebug-read-alist)) (or (cdr (assq (edebug-next-token-class) edebug-read-alist))
;; anything else, just read it. ;; anything else, just read it.
'edebug-original-read) #'read)
stream)))) stream))))
(defun edebug-read-symbol (stream) (defalias 'edebug-read-symbol #'read)
(edebug-original-read stream)) (defalias 'edebug-read-string #'read)
(defun edebug-read-string (stream)
(edebug-original-read stream))
(defun edebug-read-quote (stream) (defun edebug-read-quote (stream)
;; Turn 'thing into (quote thing) ;; Turn 'thing into (quote thing)
@ -877,7 +863,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6 ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
?7 ?8 ?9 ?0)) ?7 ?8 ?9 ?0))
(backward-char 1) (backward-char 1)
(edebug-original-read stream)) (read stream))
(t (edebug-syntax-error "Bad char after #")))) (t (edebug-syntax-error "Bad char after #"))))
(defun edebug-read-list (stream) (defun edebug-read-list (stream)
@ -1048,16 +1034,15 @@ Maybe clear the markers and delete the symbol's edebug property?"
edebug-gate edebug-gate
edebug-best-error edebug-best-error
edebug-error-point edebug-error-point
no-match
;; Do this once here instead of several times. ;; Do this once here instead of several times.
(max-lisp-eval-depth (+ 800 max-lisp-eval-depth)) (max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
(max-specpdl-size (+ 2000 max-specpdl-size))) (max-specpdl-size (+ 2000 max-specpdl-size)))
(setq no-match (let ((no-match
(catch 'no-match (catch 'no-match
(setq result (edebug-read-and-maybe-wrap-form1)) (setq result (edebug-read-and-maybe-wrap-form1))
nil)) nil)))
(if no-match (if no-match
(apply 'edebug-syntax-error no-match)) (apply 'edebug-syntax-error no-match)))
result)) result))
@ -1076,7 +1061,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
(if (and (eq 'lparen (edebug-next-token-class)) (if (and (eq 'lparen (edebug-next-token-class))
(eq 'symbol (progn (forward-char 1) (edebug-next-token-class)))) (eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
;; Find out if this is a defining form from first symbol ;; Find out if this is a defining form from first symbol
(setq def-kind (edebug-original-read (current-buffer)) (setq def-kind (read (current-buffer))
spec (and (symbolp def-kind) (get-edebug-spec def-kind)) spec (and (symbolp def-kind) (get-edebug-spec def-kind))
defining-form-p (and (listp spec) defining-form-p (and (listp spec)
(eq '&define (car spec))) (eq '&define (car spec)))
@ -1084,7 +1069,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
def-name (if (and defining-form-p def-name (if (and defining-form-p
(eq 'name (car (cdr spec))) (eq 'name (car (cdr spec)))
(eq 'symbol (edebug-next-token-class))) (eq 'symbol (edebug-next-token-class)))
(edebug-original-read (current-buffer)))))) (read (current-buffer))))))
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms) ;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(cond (cond
(defining-form-p (defining-form-p
@ -3209,7 +3194,7 @@ function or macro is called, Edebug will be called there as well."
(if (looking-at "\(") (if (looking-at "\(")
(edebug--form-data-name (edebug--form-data-name
(edebug-get-form-data-entry (point))) (edebug-get-form-data-entry (point)))
(edebug-original-read (current-buffer)))))) (read (current-buffer))))))
(edebug-instrument-function func)))) (edebug-instrument-function func))))
@ -3237,25 +3222,14 @@ canceled the first time the function is entered."
(put function 'edebug-on-entry nil)) (put function 'edebug-on-entry nil))
(if (not (fboundp 'edebug-original-debug-on-entry)) '(advice-add 'debug-on-entry :around 'edebug--debug-on-entry) ;; Should we do this?
(fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
'(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this?
;; Also need edebug-cancel-debug-on-entry ;; Also need edebug-cancel-debug-on-entry
'(defun edebug-debug-on-entry (function) '(defun edebug--debug-on-entry (orig function)
"Request FUNCTION to invoke debugger each time it is called. "If the function is instrumented for Edebug, call `edebug-on-entry'."
If the user continues, FUNCTION's execution proceeds.
Works by modifying the definition of FUNCTION,
which must be written in Lisp, not predefined.
Use `cancel-debug-on-entry' to cancel the effect of this command.
Redefining FUNCTION also does that.
This version is from Edebug. If the function is instrumented for
Edebug, it calls `edebug-on-entry'."
(interactive "aDebug on entry (to function): ")
(let ((func-data (get function 'edebug))) (let ((func-data (get function 'edebug)))
(if (or (null func-data) (markerp func-data)) (if (or (null func-data) (markerp func-data))
(edebug-original-debug-on-entry function) (funcall orig function)
(edebug-on-entry function)))) (edebug-on-entry function))))
@ -4136,9 +4110,8 @@ With prefix argument, make it a temporary breakpoint."
'edebug--called-interactively-skip) 'edebug--called-interactively-skip)
(remove-hook 'cl-read-load-hooks 'edebug--require-cl-read) (remove-hook 'cl-read-load-hooks 'edebug--require-cl-read)
(edebug-uninstall-read-eval-functions) (edebug-uninstall-read-eval-functions)
;; continue standard unloading ;; Continue standard unloading.
nil) nil)
(provide 'edebug) (provide 'edebug)
;;; edebug.el ends here ;;; edebug.el ends here