|
0
|
1 ;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb
|
|
|
2 ;;; under Emacs
|
|
|
3
|
|
|
4 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
|
|
|
5 ;; Maintainer: FSF
|
|
|
6 ;; Version: 1.3
|
|
|
7 ;; Keywords: c, unix, tools, debugging
|
|
|
8
|
|
|
9 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
|
|
|
10
|
|
|
11 ;; This file is part of XEmacs.
|
|
|
12
|
|
|
13 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
14 ;; under the terms of the GNU General Public License as published by
|
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;; any later version.
|
|
|
17
|
|
|
18 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
21 ;; General Public License for more details.
|
|
|
22
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
|
24 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
25 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
|
|
|
30 ;; It was later rewritten by rms. Some ideas were due to Masanobu.
|
|
|
31 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com>
|
|
|
32 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
|
|
|
33 ;; who also hacked the mode to use comint.el. Shane Hartman <shane@spr.com>
|
|
|
34 ;; added support for xdb (HPUX debugger).
|
|
|
35
|
|
|
36 ;; Cygnus Support added support for gdb's --annotate=2.
|
|
|
37
|
|
|
38 ;;; Code:
|
|
|
39
|
|
|
40 (require 'comint)
|
|
|
41 (require 'etags)
|
|
|
42
|
|
|
43 ;; ======================================================================
|
|
|
44 ;; GUD commands must be visible in C buffers visited by GUD
|
|
|
45
|
|
|
46 (defvar gud-key-prefix "\C-x\C-a"
|
|
|
47 "Prefix of all GUD commands valid in C buffers.")
|
|
|
48
|
|
|
49 (global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
|
|
|
50 (global-set-key "\C-x " 'gud-break) ;; backward compatibility hack
|
|
|
51
|
|
|
52 ;; ======================================================================
|
|
|
53 ;; the overloading mechanism
|
|
|
54
|
|
|
55 (defun gud-overload-functions (gud-overload-alist)
|
|
|
56 "Overload functions defined in GUD-OVERLOAD-ALIST.
|
|
|
57 This association list has elements of the form
|
|
|
58 (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)"
|
|
|
59 (mapcar
|
|
|
60 (function (lambda (p) (fset (car p) (symbol-function (cdr p)))))
|
|
|
61 gud-overload-alist))
|
|
|
62
|
|
|
63 (defun gud-massage-args (file args)
|
|
|
64 (error "GUD not properly entered."))
|
|
|
65
|
|
|
66 (defun gud-marker-filter (str)
|
|
|
67 (error "GUD not properly entered."))
|
|
|
68
|
|
|
69 (defun gud-find-file (f)
|
|
|
70 (error "GUD not properly entered."))
|
|
|
71
|
|
|
72 ;; ======================================================================
|
|
|
73 ;; command definition
|
|
|
74
|
|
|
75 ;; This macro is used below to define some basic debugger interface commands.
|
|
|
76 ;; Of course you may use `gud-def' with any other debugger command, including
|
|
|
77 ;; user defined ones.
|
|
|
78
|
|
|
79 ;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form
|
|
|
80 ;; which defines FUNC to send the command NAME to the debugger, gives
|
|
|
81 ;; it the docstring DOC, and binds that function to KEY in the GUD
|
|
|
82 ;; major mode. The function is also bound in the global keymap with the
|
|
|
83 ;; GUD prefix.
|
|
|
84
|
|
|
85 (defmacro gud-def (func cmd key &optional doc)
|
|
|
86 "Define FUNC to be a command sending STR and bound to KEY, with
|
|
|
87 optional doc string DOC. Certain %-escapes in the string arguments
|
|
|
88 are interpreted specially if present. These are:
|
|
|
89
|
|
|
90 %f name (without directory) of current source file.
|
|
|
91 %d directory of current source file.
|
|
|
92 %l number of current source line
|
|
|
93 %e text of the C lvalue or function-call expression surrounding point.
|
|
|
94 %a text of the hexadecimal address surrounding point
|
|
|
95 %p prefix argument to the command (if any) as a number
|
|
|
96
|
|
|
97 The `current' source file is the file of the current buffer (if
|
|
|
98 we're in a C file) or the source file current at the last break or
|
|
|
99 step (if we're in the GUD buffer).
|
|
|
100 The `current' line is that of the current buffer (if we're in a
|
|
|
101 source file) or the source line number at the last break or step (if
|
|
|
102 we're in the GUD buffer)."
|
|
|
103 (list 'progn
|
|
|
104 (list 'defun func '(arg)
|
|
|
105 (or doc "")
|
|
|
106 '(interactive "p")
|
|
|
107 (list 'gud-call cmd 'arg))
|
|
|
108 (if key
|
|
|
109 (list 'define-key
|
|
|
110 '(current-local-map)
|
|
|
111 (concat "\C-c" key)
|
|
|
112 (list 'quote func)))
|
|
|
113 (if key
|
|
|
114 (list 'global-set-key
|
|
|
115 (list 'concat 'gud-key-prefix key)
|
|
|
116 (list 'quote func)))))
|
|
|
117
|
|
|
118 ;; Where gud-display-frame should put the debugging arrow. This is
|
|
|
119 ;; set by the marker-filter, which scans the debugger's output for
|
|
|
120 ;; indications of the current program counter.
|
|
|
121 (defvar gud-last-frame nil)
|
|
|
122
|
|
|
123 ;; Used by gud-refresh, which should cause gud-display-frame to redisplay
|
|
|
124 ;; the last frame, even if it's been called before and gud-last-frame has
|
|
|
125 ;; been set to nil.
|
|
|
126 (defvar gud-last-last-frame nil)
|
|
|
127
|
|
|
128 ;; All debugger-specific information is collected here.
|
|
|
129 ;; Here's how it works, in case you ever need to add a debugger to the mode.
|
|
|
130 ;;
|
|
|
131 ;; Each entry must define the following at startup:
|
|
|
132 ;;
|
|
|
133 ;;<name>
|
|
|
134 ;; comint-prompt-regexp
|
|
|
135 ;; gud-<name>-massage-args
|
|
|
136 ;; gud-<name>-marker-filter
|
|
|
137 ;; gud-<name>-find-file
|
|
|
138 ;;
|
|
|
139 ;; The job of the massage-args method is to modify the given list of
|
|
|
140 ;; debugger arguments before running the debugger.
|
|
|
141 ;;
|
|
|
142 ;; The job of the marker-filter method is to detect file/line markers in
|
|
|
143 ;; strings and set the global gud-last-frame to indicate what display
|
|
|
144 ;; action (if any) should be triggered by the marker. Note that only
|
|
|
145 ;; whatever the method *returns* is displayed in the buffer; thus, you
|
|
|
146 ;; can filter the debugger's output, interpreting some and passing on
|
|
|
147 ;; the rest.
|
|
|
148 ;;
|
|
|
149 ;; The job of the find-file method is to visit and return the buffer indicated
|
|
|
150 ;; by the car of gud-tag-frame. This may be a file name, a tag name, or
|
|
|
151 ;; something else.
|
|
|
152
|
|
|
153 ;; ======================================================================
|
|
|
154 ;; gdb functions
|
|
|
155
|
|
|
156 ;;; History of argument lists passed to gdb.
|
|
|
157 (defvar gud-gdb-history nil)
|
|
|
158
|
|
|
159 (defun gud-gdb-massage-args (file args)
|
|
|
160 (cons "--annotate=2" (cons file args)))
|
|
|
161
|
|
|
162
|
|
|
163 ;;
|
|
|
164 ;; In this world, there are gdb instance objects (of unspecified
|
|
|
165 ;; representation) and buffers associated with those objects.
|
|
|
166 ;;
|
|
|
167
|
|
|
168 ;;
|
|
|
169 ;; gdb-instance objects
|
|
|
170 ;;
|
|
|
171
|
|
|
172 (defun make-gdb-instance (proc)
|
|
|
173 "Create a gdb instance object from a gdb process."
|
|
|
174 (setq last-proc proc)
|
|
|
175 (let ((instance (cons 'gdb-instance proc)))
|
|
|
176 (save-excursion
|
|
|
177 (set-buffer (process-buffer proc))
|
|
|
178 (setq gdb-buffer-instance instance)
|
|
|
179 (progn
|
|
|
180 (mapcar 'make-variable-buffer-local gdb-instance-variables)
|
|
|
181 (setq gdb-buffer-type 'gud)
|
|
|
182 ;; If we're taking over the buffer of another process,
|
|
|
183 ;; take over it's ancillery buffers as well.
|
|
|
184 ;;
|
|
|
185 (let ((dead (or old-gdb-buffer-instance)))
|
|
|
186 (mapcar
|
|
|
187 (function
|
|
|
188 (lambda (b)
|
|
|
189 (progn
|
|
|
190 (set-buffer b)
|
|
|
191 (if (eq dead gdb-buffer-instance)
|
|
|
192 (setq gdb-buffer-instance instance)))))
|
|
|
193 (buffer-list)))))
|
|
|
194 instance))
|
|
|
195
|
|
|
196 (defun gdb-instance-process (inst) (cdr inst))
|
|
|
197
|
|
|
198 ;;; The list of instance variables is built up by the expansions of
|
|
|
199 ;;; DEF-GDB-VARIABLE
|
|
|
200 ;;;
|
|
|
201 (defvar gdb-instance-variables '()
|
|
|
202 "A list of variables that are local to the gud buffer associated
|
|
|
203 with a gdb instance.")
|
|
|
204
|
|
|
205 (defmacro def-gdb-variable
|
|
|
206 (name accessor setter &optional default doc)
|
|
|
207 (`
|
|
|
208 (progn
|
|
|
209 (defvar (, name) (, default) (, (or doc "undocumented")))
|
|
|
210 (if (not (memq '(, name) gdb-instance-variables))
|
|
|
211 (setq gdb-instance-variables
|
|
|
212 (cons '(, name) gdb-instance-variables)))
|
|
|
213 (, (and accessor
|
|
|
214 (`
|
|
|
215 (defun (, accessor) (instance)
|
|
|
216 (let
|
|
|
217 ((buffer (gdb-get-instance-buffer instance 'gud)))
|
|
|
218 (and buffer
|
|
|
219 (save-excursion
|
|
|
220 (set-buffer buffer)
|
|
|
221 (, name))))))))
|
|
|
222 (, (and setter
|
|
|
223 (`
|
|
|
224 (defun (, setter) (instance val)
|
|
|
225 (let
|
|
|
226 ((buffer (gdb-get-instance-buffer instance 'gud)))
|
|
|
227 (and buffer
|
|
|
228 (save-excursion
|
|
|
229 (set-buffer buffer)
|
|
|
230 (setq (, name) val)))))))))))
|
|
|
231
|
|
|
232 (defmacro def-gdb-var (root-symbol &optional default doc)
|
|
|
233 (let* ((root (symbol-name root-symbol))
|
|
|
234 (accessor (intern (concat "gdb-instance-" root)))
|
|
|
235 (setter (intern (concat "set-gdb-instance-" root)))
|
|
|
236 (var-name (intern (concat "gdb-" root))))
|
|
|
237 (` (def-gdb-variable
|
|
|
238 (, var-name) (, accessor) (, setter)
|
|
|
239 (, default) (, doc)))))
|
|
|
240
|
|
|
241 (def-gdb-var buffer-instance nil
|
|
|
242 "In an instance buffer, the buffer's instance.")
|
|
|
243
|
|
|
244 (def-gdb-var buffer-type nil
|
|
|
245 "One of the symbols bound in gdb-instance-buffer-rules")
|
|
|
246
|
|
|
247 (def-gdb-var burst ""
|
|
|
248 "A string of characters from gdb that have not yet been processed.")
|
|
|
249
|
|
|
250 (def-gdb-var input-queue ()
|
|
|
251 "A list of high priority gdb command objects.")
|
|
|
252
|
|
|
253 (def-gdb-var idle-input-queue ()
|
|
|
254 "A list of low priority gdb command objects.")
|
|
|
255
|
|
|
256 (def-gdb-var prompting nil
|
|
|
257 "True when gdb is idle with no pending input.")
|
|
|
258
|
|
|
259 (def-gdb-var output-sink 'user
|
|
|
260 "The disposition of the output of the current gdb command.
|
|
|
261 Possible values are these symbols:
|
|
|
262
|
|
|
263 user -- gdb output should be copied to the gud buffer
|
|
|
264 for the user to see.
|
|
|
265
|
|
|
266 inferior -- gdb output should be copied to the inferior-io buffer
|
|
|
267
|
|
|
268 pre-emacs -- output should be ignored util the post-prompt
|
|
|
269 annotation is received. Then the output-sink
|
|
|
270 becomes:...
|
|
|
271 emacs -- output should be collected in the partial-output-buffer
|
|
|
272 for subsequent processing by a command. This is the
|
|
|
273 disposition of output generated by commands that
|
|
|
274 gud mode sends to gdb on its own behalf.
|
|
|
275 post-emacs -- ignore input until the prompt annotation is
|
|
|
276 received, then go to USER disposition.
|
|
|
277 ")
|
|
|
278
|
|
|
279 (def-gdb-var current-item nil
|
|
|
280 "The most recent command item sent to gdb.")
|
|
|
281
|
|
|
282 (def-gdb-var pending-triggers '()
|
|
|
283 "A list of trigger functions that have run later than their output
|
|
|
284 handlers.")
|
|
|
285
|
|
|
286 (defun in-gdb-instance-context (instance form)
|
|
|
287 "Funcall `form' in the gud buffer of `instance'"
|
|
|
288 (save-excursion
|
|
|
289 (set-buffer (gdb-get-instance-buffer instance 'gud))
|
|
|
290 (funcall form)))
|
|
|
291
|
|
|
292 ;; end of instance vars
|
|
|
293
|
|
|
294 ;;
|
|
|
295 ;; finding instances
|
|
|
296 ;;
|
|
|
297
|
|
|
298 (defun gdb-proc->instance (proc)
|
|
|
299 (save-excursion
|
|
|
300 (set-buffer (process-buffer proc))
|
|
|
301 gdb-buffer-instance))
|
|
|
302
|
|
|
303 (defun gdb-mru-instance-buffer ()
|
|
|
304 "Return the most recently used (non-auxiliary) gdb gud buffer."
|
|
|
305 (save-excursion
|
|
|
306 (gdb-goto-first-gdb-instance (buffer-list))))
|
|
|
307
|
|
|
308 (defun gdb-goto-first-gdb-instance (blist)
|
|
|
309 "Use gdb-mru-instance-buffer -- not this."
|
|
|
310 (and blist
|
|
|
311 (progn
|
|
|
312 (set-buffer (car blist))
|
|
|
313 (or (and gdb-buffer-instance
|
|
|
314 (eq gdb-buffer-type 'gud)
|
|
|
315 (car blist))
|
|
|
316 (gdb-goto-first-gdb-instance (cdr blist))))))
|
|
|
317
|
|
|
318 (defun buffer-gdb-instance (buf)
|
|
|
319 (save-excursion
|
|
|
320 (set-buffer buf)
|
|
|
321 gdb-buffer-instance))
|
|
|
322
|
|
|
323 (defun gdb-needed-default-instance ()
|
|
|
324 "Return the most recently used gdb instance or signal an error."
|
|
|
325 (let ((buffer (gdb-mru-instance-buffer)))
|
|
|
326 (or (and buffer (buffer-gdb-instance buffer))
|
|
|
327 (error "No instance of gdb found."))))
|
|
|
328
|
|
|
329 (defun gdb-instance-target-string (instance)
|
|
|
330 "The apparent name of the program being debugged by a gdb instance.
|
|
|
331 For sure this the root string used in smashing together the gud
|
|
|
332 buffer's name, even if that doesn't happen to be the name of a
|
|
|
333 program."
|
|
|
334 (in-gdb-instance-context
|
|
|
335 instance
|
|
|
336 (function (lambda () gud-target-name))))
|
|
|
337
|
|
|
338
|
|
|
339
|
|
|
340 ;;
|
|
|
341 ;; Instance Buffers.
|
|
|
342 ;;
|
|
|
343
|
|
|
344 ;; More than one buffer can be associated with a gdb instance.
|
|
|
345 ;;
|
|
|
346 ;; Each buffer has a TYPE -- a symbol that identifies the function
|
|
|
347 ;; of that particular buffer.
|
|
|
348 ;;
|
|
|
349 ;; The usual gud interaction buffer is given the type `gud' and
|
|
|
350 ;; is constructed specially.
|
|
|
351 ;;
|
|
|
352 ;; Others are constructed by gdb-get-create-instance-buffer and
|
|
|
353 ;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc
|
|
|
354
|
|
|
355 (defun gdb-get-instance-buffer (instance key)
|
|
|
356 "Return the instance buffer for `instance' tagged with type `key'.
|
|
|
357 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
|
|
|
358 (save-excursion
|
|
|
359 (gdb-look-for-tagged-buffer instance key (buffer-list))))
|
|
|
360
|
|
|
361 (defun gdb-get-create-instance-buffer (instance key)
|
|
|
362 "Create a new gdb instance buffer of the type specified by `key'.
|
|
|
363 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
|
|
|
364 (or (gdb-get-instance-buffer instance key)
|
|
|
365 (let* ((rules (assoc key gdb-instance-buffer-rules-assoc))
|
|
|
366 (name (funcall (gdb-rules-name-maker rules) instance))
|
|
|
367 (new (get-buffer-create name)))
|
|
|
368 (save-excursion
|
|
|
369 (set-buffer new)
|
|
|
370 (make-variable-buffer-local 'gdb-buffer-type)
|
|
|
371 (setq gdb-buffer-type key)
|
|
|
372 (make-variable-buffer-local 'gdb-buffer-instance)
|
|
|
373 (setq gdb-buffer-instance instance)
|
|
|
374 (if (cdr (cdr rules))
|
|
|
375 (funcall (car (cdr (cdr rules)))))
|
|
|
376 new))))
|
|
|
377
|
|
|
378 (defun gdb-rules-name-maker (rules) (car (cdr rules)))
|
|
|
379
|
|
|
380 (defun gdb-look-for-tagged-buffer (instance key bufs)
|
|
|
381 (let ((retval nil))
|
|
|
382 (while (and (not retval) bufs)
|
|
|
383 (set-buffer (car bufs))
|
|
|
384 (if (and (eq gdb-buffer-instance instance)
|
|
|
385 (eq gdb-buffer-type key))
|
|
|
386 (setq retval (car bufs)))
|
|
|
387 (setq bufs (cdr bufs))
|
|
|
388 )
|
|
|
389 retval))
|
|
|
390
|
|
|
391 (defun gdb-instance-buffer-p (buf)
|
|
|
392 (save-excursion
|
|
|
393 (set-buffer buf)
|
|
|
394 (and gdb-buffer-type
|
|
|
395 (not (eq gdb-buffer-type 'gud)))))
|
|
|
396
|
|
|
397 ;;
|
|
|
398 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
|
|
|
399 ;; at least one and possible more functions. The functions have these
|
|
|
400 ;; roles in defining a buffer type:
|
|
|
401 ;;
|
|
|
402 ;; NAME - take an instance, return a name for this type buffer for that
|
|
|
403 ;; instance.
|
|
|
404 ;; The remaining function(s) are optional:
|
|
|
405 ;;
|
|
2
|
406 ;; MODE - called in the new buffer with no arguments, should establish
|
|
0
|
407 ;; the proper mode for the buffer.
|
|
|
408 ;;
|
|
|
409
|
|
|
410 (defvar gdb-instance-buffer-rules-assoc '())
|
|
|
411
|
|
|
412 (defun gdb-set-instance-buffer-rules (buffer-type &rest rules)
|
|
|
413 (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc)))
|
|
|
414 (if binding
|
|
|
415 (setcdr binding rules)
|
|
|
416 (setq gdb-instance-buffer-rules-assoc
|
|
|
417 (cons (cons buffer-type rules)
|
|
|
418 gdb-instance-buffer-rules-assoc)))))
|
|
|
419
|
|
|
420 (gdb-set-instance-buffer-rules 'gud 'error) ; gud buffers are an exception to the rules
|
|
|
421
|
|
|
422 ;;
|
|
|
423 ;; partial-output buffers
|
|
|
424 ;;
|
|
|
425 ;; These accumulate output from a command executed on
|
|
|
426 ;; behalf of emacs (rather than the user).
|
|
|
427 ;;
|
|
|
428
|
|
|
429 (gdb-set-instance-buffer-rules 'gdb-partial-output-buffer
|
|
|
430 'gdb-partial-output-name)
|
|
|
431
|
|
|
432 (defun gdb-partial-output-name (instance)
|
|
|
433 (concat "*partial-output-"
|
|
|
434 (gdb-instance-target-string instance)
|
|
|
435 "*"))
|
|
|
436
|
|
|
437
|
|
|
438 (gdb-set-instance-buffer-rules 'gdb-inferior-io
|
|
|
439 'gdb-inferior-io-name
|
|
|
440 'gud-inferior-io-mode)
|
|
|
441
|
|
|
442 (defun gdb-inferior-io-name (instance)
|
|
|
443 (concat "*input/output of "
|
|
|
444 (gdb-instance-target-string instance)
|
|
|
445 "*"))
|
|
|
446
|
|
|
447 (defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map))
|
|
|
448 (define-key gdb-inferior-io-mode-map "\C-c\C-c" 'gdb-inferior-io-interrupt)
|
|
|
449 (define-key gdb-inferior-io-mode-map "\C-c\C-z" 'gdb-inferior-io-stop)
|
|
|
450 (define-key gdb-inferior-io-mode-map "\C-c\C-\\" 'gdb-inferior-io-quit)
|
|
|
451 (define-key gdb-inferior-io-mode-map "\C-c\C-d" 'gdb-inferior-io-eof)
|
|
|
452
|
|
|
453 (defun gud-inferior-io-mode ()
|
|
|
454 "Major mode for gud inferior-io.
|
|
|
455
|
|
|
456 \\{comint-mode-map}"
|
|
|
457 ;; We want to use comint because it has various nifty and familiar
|
|
|
458 ;; features. We don't need a process, but comint wants one, so create
|
|
|
459 ;; a dummy one.
|
|
|
460 (make-comint (substring (buffer-name) 1 (- (length (buffer-name)) 1))
|
|
|
461 "/bin/cat")
|
|
|
462 (setq major-mode 'gud-inferior-io-mode)
|
|
|
463 (setq mode-name "Debuggee I/O")
|
|
|
464 (setq comint-input-sender 'gud-inferior-io-sender)
|
|
|
465 )
|
|
|
466
|
|
|
467 (defun gud-inferior-io-sender (proc string)
|
|
|
468 (save-excursion
|
|
|
469 (set-buffer (process-buffer proc))
|
|
|
470 (let ((instance gdb-buffer-instance))
|
|
|
471 (set-buffer (gdb-get-instance-buffer instance 'gud))
|
|
|
472 (let ((gud-proc (get-buffer-process (current-buffer))))
|
|
|
473 (process-send-string gud-proc string)
|
|
|
474 (process-send-string gud-proc "\n")
|
|
|
475 ))
|
|
|
476 ))
|
|
|
477
|
|
|
478 (defun gdb-inferior-io-interrupt (instance)
|
|
|
479 "Interrupt the program being debugged."
|
|
|
480 (interactive (list (gdb-needed-default-instance)))
|
|
|
481 (interrupt-process
|
|
|
482 (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
|
|
|
483
|
|
|
484 (defun gdb-inferior-io-quit (instance)
|
|
|
485 "Send quit signal to the program being debugged."
|
|
|
486 (interactive (list (gdb-needed-default-instance)))
|
|
|
487 (quit-process
|
|
|
488 (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
|
|
|
489
|
|
|
490 (defun gdb-inferior-io-stop (instance)
|
|
|
491 "Stop the program being debugged."
|
|
|
492 (interactive (list (gdb-needed-default-instance)))
|
|
|
493 (stop-process
|
|
|
494 (get-buffer-process (gdb-get-instance-buffer instance 'gud)) comint-ptyp))
|
|
|
495
|
|
|
496 (defun gdb-inferior-io-eof (instance)
|
|
|
497 "Send end-of-file to the program being debugged."
|
|
|
498 (interactive (list (gdb-needed-default-instance)))
|
|
|
499 (process-send-eof
|
|
|
500 (get-buffer-process (gdb-get-instance-buffer instance 'gud))))
|
|
|
501
|
|
|
502
|
|
|
503 ;;
|
|
|
504 ;; gdb communications
|
|
|
505 ;;
|
|
|
506
|
|
|
507 ;; INPUT: things sent to gdb
|
|
|
508 ;;
|
|
|
509 ;; Each instance has a high and low priority
|
|
|
510 ;; input queue. Low priority input is sent only
|
|
|
511 ;; when the high priority queue is idle.
|
|
|
512 ;;
|
|
|
513 ;; The queues are lists. Each element is either
|
|
|
514 ;; a string (indicating user or user-like input)
|
|
|
515 ;; or a list of the form:
|
|
|
516 ;;
|
|
|
517 ;; (INPUT-STRING HANDLER-FN)
|
|
|
518 ;;
|
|
|
519 ;;
|
|
|
520 ;; The handler function will be called from the
|
|
|
521 ;; partial-output buffer when the command completes.
|
|
|
522 ;; This is the way to write commands which
|
|
|
523 ;; invoke gdb commands autonomously.
|
|
|
524 ;;
|
|
|
525 ;; These lists are consumed tail first.
|
|
|
526 ;;
|
|
|
527
|
|
|
528 (defun gdb-send (proc string)
|
|
|
529 "A comint send filter for gdb.
|
|
|
530 This filter may simply queue output for a later time."
|
|
|
531 (let ((instance (gdb-proc->instance proc)))
|
|
|
532 (gdb-instance-enqueue-input instance (concat string "\n"))))
|
|
|
533
|
|
|
534 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
|
|
|
535 ;; is a query, or other non-top-level prompt. To guarantee stuff will get
|
|
|
536 ;; sent to the top-level prompt, currently it must be put in the idle queue.
|
|
|
537 ;; ^^^^^^^^^
|
|
|
538 ;; [This should encourage gud extentions that invoke gdb commands to let
|
|
|
539 ;; the user go first; it is not a bug. -t]
|
|
|
540 ;;
|
|
|
541
|
|
|
542 (defun gdb-instance-enqueue-input (instance item)
|
|
|
543 (if (gdb-instance-prompting instance)
|
|
|
544 (progn
|
|
|
545 (gdb-send-item instance item)
|
|
|
546 (set-gdb-instance-prompting instance nil))
|
|
|
547 (set-gdb-instance-input-queue
|
|
|
548 instance
|
|
|
549 (cons item (gdb-instance-input-queue instance)))))
|
|
|
550
|
|
|
551 (defun gdb-instance-dequeue-input (instance)
|
|
|
552 (let ((queue (gdb-instance-input-queue instance)))
|
|
|
553 (and queue
|
|
|
554 (if (not (cdr queue))
|
|
|
555 (let ((answer (car queue)))
|
|
|
556 (set-gdb-instance-input-queue instance '())
|
|
|
557 answer)
|
|
|
558 (gdb-take-last-elt queue)))))
|
|
|
559
|
|
|
560 (defun gdb-instance-enqueue-idle-input (instance item)
|
|
|
561 (if (and (gdb-instance-prompting instance)
|
|
|
562 (not (gdb-instance-input-queue instance)))
|
|
|
563 (progn
|
|
|
564 (gdb-send-item instance item)
|
|
|
565 (set-gdb-instance-prompting instance nil))
|
|
|
566 (set-gdb-instance-idle-input-queue
|
|
|
567 instance
|
|
|
568 (cons item (gdb-instance-idle-input-queue instance)))))
|
|
|
569
|
|
|
570 (defun gdb-instance-dequeue-idle-input (instance)
|
|
|
571 (let ((queue (gdb-instance-idle-input-queue instance)))
|
|
|
572 (and queue
|
|
|
573 (if (not (cdr queue))
|
|
|
574 (let ((answer (car queue)))
|
|
|
575 (set-gdb-instance-idle-input-queue instance '())
|
|
|
576 answer)
|
|
|
577 (gdb-take-last-elt queue)))))
|
|
|
578
|
|
|
579 ; Don't use this in general.
|
|
|
580 (defun gdb-take-last-elt (l)
|
|
|
581 (if (cdr (cdr l))
|
|
|
582 (gdb-take-last-elt (cdr l))
|
|
|
583 (let ((answer (car (cdr l))))
|
|
|
584 (setcdr l '())
|
|
|
585 answer)))
|
|
|
586
|
|
|
587
|
|
|
588 ;;
|
|
|
589 ;; output -- things gdb prints to emacs
|
|
|
590 ;;
|
|
|
591 ;; GDB output is a stream interrupted by annotations.
|
|
|
592 ;; Annotations can be recognized by their beginning
|
|
|
593 ;; with \C-j\C-z\C-z<tag><opt>\C-j
|
|
|
594 ;;
|
|
|
595 ;; The tag is a string obeying symbol syntax.
|
|
|
596 ;;
|
|
|
597 ;; The optional part `<opt>' can be either the empty string
|
|
|
598 ;; or a space followed by more data relating to the annotation.
|
|
|
599 ;; For example, the SOURCE annotation is followed by a filename,
|
|
|
600 ;; line number and various useless goo. This data must not include
|
|
|
601 ;; any newlines.
|
|
|
602 ;;
|
|
|
603
|
|
|
604
|
|
|
605 (defun gud-gdb-marker-filter (string)
|
|
|
606 "A gud marker filter for gdb."
|
|
|
607 ;; Bogons don't tell us the process except through scoping crud.
|
|
|
608 (let ((instance (gdb-proc->instance proc)))
|
|
|
609 (gdb-output-burst instance string)))
|
|
|
610
|
|
|
611 (defvar gdb-annotation-rules
|
|
|
612 '(("frames-invalid" gdb-invalidate-frames)
|
|
|
613 ("breakpoints-invalid" gdb-invalidate-breakpoints)
|
|
|
614 ("pre-prompt" gdb-pre-prompt)
|
|
|
615 ("prompt" gdb-prompt)
|
|
|
616 ("commands" gdb-subprompt)
|
|
|
617 ("overload-choice" gdb-subprompt)
|
|
|
618 ("query" gdb-subprompt)
|
|
|
619 ("prompt-for-continue" gdb-subprompt)
|
|
|
620 ("post-prompt" gdb-post-prompt)
|
|
|
621 ("source" gdb-source)
|
|
|
622 ("starting" gdb-starting)
|
|
|
623 ("exited" gdb-stopping)
|
|
|
624 ("signalled" gdb-stopping)
|
|
|
625 ("signal" gdb-stopping)
|
|
|
626 ("breakpoint" gdb-stopping)
|
|
|
627 ("watchpoint" gdb-stopping)
|
|
|
628 ("stopped" gdb-stopped)
|
|
|
629 ("display-begin" gdb-display-begin)
|
|
|
630 ("display-end" gdb-display-end)
|
|
|
631 ("error-begin" gdb-error-begin)
|
|
|
632 )
|
|
|
633 "An assoc mapping annotation tags to functions which process them.")
|
|
|
634
|
|
|
635
|
|
|
636 (defun gdb-ignore-annotation (instance args)
|
|
|
637 nil)
|
|
|
638
|
|
|
639 (defconst gdb-source-spec-regexp
|
|
|
640 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x[a-f0-9]*")
|
|
|
641
|
|
|
642 ;; Do not use this except as an annotation handler."
|
|
|
643 (defun gdb-source (instance args)
|
|
|
644 (string-match gdb-source-spec-regexp args)
|
|
|
645 ;; Extract the frame position from the marker.
|
|
|
646 (setq gud-last-frame
|
|
|
647 (cons
|
|
|
648 (substring args (match-beginning 1) (match-end 1))
|
|
|
649 (string-to-int (substring args
|
|
|
650 (match-beginning 2)
|
|
|
651 (match-end 2))))))
|
|
|
652
|
|
|
653 ;; An annotation handler for `prompt'.
|
|
|
654 ;; This sends the next command (if any) to gdb.
|
|
|
655 (defun gdb-prompt (instance ignored)
|
|
|
656 (let ((sink (gdb-instance-output-sink instance)))
|
|
|
657 (cond
|
|
|
658 ((eq sink 'user) t)
|
|
|
659 ((eq sink 'post-emacs)
|
|
|
660 (set-gdb-instance-output-sink instance 'user))
|
|
|
661 (t
|
|
|
662 (set-gdb-instance-output-sink instance 'user)
|
|
|
663 (error "Phase error in gdb-prompt (got %s)" sink))))
|
|
|
664 (let ((highest (gdb-instance-dequeue-input instance)))
|
|
|
665 (if highest
|
|
|
666 (gdb-send-item instance highest)
|
|
|
667 (let ((lowest (gdb-instance-dequeue-idle-input instance)))
|
|
|
668 (if lowest
|
|
|
669 (gdb-send-item instance lowest)
|
|
|
670 (progn
|
|
|
671 (set-gdb-instance-prompting instance t)
|
|
|
672 (gud-display-frame)))))))
|
|
|
673
|
|
|
674 ;; An annotation handler for non-top-level prompts.
|
|
|
675 (defun gdb-subprompt (instance ignored)
|
|
|
676 (let ((highest (gdb-instance-dequeue-input instance)))
|
|
|
677 (if highest
|
|
|
678 (gdb-send-item instance highest)
|
|
|
679 (set-gdb-instance-prompting instance t))))
|
|
|
680
|
|
|
681 (defun gdb-send-item (instance item)
|
|
|
682 (set-gdb-instance-current-item instance item)
|
|
|
683 (if (stringp item)
|
|
|
684 (progn
|
|
|
685 (set-gdb-instance-output-sink instance 'user)
|
|
|
686 (process-send-string (gdb-instance-process instance)
|
|
|
687 item))
|
|
|
688 (progn
|
|
|
689 (gdb-clear-partial-output instance)
|
|
|
690 (set-gdb-instance-output-sink instance 'pre-emacs)
|
|
|
691 (process-send-string (gdb-instance-process instance)
|
|
|
692 (car item)))))
|
|
|
693
|
|
|
694 ;; This terminates the collection of output from a previous
|
|
|
695 ;; command if that happens to be in effect.
|
|
|
696 (defun gdb-pre-prompt (instance ignored)
|
|
|
697 (let ((sink (gdb-instance-output-sink instance)))
|
|
|
698 (cond
|
|
|
699 ((eq sink 'user) t)
|
|
|
700 ((eq sink 'emacs)
|
|
|
701 (set-gdb-instance-output-sink instance 'post-emacs)
|
|
|
702 (let ((handler
|
|
|
703 (car (cdr (gdb-instance-current-item instance)))))
|
|
|
704 (save-excursion
|
|
|
705 (set-buffer (gdb-get-create-instance-buffer
|
|
|
706 instance 'gdb-partial-output-buffer))
|
|
|
707 (funcall handler))))
|
|
|
708 (t
|
|
|
709 (set-gdb-instance-output-sink instance 'user)
|
|
|
710 (error "Output sink phase error 1.")))))
|
|
|
711
|
|
|
712 ;; An annotation handler for `starting'. This says that I/O for the subprocess
|
|
|
713 ;; is now the program being debugged, not GDB.
|
|
|
714 (defun gdb-starting (instance ignored)
|
|
|
715 (let ((sink (gdb-instance-output-sink instance)))
|
|
|
716 (cond
|
|
|
717 ((eq sink 'user)
|
|
|
718 (set-gdb-instance-output-sink instance 'inferior)
|
|
|
719 ;; FIXME: need to send queued input
|
|
|
720 )
|
|
|
721 (t (error "Unexpected `starting' annotation")))))
|
|
|
722
|
|
|
723 ;; An annotation handler for `exited' and other annotations which say that
|
|
|
724 ;; I/O for the subprocess is now GDB, not the program being debugged.
|
|
|
725 (defun gdb-stopping (instance ignored)
|
|
|
726 (let ((sink (gdb-instance-output-sink instance)))
|
|
|
727 (cond
|
|
|
728 ((eq sink 'inferior)
|
|
|
729 (set-gdb-instance-output-sink instance 'user)
|
|
|
730 )
|
|
|
731 (t (error "Unexpected stopping annotation")))))
|
|
|
732
|
|
|
733 ;; An annotation handler for `stopped'. It is just like gdb-stopping, except
|
|
|
734 ;; that if we already set the output sink to 'user in gdb-stopping, that is
|
|
|
735 ;; fine.
|
|
|
736 (defun gdb-stopped (instance ignored)
|
|
|
737 (let ((sink (gdb-instance-output-sink instance)))
|
|
|
738 (cond
|
|
|
739 ((eq sink 'inferior)
|
|
|
740 (set-gdb-instance-output-sink instance 'user)
|
|
|
741 )
|
|
|
742 ((eq sink 'user)
|
|
|
743 t)
|
|
|
744 (t (error "Unexpected stopping annotation")))))
|
|
|
745
|
|
|
746 ;; An annotation handler for `post-prompt'.
|
|
|
747 ;; This begins the collection of output from the current
|
|
|
748 ;; command if that happens to be appropriate."
|
|
|
749 (defun gdb-post-prompt (instance ignored)
|
|
|
750 (if (not (gdb-instance-pending-triggers instance))
|
|
|
751 (progn
|
|
|
752 (gdb-invalidate-registers instance ignored)
|
|
|
753 (gdb-invalidate-locals instance ignored)
|
|
|
754 (gdb-invalidate-display instance ignored)))
|
|
|
755 (let ((sink (gdb-instance-output-sink instance)))
|
|
|
756 (cond
|
|
|
757 ((eq sink 'user) t)
|
|
|
758 ((eq sink 'pre-emacs)
|
|
|
759 (set-gdb-instance-output-sink instance 'emacs))
|
|
|
760
|
|
|
761 (t
|
|
|
762 (set-gdb-instance-output-sink instance 'user)
|
|
|
763 (error "Output sink phase error 3.")))))
|
|
|
764
|
|
|
765 ;; Handle a burst of output from a gdb instance.
|
|
|
766 ;; This function is (indirectly) used as a gud-marker-filter.
|
|
|
767 ;; It must return output (if any) to be insterted in the gud
|
|
|
768 ;; buffer.
|
|
|
769
|
|
|
770 (defun gdb-output-burst (instance string)
|
|
|
771 "Handle a burst of output from a gdb instance.
|
|
|
772 This function is (indirectly) used as a gud-marker-filter.
|
|
|
773 It must return output (if any) to be insterted in the gud
|
|
|
774 buffer."
|
|
|
775
|
|
|
776 (save-match-data
|
|
|
777 (let (
|
|
|
778 ;; Recall the left over burst from last time
|
|
|
779 (burst (concat (gdb-instance-burst instance) string))
|
|
|
780 ;; Start accumulating output for the gud buffer
|
|
|
781 (output ""))
|
|
|
782
|
|
|
783 ;; Process all the complete markers in this chunk.
|
|
|
784
|
|
|
785 (while (string-match "\n\032\032\\(.*\\)\n" burst)
|
|
|
786 (let ((annotation (substring burst
|
|
|
787 (match-beginning 1)
|
|
|
788 (match-end 1))))
|
|
|
789
|
|
|
790 ;; Stuff prior to the match is just ordinary output.
|
|
|
791 ;; It is either concatenated to OUTPUT or directed
|
|
|
792 ;; elsewhere.
|
|
|
793 (setq output
|
|
|
794 (gdb-concat-output
|
|
|
795 instance
|
|
|
796 output
|
|
|
797 (substring burst 0 (match-beginning 0))))
|
|
|
798
|
|
|
799 ;; Take that stuff off the burst.
|
|
|
800 (setq burst (substring burst (match-end 0)))
|
|
|
801
|
|
|
802 ;; Parse the tag from the annotation, and maybe its arguments.
|
|
|
803 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
|
|
|
804 (let* ((annotation-type (substring annotation
|
|
|
805 (match-beginning 1)
|
|
|
806 (match-end 1)))
|
|
|
807 (annotation-arguments (substring annotation
|
|
|
808 (match-beginning 2)
|
|
|
809 (match-end 2)))
|
|
|
810 (annotation-rule (assoc annotation-type
|
|
|
811 gdb-annotation-rules)))
|
|
|
812 ;; Call the handler for this annotation.
|
|
|
813 (if annotation-rule
|
|
|
814 (funcall (car (cdr annotation-rule))
|
|
|
815 instance
|
|
|
816 annotation-arguments)
|
|
|
817 ;; Else the annotation is not recognized. Ignore it silently,
|
|
|
818 ;; so that GDB can add new annotations without causing
|
|
|
819 ;; us to blow up.
|
|
|
820 ))))
|
|
|
821
|
|
|
822
|
|
|
823 ;; Does the remaining text end in a partial line?
|
|
|
824 ;; If it does, then keep part of the burst until we get more.
|
|
|
825 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
|
|
|
826 burst)
|
|
|
827 (progn
|
|
|
828 ;; Everything before the potential marker start can be output.
|
|
|
829 (setq output
|
|
|
830 (gdb-concat-output
|
|
|
831 instance
|
|
|
832 output
|
|
|
833 (substring burst 0 (match-beginning 0))))
|
|
|
834
|
|
|
835 ;; Everything after, we save, to combine with later input.
|
|
|
836 (setq burst (substring burst (match-beginning 0))))
|
|
|
837
|
|
|
838 ;; In case we know the burst contains no partial annotations:
|
|
|
839 (progn
|
|
|
840 (setq output (gdb-concat-output instance output burst))
|
|
|
841 (setq burst "")))
|
|
|
842
|
|
|
843 ;; Save the remaining burst for the next call to this function.
|
|
|
844 (set-gdb-instance-burst instance burst)
|
|
|
845 output)))
|
|
|
846
|
|
|
847 (defun gdb-concat-output (instance so-far new)
|
|
|
848 (let ((sink (gdb-instance-output-sink instance)))
|
|
|
849 (cond
|
|
|
850 ((eq sink 'user) (concat so-far new))
|
|
|
851 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
|
|
|
852 ((eq sink 'emacs)
|
|
|
853 (gdb-append-to-partial-output instance new)
|
|
|
854 so-far)
|
|
|
855 ((eq sink 'inferior)
|
|
|
856 (gdb-append-to-inferior-io instance new)
|
|
|
857 so-far)
|
|
|
858 (t (error "Bogon output sink %S" sink)))))
|
|
|
859
|
|
|
860 (defun gdb-append-to-partial-output (instance string)
|
|
|
861 (save-excursion
|
|
|
862 (buffer-disable-undo ; Don't need undo in partial output buffer
|
|
|
863 (set-buffer
|
|
|
864 (gdb-get-create-instance-buffer
|
|
|
865 instance 'gdb-partial-output-buffer)))
|
|
|
866 (goto-char (point-max))
|
|
|
867 (insert string)))
|
|
|
868
|
|
|
869 (defun gdb-clear-partial-output (instance)
|
|
|
870 (save-excursion
|
|
|
871 (set-buffer
|
|
|
872 (gdb-get-create-instance-buffer
|
|
|
873 instance 'gdb-partial-output-buffer))
|
|
|
874 (delete-region (point-min) (point-max))))
|
|
|
875
|
|
|
876 (defun gdb-append-to-inferior-io (instance string)
|
|
|
877 (save-excursion
|
|
|
878 (set-buffer
|
|
|
879 (gdb-get-create-instance-buffer
|
|
|
880 instance 'gdb-inferior-io))
|
|
|
881 (goto-char (point-max))
|
|
|
882 (insert-before-markers string))
|
|
|
883 (gud-display-buffer
|
|
|
884 (gdb-get-create-instance-buffer instance
|
|
|
885 'gdb-inferior-io)))
|
|
|
886
|
|
|
887 (defun gdb-clear-inferior-io (instance)
|
|
|
888 (save-excursion
|
|
|
889 (set-buffer
|
|
|
890 (gdb-get-create-instance-buffer
|
|
|
891 instance 'gdb-inferior-io))
|
|
|
892 (delete-region (point-min) (point-max))))
|
|
|
893
|
|
|
894
|
|
|
895
|
|
|
896 ;; One trick is to have a command who's output is always available in
|
|
|
897 ;; a buffer of it's own, and is always up to date. We build several
|
|
|
898 ;; buffers of this type.
|
|
|
899 ;;
|
|
|
900 ;; There are two aspects to this: gdb has to tell us when the output
|
|
|
901 ;; for that command might have changed, and we have to be able to run
|
|
|
902 ;; the command behind the user's back.
|
|
|
903 ;;
|
|
|
904 ;; The idle input queue and the output phasing associated with
|
|
|
905 ;; the instance variable `(gdb-instance-output-sink instance)' help
|
|
|
906 ;; us to run commands behind the user's back.
|
|
|
907 ;;
|
|
|
908 ;; Below is the code for specificly managing buffers of output from one
|
|
|
909 ;; command.
|
|
|
910 ;;
|
|
|
911
|
|
|
912
|
|
|
913 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
|
|
|
914 ;; It adds an idle input for the command we are tracking. It should be the
|
|
|
915 ;; annotation rule binding of whatever gdb sends to tell us this command
|
|
|
916 ;; might have changed it's output.
|
|
|
917 ;;
|
|
|
918 ;; NAME is the fucntion name. DEMAND-PREDICATE tests if output is really needed.
|
|
|
919 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
|
|
|
920 ;; input in the input queue (see comment about ``gdb communications'' above).
|
|
|
921 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler)
|
|
|
922 (`
|
|
|
923 (defun (, name) (instance &optional ignored)
|
|
|
924 (if (and ((, demand-predicate) instance)
|
|
|
925 (not (member '(, name)
|
|
|
926 (gdb-instance-pending-triggers instance))))
|
|
|
927 (progn
|
|
|
928 (gdb-instance-enqueue-idle-input
|
|
|
929 instance
|
|
|
930 (list (, gdb-command) '(, output-handler)))
|
|
|
931 (set-gdb-instance-pending-triggers
|
|
|
932 instance
|
|
|
933 (cons '(, name)
|
|
|
934 (gdb-instance-pending-triggers instance)))) ))))
|
|
|
935
|
|
|
936 (defmacro def-gdb-auto-update-handler (name trigger buf-key)
|
|
|
937 (`
|
|
|
938 (defun (, name) ()
|
|
|
939 (set-gdb-instance-pending-triggers
|
|
|
940 instance
|
|
|
941 (delq '(, trigger)
|
|
|
942 (gdb-instance-pending-triggers instance)))
|
|
|
943 (let ((buf (gdb-get-instance-buffer instance
|
|
|
944 '(, buf-key))))
|
|
|
945 (and buf
|
|
|
946 (save-excursion
|
|
|
947 (set-buffer buf)
|
|
|
948 (buffer-disable-undo buf) ; don't need undo
|
|
|
949 (let ((p (point))
|
|
|
950 (buffer-read-only nil)
|
|
|
951 (instance-buf (gdb-get-create-instance-buffer
|
|
|
952 instance
|
|
|
953 'gdb-partial-output-buffer)))
|
|
|
954 (if (gud-buffers-differ buf instance-buf)
|
|
|
955 (progn
|
|
|
956 (delete-region (point-min) (point-max))
|
|
|
957 (insert-buffer instance-buf)
|
|
|
958 (if (buffer-dedicated-frame)
|
|
|
959 (fit-frame-to-buffer (buffer-dedicated-frame) buf))
|
|
|
960 ))
|
|
|
961 (goto-char p))))))))
|
|
|
962
|
|
|
963 (defmacro def-gdb-auto-updated-buffer
|
|
|
964 (buffer-key trigger-name gdb-command output-handler-name)
|
|
|
965 (`
|
|
|
966 (progn
|
|
|
967 (def-gdb-auto-update-trigger (, trigger-name)
|
|
|
968 ;; The demand predicate:
|
|
|
969 (lambda (instance)
|
|
|
970 (gdb-get-instance-buffer instance '(, buffer-key)))
|
|
|
971 (, gdb-command)
|
|
|
972 (, output-handler-name))
|
|
|
973 (def-gdb-auto-update-handler (, output-handler-name)
|
|
|
974 (, trigger-name) (, buffer-key)))))
|
|
|
975
|
|
|
976
|
|
|
977 ;;
|
|
|
978 ;; Breakpoint buffers
|
|
|
979 ;;
|
|
|
980 ;; These display the output of `info breakpoints'.
|
|
|
981 ;;
|
|
|
982
|
|
|
983
|
|
|
984 (gdb-set-instance-buffer-rules 'gdb-breakpoints-buffer
|
|
|
985 'gdb-breakpoints-buffer-name
|
|
|
986 'gud-breakpoints-mode)
|
|
|
987
|
|
|
988 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
|
|
|
989 ;; This defines the auto update rule for buffers of type
|
|
|
990 ;; `gdb-breakpoints-buffer'.
|
|
|
991 ;;
|
|
|
992 ;; It defines a function to serve as the annotation handler that
|
|
|
993 ;; handles the `foo-invalidated' message. That function is called:
|
|
|
994 gdb-invalidate-breakpoints
|
|
|
995
|
|
|
996 ;; To update the buffer, this command is sent to gdb.
|
|
|
997 "server info breakpoints\n"
|
|
|
998
|
|
|
999 ;; This also defines a function to be the handler for the output
|
|
|
1000 ;; from the command above. That function will copy the output into
|
|
|
1001 ;; the appropriately typed buffer. That function will be called:
|
|
|
1002 gdb-info-breakpoints-handler)
|
|
|
1003
|
|
|
1004 (defun gdb-breakpoints-buffer-name (instance)
|
|
|
1005 (save-excursion
|
|
|
1006 (set-buffer (process-buffer (gdb-instance-process instance)))
|
|
|
1007 (concat "*breakpoints of " (gdb-instance-target-string instance) "*")))
|
|
|
1008
|
|
|
1009 (defun gud-display-breakpoints-buffer (instance)
|
|
|
1010 (interactive (list (gdb-needed-default-instance)))
|
|
|
1011 (gud-display-buffer
|
|
|
1012 (gdb-get-create-instance-buffer instance
|
|
|
1013 'gdb-breakpoints-buffer)))
|
|
|
1014
|
|
|
1015 (defun gud-frame-breakpoints-buffer (instance)
|
|
|
1016 (interactive (list (gdb-needed-default-instance)))
|
|
|
1017 (gud-display-buffer-new-frame
|
|
|
1018 (gdb-get-create-instance-buffer instance
|
|
|
1019 'gdb-breakpoints-buffer)))
|
|
|
1020
|
|
|
1021 (defvar gud-breakpoints-mode-map nil)
|
|
|
1022 (defvar gud-breakpoints-mode-menu
|
|
|
1023 '("GDB Breakpoint Commands"
|
|
|
1024 "----"
|
|
|
1025 ["Toggle" gud-toggle-bp-this-line t]
|
|
|
1026 ["Delete" gud-delete-bp-this-line t]
|
|
|
1027 ["Condition" gud-bp-condition t]
|
|
|
1028 ["Ignore" gud-bp-ignore t])
|
|
|
1029 "*menu for gud-breakpoints-mode")
|
|
|
1030
|
|
|
1031 (setq gud-breakpoints-mode-map (make-keymap))
|
|
|
1032 (suppress-keymap gud-breakpoints-mode-map)
|
|
|
1033 (define-key gud-breakpoints-mode-map " " 'gud-toggle-bp-this-line)
|
|
|
1034 (define-key gud-breakpoints-mode-map "d" 'gud-delete-bp-this-line)
|
|
|
1035 (define-key gud-breakpoints-mode-map "c" 'gud-bp-condition)
|
|
|
1036 (define-key gud-breakpoints-mode-map "i" 'gud-bp-ignore)
|
|
|
1037 (define-key gud-breakpoints-mode-map 'button3 'gud-breakpoints-popup-menu)
|
|
|
1038 (defun gud-breakpoints-mode ()
|
|
|
1039 "Major mode for gud breakpoints.
|
|
|
1040
|
|
|
1041 \\{gud-breakpoints-mode-map}"
|
|
|
1042 (setq major-mode 'gud-breakpoints-mode)
|
|
|
1043 (setq mode-name "Breakpoints")
|
|
|
1044 (use-local-map gud-breakpoints-mode-map)
|
|
|
1045 (setq buffer-read-only t)
|
|
|
1046 (require 'mode-motion)
|
|
|
1047 (setq mode-motion-hook 'gud-breakpoints-mode-motion-hook)
|
|
|
1048 (gdb-invalidate-breakpoints gdb-buffer-instance))
|
|
|
1049
|
|
|
1050 (defun gud-toggle-bp-this-line ()
|
|
|
1051 (interactive)
|
|
|
1052 (save-excursion
|
|
|
1053 (set-buffer
|
|
|
1054 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-breakpoints-buffer))
|
|
|
1055 (if (key-press-event-p last-input-event)
|
|
|
1056 (beginning-of-line 1)
|
|
|
1057 (and mode-motion-extent (extent-buffer mode-motion-extent)
|
|
|
1058 (goto-char (extent-start-position mode-motion-extent))))
|
|
|
1059 (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
|
|
|
1060 (error "Not recognized as breakpoint line (demo foo).")
|
|
|
1061 (gdb-instance-enqueue-idle-input
|
|
|
1062 gdb-buffer-instance
|
|
|
1063 (list
|
|
|
1064 (concat
|
|
|
1065 (if (eq ?y (char-after (match-beginning 2)))
|
|
|
1066 "server disable "
|
|
|
1067 "server enable ")
|
|
|
1068 (buffer-substring (match-beginning 0)
|
|
|
1069 (match-end 1))
|
|
|
1070 "\n")
|
|
|
1071 '(lambda () nil)))
|
|
|
1072 )))
|
|
|
1073
|
|
|
1074 (defun gud-delete-bp-this-line ()
|
|
|
1075 (interactive)
|
|
|
1076 (save-excursion
|
|
|
1077 (set-buffer
|
|
|
1078 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-breakpoints-buffer))
|
|
|
1079 (if (key-press-event-p last-input-event)
|
|
|
1080 (beginning-of-line 1)
|
|
|
1081 (and mode-motion-extent (extent-buffer mode-motion-extent)
|
|
|
1082 (goto-char (extent-start-position mode-motion-extent))))
|
|
|
1083 (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
|
|
|
1084 (error "Not recognized as breakpoint line (demo foo).")
|
|
|
1085 (gdb-instance-enqueue-idle-input
|
|
|
1086 gdb-buffer-instance
|
|
|
1087 (list
|
|
|
1088 (concat
|
|
|
1089 "server delete "
|
|
|
1090 (buffer-substring (match-beginning 0)
|
|
|
1091 (match-end 1))
|
|
|
1092 "\n")
|
|
|
1093 '(lambda () nil)))
|
|
|
1094 )))
|
|
|
1095
|
|
|
1096 (defun gud-bp-condition (condition)
|
|
|
1097 (interactive "sCondition for breakpoint: ")
|
|
|
1098 (save-excursion
|
|
|
1099 (set-buffer
|
|
|
1100 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-breakpoints-buffer))
|
|
|
1101 (if (key-press-event-p last-input-event)
|
|
|
1102 (beginning-of-line 1)
|
|
|
1103 (and mode-motion-extent (extent-buffer mode-motion-extent)
|
|
|
1104 (goto-char (extent-start-position mode-motion-extent))))
|
|
|
1105 (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
|
|
|
1106 (error "Not recognized as breakpoint line (demo foo).")
|
|
|
1107 (gdb-instance-enqueue-idle-input
|
|
|
1108 gdb-buffer-instance
|
|
|
1109 (list
|
|
|
1110 (concat
|
|
|
1111 "server condition "
|
|
|
1112 (buffer-substring (match-beginning 0)
|
|
|
1113 (match-end 1))
|
|
|
1114 (if (> (length condition) 0) (concat " " condition) "")
|
|
|
1115 "\n")
|
|
|
1116 '(lambda () nil)))
|
|
|
1117 (gdb-invalidate-breakpoints gdb-buffer-instance)
|
|
|
1118 )))
|
|
|
1119
|
|
|
1120 (defun gud-bp-ignore (count)
|
|
|
1121 (interactive "nNumber of times to ignore breakpoint: ")
|
|
|
1122 (save-excursion
|
|
|
1123 (set-buffer
|
|
|
1124 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-breakpoints-buffer))
|
|
|
1125 (if (key-press-event-p last-input-event)
|
|
|
1126 (beginning-of-line 1)
|
|
|
1127 (and mode-motion-extent (extent-buffer mode-motion-extent)
|
|
|
1128 (goto-char (extent-start-position mode-motion-extent))))
|
|
|
1129 (if (not (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)"))
|
|
|
1130 (error "Not recognized as breakpoint line (demo foo).")
|
|
|
1131 (gdb-instance-enqueue-idle-input
|
|
|
1132 gdb-buffer-instance
|
|
|
1133 (list
|
|
|
1134 (concat
|
|
|
1135 "server ignore "
|
|
|
1136 (buffer-substring (match-beginning 0)
|
|
|
1137 (match-end 1))
|
|
|
1138 " "
|
|
|
1139 (int-to-string count)
|
|
|
1140 "\n")
|
|
|
1141 '(lambda () nil)))
|
|
|
1142 (gdb-invalidate-breakpoints gdb-buffer-instance)
|
|
|
1143 )))
|
|
|
1144
|
|
|
1145 (defun gud-breakpoints-mode-motion-hook (event)
|
|
|
1146 (gud-breakpoints-mode-motion-internal event "^[0-9]+[ \t]"))
|
|
|
1147
|
|
|
1148 (defun gud-breakpoints-mode-motion-internal (event regexp)
|
|
|
1149 ;;
|
|
|
1150 ;; This is mostly ripped off from mode-motion-highlight-internal but
|
|
|
1151 ;; we set the extent's face rather than setting it to highlight. That
|
|
|
1152 ;; way if we're somewhere in the breakpoint's list of commands or other
|
|
|
1153 ;; info we still highlight it.
|
|
|
1154 (if (event-buffer event)
|
|
|
1155 (let* ((buffer (event-buffer event))
|
|
|
1156 point)
|
|
|
1157 (save-excursion
|
|
|
1158 (set-buffer buffer)
|
|
|
1159 (mouse-set-point event)
|
|
|
1160 (beginning-of-line)
|
|
|
1161 (if (not (looking-at regexp))
|
|
|
1162 (re-search-backward regexp (point-min) 't))
|
|
|
1163 (setq point (point))
|
|
|
1164 (if (looking-at regexp)
|
|
|
1165 (end-of-line))
|
|
|
1166 (if (and mode-motion-extent (extent-buffer mode-motion-extent))
|
|
|
1167 (if (eq point (point))
|
|
|
1168 (delete-extent mode-motion-extent)
|
|
|
1169 (set-extent-endpoints mode-motion-extent point (point)))
|
|
|
1170 (if (eq point (point))
|
|
|
1171 nil
|
|
|
1172 (setq mode-motion-extent (make-extent point (point)))
|
|
|
1173 (set-extent-property mode-motion-extent 'face
|
|
|
1174 (get-face 'highlight)))))
|
|
|
1175 )))
|
|
|
1176
|
|
|
1177 (defun gud-breakpoints-popup-menu (event)
|
|
|
1178 (interactive "@e")
|
|
|
1179 (mouse-set-point event)
|
|
|
1180 (popup-menu gud-breakpoints-mode-menu))
|
|
|
1181
|
|
|
1182 ;;
|
|
|
1183 ;; Display expression buffers
|
|
|
1184 ;;
|
|
|
1185 ;; These show the current list of expressions which the debugger
|
|
|
1186 ;; prints when the inferior stops and their values. Note that there
|
|
|
1187 ;; isn't a "display-invalid" annotation so we have to a bit more
|
|
|
1188 ;; work than for the other auto-update buffers
|
|
|
1189 ;;
|
|
|
1190
|
|
|
1191 (gdb-set-instance-buffer-rules 'gdb-display-buffer
|
|
|
1192 'gdb-display-buffer-name
|
|
|
1193 'gud-display-mode)
|
|
|
1194
|
|
|
1195
|
|
|
1196 (def-gdb-auto-updated-buffer gdb-display-buffer
|
|
|
1197 ;; This defines the auto update rule for buffers of type
|
|
|
1198 ;; `gdb-display-buffer'.
|
|
|
1199 ;;
|
|
|
1200 ;; It defines a function to serve as the annotation handler that
|
|
|
1201 ;; handles the `foo-invalidated' message. That function is called:
|
|
|
1202 gdb-invalidate-display
|
|
|
1203
|
|
|
1204 ;; To update the buffer, this command is sent to gdb.
|
|
|
1205 "server info display\n"
|
|
|
1206
|
|
|
1207 ;; This also defines a function to be the handler for the output
|
|
|
1208 ;; from the command above. That function will copy the output into
|
|
|
1209 ;; the appropriately typed buffer. That function will be called:
|
|
|
1210 gdb-info-display-handler)
|
|
|
1211
|
|
|
1212
|
|
|
1213 ;; Since the displayed expressions buffer is not simply a copy of what gdb
|
|
|
1214 ;; prints for the "info display" command we need a slightly more complex
|
|
|
1215 ;; handler for it than the standard one which def-gdb-auto-updated-buffer
|
|
|
1216 ;; defines.
|
|
|
1217
|
|
|
1218 (defun gdb-info-display-handler ()
|
|
|
1219
|
|
|
1220 (set-gdb-instance-pending-triggers
|
|
|
1221 instance (delq 'gdb-invalidate-display
|
|
|
1222 (gdb-instance-pending-triggers instance)))
|
|
|
1223
|
|
|
1224 (let ((buf (gdb-get-instance-buffer instance 'gdb-display-buffer)))
|
|
|
1225 (and buf
|
|
|
1226 (save-excursion
|
|
|
1227 (let ((instance-buf (gdb-get-create-instance-buffer
|
|
|
1228 instance 'gdb-partial-output-buffer))
|
|
|
1229 expr-alist point expr highlight-expr)
|
|
|
1230 (set-buffer instance-buf)
|
|
|
1231 (goto-char (point-min))
|
|
|
1232 (while
|
|
|
1233 (re-search-forward "^\\([0-9]+\\): \\([ny] .*$\\)" (point-max) t)
|
|
|
1234 (setq expr-alist
|
|
|
1235 (cons
|
|
|
1236 (cons (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
1237 (buffer-substring (match-beginning 2) (match-end 2)))
|
|
|
1238 expr-alist)))
|
|
|
1239 (set-buffer buf)
|
|
|
1240 (setq buffer-read-only nil)
|
|
|
1241 (if (and mode-motion-extent
|
|
|
1242 (extent-buffer mode-motion-extent)
|
|
|
1243 (extent-start-position mode-motion-extent))
|
|
|
1244 (progn
|
|
|
1245 (goto-char (extent-start-position mode-motion-extent))
|
|
|
1246 (if (looking-at "^[0-9]+:")
|
|
|
1247 (setq highlight-expr (buffer-substring (match-beginning 0) (match-end 0))))))
|
|
|
1248 (goto-char (point-min))
|
|
|
1249 (delete-region (point-min)
|
|
|
1250 (if (not (re-search-forward "^\\([0-9]+\\): " (point-max) t))
|
|
|
1251 (point-max)
|
|
|
1252 (beginning-of-line)
|
|
|
1253 (point)))
|
|
|
1254 (if (not expr-alist)
|
|
|
1255 (progn
|
|
|
1256 (insert "There are no auto-display expressions now.\n")
|
|
|
1257 (delete-region (point) (point-max)))
|
|
|
1258 (insert "Auto-display expressions now in effect:
|
|
|
1259 Num Enb Expression = value\n")
|
|
|
1260 (while
|
|
|
1261 (re-search-forward "^\\([0-9]+\\): \\([ny]\\)" (point-max) t)
|
|
|
1262 (if (setq expr (assoc (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
1263 expr-alist))
|
|
|
1264 (progn
|
|
|
1265 (if (string-equal (substring (cdr expr) 0 1) "y")
|
|
|
1266 (replace-match "\\1: y")
|
|
|
1267 (replace-match (format "\\1: %s" (cdr expr)))
|
|
|
1268 (setq point (point))
|
|
|
1269 (if (re-search-forward "^[0-9]+: " (point-max) 'move)
|
|
|
1270 (beginning-of-line))
|
|
|
1271 (delete-region point (if (eobp) (point) (1- (point)))))
|
|
|
1272 (setq expr-alist (delq expr expr-alist)))
|
|
|
1273 (beginning-of-line)
|
|
|
1274 (setq point (point))
|
|
|
1275 (if (re-search-forward "^[0-9]+: " (point-max) 'move 2)
|
|
|
1276 (beginning-of-line))
|
|
|
1277 (delete-region point (point))))
|
|
|
1278 (goto-char (point-max))
|
|
|
1279 (while expr-alist
|
|
|
1280 (insert (concat (car (car expr-alist)) ": "
|
|
|
1281 (cdr (car expr-alist)) "\n" ))
|
|
|
1282 (setq expr-alist (cdr expr-alist))) )
|
|
|
1283 (goto-char (point-min))
|
|
|
1284 (if (and mode-motion-extent
|
|
|
1285 (extent-buffer mode-motion-extent)
|
|
|
1286 highlight-expr
|
|
|
1287 (re-search-forward (concat "^" highlight-expr ".*$") (point-max) t))
|
|
|
1288 (set-extent-endpoints mode-motion-extent (match-beginning 0) (match-end 0)))
|
|
|
1289 (setq buffer-read-only t)
|
|
|
1290 (if (buffer-dedicated-frame)
|
|
|
1291 (fit-frame-to-buffer (buffer-dedicated-frame) buf))
|
|
|
1292 )))))
|
|
|
1293
|
|
|
1294 (defvar gud-display-mode-map nil)
|
|
|
1295 (setq gud-display-mode-map (make-keymap))
|
|
|
1296 (suppress-keymap gud-display-mode-map)
|
|
|
1297
|
|
|
1298 (defvar gud-display-mode-menu
|
|
|
1299 '("GDB Display Commands"
|
|
|
1300 "----"
|
|
|
1301 ["Toggle enable" gud-toggle-disp-this-line t]
|
|
|
1302 ["Delete" gud-delete-disp-this-line t])
|
|
|
1303 "*menu for gud-display-mode")
|
|
|
1304
|
|
|
1305 (define-key gud-display-mode-map " " 'gud-toggle-disp-this-line)
|
|
|
1306 (define-key gud-display-mode-map "d" 'gud-delete-disp-this-line)
|
|
|
1307 (define-key gud-display-mode-map 'button3 'gud-display-popup-menu)
|
|
|
1308
|
|
|
1309 (defun gud-display-mode ()
|
|
|
1310 "Major mode for gud display.
|
|
|
1311
|
|
|
1312 \\{gud-display-mode-map}"
|
|
|
1313 (setq major-mode 'gud-display-mode)
|
|
|
1314 (setq mode-name "Display")
|
|
|
1315 (setq buffer-read-only t)
|
|
|
1316 (use-local-map gud-display-mode-map)
|
|
|
1317 (require 'mode-motion)
|
|
|
1318 (setq mode-motion-hook 'gud-display-mode-motion-hook)
|
|
|
1319 (gdb-invalidate-display gdb-buffer-instance)
|
|
|
1320 )
|
|
|
1321
|
|
|
1322 (defun gdb-display-buffer-name (instance)
|
|
|
1323 (save-excursion
|
|
|
1324 (set-buffer (process-buffer (gdb-instance-process instance)))
|
|
|
1325 (concat "*Displayed expressions of " (gdb-instance-target-string instance) "*")))
|
|
|
1326
|
|
|
1327 (defun gud-display-display-buffer (instance)
|
|
|
1328 (interactive (list (gdb-needed-default-instance)))
|
|
|
1329 (let ((buf (gdb-get-create-instance-buffer instance
|
|
|
1330 'gdb-display-buffer)))
|
|
|
1331 (gdb-invalidate-display instance)
|
|
|
1332 (gud-display-buffer buf)))
|
|
|
1333
|
|
|
1334
|
|
|
1335 (defun gud-frame-display-buffer (instance)
|
|
|
1336 (interactive (list (gdb-needed-default-instance)))
|
|
|
1337 (let ((buf (gdb-get-create-instance-buffer instance
|
|
|
1338 'gdb-display-buffer)))
|
|
|
1339 (gdb-invalidate-display instance)
|
|
|
1340 (gud-display-buffer-new-frame buf)))
|
|
|
1341
|
|
|
1342 (defun gud-toggle-disp-this-line ()
|
|
|
1343 (interactive)
|
|
|
1344 (save-excursion
|
|
|
1345 (set-buffer
|
|
|
1346 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-display-buffer))
|
|
|
1347 (if (key-press-event-p last-input-event)
|
|
|
1348 (beginning-of-line 1)
|
|
|
1349 (and mode-motion-extent (extent-buffer mode-motion-extent)
|
|
|
1350 (goto-char (extent-start-position mode-motion-extent))))
|
|
|
1351 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
|
|
|
1352 (error "No expression on this line.")
|
|
|
1353 (gdb-instance-enqueue-idle-input
|
|
|
1354 gdb-buffer-instance
|
|
|
1355 (list
|
|
|
1356 (concat
|
|
|
1357 (if (eq ?y (char-after (match-beginning 2)))
|
|
|
1358 "server disable display "
|
|
|
1359 "server enable display ")
|
|
|
1360 (buffer-substring (match-beginning 0)
|
|
|
1361 (match-end 1))
|
|
|
1362 "\n")
|
|
|
1363 '(lambda () nil)))
|
|
|
1364 )))
|
|
|
1365
|
|
|
1366 (defun gud-delete-disp-this-line ()
|
|
|
1367 (interactive)
|
|
|
1368 (save-excursion
|
|
|
1369 (set-buffer
|
|
|
1370 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-display-buffer))
|
|
|
1371 (if (key-press-event-p last-input-event)
|
|
|
1372 (beginning-of-line 1)
|
|
|
1373 (and mode-motion-extent (extent-buffer mode-motion-extent)
|
|
|
1374 (goto-char (extent-start-position mode-motion-extent))))
|
|
|
1375 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
|
|
|
1376 (error "No expression on this line.")
|
|
|
1377 (gdb-instance-enqueue-idle-input
|
|
|
1378 gdb-buffer-instance
|
|
|
1379 (list
|
|
|
1380 (concat
|
|
|
1381 "server delete display "
|
|
|
1382 (buffer-substring (match-beginning 0)
|
|
|
1383 (match-end 1))
|
|
|
1384 "\n")
|
|
|
1385 '(lambda () nil)))
|
|
|
1386 )))
|
|
|
1387
|
|
|
1388 (defun gud-display-mode-motion-hook (event)
|
|
|
1389 (gud-breakpoints-mode-motion-internal event "^[0-9]+: "))
|
|
|
1390
|
|
|
1391 (defun gud-display-popup-menu (event)
|
|
|
1392 (interactive "@e")
|
|
|
1393 (mouse-set-point event)
|
|
|
1394 (popup-menu gud-display-mode-menu))
|
|
|
1395
|
|
|
1396 ;; If we get an error whilst evaluating one of the expressions
|
|
|
1397 ;; we won't get the display-end annotation. Set the sink back to
|
|
|
1398 ;; user to make sure that the error message is seen
|
|
|
1399
|
|
|
1400 (defun gdb-error-begin (instance ignored)
|
|
|
1401 (set-gdb-instance-output-sink instance 'user))
|
|
|
1402
|
|
|
1403 (defun gdb-display-begin (instance ignored)
|
|
|
1404 (if (gdb-get-instance-buffer instance 'gdb-display-buffer)
|
|
|
1405 (progn
|
|
|
1406 (set-gdb-instance-output-sink instance 'emacs)
|
|
|
1407 (gdb-clear-partial-output instance))
|
|
|
1408 (set-gdb-instance-output-sink instance 'user))
|
|
|
1409 )
|
|
|
1410
|
|
|
1411 (defun gdb-display-end (instance ignored)
|
|
|
1412 (save-excursion
|
|
|
1413 (let ((display-output (gdb-get-instance-buffer instance 'gdb-display-buffer))
|
|
|
1414 display-index
|
|
|
1415 display-value
|
|
|
1416 highlight-expr)
|
|
|
1417 (if display-output
|
|
|
1418 (progn
|
|
|
1419 (set-buffer (gdb-get-instance-buffer
|
|
|
1420 instance 'gdb-partial-output-buffer))
|
|
|
1421 (goto-char (point-min))
|
|
|
1422 (looking-at "\\([0-9]+\\): ")
|
|
|
1423 (setq display-index (buffer-substring (match-beginning 1)
|
|
|
1424 (match-end 1)))
|
|
|
1425 (setq display-value (+ 2 (match-end 1)))
|
|
|
1426 (set-buffer display-output)
|
|
|
1427 (if (and mode-motion-extent
|
|
|
1428 (extent-buffer mode-motion-extent)
|
|
|
1429 (extent-start-position mode-motion-extent))
|
|
|
1430 (progn
|
|
|
1431 (goto-char (extent-start-position mode-motion-extent))
|
|
|
1432 (if (looking-at "^[0-9]+:")
|
|
|
1433 (setq highlight-expr (buffer-substring (match-beginning 0) (match-end 0))))))
|
|
|
1434 (setq buffer-read-only nil)
|
|
|
1435 (goto-char (point-min))
|
|
|
1436 (if (not (re-search-forward (concat "^" display-index ": [ny] ")
|
|
|
1437 (point-max) 'move))
|
|
|
1438 (insert (format "%s: y " display-index))
|
|
|
1439 (goto-char (match-end 0))
|
|
|
1440 (if (save-match-data
|
|
|
1441 (re-search-forward "^[0-9]+: " (point-max) 'move))
|
|
|
1442 (beginning-of-line))
|
|
|
1443 (delete-region (match-end 0) (point)))
|
|
|
1444 (insert-buffer-substring (gdb-get-instance-buffer
|
|
|
1445 instance 'gdb-partial-output-buffer)
|
|
|
1446 display-value)
|
|
|
1447 (goto-char (point-min))
|
|
|
1448 (if (and mode-motion-extent
|
|
|
1449 (extent-buffer mode-motion-extent)
|
|
|
1450 highlight-expr
|
|
|
1451 (re-search-forward (concat "^" highlight-expr ".*$") (point-max) t))
|
|
|
1452 (set-extent-endpoints mode-motion-extent (match-beginning 0) (match-end 0)))
|
|
|
1453 (setq buffer-read-only t)
|
|
|
1454 )))
|
|
|
1455 (gdb-clear-partial-output instance)
|
|
|
1456 (set-gdb-instance-output-sink instance 'user)
|
|
|
1457 ))
|
|
|
1458
|
|
|
1459
|
|
|
1460 ;;
|
|
|
1461 ;; Frames buffers. These display a perpetually correct bactracktrace
|
|
|
1462 ;; (from the command `where').
|
|
|
1463 ;;
|
|
|
1464 ;; Alas, if your stack is deep, they are costly.
|
|
|
1465 ;;
|
|
|
1466
|
|
|
1467 (gdb-set-instance-buffer-rules 'gdb-stack-buffer
|
|
|
1468 'gdb-stack-buffer-name
|
|
|
1469 'gud-frames-mode)
|
|
|
1470
|
|
|
1471 (def-gdb-auto-updated-buffer gdb-stack-buffer
|
|
|
1472 gdb-invalidate-frames
|
|
|
1473 "server where\n"
|
|
|
1474 gdb-info-frames-handler)
|
|
|
1475
|
|
|
1476 (defun gdb-stack-buffer-name (instance)
|
|
|
1477 (save-excursion
|
|
|
1478 (set-buffer (process-buffer (gdb-instance-process instance)))
|
|
|
1479 (concat "*stack frames of "
|
|
|
1480 (gdb-instance-target-string instance) "*")))
|
|
|
1481
|
|
|
1482 (defun gud-display-stack-buffer (instance)
|
|
|
1483 (interactive (list (gdb-needed-default-instance)))
|
|
|
1484 (gud-display-buffer
|
|
|
1485 (gdb-get-create-instance-buffer instance
|
|
|
1486 'gdb-stack-buffer)))
|
|
|
1487
|
|
|
1488 (defun gud-frame-stack-buffer (instance)
|
|
|
1489 (interactive (list (gdb-needed-default-instance)))
|
|
|
1490 (gud-display-buffer-new-frame
|
|
|
1491 (gdb-get-create-instance-buffer instance
|
|
|
1492 'gdb-stack-buffer)))
|
|
|
1493
|
|
|
1494 (defvar gud-frames-mode-map nil)
|
|
|
1495 (setq gud-frames-mode-map (make-keymap))
|
|
|
1496 (suppress-keymap gud-frames-mode-map)
|
|
|
1497
|
|
|
1498 ;;; XEmacs change
|
|
|
1499 ;(define-key gud-frames-mode-map [mouse-2]
|
|
|
1500 ; 'gud-frames-select-by-mouse)
|
|
|
1501
|
|
|
1502 (define-key gud-frames-mode-map [button2]
|
|
|
1503 'gud-frames-select-by-mouse)
|
|
|
1504
|
|
|
1505
|
|
|
1506 (defun gud-frames-mode ()
|
|
|
1507 "Major mode for gud frames.
|
|
|
1508
|
|
|
1509 \\{gud-frames-mode-map}"
|
|
|
1510 (setq major-mode 'gud-frames-mode)
|
|
|
1511 (setq mode-name "Frames")
|
|
|
1512 (setq buffer-read-only t)
|
|
|
1513 (use-local-map gud-frames-mode-map)
|
|
|
1514 (gdb-invalidate-frames gdb-buffer-instance))
|
|
|
1515
|
|
|
1516 (defun gud-get-frame-number ()
|
|
|
1517 (save-excursion
|
|
|
1518 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
|
|
|
1519 (n (or (and pos
|
|
|
1520 (string-to-int
|
|
|
1521 (buffer-substring (match-beginning 1)
|
|
|
1522 (match-end 1))))
|
|
|
1523 0)))
|
|
|
1524 n)))
|
|
|
1525
|
|
|
1526 (defun gud-frames-select-by-mouse (e)
|
|
|
1527 (interactive "e")
|
|
|
1528 (let (selection)
|
|
|
1529 (save-excursion
|
|
|
1530 (set-buffer (window-buffer (posn-window (event-end e))))
|
|
|
1531 (save-excursion
|
|
|
1532 (goto-char (posn-point (event-end e)))
|
|
|
1533 (setq selection (gud-get-frame-number))))
|
|
|
1534 (select-window (posn-window (event-end e)))
|
|
|
1535 (save-excursion
|
|
|
1536 (set-buffer (gdb-get-instance-buffer (gdb-needed-default-instance) 'gud))
|
|
|
1537 (gud-call "fr %p" selection)
|
|
|
1538 (gud-display-frame))))
|
|
|
1539
|
|
|
1540
|
|
|
1541 ;;
|
|
|
1542 ;; Registers buffers
|
|
|
1543 ;;
|
|
|
1544
|
|
|
1545 (def-gdb-auto-updated-buffer gdb-registers-buffer
|
|
|
1546 gdb-invalidate-registers
|
|
|
1547 "server info registers\n"
|
|
|
1548 gdb-info-registers-handler)
|
|
|
1549
|
|
|
1550 (gdb-set-instance-buffer-rules 'gdb-registers-buffer
|
|
|
1551 'gdb-registers-buffer-name
|
|
|
1552 'gud-registers-mode)
|
|
|
1553
|
|
|
1554 (defvar gud-registers-mode-map nil)
|
|
|
1555 (setq gud-registers-mode-map (make-keymap))
|
|
|
1556 (suppress-keymap gud-registers-mode-map)
|
|
|
1557
|
|
|
1558 (defun gud-registers-mode ()
|
|
|
1559 "Major mode for gud registers.
|
|
|
1560
|
|
|
1561 \\{gud-registers-mode-map}"
|
|
|
1562 (setq major-mode 'gud-registers-mode)
|
|
|
1563 (setq mode-name "Registers")
|
|
|
1564 (setq buffer-read-only t)
|
|
|
1565 (use-local-map gud-registers-mode-map)
|
|
|
1566 (gdb-invalidate-registers gdb-buffer-instance))
|
|
|
1567
|
|
|
1568 (defun gdb-registers-buffer-name (instance)
|
|
|
1569 (save-excursion
|
|
|
1570 (set-buffer (process-buffer (gdb-instance-process instance)))
|
|
|
1571 (concat "*registers of " (gdb-instance-target-string instance) "*")))
|
|
|
1572
|
|
|
1573 (defun gud-display-registers-buffer (instance)
|
|
|
1574 (interactive (list (gdb-needed-default-instance)))
|
|
|
1575 (gud-display-buffer
|
|
|
1576 (gdb-get-create-instance-buffer instance
|
|
|
1577 'gdb-registers-buffer)))
|
|
|
1578
|
|
|
1579 (defun gud-frame-registers-buffer (instance)
|
|
|
1580 (interactive (list (gdb-needed-default-instance)))
|
|
|
1581 (gud-display-buffer-new-frame
|
|
|
1582 (gdb-get-create-instance-buffer instance
|
|
|
1583 'gdb-registers-buffer)))
|
|
|
1584
|
|
|
1585 ;;
|
|
|
1586 ;; Locals buffers
|
|
|
1587 ;;
|
|
|
1588
|
|
|
1589 (def-gdb-auto-updated-buffer gdb-locals-buffer
|
|
|
1590 gdb-invalidate-locals
|
|
|
1591 "server info locals\n"
|
|
|
1592 gdb-info-locals-handler)
|
|
|
1593
|
|
|
1594 (gdb-set-instance-buffer-rules 'gdb-locals-buffer
|
|
|
1595 'gdb-locals-buffer-name
|
|
|
1596 'gud-locals-mode)
|
|
|
1597
|
|
|
1598 (defvar gud-locals-mode-map nil)
|
|
|
1599 (setq gud-locals-mode-map (make-keymap))
|
|
|
1600 (suppress-keymap gud-locals-mode-map)
|
|
|
1601
|
|
|
1602 (defun gud-locals-mode ()
|
|
|
1603 "Major mode for gud locals.
|
|
|
1604
|
|
|
1605 \\{gud-locals-mode-map}"
|
|
|
1606 (setq major-mode 'gud-locals-mode)
|
|
|
1607 (setq mode-name "Locals")
|
|
|
1608 (setq buffer-read-only t)
|
|
|
1609 (use-local-map gud-locals-mode-map)
|
|
|
1610 (gdb-invalidate-locals gdb-buffer-instance))
|
|
|
1611
|
|
|
1612 (defun gdb-locals-buffer-name (instance)
|
|
|
1613 (save-excursion
|
|
|
1614 (set-buffer (process-buffer (gdb-instance-process instance)))
|
|
|
1615 (concat "*locals of " (gdb-instance-target-string instance) "*")))
|
|
|
1616
|
|
|
1617 (defun gud-display-locals-buffer (instance)
|
|
|
1618 (interactive (list (gdb-needed-default-instance)))
|
|
|
1619 (gud-display-buffer
|
|
|
1620 (gdb-get-create-instance-buffer instance
|
|
|
1621 'gdb-locals-buffer)))
|
|
|
1622
|
|
|
1623 (defun gud-frame-locals-buffer (instance)
|
|
|
1624 (interactive (list (gdb-needed-default-instance)))
|
|
|
1625 (gud-display-buffer-new-frame
|
|
|
1626 (gdb-get-create-instance-buffer instance
|
|
|
1627 'gdb-locals-buffer)))
|
|
|
1628
|
|
|
1629
|
|
|
1630 ;;;;
|
|
|
1631 ;;;; Put a friendly face on the GDB on-line help.
|
|
|
1632 ;;;;
|
|
|
1633
|
|
|
1634 ;; Keymap for extents in the help buffer
|
|
|
1635 (setq gdb-help-extent-map (make-keymap))
|
|
|
1636 (suppress-keymap gdb-help-extent-map)
|
|
|
1637 (define-key gdb-help-extent-map 'button2 'gdb-help-xref)
|
|
|
1638 (define-key gdb-help-extent-map 'button3 'gdb-help-popup-menu)
|
|
|
1639
|
|
|
1640 ;; Keymap for elsewhere in the help buffer
|
|
|
1641 (setq gdb-help-map (make-keymap))
|
|
|
1642 (define-key gdb-help-map 'button3 'gdb-help-popup-menu)
|
|
|
1643
|
|
|
1644 (defvar gud-help-menu
|
|
|
1645 '("GDB Help Topics"
|
|
|
1646 "----"
|
|
|
1647 ("Classes of GDB Commands"
|
|
|
1648 "----"
|
|
|
1649 ["running" (gdb-help "running") t]
|
|
|
1650 ["stack" (gdb-help "stack") t]
|
|
|
1651 ["data" (gdb-help "data") t]
|
|
|
1652 ["breakpoints" (gdb-help "breakpoints") t]
|
|
|
1653 ["files" (gdb-help "files") t]
|
|
|
1654 ["status" (gdb-help "status") t]
|
|
|
1655 ["support" (gdb-help "support") t]
|
|
|
1656 ["user-defined" (gdb-help "user-defined") t]
|
|
|
1657 ["aliases" (gdb-help "aliases") t]
|
|
|
1658 ["obscure" (gdb-help "obscure") t]
|
|
|
1659 ["internals" (gdb-help "internals") t])
|
|
|
1660 "----"
|
|
|
1661 ("Prefix Commands"
|
|
|
1662 "----"
|
|
|
1663 ["info" (gdb-help "info") t]
|
|
|
1664 ["delete" (gdb-help "delete") t]
|
|
|
1665 ["disable" (gdb-help "disable") t]
|
|
|
1666 ["enable" (gdb-help "enable") t]
|
|
|
1667 ["maintenance" (gdb-help "maintenance") t]
|
|
|
1668 ["maintenance info" (gdb-help "maintenance info") t]
|
|
|
1669 ["maintenance print" (gdb-help "maintenance print") t]
|
|
|
1670 ["show" (gdb-help "show") t]
|
|
|
1671 ["show check" (gdb-help "show check") t]
|
|
|
1672 ["show history" (gdb-help "show history") t]
|
|
|
1673 ["show print" (gdb-help "show print") t]
|
|
|
1674 ["set" (gdb-help "set") t]
|
|
|
1675 ["set check" (gdb-help "set check") t]
|
|
|
1676 ["set history" (gdb-help "set history") t]
|
|
|
1677 ["set print" (gdb-help "set print") t]
|
|
|
1678 ["thread" (gdb-help "thread") t]
|
|
|
1679 ["thread apply" (gdb-help "thread apply") t]
|
|
|
1680 ["unset" (gdb-help "unset") t])
|
|
|
1681 ; Only if you build this into gdb
|
|
|
1682 ; ("Duel"
|
|
|
1683 ; ["summary" (gdb-help "duel help") t]
|
|
|
1684 ; ["ops" (gdb-help "duel ops") t]
|
|
|
1685 ; ["examples" (gdb-help "duel examples") t])
|
|
|
1686 )
|
|
|
1687 "*menu for gdb-help")
|
|
|
1688
|
|
|
1689 (defun gdb-help-popup-menu (event)
|
|
|
1690 (interactive "@e")
|
|
|
1691 (mouse-set-point event)
|
|
|
1692 (popup-menu gud-help-menu))
|
|
|
1693
|
|
|
1694 (defun gdb-help-xref (event)
|
|
|
1695 (interactive "e")
|
|
|
1696 (save-excursion
|
|
|
1697 (set-buffer (get-buffer (gettext "*Debugger Help*")))
|
|
|
1698 (let ((extent (extent-at (event-point event))))
|
|
|
1699 (gdb-help
|
|
|
1700 (or (extent-property extent 'back-to)
|
|
|
1701 (buffer-substring (extent-start-position extent)
|
|
|
1702 (extent-end-position extent)))
|
|
|
1703 gdb-help-topic)
|
|
|
1704 )))
|
|
|
1705
|
|
|
1706 (defun gdb-help-info ()
|
|
|
1707 (interactive)
|
|
|
1708 (require 'info)
|
|
|
1709 (Info-goto-node "(gdb)Top"))
|
|
|
1710
|
|
|
1711 ;; Format the help page. We lightly edit the GDB output to add instructions
|
|
|
1712 ;; on getting help on listed commands using the mouse rather than typing
|
|
|
1713 ;; "help" at gdb.
|
|
|
1714 ;;
|
|
|
1715 ;; We're not trying to re-produce Info's or w3's navigational and cross
|
|
|
1716 ;; referencing here but just to put a simple mouse-driven front end over
|
|
|
1717 ;; GDB's help.
|
|
|
1718 ;;
|
|
|
1719 ;; The help buffer *ought* to be in gdb-help-mode but we only ever create
|
|
|
1720 ;; one buffer so just setting a buffer local keymap should be good enough
|
|
|
1721 ;; for now.
|
|
|
1722
|
|
|
1723 (defun gdb-format-help-page nil
|
|
|
1724 (save-excursion
|
|
|
1725 (display-buffer (set-buffer (get-buffer-create
|
|
|
1726 (gettext "*Debugger Help*"))))
|
|
|
1727 (erase-buffer)
|
|
|
1728 (map-extents '(lambda (extent) (delete-extent extent) nil))
|
|
|
1729 (use-local-map gdb-help-map)
|
|
|
1730 (insert-buffer (gdb-get-instance-buffer
|
|
|
1731 instance 'gdb-partial-output-buffer))
|
|
|
1732 (goto-char (point-min))
|
|
|
1733 (forward-line 1)
|
|
|
1734 (while (re-search-forward "\\(^.*\\) -- .*$" (point-max) t)
|
|
|
1735 (let ((extent (make-extent (match-beginning 1) (match-end 1))))
|
|
|
1736 (set-extent-property extent 'face (find-face 'bold))
|
|
|
1737 (set-extent-property extent 'highlight t)
|
|
|
1738 (set-extent-property extent 'keymap gdb-help-extent-map)
|
|
|
1739 ))
|
|
|
1740 ;; We use the message at the end of the help to distinguish between
|
|
|
1741 ;; help on a class of commands, help on a prefix command and help
|
|
|
1742 ;; on a command.
|
|
|
1743 (goto-char (point-min))
|
|
|
1744 (cond
|
|
|
1745 ((looking-at "List of classes of commands:")
|
|
|
1746 ;; It's the list of classes
|
|
|
1747 (end-of-line)
|
|
|
1748 (insert " Click on a highlighted class to see the list of commands
|
|
|
1749 in that class.")
|
|
|
1750 )
|
|
|
1751 ((and (not (looking-at "List of classes of commands:"))
|
|
|
1752 (re-search-forward "^Type \"help\" followed by command name" (point-max) t))
|
|
|
1753 ;; It's help on a specific class
|
|
|
1754 (goto-char (point-min))
|
|
|
1755 (insert "Help on ")
|
|
|
1756 (downcase-word 1)
|
|
|
1757 (end-of-line)
|
|
|
1758 (insert " Click on a highlighted command to see the help
|
|
|
1759 for that command or click ")
|
|
|
1760 (setq point (point))
|
|
|
1761 (insert "here")
|
|
|
1762 (setq extent (make-extent point (point)))
|
|
|
1763 (set-extent-property extent 'back-to "")
|
|
|
1764 (insert " to see the list of classes of commands.\n")
|
|
|
1765 )
|
|
|
1766 ((re-search-forward "^Type \"help.*subcommand" (point-max) t)
|
|
|
1767 ;; It's a prefix command
|
|
|
1768 (goto-char (point-min))
|
|
|
1769 (insert (concat "Help on \"" gdb-help-topic "\" - "))
|
|
|
1770 (downcase-word 1)
|
|
|
1771 (end-of-line)
|
|
|
1772 (insert " Click on a highlighted topic to see the help
|
|
|
1773 for that topic or click ")
|
|
|
1774 (setq point (point))
|
|
|
1775 (insert "here")
|
|
|
1776 (setq extent (make-extent point (point)))
|
|
|
1777 (string-match " ?[^ \t]*$" gdb-help-topic)
|
|
|
1778 (if (equal ""
|
|
|
1779 (set-extent-property extent 'back-to
|
|
|
1780 (substring gdb-help-topic
|
|
|
1781 0 (match-beginning 0))))
|
|
|
1782 (insert " to see the list of classes of commands.\n")
|
|
|
1783 (insert (concat " to see the help on " (extent-property extent 'back-to ))))
|
|
|
1784 )
|
|
|
1785 (t
|
|
|
1786 ;; Must be an ordinary command
|
|
|
1787 (goto-char (point-min))
|
|
|
1788 (insert (concat "Help on \"" gdb-help-topic "\" - "))
|
|
|
1789 (insert " Click ")
|
|
|
1790 (setq point (point))
|
|
|
1791 (insert "here")
|
|
|
1792 (setq extent (make-extent point (point)))
|
|
|
1793 (if (equal "" (set-extent-property extent 'back-to gdb-previous-help-topic))
|
|
|
1794 (insert " to see the list of classes of commands.\n")
|
|
|
1795 (insert (concat " to see the help on " (extent-property extent 'back-to ))))
|
|
|
1796 )
|
|
|
1797 )
|
|
|
1798 (and extent
|
|
|
1799 (set-extent-property extent 'face (find-face 'bold))
|
|
|
1800 (set-extent-property extent 'highlight t)
|
|
|
1801 (set-extent-property extent 'keymap gdb-help-extent-map))
|
|
|
1802 (setq fill-column 78)
|
|
|
1803 (fill-region (point-min) (point))
|
|
|
1804 (insert "\n")
|
|
|
1805 ))
|
|
|
1806
|
|
|
1807 (defun gdb-help (topic &optional previous-topic)
|
|
|
1808 (interactive "sGdb Help Topic: ")
|
|
|
1809 (let ((instance (gdb-needed-default-instance))
|
|
|
1810 )
|
|
|
1811 (save-excursion
|
|
|
1812 (set-buffer (get-buffer-create (gettext "*Debugger Help*")))
|
|
|
1813 (make-variable-buffer-local 'gdb-help-topic)
|
|
|
1814 (make-variable-buffer-local 'gdb-previous-help-topic)
|
|
|
1815 (setq gdb-help-topic topic)
|
|
|
1816 (setq gdb-previous-help-topic (or previous-topic "")))
|
|
|
1817 (gdb-clear-partial-output instance)
|
|
|
1818 (gdb-instance-enqueue-idle-input
|
|
|
1819 instance
|
|
|
1820 (list
|
|
|
1821 (concat
|
|
|
1822 "server "
|
|
|
1823 (if (string-match "^duel" topic)
|
|
|
1824 ""
|
|
|
1825 "help ")
|
|
|
1826 topic
|
|
|
1827 "\n")
|
|
|
1828 'gdb-format-help-page))))
|
|
|
1829
|
|
|
1830 ;;;; Menus and stuff
|
|
|
1831
|
|
|
1832 (defun gdb-install-menubar ()
|
|
|
1833 "Installs the Gdb menu at the menubar."
|
|
|
1834
|
|
|
1835 ;; We can't define the menu at load-time because many of the functions
|
|
|
1836 ;; that we will call won't be bound then.
|
|
|
1837 (defvar gdb-menu
|
|
|
1838 '("GDB Commands"
|
|
|
1839 "----"
|
|
|
1840 ("Help"
|
|
|
1841 ["info" gdb-help-info t]
|
|
|
1842 "----"
|
|
|
1843 ["running -- Running the program" (gdb-help "running") t]
|
|
|
1844 ["stack -- Examining the stack" (gdb-help "stack") t]
|
|
|
1845 ["data -- Examining data" (gdb-help "data") t]
|
|
|
1846 ["breakpoints -- Making program stop at certain points" (gdb-help "breakpoints") t]
|
|
|
1847 ["files -- Specifying and examining files" (gdb-help "files") t]
|
|
|
1848 ["status -- Status inquiries" (gdb-help "status") t]
|
|
|
1849 ["support -- Support facilities" (gdb-help "support") t]
|
|
|
1850 ["user-defined -- User-defined commands" (gdb-help "user-defined") t]
|
|
|
1851 ["aliases -- Aliases of other commands" (gdb-help "aliases") t]
|
|
|
1852 ["obscure -- Obscure features" (gdb-help "obscure") t]
|
|
|
1853 ["internals -- Maintenance commands" (gdb-help "internals") t]
|
|
|
1854 "---"
|
|
|
1855 ; Only if you build this into gdb
|
|
|
1856 ; ["Duel summary" (gdb-help "duel help") t]
|
|
|
1857 ; ["Duel ops" (gdb-help "duel ops") t]
|
|
|
1858 ; ["Duel examples" (gdb-help "duel examples") t]
|
|
|
1859 )
|
|
|
1860 "---"
|
|
|
1861 ("New window showing"
|
|
|
1862 ["Local variables" gud-display-locals-buffer t]
|
|
|
1863 ["Displayed expressions" gud-display-display-buffer t]
|
|
|
1864 ["Breakpoints" gud-display-breakpoints-buffer t]
|
|
|
1865 ["Stack trace" gud-display-stack-buffer t]
|
|
|
1866 ["Machine registers" gud-display-registers-buffer t]
|
|
|
1867 )
|
|
|
1868 ("New frame showing"
|
|
|
1869 ["Local variables" gud-frame-locals-buffer t]
|
|
|
1870 ["Displayed expressions" gud-frame-display-buffer t]
|
|
|
1871 ["Breakpoints" gud-frame-breakpoints-buffer t]
|
|
|
1872 ["Stack trace" gud-frame-stack-buffer t]
|
|
|
1873 ["Machine registers" gud-frame-registers-buffer t]
|
|
|
1874 )
|
|
|
1875 "----"
|
|
|
1876 ["step" gud-step t]
|
|
|
1877 ["next" gud-next t]
|
|
|
1878 ["finish" gud-finish t]
|
|
|
1879 ["continue" gud-cont t]
|
|
|
1880 ["run" gud-run t]
|
|
|
1881 )
|
|
|
1882 "*The menu for GDB mode.")
|
|
|
1883 (if (and current-menubar (not (assoc "Gdb" current-menubar)))
|
|
|
1884 (progn
|
|
|
1885 (set-buffer-menubar (copy-sequence current-menubar))
|
|
|
1886 (add-menu nil "Gdb" (cdr gdb-menu))))
|
|
|
1887 )
|
|
|
1888 (add-hook 'gdb-mode-hook 'gdb-install-menubar)
|
|
|
1889
|
|
|
1890
|
|
|
1891 (gdb-set-instance-buffer-rules 'gdb-command-buffer
|
|
|
1892 'gdb-command-buffer-name
|
|
|
1893 'gud-command-mode)
|
|
|
1894
|
|
|
1895 (defvar gud-command-mode-map nil)
|
|
|
1896 (setq gud-command-mode-map (make-keymap))
|
|
|
1897 (suppress-keymap gud-command-mode-map)
|
|
|
1898 ;;; XEmacs change
|
|
|
1899 ;(define-key gud-command-mode-map [mouse-2] 'gud-menu-pick)
|
|
|
1900 (define-key gud-command-mode-map [button2] 'gud-menu-pick)
|
|
|
1901
|
|
|
1902
|
|
|
1903 (defun gud-command-mode ()
|
|
|
1904 "Major mode for gud menu.
|
|
|
1905
|
|
|
1906 \\{gud-command-mode-map}" (interactive) (setq major-mode 'gud-command-mode)
|
|
|
1907 (setq mode-name "Menu") (setq buffer-read-only t) (use-local-map
|
|
|
1908 gud-command-mode-map) (make-variable-buffer-local 'gud-menu-position)
|
|
|
1909 (if (not gud-menu-position) (gud-goto-menu gud-running-menu)))
|
|
|
1910
|
|
|
1911 (defun gdb-command-buffer-name (instance)
|
|
|
1912 (save-excursion
|
|
|
1913 (set-buffer (process-buffer (gdb-instance-process instance)))
|
|
|
1914 (concat "*menu of " (gdb-instance-target-string instance) "*")))
|
|
|
1915
|
|
|
1916 (defun gud-display-command-buffer (instance)
|
|
|
1917 (interactive (list (gdb-needed-default-instance)))
|
|
|
1918 (gud-display-buffer
|
|
|
1919 (gdb-get-create-instance-buffer instance
|
|
|
1920 'gdb-command-buffer)
|
|
|
1921 6))
|
|
|
1922
|
|
|
1923 (defun gud-frame-command-buffer (instance)
|
|
|
1924 (interactive (list (gdb-needed-default-instance)))
|
|
|
1925 (gud-display-buffer-new-frame
|
|
|
1926 (gdb-get-create-instance-buffer instance
|
|
|
1927 'gdb-command-buffer)))
|
|
|
1928
|
|
|
1929
|
|
|
1930
|
|
|
1931 (defun gdb-call-showing-gud (instance command)
|
|
|
1932 (gud-display-gud-buffer instance)
|
|
|
1933 (comint-input-sender (gdb-instance-process instance) command))
|
|
|
1934
|
|
|
1935 (defvar gud-target-history ())
|
|
|
1936
|
|
|
1937 (defun gud-temp-buffer-show (buf)
|
|
|
1938 (let ((ow (selected-window)))
|
|
|
1939 (unwind-protect
|
|
|
1940 (progn
|
|
|
1941 (pop-to-buffer buf)
|
|
|
1942
|
|
|
1943 ;; This insertion works around a bug in emacs.
|
|
|
1944 ;; The bug is that all the empty space after a
|
|
|
1945 ;; highlighted word that terminates a buffer
|
|
|
1946 ;; gets highlighted. That's really ugly, so
|
|
|
1947 ;; make sure a highlighted word can't ever
|
|
|
1948 ;; terminate the buffer.
|
|
|
1949 (goto-char (point-max))
|
|
|
1950 (insert "\n")
|
|
|
1951 (goto-char (point-min))
|
|
|
1952
|
|
|
1953 (if (< (window-height) 10)
|
|
|
1954 (enlarge-window (- 10 (window-height)))))
|
|
|
1955 (select-window ow))))
|
|
|
1956
|
|
|
1957 (defun gud-target (instance command)
|
|
|
1958 (interactive
|
|
|
1959 (let* ((instance (gdb-needed-default-instance))
|
|
|
1960 (temp-buffer-show-function (function gud-temp-buffer-show))
|
|
|
1961 (target-name (completing-read (format "Target type: ")
|
|
|
1962 '(("remote")
|
|
|
1963 ("core")
|
|
|
1964 ("child")
|
|
|
1965 ("exec"))
|
|
|
1966 nil
|
|
|
1967 t
|
|
|
1968 nil
|
|
|
1969 'gud-target-history)))
|
|
|
1970 (list instance
|
|
|
1971 (cond
|
|
|
1972 ((equal target-name "child") "run")
|
|
|
1973
|
|
|
1974 ((equal target-name "core")
|
|
|
1975 (concat "target core "
|
|
|
1976 (read-file-name "core file: "
|
|
|
1977 nil
|
|
|
1978 "core"
|
|
|
1979 t)))
|
|
|
1980
|
|
|
1981 ((equal target-name "exec")
|
|
|
1982 (concat "target exec "
|
|
|
1983 (read-file-name "exec file: "
|
|
|
1984 nil
|
|
|
1985 "a.out"
|
|
|
1986 t)))
|
|
|
1987
|
|
|
1988 ((equal target-name "remote")
|
|
|
1989 (concat "target remote "
|
|
|
1990 (read-file-name "serial line for remote: "
|
|
|
1991 "/dev/"
|
|
|
1992 "ttya"
|
|
|
1993 t)))
|
|
|
1994
|
|
|
1995 (t "echo No such target command!")))))
|
|
|
1996
|
|
|
1997 (gud-display-gud-buffer instance)
|
|
|
1998 (apply comint-input-sender
|
|
|
1999 (list (gdb-instance-process instance) command)))
|
|
|
2000
|
|
|
2001 (defun gud-backtrace ()
|
|
|
2002 (interactive)
|
|
|
2003 (let ((instance (gdb-needed-default-instance)))
|
|
|
2004 (gud-display-gud-buffer instance)
|
|
|
2005 (apply comint-input-sender
|
|
|
2006 (list (gdb-instance-process instance)
|
|
|
2007 "backtrace"))))
|
|
|
2008
|
|
|
2009 (defun gud-frame ()
|
|
|
2010 (interactive)
|
|
|
2011 (let ((instance (gdb-needed-default-instance)))
|
|
|
2012 (apply comint-input-sender
|
|
|
2013 (list (gdb-instance-process instance)
|
|
|
2014 "frame"))))
|
|
|
2015
|
|
|
2016 (defun gud-return (instance command)
|
|
|
2017 (interactive
|
|
|
2018 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2019 (list (gdb-needed-default-instance)
|
|
|
2020 (concat "return " (read-string "Expression to return: ")))))
|
|
|
2021 (gud-display-gud-buffer instance)
|
|
|
2022 (apply comint-input-sender
|
|
|
2023 (list (gdb-instance-process instance) command)))
|
|
|
2024
|
|
|
2025
|
|
|
2026 (defun gud-file (instance command)
|
|
|
2027 (interactive
|
|
|
2028 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2029 (list (gdb-needed-default-instance)
|
|
|
2030 (concat "file " (read-file-name "Executable to debug: "
|
|
|
2031 nil
|
|
|
2032 "a.out"
|
|
|
2033 t)))))
|
|
|
2034 (gud-display-gud-buffer instance)
|
|
|
2035 (apply comint-input-sender
|
|
|
2036 (list (gdb-instance-process instance) command)))
|
|
|
2037
|
|
|
2038 (defun gud-core-file (instance command)
|
|
|
2039 (interactive
|
|
|
2040 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2041 (list (gdb-needed-default-instance)
|
|
|
2042 (concat "core " (read-file-name "Core file to debug: "
|
|
|
2043 nil
|
|
|
2044 "core-file"
|
|
|
2045 t)))))
|
|
|
2046 (gud-display-gud-buffer instance)
|
|
|
2047 (apply comint-input-sender
|
|
|
2048 (list (gdb-instance-process instance) command)))
|
|
|
2049
|
|
|
2050 (defun gud-cd (dir)
|
|
|
2051 (interactive "FChange GDB's default directory: ")
|
|
|
2052 (let ((instance (gdb-needed-default-instance)))
|
|
|
2053 (save-excursion
|
|
|
2054 (set-buffer (gdb-get-instance-buffer instance 'gud))
|
|
|
2055 (cd dir))
|
|
|
2056 (gud-display-gud-buffer instance)
|
|
|
2057 (apply comint-input-sender
|
|
|
2058 (list (gdb-instance-process instance)
|
|
|
2059 (concat "cd " dir)))))
|
|
|
2060
|
|
|
2061
|
|
|
2062 (defun gud-exec-file (instance command)
|
|
|
2063 (interactive
|
|
|
2064 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2065 (list (gdb-needed-default-instance)
|
|
|
2066 (concat "exec-file " (read-file-name "Init memory from executable: "
|
|
|
2067 nil
|
|
|
2068 "a.out"
|
|
|
2069 t)))))
|
|
|
2070 (gud-display-gud-buffer instance)
|
|
|
2071 (apply comint-input-sender
|
|
|
2072 (list (gdb-instance-process instance) command)))
|
|
|
2073
|
|
|
2074 (defun gud-load (instance command)
|
|
|
2075 (interactive
|
|
|
2076 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2077 (list (gdb-needed-default-instance)
|
|
|
2078 (concat "load " (read-file-name "Dynamicly load from file: "
|
|
|
2079 nil
|
|
|
2080 "a.out"
|
|
|
2081 t)))))
|
|
|
2082 (gud-display-gud-buffer instance)
|
|
|
2083 (apply comint-input-sender
|
|
|
2084 (list (gdb-instance-process instance) command)))
|
|
|
2085
|
|
|
2086 (defun gud-symbol-file (instance command)
|
|
|
2087 (interactive
|
|
|
2088 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2089 (list (gdb-needed-default-instance)
|
|
|
2090 (concat "symbol-file " (read-file-name "Read symbol table from file: "
|
|
|
2091 nil
|
|
|
2092 "a.out"
|
|
|
2093 t)))))
|
|
|
2094 (gud-display-gud-buffer instance)
|
|
|
2095 (apply comint-input-sender
|
|
|
2096 (list (gdb-instance-process instance) command)))
|
|
|
2097
|
|
|
2098
|
|
|
2099 (defun gud-add-symbol-file (instance command)
|
|
|
2100 (interactive
|
|
|
2101 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2102 (list (gdb-needed-default-instance)
|
|
|
2103 (concat "add-symbol-file "
|
|
|
2104 (read-file-name "Add symbols from file: "
|
|
|
2105 nil
|
|
|
2106 "a.out"
|
|
|
2107 t)))))
|
|
|
2108 (gud-display-gud-buffer instance)
|
|
|
2109 (apply comint-input-sender
|
|
|
2110 (list (gdb-instance-process instance) command)))
|
|
|
2111
|
|
|
2112
|
|
|
2113 (defun gud-sharedlibrary (instance command)
|
|
|
2114 (interactive
|
|
|
2115 (let ((temp-buffer-show-function (function gud-temp-buffer-show)))
|
|
|
2116 (list (gdb-needed-default-instance)
|
|
|
2117 (concat "sharedlibrary "
|
|
|
2118 (read-string "Load symbols for files matching regexp: ")))))
|
|
|
2119 (gud-display-gud-buffer instance)
|
|
|
2120 (apply comint-input-sender
|
|
|
2121 (list (gdb-instance-process instance) command)))
|
|
|
2122
|
|
|
2123
|
|
|
2124 ;;;; Help
|
|
|
2125
|
|
|
2126
|
|
|
2127
|
|
|
2128 ;;;; Window management
|
|
|
2129
|
|
|
2130
|
|
|
2131 ;;; FIXME: This should only return true for buffers in the current instance
|
|
|
2132 (defun gud-protected-buffer-p (buffer)
|
|
|
2133 "Is BUFFER a buffer which we want to leave displayed?"
|
|
|
2134 (save-excursion
|
|
|
2135 (set-buffer buffer)
|
|
|
2136 (or gdb-buffer-type
|
|
|
2137 overlay-arrow-position)))
|
|
|
2138
|
|
|
2139 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
|
|
|
2140 ;;; to do the right thing. Seeing as there is no way for Lisp code to
|
|
|
2141 ;;; get at the use_time field of a window, I'm not sure there exists a
|
|
|
2142 ;;; more elegant solution without writing C code.
|
|
|
2143
|
|
|
2144 (defun gud-display-buffer (buf &optional size)
|
|
|
2145 (let ((must-split nil)
|
|
|
2146 (answer nil))
|
|
|
2147 (save-excursion
|
|
|
2148 (unwind-protect
|
|
|
2149 (progn
|
|
|
2150 (walk-windows
|
|
|
2151 '(lambda (win)
|
|
|
2152 (if (gud-protected-buffer-p (window-buffer win))
|
|
|
2153 (set-window-buffer-dedicated win (window-buffer win)))))
|
|
|
2154 (setq answer (get-buffer-window buf))
|
|
|
2155 (if (not answer)
|
|
|
2156 (let ((window (get-lru-window)))
|
|
|
2157 (if (not (window-dedicated-p window))
|
|
|
2158 (progn
|
|
|
2159 (set-window-buffer window buf)
|
|
|
2160 (setq answer window))
|
|
|
2161 (setq must-split t)))))
|
|
|
2162 (walk-windows
|
|
|
2163 '(lambda (win)
|
|
|
2164 (if (gud-protected-buffer-p (window-buffer win))
|
|
|
2165 (set-window-buffer-dedicated win nil)))))
|
|
|
2166 (if must-split
|
|
|
2167 (let* ((largest (get-largest-window))
|
|
|
2168 (cur-size (window-height largest))
|
|
|
2169 (new-size (and size (< size cur-size) (- cur-size size))))
|
|
|
2170 (setq answer (split-window largest new-size))
|
|
|
2171 (set-window-buffer answer buf)))
|
|
|
2172 answer)))
|
|
|
2173
|
|
|
2174 (defun existing-source-window (buffer)
|
|
|
2175 (catch 'found
|
|
|
2176 (save-excursion
|
|
|
2177 (walk-windows
|
|
|
2178 (function
|
|
|
2179 (lambda (win)
|
|
|
2180 (if (and overlay-arrow-position
|
|
|
2181 (eq (window-buffer win)
|
|
|
2182 (marker-buffer overlay-arrow-position)))
|
|
|
2183 (progn
|
|
|
2184 (set-window-buffer win buffer)
|
|
|
2185 (throw 'found win))))))
|
|
|
2186 nil)))
|
|
|
2187
|
|
|
2188 (defun gud-display-source-buffer (buffer)
|
|
|
2189 (or (existing-source-window buffer)
|
|
|
2190 (gud-display-buffer buffer)))
|
|
|
2191
|
|
|
2192 (defun gud-display-buffer-new-frame (buf)
|
|
|
2193 (save-excursion
|
|
|
2194 (set-buffer buf)
|
|
|
2195 (let* ((buf-height (+ 4 (count-lines (point-min) (point-max))))
|
|
|
2196 (frame-params (list (cons 'height buf-height)))
|
|
|
2197 )
|
|
|
2198 ;; This is a hack so that we can re-size this window to occupy just as
|
|
|
2199 ;; much space is needed.
|
|
|
2200 (setq truncate-lines t)
|
|
|
2201 (set-buffer-dedicated-frame buf (make-frame frame-params)))))
|
|
|
2202
|
|
|
2203
|
|
|
2204
|
|
|
2205 ;;; Shared keymap initialization:
|
|
|
2206
|
|
|
2207 (defun gud-display-gud-buffer (instance)
|
|
|
2208 (interactive (list (gdb-needed-default-instance)))
|
|
|
2209 (gud-display-buffer
|
|
|
2210 (gdb-get-create-instance-buffer instance 'gud)))
|
|
|
2211
|
|
|
2212 (defun gud-frame-gud-buffer (instance)
|
|
|
2213 (interactive (list (gdb-needed-default-instance)))
|
|
|
2214 (gud-display-buffer-new-frame
|
|
|
2215 (gdb-get-create-instance-buffer instance 'gud)))
|
|
|
2216
|
|
|
2217
|
|
|
2218 (defun gud-gdb-find-file (f)
|
|
|
2219 (find-file-noselect f))
|
|
|
2220
|
|
|
2221 ;;; XEmacs: don't autoload this yet since it's still buggy - use the
|
|
|
2222 ;;; one in gdb.el instead
|
|
|
2223 (defun gdb (command-line)
|
|
|
2224 "Run gdb on program FILE in buffer *gud-FILE*.
|
|
|
2225 The directory containing FILE becomes the initial working directory
|
|
|
2226 and source-file directory for your debugger."
|
|
|
2227 (interactive
|
|
|
2228 (list (read-shell-command "Run gdb (like this): "
|
|
|
2229 (if (consp gud-gdb-history)
|
|
|
2230 (car gud-gdb-history)
|
|
|
2231 "gdb ")
|
|
|
2232 '(gud-gdb-history . 1))))
|
|
|
2233 (gud-overload-functions
|
|
|
2234 '((gud-massage-args . gud-gdb-massage-args)
|
|
|
2235 (gud-marker-filter . gud-gdb-marker-filter)
|
|
|
2236 (gud-find-file . gud-gdb-find-file)
|
|
|
2237 ))
|
|
|
2238
|
|
|
2239 (let* ((words (gud-chop-words command-line))
|
|
|
2240 (program (car words))
|
|
|
2241 (file-word (let ((w (cdr words)))
|
|
|
2242 (while (and w (= ?- (aref (car w) 0)))
|
|
|
2243 (setq w (cdr w)))
|
|
|
2244 (car w)))
|
|
|
2245 (args (delq file-word (cdr words)))
|
|
|
2246 (file (and file-word (expand-file-name file-word)))
|
|
|
2247 (filepart (if file (file-name-nondirectory file) ""))
|
|
|
2248 (buffer-name (concat "*" "gdb"
|
|
|
2249 (and (string< "" filepart)
|
|
|
2250 (concat "-" filepart)) "*")))
|
|
|
2251 (setq gdb-first-time (not (get-buffer-process buffer-name))))
|
|
|
2252
|
|
|
2253 (gud-common-init command-line "gdb")
|
|
|
2254
|
|
|
2255 (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
|
|
|
2256 (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
|
|
|
2257 (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line")
|
|
|
2258 (gud-def gud-kill "kill" nil "Kill the program.")
|
|
|
2259 (gud-def gud-run "run" nil "Run the program.")
|
|
|
2260 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
|
|
|
2261 (gud-def gud-step "step %p" "\C-s" "Step one source line with display.")
|
|
|
2262 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).")
|
|
|
2263 (gud-def gud-finish "finish" "\C-f" "Finish executing current function.")
|
|
|
2264 (gud-def gud-cont "cont" "\C-r" "Continue with display.")
|
|
|
2265 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
|
|
|
2266 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
|
|
|
2267 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
|
|
|
2268
|
|
|
2269 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
|
|
|
2270 (setq comint-input-sender 'gdb-send)
|
|
|
2271 (run-hooks 'gdb-mode-hook)
|
|
|
2272 (let ((instance
|
|
|
2273 (make-gdb-instance (get-buffer-process (current-buffer)))
|
|
|
2274 ))
|
|
|
2275 (if gdb-first-time (gdb-clear-inferior-io instance)))
|
|
|
2276 )
|
|
|
2277
|
|
|
2278
|
|
|
2279 ;; ======================================================================
|
|
|
2280 ;; sdb functions
|
|
|
2281
|
|
|
2282 ;;; History of argument lists passed to sdb.
|
|
|
2283 (defvar gud-sdb-history nil)
|
|
|
2284
|
|
|
2285 (defvar gud-sdb-needs-tags (not (file-exists-p "/var"))
|
|
|
2286 "If nil, we're on a System V Release 4 and don't need the tags hack.")
|
|
|
2287
|
|
|
2288 (defvar gud-sdb-lastfile nil)
|
|
|
2289
|
|
|
2290 (defun gud-sdb-massage-args (file args)
|
|
|
2291 (cons file args))
|
|
|
2292
|
|
|
2293 (defun gud-sdb-marker-filter (string)
|
|
|
2294 (cond
|
|
|
2295 ;; System V Release 3.2 uses this format
|
|
|
2296 ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
|
|
|
2297 string)
|
|
|
2298 (setq gud-last-frame
|
|
|
2299 (cons
|
|
|
2300 (substring string (match-beginning 2) (match-end 2))
|
|
|
2301 (string-to-int
|
|
|
2302 (substring string (match-beginning 3) (match-end 3))))))
|
|
|
2303 ;; System V Release 4.0
|
|
|
2304 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
|
|
|
2305 string)
|
|
|
2306 (setq gud-sdb-lastfile
|
|
|
2307 (substring string (match-beginning 2) (match-end 2))))
|
|
|
2308 ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" string))
|
|
|
2309 (setq gud-last-frame
|
|
|
2310 (cons
|
|
|
2311 gud-sdb-lastfile
|
|
|
2312 (string-to-int
|
|
|
2313 (substring string (match-beginning 1) (match-end 1))))))
|
|
|
2314 (t
|
|
|
2315 (setq gud-sdb-lastfile nil)))
|
|
|
2316 string)
|
|
|
2317
|
|
|
2318 (defun gud-sdb-find-file (f)
|
|
|
2319 (if gud-sdb-needs-tags
|
|
|
2320 (find-tag-noselect f)
|
|
|
2321 (find-file-noselect f)))
|
|
|
2322
|
|
|
2323 ;;;###autoload
|
|
|
2324 (defun sdb (command-line)
|
|
|
2325 "Run sdb on program FILE in buffer *gud-FILE*.
|
|
|
2326 The directory containing FILE becomes the initial working directory
|
|
|
2327 and source-file directory for your debugger."
|
|
|
2328 (interactive
|
|
|
2329 (list (read-from-minibuffer "Run sdb (like this): "
|
|
|
2330 (if (consp gud-sdb-history)
|
|
|
2331 (car gud-sdb-history)
|
|
|
2332 "sdb ")
|
|
|
2333 nil nil
|
|
|
2334 '(gud-sdb-history . 1))))
|
|
|
2335 (if (and gud-sdb-needs-tags
|
|
|
2336 (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))))
|
|
|
2337 (error "The sdb support requires a valid tags table to work."))
|
|
|
2338 (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args)
|
|
|
2339 (gud-marker-filter . gud-sdb-marker-filter)
|
|
|
2340 (gud-find-file . gud-sdb-find-file)
|
|
|
2341 ))
|
|
|
2342
|
|
|
2343 (gud-common-init command-line "sdb")
|
|
|
2344
|
|
|
2345 (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.")
|
|
|
2346 (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.")
|
|
|
2347 (gud-def gud-remove "%l d" "\C-d" "Remove breakpoint at current line")
|
|
|
2348 (gud-def gud-step "s %p" "\C-s" "Step one source line with display.")
|
|
|
2349 (gud-def gud-stepi "i %p" "\C-i" "Step one instruction with display.")
|
|
|
2350 (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).")
|
|
|
2351 (gud-def gud-cont "c" "\C-r" "Continue with display.")
|
|
|
2352 (gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.")
|
|
|
2353
|
|
|
2354 (setq comint-prompt-regexp "\\(^\\|\n\\)\\*")
|
|
|
2355 (run-hooks 'sdb-mode-hook)
|
|
|
2356 )
|
|
|
2357
|
|
|
2358 ;; ======================================================================
|
|
|
2359 ;; dbx functions
|
|
|
2360
|
|
|
2361 ;;; History of argument lists passed to dbx.
|
|
|
2362 (defvar gud-dbx-history nil)
|
|
|
2363
|
|
|
2364 (defun gud-dbx-massage-args (file args)
|
|
|
2365 (cons file args))
|
|
|
2366
|
|
|
2367 (defun gud-dbx-marker-filter (string)
|
|
|
2368 (if (or (string-match
|
|
|
2369 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
|
|
|
2370 string)
|
|
|
2371 (string-match
|
|
|
2372 "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
|
|
|
2373 string))
|
|
|
2374 (setq gud-last-frame
|
|
|
2375 (cons
|
|
|
2376 (substring string (match-beginning 2) (match-end 2))
|
|
|
2377 (string-to-int
|
|
|
2378 (substring string (match-beginning 1) (match-end 1))))))
|
|
|
2379 string)
|
|
|
2380
|
|
|
2381 (defun gud-dbx-find-file (f)
|
|
|
2382 (find-file-noselect f))
|
|
|
2383
|
|
|
2384 ;;;###autoload
|
|
|
2385 (defun dbx (command-line)
|
|
|
2386 "Run dbx on program FILE in buffer *gud-FILE*.
|
|
|
2387 The directory containing FILE becomes the initial working directory
|
|
|
2388 and source-file directory for your debugger."
|
|
|
2389 (interactive
|
|
|
2390 (list (read-from-minibuffer "Run dbx (like this): "
|
|
|
2391 (if (consp gud-dbx-history)
|
|
|
2392 (car gud-dbx-history)
|
|
|
2393 "dbx ")
|
|
|
2394 nil nil
|
|
|
2395 '(gud-dbx-history . 1))))
|
|
|
2396 (gud-overload-functions '((gud-massage-args . gud-dbx-massage-args)
|
|
|
2397 (gud-marker-filter . gud-dbx-marker-filter)
|
|
|
2398 (gud-find-file . gud-dbx-find-file)
|
|
|
2399 ))
|
|
|
2400
|
|
|
2401 (gud-common-init command-line "dbx")
|
|
|
2402
|
|
|
2403 (gud-def gud-break "file \"%d%f\"\nstop at %l"
|
|
|
2404 "\C-b" "Set breakpoint at current line.")
|
|
|
2405 ;; (gud-def gud-break "stop at \"%f\":%l"
|
|
|
2406 ;; "\C-b" "Set breakpoint at current line.")
|
|
|
2407 (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line")
|
|
|
2408 (gud-def gud-step "step %p" "\C-s" "Step one line with display.")
|
|
|
2409 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
|
|
|
2410 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).")
|
|
|
2411 (gud-def gud-cont "cont" "\C-r" "Continue with display.")
|
|
|
2412 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.")
|
|
|
2413 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.")
|
|
|
2414 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
|
|
|
2415
|
|
|
2416 (setq comint-prompt-regexp "^[^)]*dbx) *")
|
|
|
2417 (run-hooks 'dbx-mode-hook)
|
|
|
2418 )
|
|
|
2419
|
|
|
2420 ;; ======================================================================
|
|
|
2421 ;; xdb (HP PARISC debugger) functions
|
|
|
2422
|
|
|
2423 ;;; History of argument lists passed to xdb.
|
|
|
2424 (defvar gud-xdb-history nil)
|
|
|
2425
|
|
|
2426 (defvar gud-xdb-directories nil
|
|
|
2427 "*A list of directories that xdb should search for source code.
|
|
|
2428 If nil, only source files in the program directory
|
|
|
2429 will be known to xdb.
|
|
|
2430
|
|
|
2431 The file names should be absolute, or relative to the directory
|
|
|
2432 containing the executable being debugged.")
|
|
|
2433
|
|
|
2434 (defun gud-xdb-massage-args (file args)
|
|
|
2435 (nconc (let ((directories gud-xdb-directories)
|
|
|
2436 (result nil))
|
|
|
2437 (while directories
|
|
|
2438 (setq result (cons (car directories) (cons "-d" result)))
|
|
|
2439 (setq directories (cdr directories)))
|
|
|
2440 (nreverse (cons file result)))
|
|
|
2441 args))
|
|
|
2442
|
|
|
2443 (defun gud-xdb-file-name (f)
|
|
|
2444 "Transform a relative pathname to a full pathname in xdb mode"
|
|
|
2445 (let ((result nil))
|
|
|
2446 (if (file-exists-p f)
|
|
|
2447 (setq result (expand-file-name f))
|
|
|
2448 (let ((directories gud-xdb-directories))
|
|
|
2449 (while directories
|
|
|
2450 (let ((path (concat (car directories) "/" f)))
|
|
|
2451 (if (file-exists-p path)
|
|
|
2452 (setq result (expand-file-name path)
|
|
|
2453 directories nil)))
|
|
|
2454 (setq directories (cdr directories)))))
|
|
|
2455 result))
|
|
|
2456
|
|
|
2457 ;; xdb does not print the lines all at once, so we have to accumulate them
|
|
|
2458 (defvar gud-xdb-accumulation "")
|
|
|
2459
|
|
|
2460 (defun gud-xdb-marker-filter (string)
|
|
|
2461 (let (result)
|
|
|
2462 (if (or (string-match comint-prompt-regexp string)
|
|
|
2463 (string-match ".*\012" string))
|
|
|
2464 (setq result (concat gud-xdb-accumulation string)
|
|
|
2465 gud-xdb-accumulation "")
|
|
|
2466 (setq gud-xdb-accumulation (concat gud-xdb-accumulation string)))
|
|
|
2467 (if result
|
|
|
2468 (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\):" result)
|
|
|
2469 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
|
|
|
2470 result))
|
|
|
2471 (let ((line (string-to-int
|
|
|
2472 (substring result (match-beginning 2) (match-end 2))))
|
|
|
2473 (file (gud-xdb-file-name
|
|
|
2474 (substring result (match-beginning 1) (match-end 1)))))
|
|
|
2475 (if file
|
|
|
2476 (setq gud-last-frame (cons file line))))))
|
|
|
2477 (or result "")))
|
|
|
2478
|
|
|
2479 (defun gud-xdb-find-file (f)
|
|
|
2480 (let ((realf (gud-xdb-file-name f)))
|
|
|
2481 (if realf (find-file-noselect realf))))
|
|
|
2482
|
|
|
2483 ;;;###autoload
|
|
|
2484 (defun xdb (command-line)
|
|
|
2485 "Run xdb on program FILE in buffer *gud-FILE*.
|
|
|
2486 The directory containing FILE becomes the initial working directory
|
|
|
2487 and source-file directory for your debugger.
|
|
|
2488
|
|
|
2489 You can set the variable 'gud-xdb-directories' to a list of program source
|
|
|
2490 directories if your program contains sources from more than one directory."
|
|
|
2491 (interactive
|
|
|
2492 (list (read-from-minibuffer "Run xdb (like this): "
|
|
|
2493 (if (consp gud-xdb-history)
|
|
|
2494 (car gud-xdb-history)
|
|
|
2495 "xdb ")
|
|
|
2496 nil nil
|
|
|
2497 '(gud-xdb-history . 1))))
|
|
|
2498 (gud-overload-functions '((gud-massage-args . gud-xdb-massage-args)
|
|
|
2499 (gud-marker-filter . gud-xdb-marker-filter)
|
|
|
2500 (gud-find-file . gud-xdb-find-file)))
|
|
|
2501
|
|
|
2502 (gud-common-init command-line "xdb")
|
|
|
2503
|
|
|
2504 (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.")
|
|
|
2505 (gud-def gud-tbreak "b %f:%l\\t" "\C-t"
|
|
|
2506 "Set temporary breakpoint at current line.")
|
|
|
2507 (gud-def gud-remove "db" "\C-d" "Remove breakpoint at current line")
|
|
|
2508 (gud-def gud-step "s %p" "\C-s" "Step one line with display.")
|
|
|
2509 (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).")
|
|
|
2510 (gud-def gud-cont "c" "\C-r" "Continue with display.")
|
|
|
2511 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.")
|
|
|
2512 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.")
|
|
|
2513 (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.")
|
|
|
2514 (gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.")
|
|
|
2515
|
|
|
2516 (setq comint-prompt-regexp "^>")
|
|
|
2517 (make-local-variable 'gud-xdb-accumulation)
|
|
|
2518 (setq gud-xdb-accumulation "")
|
|
|
2519 (run-hooks 'xdb-mode-hook))
|
|
|
2520
|
|
|
2521 ;; ======================================================================
|
|
|
2522 ;; perldb functions
|
|
|
2523
|
|
|
2524 ;;; History of argument lists passed to perldb.
|
|
|
2525 (defvar gud-perldb-history nil)
|
|
|
2526
|
|
|
2527 (defun gud-perldb-massage-args (file args)
|
|
|
2528 (cons "-d" (cons file (cons "-emacs" args))))
|
|
|
2529
|
|
|
2530 ;; There's no guarantee that Emacs will hand the filter the entire
|
|
|
2531 ;; marker at once; it could be broken up across several strings. We
|
|
|
2532 ;; might even receive a big chunk with several markers in it. If we
|
|
|
2533 ;; receive a chunk of text which looks like it might contain the
|
|
|
2534 ;; beginning of a marker, we save it here between calls to the
|
|
|
2535 ;; filter.
|
|
|
2536 (defvar gud-perldb-marker-acc "")
|
|
|
2537
|
|
|
2538 (defun gud-perldb-marker-filter (string)
|
|
|
2539 (save-match-data
|
|
|
2540 (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string))
|
|
|
2541 (let ((output ""))
|
|
|
2542
|
|
|
2543 ;; Process all the complete markers in this chunk.
|
|
|
2544 (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
|
|
|
2545 gud-perldb-marker-acc)
|
|
|
2546 (setq
|
|
|
2547
|
|
|
2548 ;; Extract the frame position from the marker.
|
|
|
2549 gud-last-frame
|
|
|
2550 (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1))
|
|
|
2551 (string-to-int (substring gud-perldb-marker-acc
|
|
|
2552 (match-beginning 2)
|
|
|
2553 (match-end 2))))
|
|
|
2554
|
|
|
2555 ;; Append any text before the marker to the output we're going
|
|
|
2556 ;; to return - we don't include the marker in this text.
|
|
|
2557 output (concat output
|
|
|
2558 (substring gud-perldb-marker-acc 0 (match-beginning 0)))
|
|
|
2559
|
|
|
2560 ;; Set the accumulator to the remaining text.
|
|
|
2561 gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-end 0))))
|
|
|
2562
|
|
|
2563 ;; Does the remaining text look like it might end with the
|
|
|
2564 ;; beginning of another marker? If it does, then keep it in
|
|
|
2565 ;; gud-perldb-marker-acc until we receive the rest of it. Since we
|
|
|
2566 ;; know the full marker regexp above failed, it's pretty simple to
|
|
|
2567 ;; test for marker starts.
|
|
|
2568 (if (string-match "^\032.*\\'" gud-perldb-marker-acc)
|
|
|
2569 (progn
|
|
|
2570 ;; Everything before the potential marker start can be output.
|
|
|
2571 (setq output (concat output (substring gud-perldb-marker-acc
|
|
|
2572 0 (match-beginning 0))))
|
|
|
2573
|
|
|
2574 ;; Everything after, we save, to combine with later input.
|
|
|
2575 (setq gud-perldb-marker-acc
|
|
|
2576 (substring gud-perldb-marker-acc (match-beginning 0))))
|
|
|
2577
|
|
|
2578 (setq output (concat output gud-perldb-marker-acc)
|
|
|
2579 gud-perldb-marker-acc ""))
|
|
|
2580
|
|
|
2581 output)))
|
|
|
2582
|
|
|
2583 (defun gud-perldb-find-file (f)
|
|
|
2584 (find-file-noselect f))
|
|
|
2585
|
|
|
2586 ;;;###autoload
|
|
|
2587 (defun perldb (command-line)
|
|
|
2588 "Run perldb on program FILE in buffer *gud-FILE*.
|
|
|
2589 The directory containing FILE becomes the initial working directory
|
|
|
2590 and source-file directory for your debugger."
|
|
|
2591 (interactive
|
|
|
2592 (list (read-from-minibuffer "Run perldb (like this): "
|
|
|
2593 (if (consp gud-perldb-history)
|
|
|
2594 (car gud-perldb-history)
|
|
|
2595 "perl ")
|
|
|
2596 nil nil
|
|
|
2597 '(gud-perldb-history . 1))))
|
|
|
2598 (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args)
|
|
|
2599 (gud-marker-filter . gud-perldb-marker-filter)
|
|
|
2600 (gud-find-file . gud-perldb-find-file)
|
|
|
2601 ))
|
|
|
2602
|
|
|
2603 (gud-common-init command-line "perldb")
|
|
|
2604
|
|
|
2605 (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.")
|
|
|
2606 (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line")
|
|
|
2607 (gud-def gud-step "s" "\C-s" "Step one source line with display.")
|
|
|
2608 (gud-def gud-next "n" "\C-n" "Step one line (skip functions).")
|
|
|
2609 (gud-def gud-cont "c" "\C-r" "Continue with display.")
|
|
|
2610 ; (gud-def gud-finish "finish" "\C-f" "Finish executing current function.")
|
|
|
2611 ; (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
|
|
|
2612 ; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
|
|
|
2613 (gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.")
|
|
|
2614
|
|
|
2615 (setq comint-prompt-regexp "^ DB<[0-9]+> ")
|
|
|
2616 (run-hooks 'perldb-mode-hook)
|
|
|
2617 )
|
|
|
2618
|
|
|
2619 ;;
|
|
|
2620 ;; End of debugger-specific information
|
|
|
2621 ;;
|
|
|
2622
|
|
|
2623
|
|
|
2624 ;;; When we send a command to the debugger via gud-call, it's annoying
|
|
|
2625 ;;; to see the command and the new prompt inserted into the debugger's
|
|
|
2626 ;;; buffer; we have other ways of knowing the command has completed.
|
|
|
2627 ;;;
|
|
|
2628 ;;; If the buffer looks like this:
|
|
|
2629 ;;; --------------------
|
|
|
2630 ;;; (gdb) set args foo bar
|
|
|
2631 ;;; (gdb) -!-
|
|
|
2632 ;;; --------------------
|
|
|
2633 ;;; (the -!- marks the location of point), and we type `C-x SPC' in a
|
|
|
2634 ;;; source file to set a breakpoint, we want the buffer to end up like
|
|
|
2635 ;;; this:
|
|
|
2636 ;;; --------------------
|
|
|
2637 ;;; (gdb) set args foo bar
|
|
|
2638 ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49.
|
|
|
2639 ;;; (gdb) -!-
|
|
|
2640 ;;; --------------------
|
|
|
2641 ;;; Essentially, the old prompt is deleted, and the command's output
|
|
|
2642 ;;; and the new prompt take its place.
|
|
|
2643 ;;;
|
|
|
2644 ;;; Not echoing the command is easy enough; you send it directly using
|
|
|
2645 ;;; comint-input-sender, and it never enters the buffer. However,
|
|
|
2646 ;;; getting rid of the old prompt is trickier; you don't want to do it
|
|
|
2647 ;;; when you send the command, since that will result in an annoying
|
|
|
2648 ;;; flicker as the prompt is deleted, redisplay occurs while Emacs
|
|
|
2649 ;;; waits for a response from the debugger, and the new prompt is
|
|
|
2650 ;;; inserted. Instead, we'll wait until we actually get some output
|
|
|
2651 ;;; from the subprocess before we delete the prompt. If the command
|
|
|
2652 ;;; produced no output other than a new prompt, that prompt will most
|
|
|
2653 ;;; likely be in the first chunk of output received, so we will delete
|
|
|
2654 ;;; the prompt and then replace it with an identical one. If the
|
|
|
2655 ;;; command produces output, the prompt is moving anyway, so the
|
|
|
2656 ;;; flicker won't be annoying.
|
|
|
2657 ;;;
|
|
|
2658 ;;; So - when we want to delete the prompt upon receipt of the next
|
|
|
2659 ;;; chunk of debugger output, we position gud-delete-prompt-marker at
|
|
|
2660 ;;; the start of the prompt; the process filter will notice this, and
|
|
|
2661 ;;; delete all text between it and the process output marker. If
|
|
|
2662 ;;; gud-delete-prompt-marker points nowhere, we leave the current
|
|
|
2663 ;;; prompt alone.
|
|
|
2664 (defvar gud-delete-prompt-marker nil)
|
|
|
2665
|
|
|
2666
|
|
|
2667 (defvar gdbish-comint-mode-map (copy-keymap comint-mode-map))
|
|
|
2668 (define-key gdbish-comint-mode-map "\C-c\M-\C-r" 'gud-display-registers-buffer)
|
|
|
2669 (define-key gdbish-comint-mode-map "\C-c\M-\C-f" 'gud-display-stack-buffer)
|
|
|
2670 (define-key gdbish-comint-mode-map "\C-c\M-\C-b" 'gud-display-breakpoints-buffer)
|
|
|
2671
|
|
|
2672 (defun gud-mode ()
|
|
|
2673 "Major mode for interacting with an inferior debugger process.
|
|
|
2674
|
|
|
2675 You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx,
|
|
|
2676 or M-x xdb. Each entry point finishes by executing a hook; `gdb-mode-hook',
|
|
|
2677 `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively.
|
|
|
2678
|
|
|
2679 After startup, the following commands are available in both the GUD
|
|
|
2680 interaction buffer and any source buffer GUD visits due to a breakpoint stop
|
|
|
2681 or step operation:
|
|
|
2682
|
|
|
2683 \\[gud-break] sets a breakpoint at the current file and line. In the
|
|
|
2684 GUD buffer, the current file and line are those of the last breakpoint or
|
|
|
2685 step. In a source buffer, they are the buffer's file and current line.
|
|
|
2686
|
|
|
2687 \\[gud-remove] removes breakpoints on the current file and line.
|
|
|
2688
|
|
|
2689 \\[gud-refresh] displays in the source window the last line referred to
|
|
|
2690 in the gud buffer.
|
|
|
2691
|
|
|
2692 \\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line,
|
|
|
2693 step-one-line (not entering function calls), and step-one-instruction
|
|
|
2694 and then update the source window with the current file and position.
|
|
|
2695 \\[gud-cont] continues execution.
|
|
|
2696
|
|
|
2697 \\[gud-print] tries to find the largest C lvalue or function-call expression
|
|
|
2698 around point, and sends it to the debugger for value display.
|
|
|
2699
|
|
|
2700 The above commands are common to all supported debuggers except xdb which
|
|
|
2701 does not support stepping instructions.
|
|
|
2702
|
|
|
2703 Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break],
|
|
|
2704 except that the breakpoint is temporary; that is, it is removed when
|
|
|
2705 execution stops on it.
|
|
|
2706
|
|
|
2707 Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack
|
|
|
2708 frame. \\[gud-down] drops back down through one.
|
|
|
2709
|
|
|
2710 If you are using gdb or xdb, \\[gud-finish] runs execution to the return from
|
|
|
2711 the current function and stops.
|
|
|
2712
|
|
|
2713 All the keystrokes above are accessible in the GUD buffer
|
|
|
2714 with the prefix C-c, and in all buffers through the prefix C-x C-a.
|
|
|
2715
|
|
|
2716 All pre-defined functions for which the concept make sense repeat
|
|
|
2717 themselves the appropriate number of times if you give a prefix
|
|
|
2718 argument.
|
|
|
2719
|
|
|
2720 You may use the `gud-def' macro in the initialization hook to define other
|
|
|
2721 commands.
|
|
|
2722
|
|
|
2723 Other commands for interacting with the debugger process are inherited from
|
|
|
2724 comint mode, which see."
|
|
|
2725 (interactive)
|
|
|
2726 (comint-mode)
|
|
|
2727 (setq major-mode 'gud-mode)
|
|
|
2728 (setq mode-name "Debugger")
|
|
|
2729 (setq mode-line-process '(": %s"))
|
|
|
2730 (use-local-map (copy-keymap gdbish-comint-mode-map))
|
|
|
2731 (setq gud-last-frame nil)
|
|
|
2732 (make-local-variable 'comint-prompt-regexp)
|
|
|
2733 (make-local-variable 'gud-delete-prompt-marker)
|
|
|
2734 (setq gud-delete-prompt-marker (make-marker))
|
|
|
2735 (run-hooks 'gud-mode-hook)
|
|
|
2736 )
|
|
|
2737
|
|
|
2738 (defvar gud-comint-buffer nil)
|
|
|
2739
|
|
|
2740 ;; Chop STRING into words separated by SPC or TAB and return a list of them.
|
|
|
2741 (defun gud-chop-words (string)
|
|
|
2742 (let ((i 0) (beg 0)
|
|
|
2743 (len (length string))
|
|
|
2744 (words nil))
|
|
|
2745 (while (< i len)
|
|
|
2746 (if (memq (aref string i) '(?\t ? ))
|
|
|
2747 (progn
|
|
|
2748 (setq words (cons (substring string beg i) words)
|
|
|
2749 beg (1+ i))
|
|
|
2750 (while (and (< beg len) (memq (aref string beg) '(?\t ? )))
|
|
|
2751 (setq beg (1+ beg)))
|
|
|
2752 (setq i (1+ beg)))
|
|
|
2753 (setq i (1+ i))))
|
|
|
2754 (if (< beg len)
|
|
|
2755 (setq words (cons (substring string beg) words)))
|
|
|
2756 (nreverse words)))
|
|
|
2757
|
|
|
2758 (defvar gud-target-name "--unknown--"
|
|
|
2759 "The apparent name of the program being debugged in a gud buffer.
|
|
|
2760 For sure this the root string used in smashing together the gud
|
|
|
2761 buffer's name, even if that doesn't happen to be the name of a
|
|
|
2762 program.")
|
|
|
2763
|
|
|
2764 ;; Perform initializations common to all debuggers.
|
|
|
2765 (defun gud-common-init (command-line debugger-name)
|
|
|
2766 (let* ((words (gud-chop-words command-line))
|
|
|
2767 (program (car words))
|
|
|
2768 (file-word (let ((w (cdr words)))
|
|
|
2769 (while (and w (= ?- (aref (car w) 0)))
|
|
|
2770 (setq w (cdr w)))
|
|
|
2771 (car w)))
|
|
|
2772 (args (delq file-word (cdr words)))
|
|
|
2773 (file (and file-word (expand-file-name file-word)))
|
|
|
2774 (filepart (if file (file-name-nondirectory file) ""))
|
|
|
2775 (buffer-name (concat "*" debugger-name
|
|
|
2776 (and (string< "" filepart)
|
|
|
2777 (concat "-" filepart)) "*")))
|
|
|
2778 (switch-to-buffer buffer-name)
|
|
|
2779 (if file
|
|
|
2780 (setq default-directory (file-name-directory file)))
|
|
|
2781 (or (bolp) (newline))
|
|
|
2782 (insert "Current directory is " default-directory "\n")
|
|
|
2783 (let ((old-instance gdb-buffer-instance))
|
|
|
2784 (apply 'make-comint (concat debugger-name
|
|
|
2785 (and (string< "" filepart)
|
|
|
2786 (concat "-" filepart)))
|
|
|
2787 program nil
|
|
|
2788 ;; There *has* to be an easier way to strip "nil"s from the output
|
|
|
2789 ;; of gud-massage-args
|
|
|
2790 (apply 'append (mapcar '(lambda (arg) (if (stringp arg) (list arg) arg))
|
|
|
2791 (gud-massage-args file args))))
|
|
|
2792 (gud-mode)
|
|
|
2793 (make-variable-buffer-local 'old-gdb-buffer-instance)
|
|
|
2794 (setq old-gdb-buffer-instance old-instance))
|
|
|
2795 (make-variable-buffer-local 'gud-target-name)
|
|
|
2796 (setq gud-target-name filepart))
|
|
|
2797 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
|
|
|
2798 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
|
|
|
2799 (gud-set-buffer)
|
|
|
2800 )
|
|
|
2801
|
|
|
2802 (defun gud-set-buffer ()
|
|
|
2803 (cond ((eq major-mode 'gud-mode)
|
|
|
2804 (setq gud-comint-buffer (current-buffer)))))
|
|
|
2805
|
|
|
2806 ;; These functions are responsible for inserting output from your debugger
|
|
|
2807 ;; into the buffer. The hard work is done by the method that is
|
|
|
2808 ;; the value of gud-marker-filter.
|
|
|
2809
|
|
|
2810 (defun gud-filter (proc string)
|
|
|
2811 ;; Here's where the actual buffer insertion is done
|
|
|
2812 (let ((inhibit-quit t))
|
|
|
2813 (save-excursion
|
|
|
2814 (set-buffer (process-buffer proc))
|
|
|
2815 (let (moving output-after-point)
|
|
|
2816 (save-excursion
|
|
|
2817 (goto-char (process-mark proc))
|
|
|
2818 ;; If we have been so requested, delete the debugger prompt.
|
|
|
2819 (if (marker-buffer gud-delete-prompt-marker)
|
|
|
2820 (progn
|
|
|
2821 (delete-region (point) gud-delete-prompt-marker)
|
|
|
2822 (set-marker gud-delete-prompt-marker nil)))
|
|
|
2823 (insert-before-markers (gud-marker-filter string))
|
|
|
2824 (setq moving (= (point) (process-mark proc)))
|
|
|
2825 (setq output-after-point (< (point) (process-mark proc)))
|
|
|
2826 ;; Check for a filename-and-line number.
|
|
|
2827 ;; Don't display the specified file
|
|
|
2828 ;; unless (1) point is at or after the position where output appears
|
|
|
2829 ;; and (2) this buffer is on the screen.
|
|
|
2830 (if (and gud-last-frame
|
|
|
2831 (not output-after-point)
|
|
|
2832 (get-buffer-window (current-buffer)))
|
|
|
2833 (gud-display-frame)))
|
|
|
2834 (if moving (goto-char (process-mark proc)))))))
|
|
|
2835
|
|
|
2836 (defun gud-proc-died (proc)
|
|
|
2837 ;; Stop displaying an arrow in a source file.
|
|
|
2838 (setq overlay-arrow-position nil)
|
|
|
2839
|
|
|
2840 ;; Kill the dummy process, so that C-x C-c won't worry about it.
|
|
|
2841 (save-excursion
|
|
|
2842 (set-buffer (process-buffer proc))
|
|
|
2843 (let ((buf (gdb-get-instance-buffer gdb-buffer-instance
|
|
|
2844 'gdb-inferior-io)))
|
|
|
2845 (if buf
|
|
|
2846 (kill-process (get-buffer-process buf)))
|
|
|
2847 )))
|
|
|
2848
|
|
|
2849 (defun gud-sentinel (proc msg)
|
|
|
2850 (cond ((null (buffer-name (process-buffer proc)))
|
|
|
2851 ;; buffer killed
|
|
|
2852 (gud-proc-died proc)
|
|
|
2853 (set-process-buffer proc nil))
|
|
|
2854 ((memq (process-status proc) '(signal exit))
|
|
|
2855 (gud-proc-died proc)
|
|
|
2856
|
|
|
2857 ;; Fix the mode line.
|
|
|
2858 (setq mode-line-process
|
|
|
2859 (concat ": "
|
|
|
2860 (symbol-name (process-status proc))))
|
|
|
2861 (let* ((obuf (current-buffer)))
|
|
|
2862 ;; save-excursion isn't the right thing if
|
|
|
2863 ;; process-buffer is current-buffer
|
|
|
2864 (unwind-protect
|
|
|
2865 (progn
|
|
|
2866 ;; Write something in *compilation* and hack its mode line,
|
|
|
2867 (set-buffer (process-buffer proc))
|
|
|
2868 ;; Force mode line redisplay soon
|
|
|
2869 (set-buffer-modified-p (buffer-modified-p))
|
|
|
2870 (if (eobp)
|
|
|
2871 (insert ?\n mode-name " " msg)
|
|
|
2872 (save-excursion
|
|
|
2873 (goto-char (point-max))
|
|
|
2874 (insert ?\n mode-name " " msg)))
|
|
|
2875 ;; If buffer and mode line will show that the process
|
|
|
2876 ;; is dead, we can delete it now. Otherwise it
|
|
|
2877 ;; will stay around until M-x list-processes.
|
|
|
2878 (delete-process proc))
|
|
|
2879 ;; Restore old buffer, but don't restore old point
|
|
|
2880 ;; if obuf is the gud buffer.
|
|
|
2881 (set-buffer obuf))))))
|
|
|
2882
|
|
|
2883 (defun gud-display-frame ()
|
|
|
2884 "Find and obey the last filename-and-line marker from the debugger.
|
|
|
2885 Obeying it means displaying in another window the specified file and line."
|
|
|
2886 (interactive)
|
|
|
2887 (if gud-last-frame
|
|
|
2888 (progn
|
|
|
2889 ; (gud-set-buffer)
|
|
|
2890 (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
|
|
|
2891 (setq gud-last-last-frame gud-last-frame
|
|
|
2892 gud-last-frame nil))))
|
|
|
2893
|
|
|
2894 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
|
|
|
2895 ;; and that its line LINE is visible.
|
|
|
2896 ;; Put the overlay-arrow on the line LINE in that buffer.
|
|
|
2897 ;; Most of the trickiness in here comes from wanting to preserve the current
|
|
|
2898 ;; region-restriction if that's possible. We use an explicit display-buffer
|
|
|
2899 ;; to get around the fact that this is called inside a save-excursion.
|
|
|
2900
|
|
|
2901 (defun gud-display-line (true-file line)
|
|
|
2902 (let* ((buffer (gud-find-file true-file))
|
|
|
2903 (window (gud-display-source-buffer buffer))
|
|
|
2904 (pos))
|
|
|
2905 (if (not window)
|
|
|
2906 (error "foo bar baz"))
|
|
|
2907 ;;; (if (equal buffer (current-buffer))
|
|
|
2908 ;;; nil
|
|
|
2909 ;;; (setq buffer-read-only nil))
|
|
|
2910 (save-excursion
|
|
|
2911 ;;; (setq buffer-read-only t)
|
|
|
2912 (set-buffer buffer)
|
|
|
2913 (save-restriction
|
|
|
2914 (widen)
|
|
|
2915 (goto-line line)
|
|
|
2916 (setq pos (point))
|
|
|
2917 (setq overlay-arrow-string "=>")
|
|
|
2918 (or overlay-arrow-position
|
|
|
2919 (setq overlay-arrow-position (make-marker)))
|
|
|
2920 (set-marker overlay-arrow-position (point) (current-buffer)))
|
|
|
2921 (cond ((or (< pos (point-min)) (> pos (point-max)))
|
|
|
2922 (widen)
|
|
|
2923 (goto-char pos))))
|
|
|
2924 (set-window-point window overlay-arrow-position)))
|
|
|
2925
|
|
|
2926 ;;; The gud-call function must do the right thing whether its invoking
|
|
|
2927 ;;; keystroke is from the GUD buffer itself (via major-mode binding)
|
|
|
2928 ;;; or a C buffer. In the former case, we want to supply data from
|
|
|
2929 ;;; gud-last-frame. Here's how we do it:
|
|
|
2930
|
|
|
2931 (defun gud-format-command (str arg)
|
|
|
2932 (let ((insource (not (eq (current-buffer) gud-comint-buffer))))
|
|
|
2933 (if (string-match "\\(.*\\)%f\\(.*\\)" str)
|
|
|
2934 (setq str (concat
|
|
|
2935 (substring str (match-beginning 1) (match-end 1))
|
|
|
2936 (file-name-nondirectory (if insource
|
|
|
2937 (buffer-file-name)
|
|
|
2938 (car gud-last-frame)))
|
|
|
2939 (substring str (match-beginning 2) (match-end 2)))))
|
|
|
2940 (if (string-match "\\(.*\\)%d\\(.*\\)" str)
|
|
|
2941 (setq str (concat
|
|
|
2942 (substring str (match-beginning 1) (match-end 1))
|
|
|
2943 (file-name-directory (if insource
|
|
|
2944 (buffer-file-name)
|
|
|
2945 (car gud-last-frame)))
|
|
|
2946 (substring str (match-beginning 2) (match-end 2)))))
|
|
|
2947 (if (string-match "\\(.*\\)%l\\(.*\\)" str)
|
|
|
2948 (setq str (concat
|
|
|
2949 (substring str (match-beginning 1) (match-end 1))
|
|
|
2950 (if insource
|
|
|
2951 (save-excursion
|
|
|
2952 (beginning-of-line)
|
|
|
2953 (save-restriction (widen)
|
|
|
2954 (1+ (count-lines 1 (point)))))
|
|
|
2955 (cdr gud-last-frame))
|
|
|
2956 (substring str (match-beginning 2) (match-end 2)))))
|
|
|
2957 (if (string-match "\\(.*\\)%e\\(.*\\)" str)
|
|
|
2958 (setq str (concat
|
|
|
2959 (substring str (match-beginning 1) (match-end 1))
|
|
|
2960 (find-c-expr)
|
|
|
2961 (substring str (match-beginning 2) (match-end 2)))))
|
|
|
2962 (if (string-match "\\(.*\\)%a\\(.*\\)" str)
|
|
|
2963 (setq str (concat
|
|
|
2964 (substring str (match-beginning 1) (match-end 1))
|
|
|
2965 (gud-read-address)
|
|
|
2966 (substring str (match-beginning 2) (match-end 2)))))
|
|
|
2967 (if (string-match "\\(.*\\)%p\\(.*\\)" str)
|
|
|
2968 (setq str (concat
|
|
|
2969 (substring str (match-beginning 1) (match-end 1))
|
|
|
2970 (if arg (int-to-string arg) "")
|
|
|
2971 (substring str (match-beginning 2) (match-end 2)))))
|
|
|
2972 )
|
|
|
2973 str
|
|
|
2974 )
|
|
|
2975
|
|
|
2976 (defun gud-read-address ()
|
|
|
2977 "Return a string containing the core-address found in the buffer at point."
|
|
|
2978 (save-excursion
|
|
|
2979 (let ((pt (point)) found begin)
|
|
|
2980 (setq found (if (search-backward "0x" (- pt 7) t) (point)))
|
|
|
2981 (cond
|
|
|
2982 (found (forward-char 2)
|
|
|
2983 (buffer-substring found
|
|
|
2984 (progn (re-search-forward "[^0-9a-f]")
|
|
|
2985 (forward-char -1)
|
|
|
2986 (point))))
|
|
|
2987 (t (setq begin (progn (re-search-backward "[^0-9]")
|
|
|
2988 (forward-char 1)
|
|
|
2989 (point)))
|
|
|
2990 (forward-char 1)
|
|
|
2991 (re-search-forward "[^0-9]")
|
|
|
2992 (forward-char -1)
|
|
|
2993 (buffer-substring begin (point)))))))
|
|
|
2994
|
|
|
2995 (defun gud-call (fmt &optional arg)
|
|
|
2996 (let ((msg (gud-format-command fmt arg)))
|
|
|
2997 (message "Command: %s" msg)
|
|
|
2998 (sit-for 0)
|
|
|
2999 (gud-basic-call msg)))
|
|
|
3000
|
|
|
3001 (defun gud-basic-call (command)
|
|
|
3002 "Invoke the debugger COMMAND displaying source in other window."
|
|
|
3003 (interactive)
|
|
|
3004 (gud-set-buffer)
|
|
|
3005 (let ((proc (get-buffer-process gud-comint-buffer)))
|
|
|
3006
|
|
|
3007 ;; Arrange for the current prompt to get deleted.
|
|
|
3008 (save-excursion
|
|
|
3009 (set-buffer gud-comint-buffer)
|
|
|
3010 (goto-char (process-mark proc))
|
|
|
3011 (beginning-of-line)
|
|
|
3012 (if (looking-at comint-prompt-regexp)
|
|
|
3013 (set-marker gud-delete-prompt-marker (point)))
|
|
|
3014 (apply comint-input-sender (list proc command)))))
|
|
|
3015
|
|
|
3016 (defun gud-refresh (&optional arg)
|
|
|
3017 "Fix up a possibly garbled display, and redraw the arrow."
|
|
|
3018 (interactive "P")
|
|
|
3019 (recenter arg)
|
|
|
3020 (or gud-last-frame (setq gud-last-frame gud-last-last-frame))
|
|
|
3021 (gud-display-frame))
|
|
|
3022
|
|
|
3023 ;;; Count windows on a given frame
|
|
|
3024 ;;
|
|
|
3025 (defun count-frame-windows (frame &optional minibuf)
|
|
|
3026 "Returns the number of visible windows on FRAME.
|
|
|
3027 Optional arg NO-MINI non-nil means don't count the minibuffer
|
|
|
3028 even if it is active."
|
|
|
3029 (let ((count 0))
|
|
|
3030 (walk-windows (function (lambda (w)
|
|
|
3031 (if (eq (window-frame w) frame)
|
|
|
3032 (setq count (+ count 1)))))
|
|
|
3033 minibuf t)
|
|
|
3034 count))
|
|
|
3035
|
|
|
3036
|
|
|
3037 ;; Attempt to fit a frame so that it is just large enough to display buf
|
|
|
3038 ;; Only changes the frame size if it has just one window and we can only
|
|
|
3039 ;; make the attempt if the buffer has truncate-lines set (otherwise it's
|
|
|
3040 ;; too painful to work out how many lines we need.
|
|
|
3041 ;; Doesn't even *attempt* to cope with fontified buffers.
|
|
|
3042
|
|
|
3043 (defun fit-frame-to-buffer (frame buf)
|
|
|
3044 (let (height-needed)
|
|
|
3045 (if (and frame
|
|
|
3046 truncate-lines
|
|
|
3047 (<= (count-frame-windows frame) 1))
|
|
|
3048 (progn
|
|
|
3049 (setq height-needed
|
|
|
3050 (+ (count-lines (point-min) (point-max)) 2))
|
|
|
3051 (cond
|
|
|
3052 ((> (frame-height frame) height-needed)
|
|
|
3053 (set-frame-height frame height-needed))
|
|
|
3054 ((< height-needed 24)
|
|
|
3055 (set-frame-height frame height-needed))
|
|
|
3056 (t
|
|
|
3057 (set-frame-height frame 24)))))))
|
|
|
3058
|
|
|
3059 ;;; Code for parsing expressions out of C code. The single entry point is
|
|
|
3060 ;;; find-c-expr, which tries to return an lvalue expression from around point.
|
|
|
3061 ;;;
|
|
|
3062 ;;; The rest of this file is a hacked version of gdbsrc.el by
|
|
|
3063 ;;; Debby Ayers <ayers@asc.slb.com>,
|
|
|
3064 ;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx.
|
|
|
3065
|
|
|
3066 (defun find-c-expr ()
|
|
|
3067 "Returns the C expr that surrounds point."
|
|
|
3068 (interactive)
|
|
|
3069 (save-excursion
|
|
|
3070 (let ((p) (expr) (test-expr))
|
|
|
3071 (setq p (point))
|
|
|
3072 (setq expr (expr-cur))
|
|
|
3073 (setq test-expr (expr-prev))
|
|
|
3074 (while (expr-compound test-expr expr)
|
|
|
3075 (setq expr (cons (car test-expr) (cdr expr)))
|
|
|
3076 (goto-char (car expr))
|
|
|
3077 (setq test-expr (expr-prev)))
|
|
|
3078 (goto-char p)
|
|
|
3079 (setq test-expr (expr-next))
|
|
|
3080 (while (expr-compound expr test-expr)
|
|
|
3081 (setq expr (cons (car expr) (cdr test-expr)))
|
|
|
3082 (setq test-expr (expr-next))
|
|
|
3083 )
|
|
|
3084 (buffer-substring (car expr) (cdr expr)))))
|
|
|
3085
|
|
|
3086 (defun expr-cur ()
|
|
|
3087 "Returns the expr that point is in; point is set to beginning of expr.
|
|
|
3088 The expr is represented as a cons cell, where the car specifies the point in
|
|
|
3089 the current buffer that marks the beginning of the expr and the cdr specifies
|
|
|
3090 the character after the end of the expr."
|
|
|
3091 (let ((p (point)) (begin) (end))
|
|
|
3092 (expr-backward-sexp)
|
|
|
3093 (setq begin (point))
|
|
|
3094 (expr-forward-sexp)
|
|
|
3095 (setq end (point))
|
|
|
3096 (if (>= p end)
|
|
|
3097 (progn
|
|
|
3098 (setq begin p)
|
|
|
3099 (goto-char p)
|
|
|
3100 (expr-forward-sexp)
|
|
|
3101 (setq end (point))
|
|
|
3102 )
|
|
|
3103 )
|
|
|
3104 (goto-char begin)
|
|
|
3105 (cons begin end)))
|
|
|
3106
|
|
|
3107 (defun expr-backward-sexp ()
|
|
|
3108 "Version of `backward-sexp' that catches errors."
|
|
|
3109 (condition-case nil
|
|
|
3110 (backward-sexp)
|
|
|
3111 (error t)))
|
|
|
3112
|
|
|
3113 (defun expr-forward-sexp ()
|
|
|
3114 "Version of `forward-sexp' that catches errors."
|
|
|
3115 (condition-case nil
|
|
|
3116 (forward-sexp)
|
|
|
3117 (error t)))
|
|
|
3118
|
|
|
3119 (defun expr-prev ()
|
|
|
3120 "Returns the previous expr, point is set to beginning of that expr.
|
|
|
3121 The expr is represented as a cons cell, where the car specifies the point in
|
|
|
3122 the current buffer that marks the beginning of the expr and the cdr specifies
|
|
|
3123 the character after the end of the expr"
|
|
|
3124 (let ((begin) (end))
|
|
|
3125 (expr-backward-sexp)
|
|
|
3126 (setq begin (point))
|
|
|
3127 (expr-forward-sexp)
|
|
|
3128 (setq end (point))
|
|
|
3129 (goto-char begin)
|
|
|
3130 (cons begin end)))
|
|
|
3131
|
|
|
3132 (defun expr-next ()
|
|
|
3133 "Returns the following expr, point is set to beginning of that expr.
|
|
|
3134 The expr is represented as a cons cell, where the car specifies the point in
|
|
|
3135 the current buffer that marks the beginning of the expr and the cdr specifies
|
|
|
3136 the character after the end of the expr."
|
|
|
3137 (let ((begin) (end))
|
|
|
3138 (expr-forward-sexp)
|
|
|
3139 (expr-forward-sexp)
|
|
|
3140 (setq end (point))
|
|
|
3141 (expr-backward-sexp)
|
|
|
3142 (setq begin (point))
|
|
|
3143 (cons begin end)))
|
|
|
3144
|
|
|
3145 (defun expr-compound-sep (span-start span-end)
|
|
|
3146 "Returns '.' for '->' & '.', returns ' ' for white space,
|
|
|
3147 returns '?' for other punctuation."
|
|
|
3148 (let ((result ? )
|
|
|
3149 (syntax))
|
|
|
3150 (while (< span-start span-end)
|
|
|
3151 (setq syntax (char-syntax (char-after span-start)))
|
|
|
3152 (cond
|
|
|
3153 ((= syntax ? ) t)
|
|
|
3154 ((= syntax ?.) (setq syntax (char-after span-start))
|
|
|
3155 (cond
|
|
|
3156 ((= syntax ?.) (setq result ?.))
|
|
|
3157 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
|
|
|
3158 (setq result ?.)
|
|
|
3159 (setq span-start (+ span-start 1)))
|
|
|
3160 (t (setq span-start span-end)
|
|
|
3161 (setq result ??)))))
|
|
|
3162 (setq span-start (+ span-start 1)))
|
|
|
3163 result))
|
|
|
3164
|
|
|
3165 (defun expr-compound (first second)
|
|
|
3166 "Non-nil if concatenating FIRST and SECOND makes a single C token.
|
|
|
3167 The two exprs are represented as a cons cells, where the car
|
|
|
3168 specifies the point in the current buffer that marks the beginning of the
|
|
|
3169 expr and the cdr specifies the character after the end of the expr.
|
|
|
3170 Link exprs of the form:
|
|
|
3171 Expr -> Expr
|
|
|
3172 Expr . Expr
|
|
|
3173 Expr (Expr)
|
|
|
3174 Expr [Expr]
|
|
|
3175 (Expr) Expr
|
|
|
3176 [Expr] Expr"
|
|
|
3177 (let ((span-start (cdr first))
|
|
|
3178 (span-end (car second))
|
|
|
3179 (syntax))
|
|
|
3180 (setq syntax (expr-compound-sep span-start span-end))
|
|
|
3181 (cond
|
|
|
3182 ((= (car first) (car second)) nil)
|
|
|
3183 ((= (cdr first) (cdr second)) nil)
|
|
|
3184 ((= syntax ?.) t)
|
|
|
3185 ((= syntax ? )
|
|
|
3186 (setq span-start (char-after (- span-start 1)))
|
|
|
3187 (setq span-end (char-after span-end))
|
|
|
3188 (cond
|
|
|
3189 ((= span-start ?) ) t )
|
|
|
3190 ((= span-start ?] ) t )
|
|
|
3191 ((= span-end ?( ) t )
|
|
|
3192 ((= span-end ?[ ) t )
|
|
|
3193 (t nil))
|
|
|
3194 )
|
|
|
3195 (t nil))))
|
|
|
3196
|
|
|
3197
|
|
|
3198 ;;; Compare two buffers. We assume that they're not narrowed.
|
|
|
3199 (defun gud-buffers-differ (buffer1 buffer2)
|
|
|
3200 (save-excursion
|
|
|
3201 (let ((size1 (progn (set-buffer buffer1) (buffer-size)))
|
|
|
3202 (size2 (progn (set-buffer buffer2) (buffer-size))))
|
|
|
3203 (cond
|
|
|
3204 ((not (= size1 size2))
|
|
|
3205 t)
|
|
|
3206 ((= (compare-buffer-substrings
|
|
|
3207 buffer1 1 size1
|
|
|
3208 buffer2 1 size2) 0)
|
|
|
3209 nil)
|
|
|
3210 (t)))))
|
|
|
3211
|
|
|
3212
|
|
|
3213 (provide 'gud)
|
|
|
3214
|
|
|
3215 ;; WTF
|
|
|
3216 (defmacro gud (form)
|
|
|
3217 (` (save-excursion (set-buffer "*gud-a.out*") (, form))))
|
|
|
3218
|
|
|
3219 (defun dbug (foo &optional fun)
|
|
|
3220 (save-excursion
|
|
|
3221 (set-buffer (get-buffer-create "*trace*"))
|
|
|
3222 (goto-char (point-max))
|
|
|
3223 (insert "***" (symbol-name foo) "\n")
|
|
|
3224 (if fun
|
|
|
3225 (funcall fun))))
|
|
|
3226
|
|
|
3227
|
|
|
3228
|
|
|
3229 ;;; gud.el ends here
|
