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