1 ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger.
3 ;; Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; Extensions to data-debug for EIEIO objects.
33 (defun data-debug-insert-object-slots (object prefix)
34 "Insert all the slots of OBJECT.
35 PREFIX specifies what to insert at the start of each line."
36 (let ((attrprefix (concat (make-string (length prefix) ? ) "] ")))
37 (data-debug/eieio-insert-slots object attrprefix)))
39 (defun data-debug-insert-object-slots-from-point (point)
40 "Insert the object slots found at the object button at POINT."
41 (let ((object (get-text-property point 'ddebug))
42 (indent (get-text-property point 'ddebug-indent))
47 (data-debug-insert-object-slots object
48 (concat (make-string indent ? )
52 (defun data-debug-insert-object-button (object prefix prebuttontext)
53 "Insert a button representing OBJECT.
54 PREFIX is the text that precedes the button.
55 PREBUTTONTEXT is some text between PREFIX and the object button."
58 (str (object-print object))
59 (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots"
60 (object-name-string object)
62 (class-parents (object-class object))
63 (length (object-slots object))
66 (insert prefix prebuttontext str)
68 (put-text-property (- end (length str)) end 'face 'font-lock-keyword-face)
69 (put-text-property start end 'ddebug object)
70 (put-text-property start end 'ddebug-indent(length prefix))
71 (put-text-property start end 'ddebug-prefix prefix)
72 (put-text-property start end 'help-echo tip)
73 (put-text-property start end 'ddebug-function
74 'data-debug-insert-object-slots-from-point)
79 ;; Each object should have an opportunity to show stuff about itself.
81 (defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
83 "Insert the slots of OBJ into the current DDEBUG buffer."
84 (data-debug-insert-thing (object-name-string obj)
87 (let* ((cl (object-class obj))
89 (data-debug-insert-thing (class-constructor cl)
92 ;; Loop over all the public slots
93 (let ((publa (aref cv class-public-a))
94 (publd (aref cv class-public-d))
97 (if (slot-boundp obj (car publa))
98 (let ((i (class-slot-initarg cl (car publa)))
99 (v (eieio-oref obj (car publa))))
100 (data-debug-insert-thing
102 (if i (symbol-name i)
103 (symbol-name (car publa)))
106 (let ((i (class-slot-initarg cl (car publa))))
107 (data-debug-insert-custom
109 (concat (if i (symbol-name i)
110 (symbol-name (car publa)))
112 'font-lock-keyword-face))
114 (setq publa (cdr publa) publd (cdr publd))))))
116 ;;; Augment the Data debug thing display list.
117 (data-debug-add-specialized-thing (lambda (thing) (object-p thing))
118 #'data-debug-insert-object-button)
122 ;; A generic function to run DDEBUG on an object and popup a new buffer.
124 (defmethod data-debug-show ((obj eieio-default-superclass))
125 "Run ddebug against any EIEIO object OBJ."
126 (data-debug-new-buffer (format "*%s DDEBUG*" (object-name obj)))
127 (data-debug-insert-object-slots obj "]"))
131 (defun eieio-debug-methodinvoke (method class)
132 "Show the method invocation order for METHOD with CLASS object."
133 (interactive "aMethod: \nXClass Expression: ")
134 (let* ((eieio-pre-method-execution-hooks
135 (lambda (l) (throw 'moose l) ))
137 (catch 'moose (eieio-generic-call
138 method (list class))))
139 (buf (data-debug-new-buffer "*Method Invocation*"))
140 (data2 (mapcar (lambda (sym)
141 (symbol-function (car sym)))
143 (data-debug-insert-thing data2 ">" "")))
145 (provide 'eieio-datadebug)
147 ;; arch-tag: 6c7c2890-7614-41b0-816b-c61f3f6a8130
148 ;;; eieio-datadebug.el ends here