e0be229d5f
* lisp/emacs-lisp/cl-generic.el (cl--generic-search-method): Fix regexp. * lisp/emacs-lisp/eieio-core.el (eieio--check-type): Remove. Use cl-check-type everywhere instead. (eieio-class-object): Remove, use find-class instead when needed. (class-p): Don't inline. (eieio-object-p): Check more thoroughly, so we don't treat cl-structs, such as eieio classes, as objects. Don't inline. (object-p): Mark as obsolete. (eieio-defclass-autoload, eieio-defclass-internal, eieio-oref) (eieio--generic-tagcode): Avoid `class-p'. (eieio-make-class-predicate, eieio-make-child-predicate): New functions. (eieio-defclass-internal): Use current-load-list rather than `class-location'. * lisp/emacs-lisp/eieio-opt.el (eieio-help-class, eieio-help-constructor): Use find-lisp-object-file-name, help-fns-short-filename and new calling convention for eieio-class-def. (eieio-build-class-list): Remove function, unused. (eieio-method-def): Remove button type, unused. (eieio-class-def): Inherit from help-function-def. (eieio--defclass-regexp): New constant. (find-function-regexp-alist): Use it. (eieio--specializers-apply-to-class-p): Handle eieio--static as well. (eieio-help-find-method-definition, eieio-help-find-class-definition): Remove functions. * lisp/emacs-lisp/eieio.el (defclass): Use new eieio-make-class-predicate and eieio-make-child-predicate. (eieio-class-parents): Use eieio--class-object. (slot-boundp, find-class, eieio-override-prin1): Avoid class-p. (slot-exists-p): Use find-class. * test/automated/eieio-tests.el (eieio-test-23-inheritance-check): Simplify.
134 lines
4.5 KiB
EmacsLisp
134 lines
4.5 KiB
EmacsLisp
;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
|
|
|
|
;; Author: Eric M. Ludlam <zappo@gnu.org>
|
|
;; Keywords: OO, lisp
|
|
;; Package: eieio
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; Extensions to data-debug for EIEIO objects.
|
|
;;
|
|
|
|
(require 'eieio)
|
|
(require 'data-debug)
|
|
|
|
;;; Code:
|
|
|
|
(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."
|
|
(let ((attrprefix (concat (make-string (length prefix) ? ) "] ")))
|
|
(data-debug/eieio-insert-slots object attrprefix)))
|
|
|
|
(defun data-debug-insert-object-slots-from-point (point)
|
|
"Insert the object slots found at the object button at POINT."
|
|
(let ((object (get-text-property point 'ddebug))
|
|
(indent (get-text-property point 'ddebug-indent))
|
|
start)
|
|
(end-of-line)
|
|
(setq start (point))
|
|
(forward-char 1)
|
|
(data-debug-insert-object-slots object
|
|
(concat (make-string indent ? )
|
|
"~ "))
|
|
(goto-char start)))
|
|
|
|
(defun data-debug-insert-object-button (object prefix prebuttontext)
|
|
"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))
|
|
))
|
|
)
|
|
(insert prefix prebuttontext str)
|
|
(setq end (point))
|
|
(put-text-property (- end (length str)) end 'face 'font-lock-keyword-face)
|
|
(put-text-property start end 'ddebug object)
|
|
(put-text-property start end 'ddebug-indent(length prefix))
|
|
(put-text-property start end 'ddebug-prefix prefix)
|
|
(put-text-property start end 'help-echo tip)
|
|
(put-text-property start end 'ddebug-function
|
|
'data-debug-insert-object-slots-from-point)
|
|
(insert "\n")))
|
|
|
|
;;; METHODS
|
|
;;
|
|
;; Each object should have an opportunity to show stuff about itself.
|
|
|
|
(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 (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) (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.
|
|
;;
|
|
(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 "]"))
|
|
|
|
(provide 'eieio-datadebug)
|
|
|
|
;;; eieio-datadebug.el ends here
|