1 ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*-
3 ;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Extensions to data-debug for EIEIO objects.
34 (defun data-debug-insert-object-slots (object prefix)
35 "Insert all the slots of OBJECT.
36 PREFIX specifies what to insert at the start of each line."
37 (let ((attrprefix (concat (make-string (length prefix) ? ) "] ")))
38 (data-debug/eieio-insert-slots object attrprefix)))
40 (defun data-debug-insert-object-slots-from-point (point)
41 "Insert the object slots found at the object button at POINT."
42 (let ((object (get-text-property point 'ddebug))
43 (indent (get-text-property point 'ddebug-indent))
48 (data-debug-insert-object-slots object
49 (concat (make-string indent ? )
53 (defun data-debug-insert-object-button (object prefix prebuttontext)
54 "Insert a button representing OBJECT.
55 PREFIX is the text that precedes the button.
56 PREBUTTONTEXT is some text between PREFIX and the object button."
59 (str (object-print object))
60 (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots"
61 (eieio-object-name-string object)
62 (eieio-object-class object)
63 (eieio-class-parents (eieio-object-class object))
64 (length (object-slots object))
67 (insert prefix prebuttontext str)
69 (put-text-property (- end (length str)) end 'face 'font-lock-keyword-face)
70 (put-text-property start end 'ddebug object)
71 (put-text-property start end 'ddebug-indent(length prefix))
72 (put-text-property start end 'ddebug-prefix prefix)
73 (put-text-property start end 'help-echo tip)
74 (put-text-property start end 'ddebug-function
75 'data-debug-insert-object-slots-from-point)
80 ;; Each object should have an opportunity to show stuff about itself.
82 (cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
84 "Insert the slots of OBJ into the current DDEBUG buffer."
85 (let ((inhibit-read-only t))
86 (data-debug-insert-thing (eieio-object-name-string obj)
89 (let* ((cl (eieio-object-class obj))
90 (cv (eieio--class-v cl)))
91 (data-debug-insert-thing (eieio--class-constructor cl)
94 ;; Loop over all the public slots
95 (let ((publa (eieio--class-public-a cv))
98 (if (slot-boundp obj (car publa))
99 (let* ((i (eieio--class-slot-initarg (eieio--class-v cl)
101 (v (eieio-oref obj (car publa))))
102 (data-debug-insert-thing
104 (if i (symbol-name i)
105 (symbol-name (car publa)))
108 (let ((i (eieio--class-slot-initarg (eieio--class-v cl)
110 (data-debug-insert-custom
112 (concat (if i (symbol-name i)
113 (symbol-name (car publa)))
115 'font-lock-keyword-face))
117 (setq publa (cdr publa)))))))
119 ;;; Augment the Data debug thing display list.
120 (data-debug-add-specialized-thing (lambda (thing) (object-p thing))
121 #'data-debug-insert-object-button)
125 ;; A generic function to run DDEBUG on an object and popup a new buffer.
127 (cl-defmethod data-debug-show ((obj eieio-default-superclass))
128 "Run ddebug against any EIEIO object OBJ."
129 (data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj)))
130 (data-debug-insert-object-slots obj "]"))
132 (provide 'eieio-datadebug)
134 ;;; eieio-datadebug.el ends here