[Emacs-diffs] master 91932ff: Use cl-print for Edebug and EIEIO

[Stefan Monnier]

branch: master
commit 91932fff1ded8ed3b4d39dd06891f26960153b9e
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    Use cl-print for Edebug and EIEIO
    
    * lisp/emacs-lisp/edebug.el (edebug-prin1-to-string): Use cl-print.
    (edebug-prin1, edebug-print): Remove.
    
    * lisp/emacs-lisp/eieio.el (object-print): Declare obsolete.
    (cl-print-object): Add a method for EIEIO objects.
    (eieio-edebug-prin1-to-string): Delete.
    (edebug-prin1-to-string): Don't advise any more.
    
    * lisp/emacs-lisp/eieio-datadebug.el (data-debug-insert-object-button):
    Replace `object-print' -> `cl-prin1-to-string'.
---
 lisp/emacs-lisp/edebug.el          | 85 ++++++++++++++++++--------------------
 lisp/emacs-lisp/eieio-datadebug.el |  2 +-
 lisp/emacs-lisp/eieio.el           | 28 ++++---------
 3 files changed, 49 insertions(+), 66 deletions(-)

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 267fc57..6013305 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -398,31 +398,30 @@ Return the result of the last expression in BODY."
 (defun edebug-current-windows (which-windows)
   ;; Get either a full window configuration or some window information.
   (if (listp which-windows)
-      (mapcar (function (lambda (window)
-                         (if (edebug-window-live-p window)
-                             (list window
-                                   (window-buffer window)
-                                   (window-point window)
-                                   (window-start window)
-                                   (window-hscroll window)))))
+      (mapcar (lambda (window)
+                (if (edebug-window-live-p window)
+                    (list window
+                          (window-buffer window)
+                          (window-point window)
+                          (window-start window)
+                          (window-hscroll window))))
              which-windows)
     (current-window-configuration)))
 
 (defun edebug-set-windows (window-info)
   ;; Set either a full window configuration or some window information.
   (if (listp window-info)
-      (mapcar (function
-              (lambda (one-window-info)
-                (if one-window-info
-                    (apply (function
-                            (lambda (window buffer point start hscroll)
-                              (if (edebug-window-live-p window)
-                                  (progn
-                                    (set-window-buffer window buffer)
-                                    (set-window-point window point)
-                                    (set-window-start window start)
-                                    (set-window-hscroll window hscroll)))))
-                           one-window-info))))
+      (mapcar (lambda (one-window-info)
+                (if one-window-info
+                    (apply (function
+                            (lambda (window buffer point start hscroll)
+                              (if (edebug-window-live-p window)
+                                  (progn
+                                    (set-window-buffer window buffer)
+                                    (set-window-point window point)
+                                    (set-window-start window start)
+                                    (set-window-hscroll window hscroll)))))
+                           one-window-info)))
              window-info)
     (set-window-configuration window-info)))
 
@@ -658,7 +657,7 @@ Maybe clear the markers and delete the symbol's edebug 
property?"
       (progn
        ;; Instead of this, we could just find all contained forms.
        ;; (put (car entry) 'edebug nil)   ;
-       ;; (mapcar 'edebug-clear-form-data-entry   ; dangerous
+       ;; (mapcar #'edebug-clear-form-data-entry   ; dangerous
        ;;   (get (car entry) 'edebug-dependents))
        ;; (set-marker (nth 1 entry) nil)
        ;; (set-marker (nth 2 entry) nil)
@@ -945,7 +944,7 @@ circular objects.  Let `read' read everything else."
       (let ((elements))
        (while (not (eq 'rbracket (edebug-next-token-class)))
          (push (edebug-read-storing-offsets stream) elements))
-       (apply 'vector (nreverse elements)))
+       (apply #'vector (nreverse elements)))
     (forward-char 1)                   ; skip \]
     ))
 
@@ -988,7 +987,7 @@ circular objects.  Let `read' read everything else."
   ;; Check if a dotted form is required.
   (if edebug-dotted-spec (edebug-no-match cursor "Dot expected."))
   ;; Check if there is at least one more argument.
-  (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error))
+  (if (edebug-empty-cursor cursor) (apply #'edebug-no-match cursor error))
   ;; Return that top element.
   (edebug-top-element cursor))
 
@@ -1095,7 +1094,7 @@ circular objects.  Let `read' read everything else."
              (setq result (edebug-read-and-maybe-wrap-form1))
              nil)))
       (if no-match
-          (apply 'edebug-syntax-error no-match)))
+          (apply #'edebug-syntax-error no-match)))
     result))
 
 
@@ -1255,7 +1254,7 @@ expressions; a `progn' form will be returned enclosing 
these forms."
       (setq sexp new-sexp
            new-sexp (edebug-unwrap sexp)))
     (if (consp new-sexp)
-       (mapcar 'edebug-unwrap* new-sexp)
+       (mapcar #'edebug-unwrap* new-sexp)
       new-sexp)))
 
 
@@ -1516,7 +1515,7 @@ expressions; a `progn' form will be returned enclosing 
these forms."
       (progn
        (if edebug-error-point
            (goto-char edebug-error-point))
-       (apply 'edebug-syntax-error args))
+       (apply #'edebug-syntax-error args))
     (throw 'no-match args)))
 
 
@@ -1712,7 +1711,7 @@ expressions; a `progn' form will be returned enclosing 
these forms."
        ;; Reset the cursor for the next match.
        (edebug-set-cursor cursor this-form this-offset))
       ;; All failed.
-      (apply 'edebug-no-match cursor "Expected one of" original-specs))
+      (apply #'edebug-no-match cursor "Expected one of" original-specs))
     ))
 
 
@@ -1738,9 +1737,9 @@ expressions; a `progn' form will be returned enclosing 
these forms."
   (edebug-match-&rest
    cursor
    (cons '&or
-        (mapcar (function (lambda (pair)
-                            (vector (format ":%s" (car pair))
-                                    (car (cdr pair)))))
+        (mapcar (lambda (pair)
+                   (vector (format ":%s" (car pair))
+                           (car (cdr pair))))
                 specs))))
 
 
@@ -1785,7 +1784,7 @@ expressions; a `progn' form will be returned enclosing 
these forms."
                            form (cdr (edebug-top-offset cursor)))
                           (cdr specs))))
              (edebug-move-cursor cursor)
-             (list (apply 'vector result)))
+             (list (apply #'vector result)))
          (edebug-no-match cursor "Expected" specs)))
 
        ((listp form)
@@ -1812,7 +1811,7 @@ expressions; a `progn' form will be returned enclosing 
these forms."
        (edebug-match-specs cursor specs 'edebug-match-specs)
       (if (not (edebug-empty-cursor cursor))
          (if edebug-best-error
-             (apply 'edebug-no-match cursor edebug-best-error)
+             (apply #'edebug-no-match cursor edebug-best-error)
            ;; A failed &rest or &optional spec may leave some args.
            (edebug-no-match cursor "Failed matching" specs)
            )))))
@@ -3377,10 +3376,10 @@ Return the result of the last expression."
   (message "%s: %s"
           (or (get (car value) 'error-message)
               (format "peculiar error (%s)" (car value)))
-          (mapconcat (function (lambda (edebug-arg)
-                                 ;; continuing after an error may
-                                 ;; complain about edebug-arg. why??
-                                 (prin1-to-string edebug-arg)))
+          (mapconcat (lambda (edebug-arg)
+                        ;; continuing after an error may
+                        ;; complain about edebug-arg. why??
+                        (prin1-to-string edebug-arg))
                      (cdr value) ", ")))
 
 (defvar print-readably) ; defined by lemacs
@@ -3411,11 +3410,9 @@ Return the result of the last expression."
 
 ;;; Read, Eval and Print
 
-(defalias 'edebug-prin1 'prin1)
-(defalias 'edebug-print 'print)
-(defalias 'edebug-prin1-to-string 'prin1-to-string)
-(defalias 'edebug-format 'format-message)
-(defalias 'edebug-message 'message)
+(defalias 'edebug-prin1-to-string #'cl-prin1-to-string)
+(defalias 'edebug-format #'format-message)
+(defalias 'edebug-message #'message)
 
 (defun edebug-eval-expression (expr)
   "Evaluate an expression in the outside environment.
@@ -3656,7 +3653,7 @@ Options:
   ;; Don't do any edebug things now.
   (let ((edebug-execution-mode 'Go-nonstop)
        (edebug-trace nil))
-    (mapcar 'edebug-safe-eval edebug-eval-list)))
+    (mapcar #'edebug-safe-eval edebug-eval-list)))
 
 (defun edebug-eval-display-list (eval-result-list)
   ;; Assumes edebug-eval-buffer exists.
@@ -3804,7 +3801,7 @@ Otherwise call `debug' normally."
 
     ;; Otherwise call debug normally.
     ;; Still need to remove extraneous edebug calls from stack.
-    (apply 'debug arg-mode args)
+    (apply #'debug arg-mode args)
     ))
 
 
@@ -3870,7 +3867,7 @@ You must include newlines in FMT to break lines, but one 
newline is appended."
     (setq truncate-lines t)
     (setq buf-window (selected-window))
     (goto-char (point-max))
-    (insert (apply 'edebug-format fmt args) "\n")
+    (insert (apply #'edebug-format fmt args) "\n")
     ;; Make it visible.
     (vertical-motion (- 1 (window-height)))
     (set-window-start buf-window (point))
@@ -3885,7 +3882,7 @@ You must include newlines in FMT to break lines, but one 
newline is appended."
 
 (defun edebug-trace (fmt &rest args)
   "Convenience call to `edebug-trace-display' using `edebug-trace-buffer'."
-  (apply 'edebug-trace-display edebug-trace-buffer fmt args))
+  (apply #'edebug-trace-display edebug-trace-buffer fmt args))
 
 
 ;;; Frequency count and coverage
diff --git a/lisp/emacs-lisp/eieio-datadebug.el 
b/lisp/emacs-lisp/eieio-datadebug.el
index 624757f..8ef92df 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -59,7 +59,7 @@ PREFIX is the text that precedes the button.
 PREBUTTONTEXT is some text between PREFIX and the object button."
   (let* ((start (point))
          (end nil)
-         (str (object-print object))
+         (str (cl-prin1-to-string object))
          (class (eieio-object-class object))
          (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots"
                       (eieio-object-name-string object)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 6872c0f..1a6d5e9 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -825,6 +825,7 @@ first and modify the returned object.")
 It is sometimes useful to put a summary of the object into the
 default #<notation> string when using EIEIO browsing tools.
 Implement this method to customize the summary."
+  (declare (obsolete cl-print-object "26.1"))
   (format "%S" this))
 
 (cl-defmethod object-print ((this eieio-default-superclass) &rest strings)
@@ -841,6 +842,12 @@ When passing in extra strings from child classes, always 
remember
 to prepend a space."
   (eieio-object-name this (apply #'concat strings)))
 
+
+(cl-defmethod cl-print-object ((object eieio-default-superclass) stream)
+  "Default printer for EIEIO objects."
+  ;; Fallback to the old `object-print'.
+  (princ (object-print object) stream))
+
 (defvar eieio-print-depth 0
   "When printing, keep track of the current indentation depth.")
 
@@ -945,27 +952,6 @@ of `eq'."
 ;; hyperlink from the constructor's docstring to see the type definition.
 (add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
 
-;;; Interfacing with edebug
-;;
-(defun eieio-edebug-prin1-to-string (print-function object &optional noescape)
-  "Display EIEIO OBJECT in fancy format.
-
-Used as advice around `edebug-prin1-to-string', held in the
-variable PRINT-FUNCTION.  Optional argument NOESCAPE is passed to
-`prin1-to-string' when appropriate."
-  (cond ((eieio--class-p object) (eieio--class-print-name object))
-       ((eieio-object-p object) (object-print object))
-       ((and (listp object) (or (eieio--class-p (car object))
-                                (eieio-object-p (car object))))
-        (concat "(" (mapconcat
-                      (lambda (x) (eieio-edebug-prin1-to-string print-function 
x))
-                      object " ")
-                 ")"))
-       (t (funcall print-function object noescape))))
-
-(advice-add 'edebug-prin1-to-string
-            :around #'eieio-edebug-prin1-to-string)
-
 (provide 'eieio)
 
 ;;; eieio ends here