1 ;;; cedet-edebug.el --- Special EDEBUG augmentation code
4 ;; Copyright (C) 2003, 2004, 2007 Eric M. Ludlam
6 ;; This program is free software; you can redistribute it and/or modify
7 ;; it under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; This program is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;; GNU General Public License for more details.
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with this program; if not, you can either send email to this
18 ;; program's author (see below) or write to:
20 ;; The Free Software Foundation, Inc.
22 ;; Cambridge, MA 02139, USA.
24 ;; Please send bug reports, etc. to zappo@gnu.org
28 ;; Some aspects of EDEBUG are not extensible. It is possible to extend
29 ;; edebug through other means, such as alias or advice, but those don't stack
30 ;; very well when there are multiple tools trying to do the same sort of thing.
32 ;; This package provides a way to extend some aspects of edebug, such as value
37 (defvar cedet-edebug-prin1-extensions
39 "An alist of of code that can extend PRIN1 for edebug.
40 Each entry has the value: (CONDITION . PRIN1COMMAND).")
42 (defun cedet-edebug-prin1-recurse (object)
43 "Recurse into OBJECT for prin1 on `cedet-edebug-prin1-to-string'."
44 (concat "(" (mapconcat 'cedet-edebug-prin1-to-string object " ") ")"))
46 (defun cedet-edebug-rebuild-prin1 ()
47 "Rebuild the function `cedet-edebug-prin1-to-string'.
48 Use the values of `cedet-edebug-prin1-extensions' as the means of
49 constructing the function."
51 (let ((c cedet-edebug-prin1-extensions)
54 (setq code (append (list (list (car (car c))
58 (fset 'cedet-edebug-prin1-to-string-inner
59 `(lambda (object &optional noescape)
60 "Display eieio OBJECT in fancy format. Overrides the edebug default.
61 Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
64 (t (prin1-to-string object noescape)))))
67 (defun cedet-edebug-prin1-to-string (object &optional noescape)
68 "CEDET version of `edebug-prin1-to-string' that adds specialty
69 print methods for very large complex objects."
70 (if (not (fboundp 'cedet-edebug-prin1-to-string-inner))
71 ;; Recreate the official fcn now.
72 (cedet-edebug-rebuild-prin1))
74 ;; Call the auto-generated version.
75 ;; 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.
104 (add-hook 'edebug-setup-hook
106 (require 'cedet-edebug)
107 ;; I suspect this isn't the best way to do this, but when
108 ;; cust-print was used on my system all my objects
109 ;; appeared as "#1 =" which was not useful. This allows
110 ;; edebug to print my objects in the nice way they were
111 ;; meant to with `object-print' and `class-name'
112 (defalias 'edebug-prin1-to-string 'cedet-edebug-prin1-to-string)
113 ;; Add a fancy binding into EDEBUG's keymap for ADEBUG.
114 (define-key edebug-mode-map "A" 'semantic-adebug-edebug-expr)
118 ;; This seems like as good a place as any to stick this hack.
120 (add-hook 'debugger-mode-hook
122 (require 'cedet-edebug)
123 ;; Add a fancy binding into the debug mode map for ADEBUG.
124 (define-key debugger-mode-map "A" 'semantic-adebug-edebug-expr)
127 (provide 'cedet-edebug)
129 ;;; cedet-edebug.el ends here