procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use cl-print for Edebug and EIEIO

Browse source 
* 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'.
This commit is contained in:
Stefan Monnier 2017-02-23 22:39:53 -05:00
parent f1f17265c9
commit 91932fff1d
3 changed files with 49 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -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

2
lisp/emacs-lisp/eieio-datadebug.el
View file

@ -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)

28
lisp/emacs-lisp/eieio.el
View file

@ -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