1 ;;; cedet-edebug.el --- Special EDEBUG augmentation code
3 ;;; Copyright (C) 2003, 2004, 2007, 2008 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 ;; Some aspects of EDEBUG are not extensible. It is possible to extend
27 ;; edebug through other means, such as alias or advice, but those don't stack
28 ;; very well when there are multiple tools trying to do the same sort of thing.
30 ;; This package provides a way to extend some aspects of edebug, such as value
37 (defvar cedet-edebug-prin1-extensions nil
38 "An alist of of code that can extend PRIN1 for edebug.
39 Each entry has the value: (CONDITION . PRIN1COMMAND).")
41 (defun cedet-edebug-prin1-recurse (object)
42 "Recurse into OBJECT for prin1 on `cedet-edebug-prin1-to-string'."
43 (concat "(" (mapconcat 'cedet-edebug-prin1-to-string object " ") ")"))
45 (defun cedet-edebug-rebuild-prin1 ()
46 "Rebuild the function `cedet-edebug-prin1-to-string'.
47 Use the values of `cedet-edebug-prin1-extensions' as the means of
48 constructing the function."
50 (let ((c cedet-edebug-prin1-extensions)
53 (setq code (append (list (list (car (car c))
57 (fset 'cedet-edebug-prin1-to-string-inner
58 `(lambda (object &optional noescape)
59 "Display eieio OBJECT in fancy format. Overrides the edebug default.
60 Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
63 (t (prin1-to-string object noescape)))))
66 (defun cedet-edebug-prin1-to-string (object &optional noescape)
67 "CEDET version of `edebug-prin1-to-string' that adds specialty
68 print methods for very large complex objects."
69 (if (not (fboundp 'cedet-edebug-prin1-to-string-inner))
70 ;; Recreate the official fcn now.
71 (cedet-edebug-rebuild-prin1))
73 ;; Call the auto-generated version.
74 ;; This is not going to be available at compile time.
76 (cedet-edebug-prin1-to-string-inner object noescape)))
79 (defun cedet-edebug-add-print-override (testfcn printfcn)
80 "Add a new EDEBUG print override.
81 TESTFCN is a routine that returns nil if the first argument
82 passed to it is not to use PRINTFCN.
83 PRINTFCN accepts an object identified by TESTFCN and
85 New tests are always added to the END of the list of tests.
86 See `cedet-edebug-prin1-extensions' for the official list."
88 (add-to-list 'cedet-edebug-prin1-extensions
89 (cons testfcn printfcn)
91 (error ;; That failed, it must be an older version of Emacs
92 ;; withouth the append argument for `add-to-list'
93 ;; Doesn't handle the don't add twice case, but that's a
94 ;; development thing and developers probably use new emacsen.
95 (setq cedet-edebug-prin1-extensions
96 (append cedet-edebug-prin1-extensions
97 (list (cons testfcn printfcn))))))
98 ;; whack the old implementation to force a rebuild.
99 (fmakunbound 'cedet-edebug-prin1-to-string-inner))
101 ;;; NOTE TO SELF. Make this system used as an extension
102 ;;; and then autoload the below.
103 (add-hook 'edebug-setup-hook
105 (require 'cedet-edebug)
106 ;; I suspect this isn't the best way to do this, but when
107 ;; cust-print was used on my system all my objects
108 ;; appeared as "#1 =" which was not useful. This allows
109 ;; edebug to print my objects in the nice way they were
110 ;; meant to with `object-print' and `class-name'
111 (defalias 'edebug-prin1-to-string 'cedet-edebug-prin1-to-string)
112 ;; Add a fancy binding into EDEBUG's keymap for ADEBUG.
113 (define-key edebug-mode-map "A" 'data-debug-edebug-expr)
117 ;; This seems like as good a place as any to stick this hack.
118 (add-hook 'debugger-mode-hook
120 (require 'cedet-edebug)
121 ;; Add a fancy binding into the debug mode map for ADEBUG.
122 (define-key debugger-mode-map "A" 'data-debug-edebug-expr)
125 (provide 'cedet-edebug)
127 ;;; cedet-edebug.el ends here