Commit | Line | Data |
---|---|---|
c9d4b5ef JK |
1 | (defmacro gud (form) |
2 | (` (save-excursion (set-buffer "*gud-a.out*") (, form)))) | |
3 | ||
4 | (defun dbug (foo &optional fun) | |
5 | (save-excursion | |
6 | (set-buffer (get-buffer-create "*trace*")) | |
7 | (goto-char (point-max)) | |
8 | (insert "***" (symbol-name foo) "\n") | |
9 | (if fun | |
10 | (funcall fun)))) | |
11 | ||
12 | ||
13 | ;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb | |
14 | ;;; under Emacs | |
15 | ||
16 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
17 | ;; Maintainer: FSF | |
18 | ;; Version: 1.3 | |
19 | ;; Keywords: unix, tools | |
20 | ||
21 | ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. | |
22 | ||
23 | ;; This file is part of GNU Emacs. | |
24 | ||
25 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
26 | ;; it under the terms of the GNU General Public License as published by | |
27 | ;; the Free Software Foundation; either version 2, or (at your option) | |
28 | ;; any later version. | |
29 | ||
30 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
31 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
32 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
33 | ;; GNU General Public License for more details. | |
34 | ||
35 | ;; You should have received a copy of the GNU General Public License | |
36 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
37 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
38 | ||
39 | ;;; Commentary: | |
40 | ||
41 | ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu> | |
42 | ;; It was later rewritten by rms. Some ideas were due to Masanobu. | |
43 | ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com> | |
44 | ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>, | |
45 | ;; who also hacked the mode to use comint.el. Shane Hartman <shane@spr.com> | |
46 | ;; added support for xdb (HPUX debugger). | |
47 | ||
f2db7337 | 48 | ;; Cygnus Support added support for gdb's --annotate=2. |
c9d4b5ef JK |
49 | |
50 | ;;; Code: | |
51 | ||
52 | (require 'comint) | |
53 | (require 'etags) | |
54 | ||
55 | ;; ====================================================================== | |
56 | ;; GUD commands must be visible in C buffers visited by GUD | |
57 | ||
58 | (defvar gud-key-prefix "\C-x\C-a" | |
59 | "Prefix of all GUD commands valid in C buffers.") | |
60 | ||
61 | (global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh) | |
62 | (global-set-key "\C-x " 'gud-break) ;; backward compatibility hack | |
63 | ||
64 | ;; ====================================================================== | |
65 | ;; the overloading mechanism | |
66 | ||
67 | (defun gud-overload-functions (gud-overload-alist) | |
68 | "Overload functions defined in GUD-OVERLOAD-ALIST. | |
69 | This association list has elements of the form | |
70 | (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)" | |
71 | (mapcar | |
72 | (function (lambda (p) (fset (car p) (symbol-function (cdr p))))) | |
73 | gud-overload-alist)) | |
74 | ||
75 | (defun gud-massage-args (file args) | |
76 | (error "GUD not properly entered.")) | |
77 | ||
78 | (defun gud-marker-filter (str) | |
79 | (error "GUD not properly entered.")) | |
80 | ||
81 | (defun gud-find-file (f) | |
82 | (error "GUD not properly entered.")) | |
83 | \f | |
84 | ;; ====================================================================== | |
85 | ;; command definition | |
86 | ||
87 | ;; This macro is used below to define some basic debugger interface commands. | |
88 | ;; Of course you may use `gud-def' with any other debugger command, including | |
89 | ;; user defined ones. | |
90 | ||
91 | ;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form | |
92 | ;; which defines FUNC to send the command NAME to the debugger, gives | |
93 | ;; it the docstring DOC, and binds that function to KEY in the GUD | |
94 | ;; major mode. The function is also bound in the global keymap with the | |
95 | ;; GUD prefix. | |
96 | ||
97 | (defmacro gud-def (func cmd key &optional doc) | |
98 | "Define FUNC to be a command sending STR and bound to KEY, with | |
99 | optional doc string DOC. Certain %-escapes in the string arguments | |
100 | are interpreted specially if present. These are: | |
101 | ||
102 | %f name (without directory) of current source file. | |
103 | %d directory of current source file. | |
104 | %l number of current source line | |
105 | %e text of the C lvalue or function-call expression surrounding point. | |
106 | %a text of the hexadecimal address surrounding point | |
107 | %p prefix argument to the command (if any) as a number | |
108 | ||
109 | The `current' source file is the file of the current buffer (if | |
110 | we're in a C file) or the source file current at the last break or | |
111 | step (if we're in the GUD buffer). | |
112 | The `current' line is that of the current buffer (if we're in a | |
113 | source file) or the source line number at the last break or step (if | |
114 | we're in the GUD buffer)." | |
115 | (list 'progn | |
116 | (list 'defun func '(arg) | |
117 | (or doc "") | |
118 | '(interactive "p") | |
119 | (list 'gud-call cmd 'arg)) | |
120 | (if key | |
121 | (list 'define-key | |
122 | '(current-local-map) | |
123 | (concat "\C-c" key) | |
124 | (list 'quote func))) | |
125 | (if key | |
126 | (list 'global-set-key | |
127 | (list 'concat 'gud-key-prefix key) | |
128 | (list 'quote func))))) | |
129 | ||
130 | ;; Where gud-display-frame should put the debugging arrow. This is | |
131 | ;; set by the marker-filter, which scans the debugger's output for | |
132 | ;; indications of the current program counter. | |
133 | (defvar gud-last-frame nil) | |
134 | ||
135 | ;; Used by gud-refresh, which should cause gud-display-frame to redisplay | |
136 | ;; the last frame, even if it's been called before and gud-last-frame has | |
137 | ;; been set to nil. | |
138 | (defvar gud-last-last-frame nil) | |
139 | ||
140 | ;; All debugger-specific information is collected here. | |
141 | ;; Here's how it works, in case you ever need to add a debugger to the mode. | |
142 | ;; | |
143 | ;; Each entry must define the following at startup: | |
144 | ;; | |
145 | ;;<name> | |
146 | ;; comint-prompt-regexp | |
147 | ;; gud-<name>-massage-args | |
148 | ;; gud-<name>-marker-filter | |
149 | ;; gud-<name>-find-file | |
150 | ;; | |
151 | ;; The job of the massage-args method is to modify the given list of | |
152 | ;; debugger arguments before running the debugger. | |
153 | ;; | |
154 | ;; The job of the marker-filter method is to detect file/line markers in | |
155 | ;; strings and set the global gud-last-frame to indicate what display | |
156 | ;; action (if any) should be triggered by the marker. Note that only | |
157 | ;; whatever the method *returns* is displayed in the buffer; thus, you | |
158 | ;; can filter the debugger's output, interpreting some and passing on | |
159 | ;; the rest. | |
160 | ;; | |
161 | ;; The job of the find-file method is to visit and return the buffer indicated | |
162 | ;; by the car of gud-tag-frame. This may be a file name, a tag name, or | |
163 | ;; something else. | |
164 | \f | |
165 | ;; ====================================================================== | |
166 | ;; gdb functions | |
167 | ||
168 | ;;; History of argument lists passed to gdb. | |
169 | (defvar gud-gdb-history nil) | |
170 | ||
171 | (defun gud-gdb-massage-args (file args) | |
f2db7337 | 172 | (cons "--annotate=2" (cons file args))) |
c9d4b5ef JK |
173 | |
174 | ||
175 | ;; | |
176 | ;; In this world, there are gdb instance objects (of unspecified | |
177 | ;; representation) and buffers associated with those objects. | |
178 | ;; | |
179 | ||
180 | ;; | |
181 | ;; gdb-instance objects | |
182 | ;; | |
183 | ||
184 | (defun make-gdb-instance (proc) | |
185 | "Create a gdb instance object from a gdb process." | |
186 | (let ((instance (cons 'gdb-instance proc))) | |
187 | (save-excursion | |
188 | (set-buffer (process-buffer proc)) | |
189 | (if (not (equal gdb-buffer-instance instance)) | |
190 | (progn | |
191 | (mapcar 'make-variable-buffer-local gdb-instance-variables) | |
192 | (setq gdb-buffer-instance instance) ; These are both... | |
193 | (setq gdb-buffer-type 'gud)))) ; ...instance variables | |
194 | instance)) | |
195 | ||
196 | (defun gdb-instance-process (inst) (cdr inst)) | |
197 | ||
198 | (defvar gdb-instance-variables '() | |
199 | "A list of variables that are local to the gud buffer associated | |
200 | with a gdb instance.") | |
201 | ||
202 | (defmacro def-gdb-variable | |
203 | (name accessor setter &optional default doc) | |
204 | (` | |
205 | (progn | |
206 | (defvar (, name) (, default) (, (or doc "undocumented"))) | |
207 | (if (not (memq '(, name) gdb-instance-variables)) | |
208 | (setq gdb-instance-variables | |
209 | (cons '(, name) gdb-instance-variables))) | |
210 | (, (and accessor | |
211 | (` | |
212 | (defun (, accessor) (instance) | |
213 | (let | |
214 | ((buffer (gdb-get-instance-buffer instance 'gud))) | |
215 | (and buffer | |
216 | (save-excursion | |
217 | (set-buffer buffer) | |
218 | (, name)))))))) | |
219 | (, (and setter | |
220 | (` | |
221 | (defun (, setter) (instance val) | |
222 | (let | |
223 | ((buffer (gdb-get-instance-buffer instance 'gud))) | |
224 | (and buffer | |
225 | (save-excursion | |
226 | (set-buffer buffer) | |
227 | (setq (, name) val))))))))))) | |
228 | ||
229 | (defmacro def-gdb-var (root-symbol &optional default doc) | |
230 | (let* ((root (symbol-name root-symbol)) | |
231 | (accessor (intern (concat "gdb-instance-" root))) | |
232 | (setter (intern (concat "set-gdb-instance-" root))) | |
233 | (var-name (intern (concat "gdb-" root)))) | |
234 | (` (def-gdb-variable | |
235 | (, var-name) (, accessor) (, setter) | |
236 | (, default) (, doc))))) | |
237 | ||
238 | (def-gdb-var buffer-instance nil | |
239 | "In an instance buffer, the buffer's instance.") | |
240 | ||
241 | (def-gdb-var buffer-type nil | |
242 | "One of the symbols bound in gdb-instance-buffer-rules") | |
243 | ||
244 | (def-gdb-var burst "" | |
245 | "A string of characters from gdb that have not yet been processed.") | |
246 | ||
247 | (def-gdb-var input-queue () | |
248 | "A list of high priority gdb command objects.") | |
249 | ||
250 | (def-gdb-var idle-input-queue () | |
251 | "A list of low priority gdb command objects.") | |
252 | ||
253 | (def-gdb-var prompting nil | |
254 | "True when gdb is idle with no pending input.") | |
255 | ||
256 | (def-gdb-var output-sink 'user | |
257 | "The disposition of the output of the current gdb command.") | |
258 | ||
259 | (def-gdb-var current-item nil | |
260 | "The most recent command item sent to gdb.") | |
261 | ||
262 | (def-gdb-var pending-triggers '() | |
263 | "A list of trigger functions that have run later than their output | |
264 | handlers.") | |
265 | ||
266 | (defun in-gdb-instance-context (instance form) | |
267 | "Funcall `form' in the gud buffer of `instance'" | |
268 | (save-excursion | |
269 | (set-buffer (gdb-get-instance-buffer instance 'gud)) | |
270 | (funcall form))) | |
271 | ||
272 | ;; end of instance vars | |
273 | ||
274 | ;; | |
275 | ;; finding instances | |
276 | ;; | |
277 | ||
278 | (defun gdb-proc->instance (proc) | |
279 | (save-excursion | |
280 | (set-buffer (process-buffer proc)) | |
281 | gdb-buffer-instance)) | |
282 | ||
283 | (defun gdb-mru-instance-buffer () | |
284 | "Return the most recently used (non-auxiliary) gdb gud buffer." | |
285 | (save-excursion | |
286 | (gdb-goto-first-gdb-instance (buffer-list)))) | |
287 | ||
288 | (defun gdb-goto-first-gdb-instance (blist) | |
289 | "Use gdb-mru-instance-buffer -- not this." | |
290 | (and blist | |
291 | (progn | |
292 | (set-buffer (car blist)) | |
293 | (or (and gdb-buffer-instance | |
294 | (eq gdb-buffer-type 'gud) | |
295 | (car blist)) | |
296 | (gdb-find-first-gdb-instance (cdr blist)))))) | |
297 | ||
298 | (defun buffer-gdb-instance (buf) | |
299 | (save-excursion | |
300 | (set-buffer buf) | |
301 | gdb-buffer-instance)) | |
302 | ||
303 | (defun gdb-needed-default-instance () | |
304 | "Return the most recently used gdb instance or signal an error." | |
305 | (let ((buffer (gdb-mru-instance-buffer))) | |
306 | (or (and buffer (buffer-gdb-instance buffer)) | |
307 | (error "No instance of gdb found.")))) | |
308 | ||
309 | (defun gdb-instance-target-string (instance) | |
310 | "The apparent name of the program being debugged by a gdb instance. | |
311 | For sure this the root string used in smashing together the gud | |
312 | buffer's name, even if that doesn't happen to be the name of a | |
313 | program." | |
314 | (in-gdb-instance-context | |
315 | instance | |
316 | (function (lambda () gud-target-name)))) | |
317 | ||
318 | ;; More than one buffer can be associated with a gdb instance. | |
319 | ;; | |
320 | ;; Each buffer has a TYPE -- an atom that identifies the function | |
321 | ;; of that particular buffer. | |
322 | ;; | |
323 | ;; The usual gud interaction buffer is given the type `gud' and | |
324 | ;; is constructed specially. | |
325 | ;; | |
326 | ;; Others are constructed by gdb-get-create-instance-buffer and | |
327 | ;; named according to the rules set forth here: | |
328 | ;; | |
329 | ||
330 | (defvar gdb-instance-buffer-rules-assoc | |
331 | '((gud error) ; gud buffers construct specially | |
332 | (gdb-partial-output-buffer | |
333 | gdb-partial-output-name | |
334 | ) | |
335 | (gdb-registers-buffer | |
336 | gdb-registers-buffer-name) | |
337 | (gdb-breakpoints-buffer | |
338 | gdb-breakpoints-buffer-name) | |
339 | (gdb-frames-buffer | |
340 | gdb-frames-buffer-name))) | |
341 | ||
342 | ||
343 | ;; | |
344 | ;; gdb communications | |
345 | ;; | |
346 | ||
347 | ;; input: things sent to gdb | |
348 | ;; | |
349 | ;; Each instance has a high and low priority | |
350 | ;; input queue. Low priority input is sent only | |
351 | ;; when the high priority queue is idle. | |
352 | ;; | |
353 | ;; The queues are lists. Each element is either | |
354 | ;; a string (indicating user or user-like input) | |
355 | ;; or a list of the form: | |
356 | ;; | |
357 | ;; (INPUT-STRING HANDLER-FN) | |
358 | ;; | |
359 | ;; | |
360 | ;; The handler function will be called from the | |
361 | ;; partial-output buffer when the command completes. | |
362 | ;; | |
363 | ;; These lists are consumed tail first. | |
364 | ;; | |
365 | ||
366 | (defun gdb-send (proc string) | |
367 | "A comint send filter for gdb. | |
368 | This filter may simply queue output for a later time." | |
369 | (let ((instance (gdb-proc->instance proc))) | |
370 | (gdb-instance-enqueue-input instance (concat string "\n")))) | |
371 | ||
f2db7337 JK |
372 | ;; Note: Stuff enqueued here will be sent to the next prompt, even if it |
373 | ;; is a query, or other non-top-level prompt. To guarantee stuff will get | |
374 | ;; sent to the top-level prompt, currently it must be put in the idle queue. | |
c9d4b5ef JK |
375 | (defun gdb-instance-enqueue-input (instance item) |
376 | "Enqueue an input item (a string or a list) for a gdb instance." | |
377 | (if (gdb-instance-prompting instance) | |
378 | (progn | |
379 | (gdb-send-item instance item) | |
380 | (set-gdb-instance-prompting instance nil)) | |
381 | (set-gdb-instance-input-queue | |
382 | instance | |
383 | (cons item (gdb-instance-input-queue instance))))) | |
384 | ||
385 | (defun gdb-instance-dequeue-input (instance) | |
386 | (let ((queue (gdb-instance-input-queue instance))) | |
387 | (and queue | |
388 | (if (not (cdr queue)) | |
389 | (let ((answer (car queue))) | |
390 | (set-gdb-instance-input-queue instance '()) | |
391 | answer) | |
392 | (gdb-take-last-elt queue))))) | |
393 | ||
394 | (defun gdb-instance-enqueue-idle-input (instance item) | |
395 | "Enqueue idle input (a string or a list) for a gdb instance." | |
396 | (if (gdb-instance-prompting instance) | |
397 | (progn | |
398 | (gdb-send-item instance item) | |
399 | (set-gdb-instance-prompting instance nil)) | |
400 | (set-gdb-instance-idle-input-queue | |
401 | instance | |
402 | (cons item (gdb-instance-idle-input-queue instance))))) | |
403 | ||
404 | (defun gdb-instance-dequeue-idle-input (instance) | |
405 | (let ((queue (gdb-instance-idle-input-queue instance))) | |
406 | (and queue | |
407 | (if (not (cdr queue)) | |
408 | (let ((answer (car queue))) | |
409 | (set-gdb-instance-idle-input-queue instance '()) | |
410 | answer) | |
411 | (gdb-take-last-elt queue))))) | |
412 | ||
413 | (defun gdb-take-last-elt (l) | |
414 | "Don't use this in general." | |
415 | (if (cdr (cdr l)) | |
416 | (gdb-take-last-elt (cdr l)) | |
417 | (let ((answer (car (cdr l)))) | |
418 | (setcdr l '()) | |
419 | answer))) | |
420 | ||
421 | ||
422 | ;; | |
423 | ;; output -- things gdb prints to emacs | |
424 | ;; | |
425 | ;; GDB output is a stream interrupted by annotations. | |
426 | ;; Annotations can be recognized by their beginning | |
427 | ;; with \C-j\C-z\C-z<tag><opt>\C-j | |
428 | ;; | |
429 | ;; The tag is a string obeying symbol syntax. | |
430 | ;; | |
431 | ;; The optional part `<opt>' can be either the empty string | |
432 | ;; or a space followed by more data relating to the annotation. | |
433 | ;; For example, the SOURCE annotation is followed by a filename, | |
434 | ;; line number and various useless goo. This data must not include | |
435 | ;; any newlines. | |
436 | ;; | |
437 | ||
438 | ||
439 | (defun gud-gdb-marker-filter (string) | |
440 | "A gud marker filter for gdb." | |
441 | ;; Bogons don't tell us the process except through scoping crud. | |
442 | (let ((instance (gdb-proc->instance proc))) | |
443 | (gdb-output-burst instance string))) | |
444 | ||
445 | (defvar gdb-annotation-rules | |
446 | '(("frames-invalid" gdb-invalidate-frames) | |
447 | ("breakpoints-invalid" gdb-invalidate-breakpoints) | |
448 | ("pre-prompt" gdb-pre-prompt) | |
449 | ("prompt" gdb-prompt) | |
f2db7337 JK |
450 | ("commands" gdb-subprompt) |
451 | ("overload-choice" gdb-subprompt) | |
452 | ("query" gdb-subprompt) | |
453 | ("prompt-for-continue" gdb-subprompt) | |
c9d4b5ef JK |
454 | ("post-prompt" gdb-post-prompt) |
455 | ("source" gdb-source) | |
f2db7337 | 456 | ) |
c9d4b5ef JK |
457 | "An assoc mapping annotation tags to functions which process them.") |
458 | ||
459 | ||
460 | (defun gdb-ignore-annotation (instance args) | |
461 | nil) | |
462 | ||
463 | (defconst gdb-source-spec-regexp | |
464 | "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x[a-f0-9]*") | |
465 | ||
466 | (defun gdb-source (instance args) | |
467 | "Do not use this except as an annotation handler." | |
468 | (string-match gdb-source-spec-regexp args) | |
469 | ;; Extract the frame position from the marker. | |
470 | (setq gud-last-frame | |
471 | (cons | |
472 | (substring args (match-beginning 1) (match-end 1)) | |
473 | (string-to-int (substring args | |
474 | (match-beginning 2) | |
475 | (match-end 2)))))) | |
476 | ||
477 | (defun gdb-prompt (instance ignored) | |
478 | "An annotation handler for `prompt'. | |
479 | This sends the next command (if any) to gdb." | |
480 | (let ((sink (gdb-instance-output-sink instance))) | |
481 | (cond | |
482 | ((eq sink 'user) t) | |
483 | ((eq sink 'post-emacs) | |
484 | (set-gdb-instance-output-sink instance 'user)) | |
485 | ((or (eq sink 'emacs) | |
486 | (eq sink 'pre-emacs)) | |
487 | (set-gdb-instance-output-sink instance 'user) | |
488 | (error "Phase error in gdb-prompt (got %s)" sink)) | |
489 | (t (set-gdb-instance-output-sink instance 'user)))) | |
490 | (let ((highest (gdb-instance-dequeue-input instance))) | |
491 | (if highest | |
492 | (gdb-send-item instance highest) | |
493 | (let ((lowest (gdb-instance-dequeue-idle-input instance))) | |
494 | (if lowest | |
495 | (gdb-send-item instance lowest) | |
496 | (set-gdb-instance-prompting instance t)))))) | |
497 | ||
f2db7337 JK |
498 | (defun gdb-subprompt (instance ignored) |
499 | "An annotation handler for non-top-level prompts." | |
500 | (let ((highest (gdb-instance-dequeue-input instance))) | |
501 | (if highest | |
502 | (gdb-send-item instance highest) | |
503 | (set-gdb-instance-prompting instance t)))) | |
504 | ||
c9d4b5ef JK |
505 | (defun gdb-send-item (instance item) |
506 | (dbug 'sending | |
507 | (function | |
508 | (lambda () | |
509 | (insert (format "%s\n" item))))) | |
510 | (set-gdb-instance-current-item instance item) | |
511 | (if (stringp item) | |
512 | (progn | |
513 | (set-gdb-instance-output-sink instance 'user) | |
514 | (process-send-string (gdb-instance-process instance) | |
515 | item)) | |
516 | (progn | |
517 | (gdb-clear-partial-output instance) | |
518 | (set-gdb-instance-output-sink instance 'pre-emacs) | |
519 | (process-send-string (gdb-instance-process instance) | |
520 | (car item))))) | |
521 | ||
522 | (defun gdb-pre-prompt (instance ignored) | |
523 | "An annotation handler for `pre-prompt'. | |
524 | This terminates the collection of output from a previous | |
525 | command if that happens to be in effect." | |
526 | (let ((sink (gdb-instance-output-sink instance))) | |
527 | (cond | |
528 | ((eq sink 'user) t) | |
529 | ((eq sink 'emacs) | |
530 | (set-gdb-instance-output-sink instance 'post-emacs) | |
531 | (let ((handler | |
532 | (car (cdr (gdb-instance-current-item instance))))) | |
533 | (save-excursion | |
534 | (set-buffer (gdb-get-create-instance-buffer | |
535 | instance 'gdb-partial-output-buffer)) | |
536 | (funcall handler)))) | |
537 | ((eq sink 'pre-emacs) | |
538 | (set-gdb-instance-output-sink instance 'user) | |
539 | (error "Output sink phase error 1.")) | |
540 | ((eq sink 'post-emacs) | |
541 | (set-gdb-instance-output-sink instance 'user) | |
542 | (error "Output sink phase error 2."))))) | |
543 | ||
544 | (defun gdb-post-prompt (instance ignored) | |
f2db7337 | 545 | "An annotation handler for `post-prompt'. |
c9d4b5ef JK |
546 | This begins the collection of output from the current |
547 | command if that happens to be appropriate." | |
548 | (gdb-invalidate-registers instance ignored) | |
549 | (let ((sink (gdb-instance-output-sink instance))) | |
550 | (cond | |
551 | ((eq sink 'user) t) | |
552 | ((eq sink 'pre-emacs) | |
553 | (set-gdb-instance-output-sink instance 'emacs)) | |
554 | ||
555 | ((eq sink 'emacs) | |
556 | (set-gdb-instance-output-sink instance 'user) | |
557 | (error "Output sink phase error 3.")) | |
558 | ||
559 | ((eq sink 'post-emacs) | |
560 | (set-gdb-instance-output-sink instance 'user) | |
561 | (error "Output sink phase error 3."))))) | |
562 | ||
563 | ||
564 | (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler) | |
565 | (` | |
566 | (defun (, name) (instance ignored) | |
567 | (if (and ((, demand-predicate) instance) | |
568 | (not (member '(, name) | |
569 | (gdb-instance-pending-triggers instance)))) | |
570 | (progn | |
571 | (gdb-instance-enqueue-idle-input | |
572 | instance | |
573 | (list (, gdb-command) '(, output-handler))) | |
574 | (set-gdb-instance-pending-triggers | |
575 | instance | |
576 | (cons '(, name) | |
577 | (gdb-instance-pending-triggers instance)))))))) | |
578 | ||
579 | (defmacro def-gdb-auto-update-handler (name trigger buf-key) | |
580 | (` | |
581 | (defun (, name) () | |
582 | (set-gdb-instance-pending-triggers | |
583 | instance | |
584 | (delq '(, trigger) | |
585 | (gdb-instance-pending-triggers instance))) | |
586 | (let ((buf (gdb-get-instance-buffer instance | |
587 | '(, buf-key)))) | |
588 | (and buf | |
589 | (save-excursion | |
590 | (set-buffer buf) | |
591 | (let ((p (point))) | |
592 | (kill-region (point-min) (point-max)) | |
593 | (insert-buffer (gdb-get-create-instance-buffer | |
594 | instance | |
595 | 'gdb-partial-output-buffer)) | |
596 | (goto-char p)))))))) | |
597 | ||
598 | (defmacro def-gdb-auto-updated-buffer | |
599 | (buffer-key trigger-name gdb-command output-handler-name) | |
600 | (` | |
601 | (progn | |
602 | (def-gdb-auto-update-trigger (, trigger-name) | |
603 | ;; The demand predicate: | |
604 | (lambda (instance) | |
605 | (gdb-get-instance-buffer instance '(, buffer-key))) | |
606 | (, gdb-command) | |
607 | (, output-handler-name)) | |
608 | (def-gdb-auto-update-handler (, output-handler-name) | |
609 | (, trigger-name) (, buffer-key))))) | |
610 | ||
611 | ||
612 | ||
613 | (def-gdb-auto-updated-buffer gdb-breakpoints-buffer | |
614 | ;; This defines the auto update rule for buffers of type | |
615 | ;; `gdb-breakpoints-buffer'. | |
616 | ;; | |
617 | ;; It defines a function to serve as the annotation handler that | |
618 | ;; handles the `foo-invalidated' message. That function is called: | |
619 | gdb-invalidate-breakpoints | |
620 | ||
621 | ;; To update the buffer, this command is sent to gdb. | |
622 | "server info breakpoints\n" | |
623 | ||
624 | ;; This also defines a function to be the handler for the output | |
625 | ;; from the command above. That function will copy the output into | |
626 | ;; the appropriately typed buffer. That function will be called: | |
627 | gdb-info-breakpoints-handler) | |
628 | ||
629 | (def-gdb-auto-updated-buffer gdb-frames-buffer | |
630 | gdb-invalidate-frames | |
631 | "server where\n" | |
632 | gdb-info-frames-handler) | |
633 | ||
634 | ||
635 | (def-gdb-auto-updated-buffer gdb-registers-buffer | |
636 | gdb-invalidate-registers | |
637 | "server info registers\n" | |
638 | gdb-info-registers-handler) | |
639 | ||
640 | ;; | |
641 | ;; At any given time, output from gdb is being directed | |
642 | ;; one of three places. By default, it goes into the gdb | |
643 | ;; interaction buffer. For commands executed on behalf | |
644 | ;; of emacs, it goes into a scratch buffer (not `the'). | |
645 | ;; Finally, some gdb output is simply thrown away; for example, | |
646 | ;; the prompt that follows output from a command executed | |
647 | ;; for emacs. | |
648 | ;; | |
649 | ||
650 | (defvar gdb-output-sink 'user | |
651 | "An buffer-local indication of how output from an inferior gdb | |
652 | should be directed. Legit values are: | |
653 | ||
654 | USER -- the output should be appended to the gud | |
655 | buffer. | |
656 | ||
657 | PRE-EMACS -- throw away output preceding output for emacs. | |
658 | EMACS -- redirect output to the partial-output buffer. | |
659 | POST-EMACS -- throw away output following output for emacs.") | |
660 | ||
661 | (defun gdb-output-burst (instance string) | |
662 | "Handle a burst of output from a gdb instance. | |
663 | This function is (indirectly) used as a gud-marker-filter. | |
664 | It must return output (if any) to be insterted in the gud | |
665 | buffer." | |
666 | ||
667 | (save-match-data | |
668 | (let ( | |
669 | ;; Recall the left over burst from last time | |
670 | (burst (concat (gdb-instance-burst instance) string)) | |
671 | ;; Start accumulating output for the gud buffer | |
672 | (output "")) | |
673 | ||
674 | ;; Process all the complete markers in this chunk. | |
675 | ||
676 | (while (string-match "\n\032\032\\(.*\\)\n" burst) | |
677 | (let ((annotation (substring burst | |
678 | (match-beginning 1) | |
679 | (match-end 1)))) | |
680 | ||
681 | ;; Stuff prior to the match is just ordinary output. | |
682 | ;; It is either concatenated to OUTPUT or directed | |
683 | ;; elsewhere. | |
684 | (setq output | |
685 | (gdb-concat-output | |
686 | instance | |
687 | output | |
688 | (substring burst 0 (match-beginning 0)))) | |
689 | ||
690 | ;; Take that stuff off the burst. | |
691 | (setq burst (substring burst (match-end 0))) | |
692 | ||
693 | ;; Parse the tag from the annotation, and maybe its arguments. | |
694 | (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) | |
695 | (let* ((annotation-type (substring annotation | |
696 | (match-beginning 1) | |
697 | (match-end 1))) | |
698 | (annotation-arguments (substring annotation | |
699 | (match-beginning 2) | |
700 | (match-end 2))) | |
701 | (annotation-rule (assoc annotation-type | |
702 | gdb-annotation-rules))) | |
703 | ;; Call the handler for this annotation. | |
704 | (dbug 'annotation | |
705 | '(lambda () (insert annotation-type "\n"))) | |
706 | (if annotation-rule | |
707 | (funcall (car (cdr annotation-rule)) | |
708 | instance | |
709 | annotation-arguments) | |
f2db7337 JK |
710 | ;; Else the annotation is not recognized. Ignore it silently, |
711 | ;; so that GDB can add new annotations without causing | |
712 | ;; us to blow up. | |
713 | )))) | |
c9d4b5ef JK |
714 | |
715 | ||
716 | ;; Does the remaining text end in a partial line? | |
717 | ;; If it does, then keep part of the burst until we get more. | |
718 | (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" | |
719 | burst) | |
720 | (progn | |
721 | ;; Everything before the potential marker start can be output. | |
722 | (setq output | |
723 | (gdb-concat-output | |
724 | instance | |
725 | output | |
726 | (substring burst 0 (match-beginning 0)))) | |
727 | ||
728 | ;; Everything after, we save, to combine with later input. | |
729 | (setq burst (substring burst (match-beginning 0)))) | |
730 | ||
731 | ;; In case we know the burst contains no partial annotations: | |
732 | (progn | |
733 | (setq output (gdb-concat-output instance output burst)) | |
734 | (setq burst ""))) | |
735 | ||
736 | ;; Save the remaining burst for the next call to this function. | |
737 | (set-gdb-instance-burst instance burst) | |
738 | output))) | |
739 | ||
740 | (defun gdb-concat-output (instance so-far new) | |
741 | (let ((sink (gdb-instance-output-sink instance))) | |
742 | (cond | |
743 | ((eq sink 'user) (concat so-far new)) | |
744 | ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) | |
745 | ((eq sink 'emacs) | |
746 | (gdb-append-to-partial-output instance new) | |
747 | so-far) | |
748 | (t (error "Bogon output sink %d" sink))))) | |
749 | ||
750 | (defun gdb-append-to-partial-output (instance string) | |
751 | (save-excursion | |
752 | (set-buffer | |
753 | (gdb-get-create-instance-buffer | |
754 | instance 'gdb-partial-output-buffer)) | |
755 | (goto-char (point-max)) | |
756 | (insert string))) | |
757 | ||
758 | (defun gdb-clear-partial-output (instance) | |
759 | (save-excursion | |
760 | (set-buffer | |
761 | (gdb-get-create-instance-buffer | |
762 | instance 'gdb-partial-output-buffer)) | |
763 | (kill-region (point-min) (point-max)))) | |
764 | ||
765 | ;; | |
766 | ;; Instance Buffers. | |
767 | ;; | |
768 | ;; These are buffers that display output from gdb (or other | |
769 | ;; information) that we want to filter out from the general gdb | |
770 | ;; interaction buffer. (e.g. the backtrace buffer). | |
771 | ;; | |
772 | ;; The general pattern is that each kind of buffer is associated | |
773 | ;; with a rule to refresh its contents. The rule includes one | |
774 | ;; function to call when it is noticed that the buffer is out of | |
775 | ;; date. Typically, that will queue up an idle command for gdb. | |
776 | ;; | |
777 | ;; Every type of instance buffer is identified by some atom | |
778 | ;; such as gdb-frames-buffer. An instance and one of these | |
779 | ;; atoms uniquely identifies a particular instance buffer. | |
780 | ;; | |
781 | ||
782 | (defun gdb-get-instance-buffer (instance key) | |
783 | "Return the instance buffer for `instance' tagged with type `key'. | |
784 | The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |
785 | (save-excursion | |
786 | (gdb-look-for-tagged-buffer instance key (buffer-list)))) | |
787 | ||
788 | (defun gdb-get-create-instance-buffer (instance key) | |
789 | "Create a new gdb instance buffer of the type specified by `key'. | |
790 | The key should be one of the cars in `gdb-instance-buffer-rules-assoc'." | |
791 | (or (gdb-get-instance-buffer instance key) | |
792 | (let* ((rules (assoc key gdb-instance-buffer-rules-assoc)) | |
793 | (name (funcall (gdb-rules-name-maker rules) instance)) | |
794 | (new (get-buffer-create name))) | |
795 | (save-excursion | |
796 | (set-buffer new) | |
797 | (make-variable-buffer-local 'gdb-buffer-type) | |
798 | (setq gdb-buffer-type key) | |
799 | (make-variable-buffer-local 'gdb-buffer-instance) | |
800 | (setq gdb-buffer-instance instance) | |
801 | new)))) | |
802 | ||
803 | (defun gdb-rules-name-maker (rules) (car (cdr rules))) | |
804 | ||
805 | (defun gdb-look-for-tagged-buffer (instance key bufs) | |
806 | (and bufs | |
807 | (set-buffer (car bufs)) | |
808 | (or (and (eq gdb-buffer-instance instance) | |
809 | (eq gdb-buffer-type key) | |
810 | (car bufs)) | |
811 | (gdb-look-for-tagged-buffer instance key (cdr bufs))))) | |
812 | ||
813 | (defun gdb-instance-buffer-p (buf) | |
814 | (save-excursion | |
815 | (set-buffer buf) | |
816 | (and gdb-buffer-type | |
817 | (not (eq gdb-buffer-type 'gud))))) | |
818 | ||
819 | ;; | |
820 | ;; partial-output buffers | |
821 | ;; | |
822 | ;; These accumulate output from a command executed on | |
823 | ;; behalf of emacs (rather than the user). When the | |
824 | ;; output is complete, the hooks bound to `gdb-command-complete-hooks' | |
825 | ;; are called (and then cleared). Usually these hooks are not | |
826 | ;; set directly but rather implicitly according to the | |
827 | ;; instance-buffer rules. | |
828 | ;; | |
829 | ||
830 | (defun gdb-partial-output-name (instance) | |
831 | (concat "*partial-output-" | |
832 | (gdb-instance-target-string instance) | |
833 | "*")) | |
834 | ||
835 | ;; | |
836 | ;; Backtrace buffers | |
837 | ;; | |
838 | ||
839 | (defun gdb-frames-buffer-name (instance) | |
840 | (save-excursion | |
841 | (set-buffer (process-buffer (gdb-instance-process instance))) | |
842 | (concat "*stack frames of " | |
843 | (gdb-instance-target-string instance) "*"))) | |
844 | ||
845 | (defun gud-display-frames-buffer (instance) | |
846 | (interactive (list (gdb-needed-default-instance))) | |
847 | (display-buffer | |
848 | (gdb-get-create-instance-buffer instance | |
849 | 'gdb-frames-buffer))) | |
850 | ||
851 | ;; | |
852 | ;; Breakpoint buffers | |
853 | ;; | |
854 | ||
855 | (defun gdb-breakpoints-buffer-name (instance) | |
856 | (save-excursion | |
857 | (set-buffer (process-buffer (gdb-instance-process instance))) | |
858 | (concat "*breakpoints of " (gdb-instance-target-string instance) "*"))) | |
859 | ||
860 | (defun gud-display-breakpoints-buffer (instance) | |
861 | (interactive (list (gdb-needed-default-instance))) | |
862 | (display-buffer | |
863 | (gdb-get-create-instance-buffer instance | |
864 | 'gdb-breakpoints-buffer))) | |
865 | ||
866 | ||
867 | ;; | |
868 | ;; Registers buffers | |
869 | ;; | |
870 | ||
871 | (defun gdb-registers-buffer-name (instance) | |
872 | (save-excursion | |
873 | (set-buffer (process-buffer (gdb-instance-process instance))) | |
874 | (concat "*registers of " (gdb-instance-target-string instance) "*"))) | |
875 | ||
876 | (defun gud-display-registers-buffer (instance) | |
877 | (interactive (list (gdb-needed-default-instance))) | |
878 | (display-buffer | |
879 | (gdb-get-create-instance-buffer instance | |
880 | 'gdb-registers-buffer))) | |
881 | ||
882 | ||
883 | ||
884 | ||
885 | (defun gud-gdb-find-file (f) | |
886 | (find-file-noselect f)) | |
887 | ||
888 | ;;;###autoload | |
889 | (defun gdb (command-line) | |
890 | "Run gdb on program FILE in buffer *gud-FILE*. | |
891 | The directory containing FILE becomes the initial working directory | |
892 | and source-file directory for your debugger." | |
893 | (interactive | |
894 | (list (read-from-minibuffer "Run gdb (like this): " | |
895 | (if (consp gud-gdb-history) | |
896 | (car gud-gdb-history) | |
f2db7337 | 897 | "gdb ") |
c9d4b5ef JK |
898 | nil nil |
899 | '(gud-gdb-history . 1)))) | |
900 | (gud-overload-functions | |
901 | '((gud-massage-args . gud-gdb-massage-args) | |
902 | (gud-marker-filter . gud-gdb-marker-filter) | |
903 | (gud-find-file . gud-gdb-find-file) | |
904 | )) | |
905 | ||
906 | (gud-common-init command-line) | |
907 | ||
908 | (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") | |
909 | (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.") | |
910 | (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") | |
911 | (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") | |
912 | (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") | |
913 | (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") | |
914 | (gud-def gud-cont "cont" "\C-r" "Continue with display.") | |
915 | (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") | |
916 | (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") | |
917 | (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") | |
918 | (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") | |
919 | ||
920 | (setq comint-prompt-regexp "^(.*gdb[+]?) *") | |
921 | (setq comint-input-sender 'gdb-send) | |
922 | (run-hooks 'gdb-mode-hook) | |
923 | (make-gdb-instance (get-buffer-process (current-buffer))) | |
924 | ) | |
925 | ||
926 | \f | |
927 | ;; ====================================================================== | |
928 | ;; sdb functions | |
929 | ||
930 | ;;; History of argument lists passed to sdb. | |
931 | (defvar gud-sdb-history nil) | |
932 | ||
933 | (defvar gud-sdb-needs-tags (not (file-exists-p "/var")) | |
934 | "If nil, we're on a System V Release 4 and don't need the tags hack.") | |
935 | ||
936 | (defvar gud-sdb-lastfile nil) | |
937 | ||
938 | (defun gud-sdb-massage-args (file args) | |
939 | (cons file args)) | |
940 | ||
941 | (defun gud-sdb-marker-filter (string) | |
942 | (cond | |
943 | ;; System V Release 3.2 uses this format | |
944 | ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" | |
945 | string) | |
946 | (setq gud-last-frame | |
947 | (cons | |
948 | (substring string (match-beginning 2) (match-end 2)) | |
949 | (string-to-int | |
950 | (substring string (match-beginning 3) (match-end 3)))))) | |
951 | ;; System V Release 4.0 | |
952 | ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" | |
953 | string) | |
954 | (setq gud-sdb-lastfile | |
955 | (substring string (match-beginning 2) (match-end 2)))) | |
956 | ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" string)) | |
957 | (setq gud-last-frame | |
958 | (cons | |
959 | gud-sdb-lastfile | |
960 | (string-to-int | |
961 | (substring string (match-beginning 1) (match-end 1)))))) | |
962 | (t | |
963 | (setq gud-sdb-lastfile nil))) | |
964 | string) | |
965 | ||
966 | (defun gud-sdb-find-file (f) | |
967 | (if gud-sdb-needs-tags | |
968 | (find-tag-noselect f) | |
969 | (find-file-noselect f))) | |
970 | ||
971 | ;;;###autoload | |
972 | (defun sdb (command-line) | |
973 | "Run sdb on program FILE in buffer *gud-FILE*. | |
974 | The directory containing FILE becomes the initial working directory | |
975 | and source-file directory for your debugger." | |
976 | (interactive | |
977 | (list (read-from-minibuffer "Run sdb (like this): " | |
978 | (if (consp gud-sdb-history) | |
979 | (car gud-sdb-history) | |
980 | "sdb ") | |
981 | nil nil | |
982 | '(gud-sdb-history . 1)))) | |
983 | (if (and gud-sdb-needs-tags | |
984 | (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name)))) | |
985 | (error "The sdb support requires a valid tags table to work.")) | |
986 | (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args) | |
987 | (gud-marker-filter . gud-sdb-marker-filter) | |
988 | (gud-find-file . gud-sdb-find-file) | |
989 | )) | |
990 | ||
991 | (gud-common-init command-line) | |
992 | ||
993 | (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") | |
994 | (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.") | |
995 | (gud-def gud-remove "%l d" "\C-d" "Remove breakpoint at current line") | |
996 | (gud-def gud-step "s %p" "\C-s" "Step one source line with display.") | |
997 | (gud-def gud-stepi "i %p" "\C-i" "Step one instruction with display.") | |
998 | (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") | |
999 | (gud-def gud-cont "c" "\C-r" "Continue with display.") | |
1000 | (gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.") | |
1001 | ||
1002 | (setq comint-prompt-regexp "\\(^\\|\n\\)\\*") | |
1003 | (run-hooks 'sdb-mode-hook) | |
1004 | ) | |
1005 | \f | |
1006 | ;; ====================================================================== | |
1007 | ;; dbx functions | |
1008 | ||
1009 | ;;; History of argument lists passed to dbx. | |
1010 | (defvar gud-dbx-history nil) | |
1011 | ||
1012 | (defun gud-dbx-massage-args (file args) | |
1013 | (cons file args)) | |
1014 | ||
1015 | (defun gud-dbx-marker-filter (string) | |
1016 | (if (or (string-match | |
1017 | "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" | |
1018 | string) | |
1019 | (string-match | |
1020 | "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" | |
1021 | string)) | |
1022 | (setq gud-last-frame | |
1023 | (cons | |
1024 | (substring string (match-beginning 2) (match-end 2)) | |
1025 | (string-to-int | |
1026 | (substring string (match-beginning 1) (match-end 1)))))) | |
1027 | string) | |
1028 | ||
1029 | (defun gud-dbx-find-file (f) | |
1030 | (find-file-noselect f)) | |
1031 | ||
1032 | ;;;###autoload | |
1033 | (defun dbx (command-line) | |
1034 | "Run dbx on program FILE in buffer *gud-FILE*. | |
1035 | The directory containing FILE becomes the initial working directory | |
1036 | and source-file directory for your debugger." | |
1037 | (interactive | |
1038 | (list (read-from-minibuffer "Run dbx (like this): " | |
1039 | (if (consp gud-dbx-history) | |
1040 | (car gud-dbx-history) | |
1041 | "dbx ") | |
1042 | nil nil | |
1043 | '(gud-dbx-history . 1)))) | |
1044 | (gud-overload-functions '((gud-massage-args . gud-dbx-massage-args) | |
1045 | (gud-marker-filter . gud-dbx-marker-filter) | |
1046 | (gud-find-file . gud-dbx-find-file) | |
1047 | )) | |
1048 | ||
1049 | (gud-common-init command-line) | |
1050 | ||
1051 | (gud-def gud-break "file \"%d%f\"\nstop at %l" | |
1052 | "\C-b" "Set breakpoint at current line.") | |
1053 | ;; (gud-def gud-break "stop at \"%f\":%l" | |
1054 | ;; "\C-b" "Set breakpoint at current line.") | |
1055 | (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") | |
1056 | (gud-def gud-step "step %p" "\C-s" "Step one line with display.") | |
1057 | (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") | |
1058 | (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") | |
1059 | (gud-def gud-cont "cont" "\C-r" "Continue with display.") | |
1060 | (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") | |
1061 | (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") | |
1062 | (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") | |
1063 | ||
1064 | (setq comint-prompt-regexp "^[^)]*dbx) *") | |
1065 | (run-hooks 'dbx-mode-hook) | |
1066 | ) | |
1067 | \f | |
1068 | ;; ====================================================================== | |
1069 | ;; xdb (HP PARISC debugger) functions | |
1070 | ||
1071 | ;;; History of argument lists passed to xdb. | |
1072 | (defvar gud-xdb-history nil) | |
1073 | ||
1074 | (defvar gud-xdb-directories nil | |
1075 | "*A list of directories that xdb should search for source code. | |
1076 | If nil, only source files in the program directory | |
1077 | will be known to xdb. | |
1078 | ||
1079 | The file names should be absolute, or relative to the directory | |
1080 | containing the executable being debugged.") | |
1081 | ||
1082 | (defun gud-xdb-massage-args (file args) | |
1083 | (nconc (let ((directories gud-xdb-directories) | |
1084 | (result nil)) | |
1085 | (while directories | |
1086 | (setq result (cons (car directories) (cons "-d" result))) | |
1087 | (setq directories (cdr directories))) | |
1088 | (nreverse (cons file result))) | |
1089 | args)) | |
1090 | ||
1091 | (defun gud-xdb-file-name (f) | |
1092 | "Transform a relative pathname to a full pathname in xdb mode" | |
1093 | (let ((result nil)) | |
1094 | (if (file-exists-p f) | |
1095 | (setq result (expand-file-name f)) | |
1096 | (let ((directories gud-xdb-directories)) | |
1097 | (while directories | |
1098 | (let ((path (concat (car directories) "/" f))) | |
1099 | (if (file-exists-p path) | |
1100 | (setq result (expand-file-name path) | |
1101 | directories nil))) | |
1102 | (setq directories (cdr directories))))) | |
1103 | result)) | |
1104 | ||
1105 | ;; xdb does not print the lines all at once, so we have to accumulate them | |
1106 | (defvar gud-xdb-accumulation "") | |
1107 | ||
1108 | (defun gud-xdb-marker-filter (string) | |
1109 | (let (result) | |
1110 | (if (or (string-match comint-prompt-regexp string) | |
1111 | (string-match ".*\012" string)) | |
1112 | (setq result (concat gud-xdb-accumulation string) | |
1113 | gud-xdb-accumulation "") | |
1114 | (setq gud-xdb-accumulation (concat gud-xdb-accumulation string))) | |
1115 | (if result | |
1116 | (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\):" result) | |
1117 | (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" | |
1118 | result)) | |
1119 | (let ((line (string-to-int | |
1120 | (substring result (match-beginning 2) (match-end 2)))) | |
1121 | (file (gud-xdb-file-name | |
1122 | (substring result (match-beginning 1) (match-end 1))))) | |
1123 | (if file | |
1124 | (setq gud-last-frame (cons file line)))))) | |
1125 | (or result ""))) | |
1126 | ||
1127 | (defun gud-xdb-find-file (f) | |
1128 | (let ((realf (gud-xdb-file-name f))) | |
1129 | (if realf (find-file-noselect realf)))) | |
1130 | ||
1131 | ;;;###autoload | |
1132 | (defun xdb (command-line) | |
1133 | "Run xdb on program FILE in buffer *gud-FILE*. | |
1134 | The directory containing FILE becomes the initial working directory | |
1135 | and source-file directory for your debugger. | |
1136 | ||
1137 | You can set the variable 'gud-xdb-directories' to a list of program source | |
1138 | directories if your program contains sources from more than one directory." | |
1139 | (interactive | |
1140 | (list (read-from-minibuffer "Run xdb (like this): " | |
1141 | (if (consp gud-xdb-history) | |
1142 | (car gud-xdb-history) | |
1143 | "xdb ") | |
1144 | nil nil | |
1145 | '(gud-xdb-history . 1)))) | |
1146 | (gud-overload-functions '((gud-massage-args . gud-xdb-massage-args) | |
1147 | (gud-marker-filter . gud-xdb-marker-filter) | |
1148 | (gud-find-file . gud-xdb-find-file))) | |
1149 | ||
1150 | (gud-common-init command-line) | |
1151 | ||
1152 | (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") | |
1153 | (gud-def gud-tbreak "b %f:%l\\t" "\C-t" | |
1154 | "Set temporary breakpoint at current line.") | |
1155 | (gud-def gud-remove "db" "\C-d" "Remove breakpoint at current line") | |
1156 | (gud-def gud-step "s %p" "\C-s" "Step one line with display.") | |
1157 | (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).") | |
1158 | (gud-def gud-cont "c" "\C-r" "Continue with display.") | |
1159 | (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") | |
1160 | (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") | |
1161 | (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.") | |
1162 | (gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.") | |
1163 | ||
1164 | (setq comint-prompt-regexp "^>") | |
1165 | (make-local-variable 'gud-xdb-accumulation) | |
1166 | (setq gud-xdb-accumulation "") | |
1167 | (run-hooks 'xdb-mode-hook)) | |
1168 | \f | |
1169 | ;; ====================================================================== | |
1170 | ;; perldb functions | |
1171 | ||
1172 | ;;; History of argument lists passed to perldb. | |
1173 | (defvar gud-perldb-history nil) | |
1174 | ||
1175 | (defun gud-perldb-massage-args (file args) | |
1176 | (cons "-d" (cons file (cons "-emacs" args)))) | |
1177 | ||
1178 | ;; There's no guarantee that Emacs will hand the filter the entire | |
1179 | ;; marker at once; it could be broken up across several strings. We | |
1180 | ;; might even receive a big chunk with several markers in it. If we | |
1181 | ;; receive a chunk of text which looks like it might contain the | |
1182 | ;; beginning of a marker, we save it here between calls to the | |
1183 | ;; filter. | |
1184 | (defvar gud-perldb-marker-acc "") | |
1185 | ||
1186 | (defun gud-perldb-marker-filter (string) | |
1187 | (save-match-data | |
1188 | (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string)) | |
1189 | (let ((output "")) | |
1190 | ||
1191 | ;; Process all the complete markers in this chunk. | |
1192 | (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" | |
1193 | gud-perldb-marker-acc) | |
1194 | (setq | |
1195 | ||
1196 | ;; Extract the frame position from the marker. | |
1197 | gud-last-frame | |
1198 | (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1)) | |
1199 | (string-to-int (substring gud-perldb-marker-acc | |
1200 | (match-beginning 2) | |
1201 | (match-end 2)))) | |
1202 | ||
1203 | ;; Append any text before the marker to the output we're going | |
1204 | ;; to return - we don't include the marker in this text. | |
1205 | output (concat output | |
1206 | (substring gud-perldb-marker-acc 0 (match-beginning 0))) | |
1207 | ||
1208 | ;; Set the accumulator to the remaining text. | |
1209 | gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-end 0)))) | |
1210 | ||
1211 | ;; Does the remaining text look like it might end with the | |
1212 | ;; beginning of another marker? If it does, then keep it in | |
1213 | ;; gud-perldb-marker-acc until we receive the rest of it. Since we | |
1214 | ;; know the full marker regexp above failed, it's pretty simple to | |
1215 | ;; test for marker starts. | |
1216 | (if (string-match "^\032.*\\'" gud-perldb-marker-acc) | |
1217 | (progn | |
1218 | ;; Everything before the potential marker start can be output. | |
1219 | (setq output (concat output (substring gud-perldb-marker-acc | |
1220 | 0 (match-beginning 0)))) | |
1221 | ||
1222 | ;; Everything after, we save, to combine with later input. | |
1223 | (setq gud-perldb-marker-acc | |
1224 | (substring gud-perldb-marker-acc (match-beginning 0)))) | |
1225 | ||
1226 | (setq output (concat output gud-perldb-marker-acc) | |
1227 | gud-perldb-marker-acc "")) | |
1228 | ||
1229 | output))) | |
1230 | ||
1231 | (defun gud-perldb-find-file (f) | |
1232 | (find-file-noselect f)) | |
1233 | ||
1234 | ;;;###autoload | |
1235 | (defun perldb (command-line) | |
1236 | "Run perldb on program FILE in buffer *gud-FILE*. | |
1237 | The directory containing FILE becomes the initial working directory | |
1238 | and source-file directory for your debugger." | |
1239 | (interactive | |
1240 | (list (read-from-minibuffer "Run perldb (like this): " | |
1241 | (if (consp gud-perldb-history) | |
1242 | (car gud-perldb-history) | |
1243 | "perl ") | |
1244 | nil nil | |
1245 | '(gud-perldb-history . 1)))) | |
1246 | (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args) | |
1247 | (gud-marker-filter . gud-perldb-marker-filter) | |
1248 | (gud-find-file . gud-perldb-find-file) | |
1249 | )) | |
1250 | ||
1251 | (gud-common-init command-line) | |
1252 | ||
1253 | (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") | |
1254 | (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line") | |
1255 | (gud-def gud-step "s" "\C-s" "Step one source line with display.") | |
1256 | (gud-def gud-next "n" "\C-n" "Step one line (skip functions).") | |
1257 | (gud-def gud-cont "c" "\C-r" "Continue with display.") | |
1258 | ; (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") | |
1259 | ; (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") | |
1260 | ; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") | |
1261 | (gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.") | |
1262 | ||
1263 | (setq comint-prompt-regexp "^ DB<[0-9]+> ") | |
1264 | (run-hooks 'perldb-mode-hook) | |
1265 | ) | |
1266 | ||
1267 | ;; | |
1268 | ;; End of debugger-specific information | |
1269 | ;; | |
1270 | ||
1271 | \f | |
1272 | ;;; When we send a command to the debugger via gud-call, it's annoying | |
1273 | ;;; to see the command and the new prompt inserted into the debugger's | |
1274 | ;;; buffer; we have other ways of knowing the command has completed. | |
1275 | ;;; | |
1276 | ;;; If the buffer looks like this: | |
1277 | ;;; -------------------- | |
1278 | ;;; (gdb) set args foo bar | |
1279 | ;;; (gdb) -!- | |
1280 | ;;; -------------------- | |
1281 | ;;; (the -!- marks the location of point), and we type `C-x SPC' in a | |
1282 | ;;; source file to set a breakpoint, we want the buffer to end up like | |
1283 | ;;; this: | |
1284 | ;;; -------------------- | |
1285 | ;;; (gdb) set args foo bar | |
1286 | ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. | |
1287 | ;;; (gdb) -!- | |
1288 | ;;; -------------------- | |
1289 | ;;; Essentially, the old prompt is deleted, and the command's output | |
1290 | ;;; and the new prompt take its place. | |
1291 | ;;; | |
1292 | ;;; Not echoing the command is easy enough; you send it directly using | |
1293 | ;;; process-send-string, and it never enters the buffer. However, | |
1294 | ;;; getting rid of the old prompt is trickier; you don't want to do it | |
1295 | ;;; when you send the command, since that will result in an annoying | |
1296 | ;;; flicker as the prompt is deleted, redisplay occurs while Emacs | |
1297 | ;;; waits for a response from the debugger, and the new prompt is | |
1298 | ;;; inserted. Instead, we'll wait until we actually get some output | |
1299 | ;;; from the subprocess before we delete the prompt. If the command | |
1300 | ;;; produced no output other than a new prompt, that prompt will most | |
1301 | ;;; likely be in the first chunk of output received, so we will delete | |
1302 | ;;; the prompt and then replace it with an identical one. If the | |
1303 | ;;; command produces output, the prompt is moving anyway, so the | |
1304 | ;;; flicker won't be annoying. | |
1305 | ;;; | |
1306 | ;;; So - when we want to delete the prompt upon receipt of the next | |
1307 | ;;; chunk of debugger output, we position gud-delete-prompt-marker at | |
1308 | ;;; the start of the prompt; the process filter will notice this, and | |
1309 | ;;; delete all text between it and the process output marker. If | |
1310 | ;;; gud-delete-prompt-marker points nowhere, we leave the current | |
1311 | ;;; prompt alone. | |
1312 | (defvar gud-delete-prompt-marker nil) | |
1313 | ||
1314 | \f | |
1315 | (defvar gdbish-comint-mode-map (copy-keymap comint-mode-map)) | |
1316 | (define-key gdbish-comint-mode-map "\C-c\M-\C-r" 'gud-display-registers-buffer) | |
1317 | (define-key gdbish-comint-mode-map "\C-c\M-\C-f" 'gud-display-frames-buffer) | |
1318 | (define-key gdbish-comint-mode-map "\C-c\M-\C-b" 'gud-display-breakpoints-buffer) | |
1319 | ||
1320 | (defun gud-mode () | |
1321 | "Major mode for interacting with an inferior debugger process. | |
1322 | ||
1323 | You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx, | |
1324 | or M-x xdb. Each entry point finishes by executing a hook; `gdb-mode-hook', | |
1325 | `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively. | |
1326 | ||
1327 | After startup, the following commands are available in both the GUD | |
1328 | interaction buffer and any source buffer GUD visits due to a breakpoint stop | |
1329 | or step operation: | |
1330 | ||
1331 | \\[gud-break] sets a breakpoint at the current file and line. In the | |
1332 | GUD buffer, the current file and line are those of the last breakpoint or | |
1333 | step. In a source buffer, they are the buffer's file and current line. | |
1334 | ||
1335 | \\[gud-remove] removes breakpoints on the current file and line. | |
1336 | ||
1337 | \\[gud-refresh] displays in the source window the last line referred to | |
1338 | in the gud buffer. | |
1339 | ||
1340 | \\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line, | |
1341 | step-one-line (not entering function calls), and step-one-instruction | |
1342 | and then update the source window with the current file and position. | |
1343 | \\[gud-cont] continues execution. | |
1344 | ||
1345 | \\[gud-print] tries to find the largest C lvalue or function-call expression | |
1346 | around point, and sends it to the debugger for value display. | |
1347 | ||
1348 | The above commands are common to all supported debuggers except xdb which | |
1349 | does not support stepping instructions. | |
1350 | ||
1351 | Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break], | |
1352 | except that the breakpoint is temporary; that is, it is removed when | |
1353 | execution stops on it. | |
1354 | ||
1355 | Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack | |
1356 | frame. \\[gud-down] drops back down through one. | |
1357 | ||
1358 | If you are using gdb or xdb, \\[gud-finish] runs execution to the return from | |
1359 | the current function and stops. | |
1360 | ||
1361 | All the keystrokes above are accessible in the GUD buffer | |
1362 | with the prefix C-c, and in all buffers through the prefix C-x C-a. | |
1363 | ||
1364 | All pre-defined functions for which the concept make sense repeat | |
1365 | themselves the appropriate number of times if you give a prefix | |
1366 | argument. | |
1367 | ||
1368 | You may use the `gud-def' macro in the initialization hook to define other | |
1369 | commands. | |
1370 | ||
1371 | Other commands for interacting with the debugger process are inherited from | |
1372 | comint mode, which see." | |
1373 | (interactive) | |
1374 | (comint-mode) | |
1375 | (setq major-mode 'gud-mode) | |
1376 | (setq mode-name "Debugger") | |
1377 | (setq mode-line-process '(": %s")) | |
1378 | (use-local-map (copy-keymap gdbish-comint-mode-map)) | |
1379 | (make-local-variable 'gud-last-frame) | |
1380 | (setq gud-last-frame nil) | |
1381 | (make-local-variable 'comint-prompt-regexp) | |
1382 | (make-local-variable 'gud-delete-prompt-marker) | |
1383 | (setq gud-delete-prompt-marker (make-marker)) | |
1384 | (run-hooks 'gud-mode-hook) | |
1385 | ) | |
1386 | ||
1387 | (defvar gud-comint-buffer nil) | |
1388 | ||
1389 | ;; Chop STRING into words separated by SPC or TAB and return a list of them. | |
1390 | (defun gud-chop-words (string) | |
1391 | (let ((i 0) (beg 0) | |
1392 | (len (length string)) | |
1393 | (words nil)) | |
1394 | (while (< i len) | |
1395 | (if (memq (aref string i) '(?\t ? )) | |
1396 | (progn | |
1397 | (setq words (cons (substring string beg i) words) | |
1398 | beg (1+ i)) | |
1399 | (while (and (< beg len) (memq (aref string beg) '(?\t ? ))) | |
1400 | (setq beg (1+ beg))) | |
1401 | (setq i (1+ beg))) | |
1402 | (setq i (1+ i)))) | |
1403 | (if (< beg len) | |
1404 | (setq words (cons (substring string beg) words))) | |
1405 | (nreverse words))) | |
1406 | ||
1407 | (defvar gud-target-name "--unknown--" | |
1408 | "The apparent name of the program being debugged in a gud buffer. | |
1409 | For sure this the root string used in smashing together the gud | |
1410 | buffer's name, even if that doesn't happen to be the name of a | |
1411 | program.") | |
1412 | ||
1413 | ;; Perform initializations common to all debuggers. | |
1414 | (defun gud-common-init (command-line) | |
1415 | (let* ((words (gud-chop-words command-line)) | |
1416 | (program (car words)) | |
1417 | (file-word (let ((w (cdr words))) | |
1418 | (while (and w (= ?- (aref (car w) 0))) | |
1419 | (setq w (cdr w))) | |
1420 | (car w))) | |
1421 | (args (delq file-word (cdr words))) | |
1422 | (file (expand-file-name file-word)) | |
1423 | (filepart (file-name-nondirectory file)) | |
1424 | (buffer-name (concat "*gud-" filepart "*"))) | |
1425 | (switch-to-buffer buffer-name) | |
1426 | (setq default-directory (file-name-directory file)) | |
1427 | (or (bolp) (newline)) | |
1428 | (insert "Current directory is " default-directory "\n") | |
1429 | (apply 'make-comint (concat "gud-" filepart) program nil | |
1430 | (gud-massage-args file args)) | |
1431 | (gud-mode) | |
1432 | (make-variable-buffer-local 'gud-target-name) | |
1433 | (setq gud-target-name filepart)) | |
1434 | (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) | |
1435 | (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) | |
1436 | (gud-set-buffer) | |
1437 | ) | |
1438 | ||
1439 | (defun gud-set-buffer () | |
1440 | (cond ((eq major-mode 'gud-mode) | |
1441 | (setq gud-comint-buffer (current-buffer))))) | |
1442 | ||
1443 | ;; These functions are responsible for inserting output from your debugger | |
1444 | ;; into the buffer. The hard work is done by the method that is | |
1445 | ;; the value of gud-marker-filter. | |
1446 | ||
1447 | (defun gud-filter (proc string) | |
1448 | ;; Here's where the actual buffer insertion is done | |
1449 | (let ((inhibit-quit t)) | |
1450 | (save-excursion | |
1451 | (set-buffer (process-buffer proc)) | |
1452 | (let (moving output-after-point) | |
1453 | (save-excursion | |
1454 | (goto-char (process-mark proc)) | |
1455 | ;; If we have been so requested, delete the debugger prompt. | |
1456 | (if (marker-buffer gud-delete-prompt-marker) | |
1457 | (progn | |
1458 | (delete-region (point) gud-delete-prompt-marker) | |
1459 | (set-marker gud-delete-prompt-marker nil))) | |
1460 | (insert-before-markers (gud-marker-filter string)) | |
1461 | (setq moving (= (point) (process-mark proc))) | |
1462 | (setq output-after-point (< (point) (process-mark proc))) | |
1463 | ;; Check for a filename-and-line number. | |
1464 | ;; Don't display the specified file | |
1465 | ;; unless (1) point is at or after the position where output appears | |
1466 | ;; and (2) this buffer is on the screen. | |
1467 | (if (and gud-last-frame | |
1468 | (not output-after-point) | |
1469 | (get-buffer-window (current-buffer))) | |
1470 | (gud-display-frame))) | |
1471 | (if moving (goto-char (process-mark proc))))))) | |
1472 | ||
1473 | (defun gud-sentinel (proc msg) | |
1474 | (cond ((null (buffer-name (process-buffer proc))) | |
1475 | ;; buffer killed | |
1476 | ;; Stop displaying an arrow in a source file. | |
1477 | (setq overlay-arrow-position nil) | |
1478 | (set-process-buffer proc nil)) | |
1479 | ((memq (process-status proc) '(signal exit)) | |
1480 | ;; Stop displaying an arrow in a source file. | |
1481 | (setq overlay-arrow-position nil) | |
1482 | ;; Fix the mode line. | |
1483 | (setq mode-line-process | |
1484 | (concat ": " | |
1485 | (symbol-name (process-status proc)))) | |
1486 | (let* ((obuf (current-buffer))) | |
1487 | ;; save-excursion isn't the right thing if | |
1488 | ;; process-buffer is current-buffer | |
1489 | (unwind-protect | |
1490 | (progn | |
1491 | ;; Write something in *compilation* and hack its mode line, | |
1492 | (set-buffer (process-buffer proc)) | |
1493 | ;; Force mode line redisplay soon | |
1494 | (set-buffer-modified-p (buffer-modified-p)) | |
1495 | (if (eobp) | |
1496 | (insert ?\n mode-name " " msg) | |
1497 | (save-excursion | |
1498 | (goto-char (point-max)) | |
1499 | (insert ?\n mode-name " " msg))) | |
1500 | ;; If buffer and mode line will show that the process | |
1501 | ;; is dead, we can delete it now. Otherwise it | |
1502 | ;; will stay around until M-x list-processes. | |
1503 | (delete-process proc)) | |
1504 | ;; Restore old buffer, but don't restore old point | |
1505 | ;; if obuf is the gud buffer. | |
1506 | (set-buffer obuf)))))) | |
1507 | ||
1508 | (defun gud-display-frame () | |
1509 | "Find and obey the last filename-and-line marker from the debugger. | |
1510 | Obeying it means displaying in another window the specified file and line." | |
1511 | (interactive) | |
1512 | (if gud-last-frame | |
1513 | (progn | |
1514 | (gud-set-buffer) | |
1515 | (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) | |
1516 | (setq gud-last-last-frame gud-last-frame | |
1517 | gud-last-frame nil)))) | |
1518 | ||
1519 | ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen | |
1520 | ;; and that its line LINE is visible. | |
1521 | ;; Put the overlay-arrow on the line LINE in that buffer. | |
1522 | ;; Most of the trickiness in here comes from wanting to preserve the current | |
1523 | ;; region-restriction if that's possible. We use an explicit display-buffer | |
1524 | ;; to get around the fact that this is called inside a save-excursion. | |
1525 | ||
1526 | (defun gud-display-line (true-file line) | |
1527 | (let* ((buffer (gud-find-file true-file)) | |
1528 | (window (display-buffer buffer)) | |
1529 | (pos)) | |
1530 | ;;; (if (equal buffer (current-buffer)) | |
1531 | ;;; nil | |
1532 | ;;; (setq buffer-read-only nil)) | |
1533 | (save-excursion | |
1534 | ;;; (setq buffer-read-only t) | |
1535 | (set-buffer buffer) | |
1536 | (save-restriction | |
1537 | (widen) | |
1538 | (goto-line line) | |
1539 | (setq pos (point)) | |
1540 | (setq overlay-arrow-string "=>") | |
1541 | (or overlay-arrow-position | |
1542 | (setq overlay-arrow-position (make-marker))) | |
1543 | (set-marker overlay-arrow-position (point) (current-buffer))) | |
1544 | (cond ((or (< pos (point-min)) (> pos (point-max))) | |
1545 | (widen) | |
1546 | (goto-char pos)))) | |
1547 | (set-window-point window overlay-arrow-position))) | |
1548 | ||
1549 | ;;; The gud-call function must do the right thing whether its invoking | |
1550 | ;;; keystroke is from the GUD buffer itself (via major-mode binding) | |
1551 | ;;; or a C buffer. In the former case, we want to supply data from | |
1552 | ;;; gud-last-frame. Here's how we do it: | |
1553 | ||
1554 | (defun gud-format-command (str arg) | |
1555 | (let ((insource (not (eq (current-buffer) gud-comint-buffer)))) | |
1556 | (if (string-match "\\(.*\\)%f\\(.*\\)" str) | |
1557 | (setq str (concat | |
1558 | (substring str (match-beginning 1) (match-end 1)) | |
1559 | (file-name-nondirectory (if insource | |
1560 | (buffer-file-name) | |
1561 | (car gud-last-frame))) | |
1562 | (substring str (match-beginning 2) (match-end 2))))) | |
1563 | (if (string-match "\\(.*\\)%d\\(.*\\)" str) | |
1564 | (setq str (concat | |
1565 | (substring str (match-beginning 1) (match-end 1)) | |
1566 | (file-name-directory (if insource | |
1567 | (buffer-file-name) | |
1568 | (car gud-last-frame))) | |
1569 | (substring str (match-beginning 2) (match-end 2))))) | |
1570 | (if (string-match "\\(.*\\)%l\\(.*\\)" str) | |
1571 | (setq str (concat | |
1572 | (substring str (match-beginning 1) (match-end 1)) | |
1573 | (if insource | |
1574 | (save-excursion | |
1575 | (beginning-of-line) | |
1576 | (save-restriction (widen) | |
1577 | (1+ (count-lines 1 (point))))) | |
1578 | (cdr gud-last-frame)) | |
1579 | (substring str (match-beginning 2) (match-end 2))))) | |
1580 | (if (string-match "\\(.*\\)%e\\(.*\\)" str) | |
1581 | (setq str (concat | |
1582 | (substring str (match-beginning 1) (match-end 1)) | |
1583 | (find-c-expr) | |
1584 | (substring str (match-beginning 2) (match-end 2))))) | |
1585 | (if (string-match "\\(.*\\)%a\\(.*\\)" str) | |
1586 | (setq str (concat | |
1587 | (substring str (match-beginning 1) (match-end 1)) | |
1588 | (gud-read-address) | |
1589 | (substring str (match-beginning 2) (match-end 2))))) | |
1590 | (if (string-match "\\(.*\\)%p\\(.*\\)" str) | |
1591 | (setq str (concat | |
1592 | (substring str (match-beginning 1) (match-end 1)) | |
1593 | (if arg (int-to-string arg) "") | |
1594 | (substring str (match-beginning 2) (match-end 2))))) | |
1595 | ) | |
1596 | str | |
1597 | ) | |
1598 | ||
1599 | (defun gud-read-address () | |
1600 | "Return a string containing the core-address found in the buffer at point." | |
1601 | (save-excursion | |
1602 | (let ((pt (point)) found begin) | |
1603 | (setq found (if (search-backward "0x" (- pt 7) t) (point))) | |
1604 | (cond | |
1605 | (found (forward-char 2) | |
1606 | (buffer-substring found | |
1607 | (progn (re-search-forward "[^0-9a-f]") | |
1608 | (forward-char -1) | |
1609 | (point)))) | |
1610 | (t (setq begin (progn (re-search-backward "[^0-9]") | |
1611 | (forward-char 1) | |
1612 | (point))) | |
1613 | (forward-char 1) | |
1614 | (re-search-forward "[^0-9]") | |
1615 | (forward-char -1) | |
1616 | (buffer-substring begin (point))))))) | |
1617 | ||
1618 | (defun gud-call (fmt &optional arg) | |
1619 | (let ((msg (gud-format-command fmt arg))) | |
1620 | (message "Command: %s" msg) | |
1621 | (sit-for 0) | |
1622 | (gud-basic-call msg))) | |
1623 | ||
1624 | (defun gud-basic-call (command) | |
1625 | "Invoke the debugger COMMAND displaying source in other window." | |
1626 | (interactive) | |
1627 | (gud-set-buffer) | |
1628 | (let ((command (concat command "\n")) | |
1629 | (proc (get-buffer-process gud-comint-buffer))) | |
1630 | ||
1631 | ;; Arrange for the current prompt to get deleted. | |
1632 | (save-excursion | |
1633 | (set-buffer gud-comint-buffer) | |
1634 | (goto-char (process-mark proc)) | |
1635 | (beginning-of-line) | |
1636 | (if (looking-at comint-prompt-regexp) | |
1637 | (set-marker gud-delete-prompt-marker (point)))) | |
1638 | (process-send-string proc command))) | |
1639 | ||
1640 | (defun gud-refresh (&optional arg) | |
1641 | "Fix up a possibly garbled display, and redraw the arrow." | |
1642 | (interactive "P") | |
1643 | (recenter arg) | |
1644 | (or gud-last-frame (setq gud-last-frame gud-last-last-frame)) | |
1645 | (gud-display-frame)) | |
1646 | \f | |
1647 | ;;; Code for parsing expressions out of C code. The single entry point is | |
1648 | ;;; find-c-expr, which tries to return an lvalue expression from around point. | |
1649 | ;;; | |
1650 | ;;; The rest of this file is a hacked version of gdbsrc.el by | |
1651 | ;;; Debby Ayers <ayers@asc.slb.com>, | |
1652 | ;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx. | |
1653 | ||
1654 | (defun find-c-expr () | |
1655 | "Returns the C expr that surrounds point." | |
1656 | (interactive) | |
1657 | (save-excursion | |
1658 | (let ((p) (expr) (test-expr)) | |
1659 | (setq p (point)) | |
1660 | (setq expr (expr-cur)) | |
1661 | (setq test-expr (expr-prev)) | |
1662 | (while (expr-compound test-expr expr) | |
1663 | (setq expr (cons (car test-expr) (cdr expr))) | |
1664 | (goto-char (car expr)) | |
1665 | (setq test-expr (expr-prev))) | |
1666 | (goto-char p) | |
1667 | (setq test-expr (expr-next)) | |
1668 | (while (expr-compound expr test-expr) | |
1669 | (setq expr (cons (car expr) (cdr test-expr))) | |
1670 | (setq test-expr (expr-next)) | |
1671 | ) | |
1672 | (buffer-substring (car expr) (cdr expr))))) | |
1673 | ||
1674 | (defun expr-cur () | |
1675 | "Returns the expr that point is in; point is set to beginning of expr. | |
1676 | The expr is represented as a cons cell, where the car specifies the point in | |
1677 | the current buffer that marks the beginning of the expr and the cdr specifies | |
1678 | the character after the end of the expr." | |
1679 | (let ((p (point)) (begin) (end)) | |
1680 | (expr-backward-sexp) | |
1681 | (setq begin (point)) | |
1682 | (expr-forward-sexp) | |
1683 | (setq end (point)) | |
1684 | (if (>= p end) | |
1685 | (progn | |
1686 | (setq begin p) | |
1687 | (goto-char p) | |
1688 | (expr-forward-sexp) | |
1689 | (setq end (point)) | |
1690 | ) | |
1691 | ) | |
1692 | (goto-char begin) | |
1693 | (cons begin end))) | |
1694 | ||
1695 | (defun expr-backward-sexp () | |
1696 | "Version of `backward-sexp' that catches errors." | |
1697 | (condition-case nil | |
1698 | (backward-sexp) | |
1699 | (error t))) | |
1700 | ||
1701 | (defun expr-forward-sexp () | |
1702 | "Version of `forward-sexp' that catches errors." | |
1703 | (condition-case nil | |
1704 | (forward-sexp) | |
1705 | (error t))) | |
1706 | ||
1707 | (defun expr-prev () | |
1708 | "Returns the previous expr, point is set to beginning of that expr. | |
1709 | The expr is represented as a cons cell, where the car specifies the point in | |
1710 | the current buffer that marks the beginning of the expr and the cdr specifies | |
1711 | the character after the end of the expr" | |
1712 | (let ((begin) (end)) | |
1713 | (expr-backward-sexp) | |
1714 | (setq begin (point)) | |
1715 | (expr-forward-sexp) | |
1716 | (setq end (point)) | |
1717 | (goto-char begin) | |
1718 | (cons begin end))) | |
1719 | ||
1720 | (defun expr-next () | |
1721 | "Returns the following expr, point is set to beginning of that expr. | |
1722 | The expr is represented as a cons cell, where the car specifies the point in | |
1723 | the current buffer that marks the beginning of the expr and the cdr specifies | |
1724 | the character after the end of the expr." | |
1725 | (let ((begin) (end)) | |
1726 | (expr-forward-sexp) | |
1727 | (expr-forward-sexp) | |
1728 | (setq end (point)) | |
1729 | (expr-backward-sexp) | |
1730 | (setq begin (point)) | |
1731 | (cons begin end))) | |
1732 | ||
1733 | (defun expr-compound-sep (span-start span-end) | |
1734 | "Returns '.' for '->' & '.', returns ' ' for white space, | |
1735 | returns '?' for other punctuation." | |
1736 | (let ((result ? ) | |
1737 | (syntax)) | |
1738 | (while (< span-start span-end) | |
1739 | (setq syntax (char-syntax (char-after span-start))) | |
1740 | (cond | |
1741 | ((= syntax ? ) t) | |
1742 | ((= syntax ?.) (setq syntax (char-after span-start)) | |
1743 | (cond | |
1744 | ((= syntax ?.) (setq result ?.)) | |
1745 | ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>)) | |
1746 | (setq result ?.) | |
1747 | (setq span-start (+ span-start 1))) | |
1748 | (t (setq span-start span-end) | |
1749 | (setq result ??))))) | |
1750 | (setq span-start (+ span-start 1))) | |
1751 | result)) | |
1752 | ||
1753 | (defun expr-compound (first second) | |
1754 | "Non-nil if concatenating FIRST and SECOND makes a single C token. | |
1755 | The two exprs are represented as a cons cells, where the car | |
1756 | specifies the point in the current buffer that marks the beginning of the | |
1757 | expr and the cdr specifies the character after the end of the expr. | |
1758 | Link exprs of the form: | |
1759 | Expr -> Expr | |
1760 | Expr . Expr | |
1761 | Expr (Expr) | |
1762 | Expr [Expr] | |
1763 | (Expr) Expr | |
1764 | [Expr] Expr" | |
1765 | (let ((span-start (cdr first)) | |
1766 | (span-end (car second)) | |
1767 | (syntax)) | |
1768 | (setq syntax (expr-compound-sep span-start span-end)) | |
1769 | (cond | |
1770 | ((= (car first) (car second)) nil) | |
1771 | ((= (cdr first) (cdr second)) nil) | |
1772 | ((= syntax ?.) t) | |
1773 | ((= syntax ? ) | |
1774 | (setq span-start (char-after (- span-start 1))) | |
1775 | (setq span-end (char-after span-end)) | |
1776 | (cond | |
1777 | ((= span-start ?) ) t ) | |
1778 | ((= span-start ?] ) t ) | |
1779 | ((= span-end ?( ) t ) | |
1780 | ((= span-end ?[ ) t ) | |
1781 | (t nil)) | |
1782 | ) | |
1783 | (t nil)))) | |
1784 | ||
1785 | (provide 'gud) | |
1786 | ||
1787 | ;;; gud.el ends here | |
1788 | ||
1789 | (defun toggle-bp-this-line () | |
1790 | (interactive) | |
1791 | (save-excursion | |
1792 | (let (bp-num bp-state) | |
1793 | (beginning-of-line 1) | |
1794 | (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")) | |
1795 | (error "Not recognized as breakpoint line (demo foo).") | |
1796 | (process-send-string | |
1797 | gdb-buffer-process!!! | |
1798 | (concat | |
1799 | (if (eq ?y (char-after (match-beginning 2))) | |
1800 | "server disable " | |
1801 | "server enable ") | |
1802 | (buffer-substring (match-beginning 0) | |
1803 | (match-end 1)) | |
1804 | "\n")))))) | |
1805 | ||
1806 |