[Emacs-diffs] trunk r117558: * lisp/emacs-lisp/edebug.el: Use nadvice.

[Stefan Monnier]

------------------------------------------------------------
revno: 117558
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sun 2014-07-20 21:56:54 -0400
message:
  * lisp/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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/edebug.el      edebug.el-20091113204419-o5vbwnq5f7feedwu-483

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-07-21 01:38:21 +0000
+++ b/lisp/ChangeLog    2014-07-21 01:56:54 +0000
@@ -1,5 +1,18 @@
 2014-07-21  Stefan Monnier  <address@hidden>
 
+       * 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
        it also makes sense to bind it to a non-mouse event.
 

=== modified file 'lisp/emacs-lisp/edebug.el'
--- a/lisp/emacs-lisp/edebug.el 2014-07-05 19:11:59 +0000
+++ b/lisp/emacs-lisp/edebug.el 2014-07-21 01:56:54 +0000
@@ -410,12 +410,7 @@
 ;; read is redefined to maybe instrument forms.
 ;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
 
-;; Save the original read function
-(defalias 'edebug-original-read
-  (symbol-function (if (fboundp 'edebug-original-read)
-                       'edebug-original-read 'read)))
-
-(defun edebug-read (&optional stream)
+(defun edebug--read (orig &optional stream)
   "Read one Lisp expression as text from STREAM, return as Lisp object.
 If STREAM is nil, use the value of `standard-input' (which see).
 STREAM or the value of `standard-input' may be:
@@ -433,10 +428,7 @@
   (or stream (setq stream standard-input))
   (if (eq stream (current-buffer))
       (edebug-read-and-maybe-wrap-form)
-    (edebug-original-read stream)))
-
-(or (fboundp 'edebug-original-eval-defun)
-    (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
+    (funcall (or orig #'read) stream)))
 
 (defvar edebug-result) ; The result of the function call returned by body.
 
@@ -567,16 +559,13 @@
 
 (defun edebug-install-read-eval-functions ()
   (interactive)
-  ;; Don't install if already installed.
-  (unless load-read-function
-    (setq load-read-function 'edebug-read)
-    (defalias 'eval-defun 'edebug-eval-defun)))
+  (add-function :around load-read-function #'edebug--read)
+  (advice-add 'eval-defun :override 'edebug-eval-defun))
 
 (defun edebug-uninstall-read-eval-functions ()
   (interactive)
-  (setq load-read-function nil)
-  (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
-
+  (remove-function load-read-function #'edebug--read)
+  (advice-remove 'eval-defun 'edebug-eval-defun))
 
 ;;; Edebug internal data
 
@@ -721,8 +710,8 @@
     (cond
      ;; read goes one too far if a (possibly quoted) string or symbol
      ;; is immediately followed by non-whitespace.
-     ((eq class 'symbol) (edebug-original-read (current-buffer)))
-     ((eq class 'string) (edebug-original-read (current-buffer)))
+     ((eq class 'symbol) (read (current-buffer)))
+     ((eq class 'string) (read (current-buffer)))
      ((eq class 'quote) (forward-char 1)
       (list 'quote (edebug-read-sexp)))
      ((eq class 'backquote)
@@ -730,7 +719,7 @@
      ((eq class 'comma)
       (list '\, (edebug-read-sexp)))
      (t ; anything else, just read it.
-      (edebug-original-read (current-buffer))))))
+      (read (current-buffer))))))
 
 ;;; Offsets for reader
 
@@ -826,14 +815,11 @@
       (funcall
        (or (cdr (assq (edebug-next-token-class) edebug-read-alist))
           ;; anything else, just read it.
-          'edebug-original-read)
+          #'read)
        stream))))
 
-(defun edebug-read-symbol (stream)
-  (edebug-original-read stream))
-
-(defun edebug-read-string (stream)
-  (edebug-original-read stream))
+(defalias 'edebug-read-symbol #'read)
+(defalias 'edebug-read-string #'read)
 
 (defun edebug-read-quote (stream)
   ;; Turn 'thing into (quote thing)
@@ -877,7 +863,7 @@
        ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
                                  ?7 ?8 ?9 ?0))
         (backward-char 1)
-        (edebug-original-read stream))
+        (read stream))
        (t (edebug-syntax-error "Bad char after #"))))
 
 (defun edebug-read-list (stream)
@@ -1048,16 +1034,15 @@
        edebug-gate
        edebug-best-error
        edebug-error-point
-       no-match
        ;; Do this once here instead of several times.
        (max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
        (max-specpdl-size (+ 2000 max-specpdl-size)))
-    (setq no-match
-         (catch 'no-match
-           (setq result (edebug-read-and-maybe-wrap-form1))
-           nil))
-    (if no-match
-       (apply 'edebug-syntax-error no-match))
+    (let ((no-match
+           (catch 'no-match
+             (setq result (edebug-read-and-maybe-wrap-form1))
+             nil)))
+      (if no-match
+          (apply 'edebug-syntax-error no-match)))
     result))
 
 
@@ -1076,7 +1061,7 @@
       (if (and (eq 'lparen (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
-         (setq def-kind (edebug-original-read (current-buffer))
+         (setq def-kind (read (current-buffer))
                spec (and (symbolp def-kind) (get-edebug-spec def-kind))
                defining-form-p (and (listp spec)
                                     (eq '&define (car spec)))
@@ -1084,7 +1069,7 @@
                def-name (if (and defining-form-p
                                  (eq 'name (car (cdr spec)))
                                  (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)
     (cond
      (defining-form-p
@@ -3209,7 +3194,7 @@
             (if (looking-at "\(")
                 (edebug--form-data-name
                  (edebug-get-form-data-entry (point)))
-              (edebug-original-read (current-buffer))))))
+              (read (current-buffer))))))
       (edebug-instrument-function func))))
 
 
@@ -3237,25 +3222,14 @@
   (put function 'edebug-on-entry nil))
 
 
-(if (not (fboundp 'edebug-original-debug-on-entry))
-    (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
-'(fset 'debug-on-entry 'edebug-debug-on-entry)  ;; Should we do this?
+'(advice-add 'debug-on-entry :around 'edebug--debug-on-entry)  ;; Should we do 
this?
 ;; Also need edebug-cancel-debug-on-entry
 
-'(defun edebug-debug-on-entry (function)
-  "Request FUNCTION to invoke debugger each time it is called.
-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): ")
+'(defun edebug--debug-on-entry (orig function)
+  "If the function is instrumented for Edebug, call `edebug-on-entry'."
   (let ((func-data (get function 'edebug)))
     (if (or (null func-data) (markerp func-data))
-       (edebug-original-debug-on-entry function)
+       (funcall orig function)
       (edebug-on-entry function))))
 
 
@@ -4136,9 +4110,8 @@
                'edebug--called-interactively-skip)
   (remove-hook 'cl-read-load-hooks 'edebug--require-cl-read)
   (edebug-uninstall-read-eval-functions)
-  ;; continue standard unloading
+  ;; Continue standard unloading.
   nil)
 
 (provide 'edebug)
-
 ;;; edebug.el ends here