]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/eieio-datadebug.el
* lisp/emacs-lisp/cl-generic.el: Add support for cl-next-method-p.
[gnu-emacs] / lisp / emacs-lisp / eieio-datadebug.el
index 7daa24257a1797095707e489f23b138feecea1cc..ab8d41e4ac4d31b85729d7ce41f75fdc14902fa6 100644 (file)
@@ -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-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: OO, lisp
@@ -80,38 +80,41 @@ 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)
+                                         prefix)
   "Insert the slots of OBJ into the current DDEBUG buffer."
-  (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)
-                                 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 ((inhibit-read-only t))
+    (data-debug-insert-thing (eieio-object-name-string obj)
+                            prefix
+                            "Name: ")
+    (let* ((cl (eieio-object-class obj))
+          (cv (eieio--class-v cl)))
+      (data-debug-insert-thing (eieio--class-constructor cl)
+                              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 (eieio--class-slot-initarg (eieio--class-v 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 (eieio--class-slot-initarg (eieio--class-v 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)))))))
 
 ;;; Augment the Data debug thing display list.
 (data-debug-add-specialized-thing (lambda (thing) (object-p thing))
@@ -134,9 +137,9 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
   (let* ((eieio-pre-method-execution-functions
          (lambda (l) (throw 'moose l) ))
         (data
-         (catch 'moose (eieio-generic-call
+         (catch 'moose (eieio--generic-call
                         method (list class))))
-        (buf (data-debug-new-buffer "*Method Invocation*"))
+        (_buf (data-debug-new-buffer "*Method Invocation*"))
         (data2 (mapcar (lambda (sym)
                          (symbol-function (car sym)))
                          data)))