X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/732fd4c7e11debd61c97eaaba3038d61e6ec7024..44eca25a4bd1513f08ca380c9f6722c21376ac9f:/lisp/emacs-lisp/eieio-datadebug.el

diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index 0a51ecfa20..0eaec49be3 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -1,6 +1,6 @@
-;;; 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.
+;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: OO, lisp
@@ -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