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
34 (defvar cedet-edebug-prin1-extensions nil
35 "An alist of of code that can extend PRIN1 for edebug.
36 Each entry has the value: (CONDITION . PRIN1COMMAND).")
38 (defun cedet-edebug-prin1-recurse (object)
39 "Recurse into OBJECT for prin1 on `cedet-edebug-prin1-to-string'."
40 (concat "(" (mapconcat 'cedet-edebug-prin1-to-string object " ") ")"))
42 (defun cedet-edebug-rebuild-prin1 ()
43 "Rebuild the function `cedet-edebug-prin1-to-string'.
44 Use the values of `cedet-edebug-prin1-extensions' as the means of
45 constructing the function."
47 (let ((c cedet-edebug-prin1-extensions)
50 (setq code (append (list (list (car (car c))
54 (fset 'cedet-edebug-prin1-to-string-inner
55 `(lambda (object &optional noescape)
56 "Display eieio OBJECT in fancy format. Overrides the edebug default.
57 Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
60 (t (prin1-to-string object noescape)))))
63 (defun cedet-edebug-prin1-to-string (object &optional noescape)
64 "CEDET version of `edebug-prin1-to-string' that adds specialty
65 print methods for very large complex objects."
66 (if (not (fboundp 'cedet-edebug-prin1-to-string-inner))
67 ;; Recreate the official fcn now.
68 (cedet-edebug-rebuild-prin1))
70 ;; Call the auto-generated version.
71 ;; This is not going to be available at compile time.
73 (cedet-edebug-prin1-to-string-inner object noescape)))
76 (defun cedet-edebug-add-print-override (testfcn printfcn)
77 "Add a new EDEBUG print override.
78 TESTFCN is a routine that returns nil if the first argument
79 passed to it is not to use PRINTFCN.
80 PRINTFCN accepts an object identified by TESTFCN and
82 New tests are always added to the END of the list of tests.
83 See `cedet-edebug-prin1-extensions' for the official list."
85 (add-to-list 'cedet-edebug-prin1-extensions
86 (cons testfcn printfcn)
88 (error ;; That failed, it must be an older version of Emacs
89 ;; withouth the append argument for `add-to-list'
90 ;; Doesn't handle the don't add twice case, but that's a
91 ;; development thing and developers probably use new emacsen.
92 (setq cedet-edebug-prin1-extensions
93 (append cedet-edebug-prin1-extensions
94 (list (cons testfcn printfcn))))))
95 ;; whack the old implementation to force a rebuild.
96 (fmakunbound 'cedet-edebug-prin1-to-string-inner))
98 ;;; NOTE TO SELF. Make this system used as an extension
99 ;;; and then autoload the below.
100 (add-hook 'edebug-setup-hook
102 (require 'cedet-edebug)
103 ;; I suspect this isn't the best way to do this, but when
104 ;; cust-print was used on my system all my objects
105 ;; appeared as "#1 =" which was not useful. This allows
106 ;; edebug to print my objects in the nice way they were
107 ;; meant to with `object-print' and `class-name'
108 (defalias 'edebug-prin1-to-string 'cedet-edebug-prin1-to-string)
109 ;; Add a fancy binding into EDEBUG's keymap for ADEBUG.
110 (define-key edebug-mode-map "A" 'data-debug-edebug-expr)
114 ;; This seems like as good a place as any to stick this hack.
115 (add-hook 'debugger-mode-hook
117 (require 'cedet-edebug)
118 ;; Add a fancy binding into the debug mode map for ADEBUG.
119 (define-key debugger-mode-map "A" 'data-debug-edebug-expr)
122 (provide 'cedet-edebug)
124 ;;; cedet-edebug.el ends here