branch: externals/dict-tree
commit 0ef5b5892bbdf3c63af5a1aa2500d119e731480f
Author: Toby S. Cubitt <toby-predict...@dr-qubit.org>
Commit: Toby S. Cubitt <toby-predict...@dr-qubit.org>
Revert "Replaced advice with cedet-edebug.el for pretty-printing"
This reverts commit 5e3702f1a02de5594bcd5cd363e399e3020b6302.
---
dict-tree.el | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++-------
1 file changed, 71 insertions(+), 9 deletions(-)
diff --git a/dict-tree.el b/dict-tree.el
index 6d5ad4d..2278866 100644
--- a/dict-tree.el
+++ b/dict-tree.el
@@ -3345,27 +3345,89 @@ extension, suitable for passing to `load-library'."
;; ----------------------------------------------------------------
;; Pretty-print dictionaries during edebug
-;; We use `cedet-edebug-add-print-override' from cedet-edebug.el to make
-;; edebug print "#<dict-tree NAME>" instead of the full print form for
-;; dictionaries. (This is cleaner than using aliases or advice.)
+;; We advise the `edebug-prin1' and `edebug-prin1-to-string' functions
+;; (actually, aliases) so that they pring "#<dict-tree NAME>" instead of
+;; the full print form for dictionaries.
;;
;; This is because, if left to its own devices, edebug hangs for ages
;; whilst printing large dictionaries, and you either have to wait for a
;; *very* long time for it to finish, or kill Emacs entirely. (Even C-g
-;; C-g fails!) Since the print form of a dictionary is practically
-;; incomprehensible anyway, we don't lose much by doing this.
+;; C-g fails!)
+;;
+;; Since the print form of a dictionary is practically incomprehensible
+;; anyway, we don't lose much by doing this. If you *really* want to
+;; print dictionaries in full whilst edebugging, despite this warning,
+;; disable the advice.
+;;
+;; FIXME: Should use `cedet-edebug-prin1-extensions' instead of advice
+;; when `cedet-edebug' is loaded, though I believe this still
+;; works in that case.
-(require 'cedet-edebug)
-(defun dictree-pretty-print (dict)
- (concat "#<dict-tree \"" (dictree--name dict) "\">"))
+(eval-when-compile
+ (require 'edebug)
+ (require 'advice))
-(cedet-edebug-add-print-override 'dictree-p 'dictree-pretty-print)
+
+(defun dictree--edebug-pretty-print (object)
+ (cond
+ ((dictree-p object)
+ (concat "#<dict-tree \"" (dictree-name object) "\">"))
+ ((consp object)
+ (if (consp (cdr object))
+ (let ((pretty "("))
+ (while object
+ (setq pretty
+ (concat pretty
+ (dictree--edebug-pretty-print
+ (if (atom object)
+ (prog1
+ (dictree--edebug-pretty-print object)
+ (setq object nil))
+ (pop object)))
+ (when object " "))))
+ (concat pretty ")"))
+ (concat "(" (dictree--edebug-pretty-print (car object))
+ " . " (dictree--edebug-pretty-print (cdr object)) ")")))
+ ((vectorp object)
+ (let ((pretty "[") (len (length object)))
+ (dotimes (i (1- len))
+ (setq pretty
+ (concat pretty
+ (dictree--edebug-pretty-print (aref object i))
+ " ")))
+ (concat pretty
+ (dictree--edebug-pretty-print (aref object (1- len)))
+ "]")))
+ (t (prin1-to-string object))))
+
+
+(ad-define-subr-args 'edebug-prin1 '(object &optional printcharfun))
+
+(defadvice edebug-prin1
+ (around dictree activate compile preactivate)
+ (let ((pretty (dictree--edebug-pretty-print object)))
+ (if pretty
+ (progn
+ (prin1 pretty printcharfun)
+ (setq ad-return-value pretty))
+ ad-do-it)))
+
+
+(ad-define-subr-args 'edebug-prin1-to-string '(object &optional noescape))
+
+(defadvice edebug-prin1-to-string
+ (around dictree activate compile preactivate)
+ (let ((pretty (dictree--edebug-pretty-print object)))
+ (if pretty
+ (setq ad-return-value pretty)
+ ad-do-it)))
(provide 'dict-tree)
+
;;; Local Variables:
;;; fill-column: 72
;;; End:
