Mercurial > emacs
annotate lisp/cedet/semantic/debug.el @ 106196:2721ecb2b07c
* cedet/semantic/ia.el (semantic-ia-completion-format-tag-function):
Use semantic-format-tag-prototype.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 22 Nov 2009 23:09:17 +0000 |
parents | 83dde921cc1b |
children | 1d1d5d9bd884 |
rev | line source |
---|---|
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
1 ;;; semantic/debug.el --- Language Debugger framework |
104421 | 2 |
105285 | 3 ;; Copyright (C) 2003, 2004, 2005, 2008, 2009 Free Software Foundation, Inc. |
104421 | 4 |
5 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation, either version 3 of the License, or | |
12 ;; (at your option) any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | |
22 ;;; Commentary: | |
23 ;; | |
24 ;; To provide better support for debugging parsers, this framework | |
25 ;; provides the interface for debugging. The work of parsing and | |
26 ;; controlling and stepping through the parsing work must be implemented | |
27 ;; by the parser. | |
28 ;; | |
105336 | 29 ;; Fortunately, the nature of language support files means that the parser |
104421 | 30 ;; may not need to be instrumented first. |
31 ;; | |
32 ;; The debugger uses EIEIO objects. One object controls the user | |
33 ;; interface, including stepping, data-view, queries. A second | |
34 ;; object implemented here represents the parser itself. A third represents | |
35 ;; a parser independent frame which knows how to highlight the parser buffer. | |
36 ;; Each parser must implement the interface and override any methods as needed. | |
37 ;; | |
38 | |
105652
51bc239bdc37
* cedet/srecode/srt.el:
Chong Yidong <cyd@stupidchicken.com>
parents:
105377
diff
changeset
|
39 (eval-when-compile (require 'cl)) |
104421 | 40 (require 'semantic) |
41 (require 'eieio) | |
104470
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
42 (eval-when-compile (require 'semantic/find)) |
104421 | 43 |
44 ;;; Code: | |
104470
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
45 |
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
46 ;;;###autoload |
104421 | 47 (defvar semantic-debug-parser-source nil |
48 "For any buffer, the file name (no path) of the parser. | |
49 This would be a parser for a specific language, not the source | |
50 to one of the parser generators.") | |
104470
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
51 ;;;###autoload |
104421 | 52 (make-variable-buffer-local 'semantic-debug-parser-source) |
53 | |
104470
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
54 ;;;###autoload |
104421 | 55 (defvar semantic-debug-parser-class nil |
56 "Class to create when building a debug parser object.") | |
104470
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
57 ;;;###autoload |
104421 | 58 (make-variable-buffer-local 'semantic-debug-parser-class) |
59 | |
60 (defvar semantic-debug-enabled nil | |
61 "Non-nil when debugging a parser.") | |
62 | |
63 ;;; Variables used during a debug session. | |
64 (defvar semantic-debug-current-interface nil | |
65 "The debugger interface currently active for this buffer.") | |
66 | |
67 (defvar semantic-debug-current-parser nil | |
68 "The parser current active for this buffer.") | |
69 | |
70 ;;; User Interface Portion | |
71 ;; | |
72 (defclass semantic-debug-interface () | |
73 ((parser-buffer :initarg :parser-buffer | |
74 :type buffer | |
75 :documentation | |
76 "The buffer containing the parser we are debugging.") | |
77 (parser-local-map :initarg :parser-local-map | |
78 :type keymap | |
79 :documentation | |
80 "The local keymap originally in the PARSER buffer.") | |
81 (parser-location :type marker | |
82 :documentation | |
83 "A marker representing where we are in the parser buffer.") | |
84 (source-buffer :initarg :source-buffer | |
85 :type buffer | |
86 :documentation | |
87 "The buffer containing the source we are parsing. | |
88 The :parser-buffer defines a parser that can parse the text in the | |
89 :source-buffer.") | |
90 (source-local-map :initarg :source-local-map | |
91 :type keymap | |
92 :documentation | |
93 "The local keymap originally in the SOURCE buffer.") | |
94 (source-location :type marker | |
95 :documentation | |
96 "A marker representing where we are in the parser buffer.") | |
97 (data-buffer :initarg :data-buffer | |
98 :type buffer | |
99 :documentation | |
100 "Buffer being used to display some useful data. | |
101 These buffers are brought into view when layout occurs.") | |
102 (current-frame :type semantic-debug-frame | |
103 :documentation | |
104 "The currently displayed frame.") | |
105 (overlays :type list | |
106 :initarg nil | |
107 :documentation | |
108 "Any active overlays being used to show the debug position.") | |
109 ) | |
110 "Controls action when in `semantic-debug-mode'") | |
111 | |
112 ;; Methods | |
113 (defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame) | |
114 "Set the current frame on IFACE to FRAME." | |
115 (if frame | |
116 (oset iface current-frame frame) | |
117 (slot-makeunbound iface 'current-frame))) | |
118 | |
119 (defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point) | |
120 "Set the parser location in IFACE to POINT." | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
121 (with-current-buffer (oref iface parser-buffer) |
104421 | 122 (if (not (slot-boundp iface 'parser-location)) |
123 (oset iface parser-location (make-marker))) | |
124 (move-marker (oref iface parser-location) point)) | |
125 ) | |
126 | |
127 (defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point) | |
128 "Set the source location in IFACE to POINT." | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
129 (with-current-buffer (oref iface source-buffer) |
104421 | 130 (if (not (slot-boundp iface 'source-location)) |
131 (oset iface source-location (make-marker))) | |
132 (move-marker (oref iface source-location) point)) | |
133 ) | |
134 | |
135 (defmethod semantic-debug-interface-layout ((iface semantic-debug-interface)) | |
136 "Layout windows in the current frame to facilitate debugging." | |
137 (delete-other-windows) | |
138 ;; Deal with the data buffer | |
139 (when (slot-boundp iface 'data-buffer) | |
140 (let ((lines (/ (frame-height (selected-frame)) 3)) | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
141 (cnt (with-current-buffer (oref iface data-buffer) |
104421 | 142 (count-lines (point-min) (point-max)))) |
143 ) | |
144 ;; Set the number of lines to 1/3, or the size of the data buffer. | |
145 (if (< cnt lines) (setq cnt lines)) | |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
146 |
104421 | 147 (split-window-vertically cnt) |
148 (switch-to-buffer (oref iface data-buffer)) | |
149 ) | |
150 (other-window 1)) | |
151 ;; Parser | |
152 (switch-to-buffer (oref iface parser-buffer)) | |
153 (when (slot-boundp iface 'parser-location) | |
154 (goto-char (oref iface parser-location))) | |
155 (split-window-vertically) | |
156 (other-window 1) | |
157 ;; Source | |
158 (switch-to-buffer (oref iface source-buffer)) | |
159 (when (slot-boundp iface 'source-location) | |
160 (goto-char (oref iface source-location))) | |
161 ) | |
162 | |
163 (defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token) | |
164 "For IFACE, highlight TOKEN in the source buffer . | |
165 TOKEN is a lexical token." | |
166 (set-buffer (oref iface :source-buffer)) | |
167 | |
168 (object-add-to-list iface 'overlays | |
169 (semantic-lex-highlight-token token)) | |
170 | |
171 (semantic-debug-set-source-location iface (semantic-lex-token-start token)) | |
172 ) | |
173 | |
174 (defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match) | |
175 "For IFACE, highlight NONTERM in the parser buffer. | |
176 NONTERM is the name of the rule currently being processed that shows up | |
177 as a nonterminal (or tag) in the source buffer. | |
178 If RULE and MATCH indicies are specified, highlight those also." | |
179 (set-buffer (oref iface :parser-buffer)) | |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
180 |
104421 | 181 (let* ((rules (semantic-find-tags-by-class 'nonterminal (current-buffer))) |
182 (nt (semantic-find-first-tag-by-name nonterm rules)) | |
183 (o nil) | |
184 ) | |
185 (when nt | |
186 ;; I know it is the first symbol appearing in the body of this token. | |
187 (goto-char (semantic-tag-start nt)) | |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
188 |
104421 | 189 (setq o (semantic-make-overlay (point) (progn (forward-sexp 1) (point)))) |
190 (semantic-overlay-put o 'face 'highlight) | |
191 | |
192 (object-add-to-list iface 'overlays o) | |
193 | |
194 (semantic-debug-set-parser-location iface (semantic-overlay-start o)) | |
195 | |
196 (when (and rule match) | |
197 | |
198 ;; Rule, an int, is the rule inside the nonterminal we are following. | |
199 (re-search-forward ":\\s-*") | |
200 (while (/= 0 rule) | |
201 (re-search-forward "^\\s-*|\\s-*") | |
202 (setq rule (1- rule))) | |
203 | |
204 ;; Now find the match inside the rule | |
205 (while (/= 0 match) | |
206 (forward-sexp 1) | |
207 (skip-chars-forward " \t") | |
208 (setq match (1- match))) | |
209 | |
210 ;; Now highlight the thingy we find there. | |
211 (setq o (semantic-make-overlay (point) (progn (forward-sexp 1) (point)))) | |
212 (semantic-overlay-put o 'face 'highlight) | |
213 | |
214 (object-add-to-list iface 'overlays o) | |
215 | |
216 ;; If we have a match for a sub-rule, have the parser position | |
217 ;; move so we can see it in the output window for very long rules. | |
218 (semantic-debug-set-parser-location iface (semantic-overlay-start o)) | |
219 | |
220 )))) | |
221 | |
222 (defmethod semantic-debug-unhighlight ((iface semantic-debug-interface)) | |
223 "Remove all debugging overlays." | |
224 (mapc 'semantic-overlay-delete (oref iface overlays)) | |
225 (oset iface overlays nil)) | |
226 | |
227 ;; Call from the parser at a breakpoint | |
228 (defvar semantic-debug-user-command nil | |
229 "The command the user is requesting.") | |
230 | |
231 (defun semantic-debug-break (frame) | |
232 "Stop parsing now at FRAME. | |
233 FRAME is an object that represents the parser's view of the | |
234 current state of the world. | |
235 This function enters a recursive edit. It returns | |
236 on an `exit-recursive-edit', or if someone uses one | |
237 of the `semantic-debug-mode' commands. | |
238 It returns the command specified. Parsers need to take action | |
239 on different types of return values." | |
240 (save-window-excursion | |
241 ;; Set up displaying information | |
242 (semantic-debug-mode t) | |
243 (unwind-protect | |
244 (progn | |
245 (semantic-debug-frame-highlight frame) | |
246 (semantic-debug-interface-layout semantic-debug-current-interface) | |
247 (condition-case nil | |
248 ;; Enter recursive edit... wait for user command. | |
249 (recursive-edit) | |
250 (error nil))) | |
251 (semantic-debug-unhighlight semantic-debug-current-interface) | |
252 (semantic-debug-mode nil)) | |
253 ;; Find the requested user state. Do something. | |
254 (let ((returnstate semantic-debug-user-command)) | |
255 (setq semantic-debug-user-command nil) | |
256 returnstate) | |
257 )) | |
258 | |
259 ;;; Frame | |
260 ;; | |
261 ;; A frame can represent the state at a break point. | |
262 (defclass semantic-debug-frame () | |
263 ( | |
264 ) | |
265 "One frame representation.") | |
266 | |
267 (defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame)) | |
268 "Highlight one parser frame." | |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
269 |
104421 | 270 ) |
271 | |
272 (defmethod semantic-debug-frame-info ((frame semantic-debug-frame)) | |
273 "Display info about this one parser frame." | |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
274 |
104421 | 275 ) |
276 | |
277 ;;; Major Mode | |
278 ;; | |
279 (defvar semantic-debug-mode-map | |
280 (let ((km (make-sparse-keymap))) | |
281 (define-key km "n" 'semantic-debug-next) | |
282 (define-key km " " 'semantic-debug-next) | |
283 (define-key km "s" 'semantic-debug-step) | |
284 (define-key km "u" 'semantic-debug-up) | |
285 (define-key km "d" 'semantic-debug-down) | |
286 (define-key km "f" 'semantic-debug-fail-match) | |
287 (define-key km "h" 'semantic-debug-print-state) | |
288 (define-key km "s" 'semantic-debug-jump-to-source) | |
289 (define-key km "p" 'semantic-debug-jump-to-parser) | |
290 (define-key km "q" 'semantic-debug-quit) | |
291 (define-key km "a" 'semantic-debug-abort) | |
292 (define-key km "g" 'semantic-debug-go) | |
293 (define-key km "b" 'semantic-debug-set-breakpoint) | |
294 ;; Some boring bindings. | |
295 (define-key km "e" 'eval-expression) | |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
296 |
104421 | 297 km) |
298 "Keymap used when in semantic-debug-node.") | |
299 | |
300 (defun semantic-debug-mode (onoff) | |
301 "Turn `semantic-debug-mode' on and off. | |
302 Argument ONOFF is non-nil when we are entering debug mode. | |
303 \\{semantic-debug-mode-map}" | |
304 (let ((iface semantic-debug-current-interface)) | |
305 (if onoff | |
306 ;; Turn it on | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
307 (with-current-buffer (oref iface parser-buffer) |
104421 | 308 ;; Install our map onto this buffer |
309 (use-local-map semantic-debug-mode-map) | |
310 ;; Make the buffer read only | |
311 (toggle-read-only 1) | |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
312 |
104421 | 313 (set-buffer (oref iface source-buffer)) |
314 ;; Use our map in the source buffer also | |
315 (use-local-map semantic-debug-mode-map) | |
316 ;; Make the buffer read only | |
317 (toggle-read-only 1) | |
318 ;; Hooks | |
104513
a6a812dd2d88
* cedet/semantic/lex.el (semantic-lex-reset-hooks): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
104470
diff
changeset
|
319 (run-hooks 'semantic-debug-mode-hook) |
104421 | 320 ) |
321 ;; Restore old mode information | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
322 (with-current-buffer |
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
323 (oref semantic-debug-current-interface parser-buffer) |
104421 | 324 (use-local-map |
325 (oref semantic-debug-current-interface parser-local-map)) | |
326 ) | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
327 (with-current-buffer |
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
328 (oref semantic-debug-current-interface source-buffer) |
104421 | 329 (use-local-map |
330 (oref semantic-debug-current-interface source-local-map)) | |
331 ) | |
104513
a6a812dd2d88
* cedet/semantic/lex.el (semantic-lex-reset-hooks): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
104470
diff
changeset
|
332 (run-hooks 'semantic-debug-exit-hook) |
104421 | 333 ))) |
334 | |
335 (defun semantic-debug () | |
336 "Parse the current buffer and run in debug mode." | |
337 (interactive) | |
338 (if semantic-debug-current-interface | |
339 (error "You are already in a debug session")) | |
340 (if (not semantic-debug-parser-class) | |
341 (error "This major mode does not support parser debugging")) | |
342 ;; Clear the cache to force a full reparse. | |
343 (semantic-clear-toplevel-cache) | |
344 ;; Do the parse | |
345 (let ((semantic-debug-enabled t) | |
346 ;; Create an interface | |
347 (semantic-debug-current-interface | |
348 (let ((parserb (semantic-debug-find-parser-source))) | |
349 (semantic-debug-interface | |
350 "Debug Interface" | |
351 :parser-buffer parserb | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105652
diff
changeset
|
352 :parser-local-map (with-current-buffer parserb |
104421 | 353 (current-local-map)) |
354 :source-buffer (current-buffer) | |
355 :source-local-map (current-local-map) | |
356 ))) | |
357 ;; Create a parser debug interface | |
358 (semantic-debug-current-parser | |
359 (funcall semantic-debug-parser-class "parser")) | |
360 ) | |
361 ;; We could recurse into a parser while debugging. | |
362 ;; Is that a problem? | |
363 (semantic-fetch-tags) | |
364 ;; We should turn the auto-parser back on, but don't do it for | |
365 ;; now until the debugger is working well. | |
366 )) | |
367 | |
368 (defun semantic-debug-find-parser-source () | |
369 "Return a buffer containing the parser source file for the current buffer. | |
370 The parser needs to be on the load path, or this routine returns nil." | |
371 (if (not semantic-debug-parser-source) | |
372 (error "No parser is associated with this buffer")) | |
373 (let ((parser (locate-library semantic-debug-parser-source t))) | |
374 (if parser | |
375 (find-file-noselect parser) | |
376 (error "Cannot find parser source. It should be on the load-path")))) | |
377 | |
378 ;;; Debugger commands | |
379 ;; | |
380 (defun semantic-debug-next () | |
381 "Perform one parser operation. | |
382 In the recursive parser, this steps past one match rule. | |
383 In other parsers, this may be just like `semantic-debug-step'." | |
384 (interactive) | |
385 (let ((parser semantic-debug-current-parser)) | |
386 (semantic-debug-parser-next parser) | |
387 (exit-recursive-edit) | |
388 ) | |
389 ) | |
390 | |
391 (defun semantic-debug-step () | |
392 "Perform one parser operation." | |
393 (interactive) | |
394 (let ((parser semantic-debug-current-parser)) | |
395 (semantic-debug-parser-step parser) | |
396 (exit-recursive-edit) | |
397 ) | |
398 ) | |
399 | |
400 (defun semantic-debug-up () | |
401 "Move highlighting representation up one level." | |
402 (interactive) | |
403 (message "Not implemented yet.") | |
404 ) | |
405 | |
406 (defun semantic-debug-down () | |
407 "Move highlighting representation down one level." | |
408 (interactive) | |
409 (message "Not implemented yet.") | |
410 ) | |
411 | |
412 (defun semantic-debug-fail-match () | |
413 "Artificially fail the current match." | |
414 (interactive) | |
415 (let ((parser semantic-debug-current-parser)) | |
416 (semantic-debug-parser-fail parser) | |
417 (exit-recursive-edit) | |
418 ) | |
419 ) | |
420 | |
421 (defun semantic-debug-print-state () | |
422 "Show interesting parser state." | |
423 (interactive) | |
424 (let ((parser semantic-debug-current-parser)) | |
425 (semantic-debug-parser-print-state parser) | |
426 ) | |
427 ) | |
428 | |
429 (defun semantic-debug-jump-to-source () | |
430 "Move cursor to the source code being parsed at the current lexical token." | |
431 (interactive) | |
432 (let* ((interface semantic-debug-current-interface) | |
433 (buf (oref interface source-buffer))) | |
434 (if (get-buffer-window buf) | |
435 (progn | |
436 (select-frame (window-frame (get-buffer-window buf))) | |
437 (select-window (get-buffer-window buf))) | |
438 ;; Technically, this should do a window layout operation | |
439 (switch-to-buffer buf)) | |
440 ) | |
441 ) | |
442 | |
443 (defun semantic-debug-jump-to-parser () | |
444 "Move cursor to the parser being debugged." | |
445 (interactive) | |
446 (let* ((interface semantic-debug-current-interface) | |
447 (buf (oref interface parser-buffer))) | |
448 (if (get-buffer-window buf) | |
449 (progn | |
450 (select-frame (window-frame (get-buffer-window buf))) | |
451 (select-window (get-buffer-window buf))) | |
452 ;; Technically, this should do a window layout operation | |
453 (switch-to-buffer buf)) | |
454 ) | |
455 ) | |
456 | |
457 (defun semantic-debug-quit () | |
458 "Exit debug mode, blowing all stack, and leaving the parse incomplete. | |
459 Do not update any tokens already parsed." | |
460 (interactive) | |
461 (let ((parser semantic-debug-current-parser)) | |
462 (semantic-debug-parser-quit parser) | |
463 (exit-recursive-edit) | |
464 ) | |
465 ) | |
466 | |
467 (defun semantic-debug-abort () | |
468 "Abort one level of debug mode, blowing all stack." | |
469 (interactive) | |
470 (let ((parser semantic-debug-current-parser)) | |
471 (semantic-debug-parser-abort parser) | |
472 (exit-recursive-edit) | |
473 ) | |
474 ) | |
475 | |
476 (defun semantic-debug-go () | |
477 "Continue parsing till finish or breakpoint." | |
478 (interactive) | |
479 (let ((parser semantic-debug-current-parser)) | |
480 (semantic-debug-parser-go parser) | |
481 (exit-recursive-edit) | |
482 ) | |
483 ) | |
484 | |
485 (defun semantic-debug-set-breakpoint () | |
486 "Set a breakpoint at the current rule location." | |
487 (interactive) | |
488 (let ((parser semantic-debug-current-parser) | |
489 ;; Get the location as semantic tokens. | |
490 (location (semantic-current-tag)) | |
491 ) | |
492 (if location | |
493 (semantic-debug-parser-break parser location) | |
494 (error "Not on a rule")) | |
495 ) | |
496 ) | |
497 | |
498 | |
499 ;;; Debugger superclass | |
500 ;; | |
501 (defclass semantic-debug-parser () | |
502 ( | |
503 ) | |
504 "Represents a parser and its state. | |
505 When implementing the debug parser you can add extra functionality | |
506 by overriding one of the command methods. Be sure to use | |
507 `call-next-method' so that the debug command is saved, and passed | |
508 down to your parser later." | |
509 :abstract t) | |
510 | |
511 (defmethod semantic-debug-parser-next ((parser semantic-debug-parser)) | |
512 "Execute next for this PARSER." | |
513 (setq semantic-debug-user-command 'next) | |
514 ) | |
515 | |
516 (defmethod semantic-debug-parser-step ((parser semantic-debug-parser)) | |
517 "Execute a step for this PARSER." | |
518 (setq semantic-debug-user-command 'step) | |
519 ) | |
520 | |
521 (defmethod semantic-debug-parser-go ((parser semantic-debug-parser)) | |
522 "Continue executiong in this PARSER until the next breakpoint." | |
523 (setq semantic-debug-user-command 'go) | |
524 ) | |
525 | |
526 (defmethod semantic-debug-parser-fail ((parser semantic-debug-parser)) | |
527 "Continue executiong in this PARSER until the next breakpoint." | |
528 (setq semantic-debug-user-command 'fail) | |
529 ) | |
530 | |
531 (defmethod semantic-debug-parser-quit ((parser semantic-debug-parser)) | |
532 "Continue executiong in this PARSER until the next breakpoint." | |
533 (setq semantic-debug-user-command 'quit) | |
534 ) | |
535 | |
536 (defmethod semantic-debug-parser-abort ((parser semantic-debug-parser)) | |
537 "Continue executiong in this PARSER until the next breakpoint." | |
538 (setq semantic-debug-user-command 'abort) | |
539 ) | |
540 | |
541 (defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser)) | |
542 "Print state for this PARSER at the current breakpoint." | |
543 (with-slots (current-frame) semantic-debug-current-interface | |
544 (when current-frame | |
545 (semantic-debug-frame-info current-frame) | |
546 ))) | |
547 | |
548 (defmethod semantic-debug-parser-break ((parser semantic-debug-parser)) | |
549 "Set a breakpoint for this PARSER." | |
550 ) | |
551 | |
552 ;; Stack stuff | |
553 (defmethod semantic-debug-parser-frames ((parser semantic-debug-parser)) | |
554 "Return a list of frames for the current parser. | |
555 A frame is of the form: | |
556 ( .. .what ? .. ) | |
557 " | |
558 (error "Parser has not implemented frame values") | |
559 ) | |
560 | |
561 | |
562 (provide 'semantic/debug) | |
563 | |
104470
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
564 ;; Local variables: |
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
565 ;; generated-autoload-file: "loaddefs.el" |
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
566 ;; generated-autoload-load-name: "semantic/debug" |
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
567 ;; End: |
6ccad1511df1
Minor whitespace changes and `require' fixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
104468
diff
changeset
|
568 |
105377 | 569 ;; arch-tag: 6f189d2d-8a65-45a5-a7f0-9894625eb860 |
104468
3e6235dcb480
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
570 ;;; semantic/debug.el ends here |