diff options
Diffstat (limited to 'lisp/emacs-lisp/eieio-datadebug.el')
| -rw-r--r-- | lisp/emacs-lisp/eieio-datadebug.el | 90 |
1 files changed, 35 insertions, 55 deletions
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 0a51ecfa203..c820180359b 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -1,4 +1,4 @@ -;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. +;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*- ;; Copyright (C) 2007-2015 Free Software Foundation, Inc. @@ -31,6 +31,9 @@ ;;; Code: +(declare-function data-debug/eieio-insert-slots "eieio-datadebug" + (obj eieio-default-superclass)) + (defun data-debug-insert-object-slots (object prefix) "Insert all the slots of OBJECT. PREFIX specifies what to insert at the start of each line." @@ -54,16 +57,17 @@ PREFIX specifies what to insert at the start of each line." "Insert a button representing OBJECT. 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)) - (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots" - (eieio-object-name-string object) - (eieio-object-class object) - (eieio-class-parents (eieio-object-class object)) - (length (object-slots object)) - )) - ) + (let* ((start (point)) + (end nil) + (str (object-print object)) + (class (eieio-object-class object)) + (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots" + (eieio-object-name-string object) + class + (eieio-class-parents class) + (length (eieio-class-slots class)) + )) + ) (insert prefix prebuttontext str) (setq end (point)) (put-text-property (- end (length str)) end 'face 'font-lock-keyword-face) @@ -79,70 +83,46 @@ PREBUTTONTEXT is some text between PREFIX and the object button." ;; ;; Each object should have an opportunity to show stuff about itself. -(defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass) - prefix) +(cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass) + prefix) "Insert the slots of OBJ into the current DDEBUG buffer." (let ((inhibit-read-only t)) (data-debug-insert-thing (eieio-object-name-string obj) prefix "Name: ") - (let* ((cl (eieio-object-class obj)) - (cv (class-v cl))) - (data-debug-insert-thing (class-constructor cl) + (let* ((cv (eieio--object-class obj))) + (data-debug-insert-thing (eieio--class-name cv) prefix "Class: ") ;; Loop over all the public slots - (let ((publa (eieio--class-public-a cv)) - ) - (while publa - (if (slot-boundp obj (car publa)) - (let* ((i (class-slot-initarg cl (car publa))) - (v (eieio-oref obj (car publa)))) - (data-debug-insert-thing - v prefix (concat - (if i (symbol-name i) - (symbol-name (car publa))) - " "))) - ;; Unbound case - (let ((i (class-slot-initarg cl (car publa)))) - (data-debug-insert-custom - "#unbound" prefix - (concat (if i (symbol-name i) - (symbol-name (car publa))) - " ") - 'font-lock-keyword-face)) - ) - (setq publa (cdr publa))))))) + (let ((slots (eieio--class-slots cv))) + (dotimes (i (length slots)) + (let* ((slot (aref slots i)) + (sname (cl--slot-descriptor-name slot)) + (i (eieio--class-slot-initarg cv sname)) + (sstr (concat (symbol-name (or i sname)) " "))) + (if (slot-boundp obj sname) + (let* ((v (eieio-oref obj sname))) + (data-debug-insert-thing v prefix sstr)) + ;; Unbound case + (data-debug-insert-custom + "#unbound" prefix sstr + 'font-lock-keyword-face) + ))))))) ;;; Augment the Data debug thing display list. -(data-debug-add-specialized-thing (lambda (thing) (object-p thing)) +(data-debug-add-specialized-thing (lambda (thing) (eieio-object-p thing)) #'data-debug-insert-object-button) ;;; DEBUG METHODS ;; ;; A generic function to run DDEBUG on an object and popup a new buffer. ;; -(defmethod data-debug-show ((obj eieio-default-superclass)) +(cl-defmethod data-debug-show ((obj eieio-default-superclass)) "Run ddebug against any EIEIO object OBJ." (data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj))) (data-debug-insert-object-slots obj "]")) -;;; DEBUG FUNCTIONS -;; -(defun eieio-debug-methodinvoke (method class) - "Show the method invocation order for METHOD with CLASS object." - (interactive "aMethod: \nXClass Expression: ") - (let* ((eieio-pre-method-execution-functions - (lambda (l) (throw 'moose l) )) - (data - (catch 'moose (eieio-generic-call - method (list class)))) - (buf (data-debug-new-buffer "*Method Invocation*")) - (data2 (mapcar (lambda (sym) - (symbol-function (car sym))) - data))) - (data-debug-insert-thing data2 ">" ""))) - (provide 'eieio-datadebug) ;;; eieio-datadebug.el ends here |