1 ;;; gdb-ui.el --- User Interface for running GDB
3 ;; Author: Nick Roberts <nick@nick.uklinux.net>
5 ;; Keywords: unix, tools
7 ;; Copyright (C) 2002 Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; This mode acts as a graphical user interface to GDB. You can interact with
29 ;; GDB through the GUD buffer in the usual way, but there are also further
30 ;; buffers which control the execution and describe the state of your program.
31 ;; It separates the input/output of your program from that of GDB and displays
32 ;; expressions and their current values in their own buffers. It also uses
33 ;; features of Emacs 21 such as the display margin for breakpoints, and the
34 ;; toolbar (see the GDB Graphical Interface section in the Emacs info manual).
36 ;; Start the debugger with M-x gdba.
38 ;; This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim
39 ;; Kingdon and uses GDB's annotation interface. You don't need to know about
40 ;; annotations to use this mode as a debugger, but if you are interested
41 ;; developing the mode itself, then see the Annotations section in the GDB
45 ;; Does not auto-display arrays of structures or structures containing arrays.
46 ;; On MS Windows, Gdb 5.1.1 from MinGW 2.0 does not flush the output from the
53 (defvar gdb-current-address
"main" "Initialisation for Assembler buffer.")
54 (defvar gdb-previous-address nil
)
55 (defvar gdb-previous-frame nil
)
56 (defvar gdb-current-frame
"main")
57 (defvar gdb-view-source t
"Non-nil means that source code can be viewed")
58 (defvar gdb-selected-view
'source
"Code type that user wishes to view")
59 (defvar gdb-var-list nil
"List of variables in watch window")
60 (defvar gdb-var-changed nil
"Non-nil means that gdb-var-list has changed")
61 (defvar gdb-update-flag t
"Non-il means update buffers")
62 (defvar gdb-buffer-type nil
)
63 (defvar gdb-variables
'()
64 "A list of variables that are local to the GUD buffer.")
67 (defun gdba (command-line)
68 "Run gdb on program FILE in buffer *gud-FILE*.
69 The directory containing FILE becomes the initial working directory
70 and source-file directory for your debugger.
72 If `gdb-many-windows' is nil (the default value) then gdb starts with
73 just two windows : the GUD and the source buffer. If it is t the
74 following layout will appear (keybindings given in relevant buffer) :
76 ---------------------------------------------------------------------
78 ---------------------------------------------------------------------
79 GUD buffer (I/O of GDB) | Locals buffer
83 ---------------------------------------------------------------------
84 Source buffer | Input/Output (of debuggee) buffer
92 ---------------------------------------------------------------------
93 Stack buffer | Breakpoints buffer
94 RET gdb-frames-select | SPC gdb-toggle-breakpoint
95 | RET gdb-goto-breakpoint
96 | d gdb-delete-breakpoint
97 ---------------------------------------------------------------------
99 All the buffers share the toolbar and source should always display in the same
100 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
101 icons are displayed both by setting a break with gud-break and by typing break
104 This works best (depending on the size of your monitor) using most of the
107 Displayed expressions appear in separate frames. Arrays may be displayed
108 as slices and visualised using the graph program from plotutils if installed.
109 Pointers in structures may be followed in a tree-like fashion.
111 The following interactive lisp functions help control operation :
113 `gdb-many-windows' - Toggle the number of windows gdb uses.
114 `gdb-restore-windows' - To restore the window layout."
116 (interactive (list (gud-query-cmdline 'gdba
)))
118 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
121 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
122 (set (make-local-variable 'gud-marker-filter
) 'gud-gdba-marker-filter
)
124 (gud-def gud-break
(if (not (string-equal mode-name
"Assembler"))
125 (gud-call "break %f:%l" arg
)
129 (gud-call "break *%a" arg
)))
130 "\C-b" "Set breakpoint at current line or address.")
132 (gud-def gud-remove
(if (not (string-equal mode-name
"Assembler"))
133 (gud-call "clear %f:%l" arg
)
137 (gud-call "clear *%a" arg
)))
138 "\C-d" "Remove breakpoint at current line or address.")
140 (gud-def gud-until
(if (not (string-equal mode-name
"Assembler"))
141 (gud-call "until %f:%l" arg
)
145 (gud-call "until *%a" arg
)))
146 "\C-u" "Continue to current line or address.")
148 (setq comint-input-sender
'gdb-send
)
151 (setq gdb-current-address
"main")
152 (setq gdb-previous-address nil
)
153 (setq gdb-previous-frame nil
)
154 (setq gdb-current-frame
"main")
155 (setq gdb-view-source t
)
156 (setq gdb-selected-view
'source
)
157 (setq gdb-var-list nil
)
158 (setq gdb-var-changed nil
)
159 (setq gdb-update-flag t
)
161 (mapc 'make-local-variable gdb-variables
)
162 (setq gdb-buffer-type
'gdba
)
164 (gdb-clear-inferior-io)
166 (if (eq window-system
'w32
)
167 (gdb-enqueue-input (list "set new-console off\n" 'ignore
)))
168 (gdb-enqueue-input (list "set height 0\n" 'ignore
))
169 ;; find source file and compilation directory here
170 (gdb-enqueue-input (list "server list main\n" 'ignore
)) ; C program
171 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore
)) ; Fortran program
172 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info
))
174 (run-hooks 'gdba-mode-hook
))
179 (let ((expr (tooltip-identifier-from-point (point))))
180 (setq expr
(concat gdb-current-frame
"::" expr
))
181 (catch 'already-watched
182 (dolist (var gdb-var-list
)
183 (if (string-equal expr
(car var
)) (throw 'already-watched nil
)))
185 (list (concat "interpreter mi \"-var-create - * " expr
"\"\n")
186 `(lambda () (gdb-var-create-handler ,expr
))))))
187 (select-window (get-buffer-window gud-comint-buffer
)))
189 (defconst gdb-var-create-regexp
190 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
192 (defun gdb-var-create-handler (expr)
193 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
194 (goto-char (point-min))
195 (if (re-search-forward gdb-var-create-regexp nil t
)
196 (let ((var (list expr
197 (match-string-no-properties 1)
198 (match-string-no-properties 2)
199 (match-string-no-properties 3)
201 (push var gdb-var-list
)
203 (if (equal (nth 2 var
) "0")
205 (list (concat "interpreter mi \"-var-evaluate-expression "
207 `(lambda () (gdb-var-evaluate-expression-handler
209 (setq gdb-var-changed t
)))
210 (if (re-search-forward "Undefined command" nil t
)
211 (message "Watching expressions requires gdb 6.0 onwards")
212 (message "No symbol %s in current context." expr
)))))
214 (defun gdb-var-evaluate-expression-handler (varnum)
215 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
216 (goto-char (point-min))
217 (re-search-forward ".*value=\"\\(.*?\\)\"" nil t
)
218 (let ((var-list nil
))
219 (dolist (var gdb-var-list
)
220 (if (string-equal varnum
(cadr var
))
222 (push (nreverse (cons (match-string-no-properties 1)
223 (cdr (nreverse var
)))) var-list
))
224 (push var var-list
)))
225 (setq gdb-var-list
(nreverse var-list
))))
226 (setq gdb-var-changed t
))
228 (defun gdb-var-list-children (varnum)
230 (list (concat "interpreter mi \"-var-list-children " varnum
"\"\n")
231 `(lambda () (gdb-var-list-children-handler ,varnum
)))))
233 (defconst gdb-var-list-children-regexp
234 "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
236 (defun gdb-var-list-children-handler (varnum)
237 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
238 (goto-char (point-min))
239 (let ((var-list nil
))
240 (catch 'child-already-watched
241 (dolist (var gdb-var-list
)
242 (if (string-equal varnum
(cadr var
))
245 (while (re-search-forward gdb-var-list-children-regexp nil t
)
246 (let ((varchild (list (match-string-no-properties 2)
247 (match-string-no-properties 1)
248 (match-string-no-properties 3)
249 (match-string-no-properties 4)
251 (dolist (var1 gdb-var-list
)
252 (if (string-equal (cadr var1
) (cadr varchild
))
253 (throw 'child-already-watched nil
)))
254 (push varchild var-list
)
255 (if (equal (nth 2 varchild
) "0")
258 (concat "interpreter mi \"-var-evaluate-expression "
259 (nth 1 varchild
) "\"\n")
260 `(lambda () (gdb-var-evaluate-expression-handler
261 ,(nth 1 varchild
)))))))))
262 (push var var-list
)))
263 (setq gdb-var-list
(nreverse var-list
))))))
265 (defun gdb-var-update ()
266 (setq gdb-update-flag nil
)
267 (if (not (member 'gdb-var-update
(gdb-get-pending-triggers)))
269 (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"
270 'gdb-var-update-handler
))
271 (gdb-set-pending-triggers (cons 'gdb-var-update
272 (gdb-get-pending-triggers))))))
274 (defconst gdb-var-update-regexp
"name=\"\\(.*?\\)\"")
276 (defun gdb-var-update-handler ()
277 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
278 (goto-char (point-min))
279 (while (re-search-forward gdb-var-update-regexp nil t
)
280 (let ((varnum (match-string-no-properties 1)))
282 (list (concat "interpreter mi \"-var-evaluate-expression "
284 `(lambda () (gdb-var-evaluate-expression-handler
286 (gdb-set-pending-triggers
287 (delq 'gdb-var-update
(gdb-get-pending-triggers))))
289 (defun gdb-var-delete (text token indent
)
290 "Delete watched expression."
293 (string-match "\\(\\S-+\\)" text
)
294 (let* ((expr (match-string 1 text
))
295 (var (assoc expr gdb-var-list
))
298 (list (concat "interpreter mi \"-var-delete " varnum
"\"\n")
300 (setq gdb-var-list
(delq var gdb-var-list
))
301 (dolist (varchild gdb-var-list
)
302 (if (string-match (concat (nth 1 var
) "\\.") (nth 1 varchild
))
303 (setq gdb-var-list
(delq varchild gdb-var-list
)))))
304 (setq gdb-var-changed t
)))
306 (defun gdb-speedbar-expand-node (text token indent
)
307 "Expand the node the user clicked on.
308 TEXT is the text of the button we clicked on, a + or - item.
309 TOKEN is data related to this node.
310 INDENT is the current indentation depth."
311 (cond ((string-match "+" text
) ;expand this node
312 (gdb-var-list-children token
))
313 ((string-match "-" text
) ;contract this node
314 (dolist (var gdb-var-list
)
315 (if (string-match (concat token
"\\.") (nth 1 var
))
316 (setq gdb-var-list
(delq var gdb-var-list
))))
317 (setq gdb-var-changed t
))))
320 ;; ======================================================================
322 ;; In this world, there are gdb variables (of unspecified
323 ;; representation) and buffers associated with those objects.
324 ;; The list of variables is built up by the expansions of
327 (defmacro def-gdb-var
(root-symbol &optional default doc
)
328 (let* ((root (symbol-name root-symbol
))
329 (accessor (intern (concat "gdb-get-" root
)))
330 (setter (intern (concat "gdb-set-" root
)))
331 (name (intern (concat "gdb-" root
))))
333 (defvar ,name
,default
,doc
)
334 (if (not (memq ',name gdb-variables
))
335 (push ',name gdb-variables
))
337 (buffer-local-value ',name gud-comint-buffer
))
339 (with-current-buffer gud-comint-buffer
340 (setq ,name val
))))))
342 (def-gdb-var buffer-type nil
343 "One of the symbols bound in gdb-buffer-rules")
345 (def-gdb-var burst
""
346 "A string of characters from gdb that have not yet been processed.")
348 (def-gdb-var input-queue
()
349 "A list of gdb command objects.")
351 (def-gdb-var prompting nil
352 "True when gdb is idle with no pending input.")
354 (def-gdb-var output-sink
'user
355 "The disposition of the output of the current gdb command.
356 Possible values are these symbols:
358 user -- gdb output should be copied to the GUD buffer
361 inferior -- gdb output should be copied to the inferior-io buffer
363 pre-emacs -- output should be ignored util the post-prompt
364 annotation is received. Then the output-sink
366 emacs -- output should be collected in the partial-output-buffer
367 for subsequent processing by a command. This is the
368 disposition of output generated by commands that
369 gdb mode sends to gdb on its own behalf.
370 post-emacs -- ignore input until the prompt annotation is
371 received, then go to USER disposition.
374 (def-gdb-var current-item nil
375 "The most recent command item sent to gdb.")
377 (def-gdb-var pending-triggers
'()
378 "A list of trigger functions that have run later than their output
381 ;; end of gdb variables
383 (defun gdb-get-target-string ()
384 (with-current-buffer gud-comint-buffer
391 ;; Each buffer has a TYPE -- a symbol that identifies the function
392 ;; of that particular buffer.
394 ;; The usual gdb interaction buffer is given the type `gdba' and
395 ;; is constructed specially.
397 ;; Others are constructed by gdb-get-create-buffer and
398 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
400 (defvar gdb-buffer-rules-assoc
'())
402 (defun gdb-get-buffer (key)
403 "Return the gdb buffer tagged with type KEY.
404 The key should be one of the cars in `gdb-buffer-rules-assoc'."
406 (gdb-look-for-tagged-buffer key
(buffer-list))))
408 (defun gdb-get-create-buffer (key)
409 "Create a new gdb buffer of the type specified by KEY.
410 The key should be one of the cars in `gdb-buffer-rules-assoc'."
411 (or (gdb-get-buffer key
)
412 (let* ((rules (assoc key gdb-buffer-rules-assoc
))
413 (name (funcall (gdb-rules-name-maker rules
)))
414 (new (get-buffer-create name
)))
415 (with-current-buffer new
416 ;; FIXME: This should be set after calling the function, since the
417 ;; function should run kill-all-local-variables.
418 (set (make-local-variable 'gdb-buffer-type
) key
)
419 (if (cdr (cdr rules
))
420 (funcall (car (cdr (cdr rules
)))))
421 (set (make-local-variable 'gud-comint-buffer
) gud-comint-buffer
)
422 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
423 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
426 (defun gdb-rules-name-maker (rules) (car (cdr rules
)))
428 (defun gdb-look-for-tagged-buffer (key bufs
)
430 (while (and (not retval
) bufs
)
431 (set-buffer (car bufs
))
432 (if (eq gdb-buffer-type key
)
433 (setq retval
(car bufs
)))
434 (setq bufs
(cdr bufs
)))
438 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
439 ;; at least one and possible more functions. The functions have these
440 ;; roles in defining a buffer type:
442 ;; NAME - Return a name for this buffer type.
444 ;; The remaining function(s) are optional:
446 ;; MODE - called in a new buffer with no arguments, should establish
447 ;; the proper mode for the buffer.
450 (defun gdb-set-buffer-rules (buffer-type &rest rules
)
451 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc
)))
453 (setcdr binding rules
)
454 (push (cons buffer-type rules
)
455 gdb-buffer-rules-assoc
))))
457 ;; GUD buffers are an exception to the rules
458 (gdb-set-buffer-rules 'gdba
'error
)
461 ;; Partial-output buffer : This accumulates output from a command executed on
462 ;; behalf of emacs (rather than the user).
464 (gdb-set-buffer-rules 'gdb-partial-output-buffer
465 'gdb-partial-output-name
)
467 (defun gdb-partial-output-name ()
468 (concat "*partial-output-"
469 (gdb-get-target-string)
473 (gdb-set-buffer-rules 'gdb-inferior-io
474 'gdb-inferior-io-name
475 'gdb-inferior-io-mode
)
477 (defun gdb-inferior-io-name ()
478 (concat "*input/output of "
479 (gdb-get-target-string)
482 (defvar gdb-inferior-io-mode-map
483 (let ((map (make-sparse-keymap)))
484 (define-key map
"\C-c\C-c" 'gdb-inferior-io-interrupt
)
485 (define-key map
"\C-c\C-z" 'gdb-inferior-io-stop
)
486 (define-key map
"\C-c\C-\\" 'gdb-inferior-io-quit
)
487 (define-key map
"\C-c\C-d" 'gdb-inferior-io-eof
)
490 (define-derived-mode gdb-inferior-io-mode comint-mode
"Debuggee I/O"
491 "Major mode for gdb inferior-io."
492 :syntax-table nil
:abbrev-table nil
493 ;; We want to use comint because it has various nifty and familiar
494 ;; features. We don't need a process, but comint wants one, so create
496 (make-comint-in-buffer
497 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
498 (current-buffer) "hexl")
499 (setq comint-input-sender
'gdb-inferior-io-sender
))
501 (defun gdb-inferior-io-sender (proc string
)
502 ;; PROC is the pseudo-process created to satisfy comint.
503 (with-current-buffer (process-buffer proc
)
504 (setq proc
(get-buffer-process gud-comint-buffer
))
505 (process-send-string proc string
)
506 (process-send-string proc
"\n")))
508 (defun gdb-inferior-io-interrupt ()
509 "Interrupt the program being debugged."
512 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
514 (defun gdb-inferior-io-quit ()
515 "Send quit signal to the program being debugged."
518 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
520 (defun gdb-inferior-io-stop ()
521 "Stop the program being debugged."
524 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
526 (defun gdb-inferior-io-eof ()
527 "Send end-of-file to the program being debugged."
530 (get-buffer-process gud-comint-buffer
)))
534 ;; gdb communications
537 ;; INPUT: things sent to gdb
539 ;; The queues are lists. Each element is either a string (indicating user or
540 ;; user-like input) or a list of the form:
542 ;; (INPUT-STRING HANDLER-FN)
544 ;; The handler function will be called from the partial-output buffer when the
545 ;; command completes. This is the way to write commands which invoke gdb
546 ;; commands autonomously.
548 ;; These lists are consumed tail first.
551 (defun gdb-send (proc string
)
552 "A comint send filter for gdb.
553 This filter may simply queue output for a later time."
554 (gdb-enqueue-input (concat string
"\n")))
556 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
557 ;; is a query, or other non-top-level prompt.
559 (defun gdb-enqueue-input (item)
560 (if (gdb-get-prompting)
563 (gdb-set-prompting nil
))
565 (cons item
(gdb-get-input-queue)))))
567 (defun gdb-dequeue-input ()
568 (let ((queue (gdb-get-input-queue)))
570 (if (not (cdr queue
))
571 (let ((answer (car queue
)))
572 (gdb-set-input-queue '())
574 (gdb-take-last-elt queue
)))))
576 ;; Don't use this in general.
577 (defun gdb-take-last-elt (l)
579 (gdb-take-last-elt (cdr l
))
580 (let ((answer (car (cdr l
))))
586 ;; output -- things gdb prints to emacs
588 ;; GDB output is a stream interrupted by annotations.
589 ;; Annotations can be recognized by their beginning
590 ;; with \C-j\C-z\C-z<tag><opt>\C-j
592 ;; The tag is a string obeying symbol syntax.
594 ;; The optional part `<opt>' can be either the empty string
595 ;; or a space followed by more data relating to the annotation.
596 ;; For example, the SOURCE annotation is followed by a filename,
597 ;; line number and various useless goo. This data must not include
601 (defcustom gud-gdba-command-name
"~/gdb/gdb/gdb -annotate=3"
602 "Default command to execute an executable under the GDB-UI debugger."
606 (defvar gdb-annotation-rules
607 '(("pre-prompt" gdb-pre-prompt
)
608 ("prompt" gdb-prompt
)
609 ("commands" gdb-subprompt
)
610 ("overload-choice" gdb-subprompt
)
611 ("query" gdb-subprompt
)
612 ("prompt-for-continue" gdb-subprompt
)
613 ("post-prompt" gdb-post-prompt
)
614 ("source" gdb-source
)
615 ("starting" gdb-starting
)
616 ("exited" gdb-stopping
)
617 ("signalled" gdb-stopping
)
618 ("signal" gdb-stopping
)
619 ("breakpoint" gdb-stopping
)
620 ("watchpoint" gdb-stopping
)
621 ("frame-begin" gdb-frame-begin
)
622 ("stopped" gdb-stopped
)
623 ) "An assoc mapping annotation tags to functions which process them.")
625 (defconst gdb-source-spec-regexp
626 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
628 ;; Do not use this except as an annotation handler.
629 (defun gdb-source (args)
630 (string-match gdb-source-spec-regexp args
)
631 ;; Extract the frame position from the marker.
634 (match-string 1 args
)
635 (string-to-int (match-string 2 args
))))
636 (setq gdb-current-address
(match-string 3 args
))
637 (setq gdb-view-source t
))
639 (defun gdb-send-item (item)
640 (gdb-set-current-item item
)
643 (gdb-set-output-sink 'user
)
644 (process-send-string (get-buffer-process gud-comint-buffer
) item
))
646 (gdb-clear-partial-output)
647 (gdb-set-output-sink 'pre-emacs
)
648 (process-send-string (get-buffer-process gud-comint-buffer
)
651 (defun gdb-pre-prompt (ignored)
652 "An annotation handler for `pre-prompt'. This terminates the collection of
653 output from a previous command if that happens to be in effect."
654 (let ((sink (gdb-get-output-sink)))
658 (gdb-set-output-sink 'post-emacs
))
660 (gdb-set-output-sink 'user
)
661 (error "Phase error in gdb-pre-prompt (got %s)" sink
)))))
663 (defun gdb-prompt (ignored)
664 "An annotation handler for `prompt'.
665 This sends the next command (if any) to gdb."
666 (let ((sink (gdb-get-output-sink)))
669 ((eq sink
'post-emacs
)
670 (gdb-set-output-sink 'user
)
672 (car (cdr (gdb-get-current-item)))))
673 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
676 (gdb-set-output-sink 'user
)
677 (error "Phase error in gdb-prompt (got %s)" sink
))))
678 (let ((input (gdb-dequeue-input)))
680 (gdb-send-item input
)
682 (gdb-set-prompting t
)
683 (gud-display-frame)))))
685 (defun gdb-subprompt (ignored)
686 "An annotation handler for non-top-level prompts."
687 (gdb-set-prompting t
))
689 (defun gdb-starting (ignored)
690 "An annotation handler for `starting'. This says that I/O for the
691 subprocess is now the program being debugged, not GDB."
692 (let ((sink (gdb-get-output-sink)))
697 (gdb-set-output-sink 'inferior
)))
698 (t (error "Unexpected `starting' annotation")))))
700 (defun gdb-stopping (ignored)
701 "An annotation handler for `exited' and other annotations which say that I/O
702 for the subprocess is now GDB, not the program being debugged."
703 (let ((sink (gdb-get-output-sink)))
706 (gdb-set-output-sink 'user
))
707 (t (error "Unexpected stopping annotation")))))
709 (defun gdb-frame-begin (ignored)
710 (let ((sink (gdb-get-output-sink)))
713 (gdb-set-output-sink 'user
))
716 (t (error "Unexpected frame-begin annotation (%S)" sink
)))))
718 (defun gdb-stopped (ignored)
719 "An annotation handler for `stopped'. It is just like gdb-stopping, except
720 that if we already set the output sink to 'user in gdb-stopping, that is fine."
721 (setq gud-running nil
)
722 (let ((sink (gdb-get-output-sink)))
725 (gdb-set-output-sink 'user
))
727 (t (error "Unexpected stopped annotation")))))
729 (defun gdb-post-prompt (ignored)
730 "An annotation handler for `post-prompt'. This begins the collection of
731 output from the current command if that happens to be appropriate."
732 (if (and (not (gdb-get-pending-triggers)) gdb-update-flag
)
734 (gdb-get-current-frame)
735 (gdb-invalidate-frames)
736 (gdb-invalidate-breakpoints)
737 (gdb-invalidate-assembler)
738 (gdb-invalidate-registers)
739 (gdb-invalidate-locals)
740 (gdb-invalidate-threads)))
741 (setq gdb-update-flag t
)
742 (let ((sink (gdb-get-output-sink)))
745 ((eq sink
'pre-emacs
)
746 (gdb-set-output-sink 'emacs
))
748 (gdb-set-output-sink 'user
)
749 (error "Phase error in gdb-post-prompt (got %s)" sink
)))))
751 (defun gud-gdba-marker-filter (string)
752 "A gud marker filter for gdb. Handle a burst of output from GDB."
754 ;; Recall the left over burst from last time
755 (burst (concat (gdb-get-burst) string
))
756 ;; Start accumulating output for the GUD buffer
759 ;; Process all the complete markers in this chunk.
760 (while (string-match "\n\032\032\\(.*\\)\n" burst
)
761 (let ((annotation (match-string 1 burst
)))
763 ;; Stuff prior to the match is just ordinary output.
764 ;; It is either concatenated to OUTPUT or directed
769 (substring burst
0 (match-beginning 0))))
771 ;; Take that stuff off the burst.
772 (setq burst
(substring burst
(match-end 0)))
774 ;; Parse the tag from the annotation, and maybe its arguments.
775 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation
)
776 (let* ((annotation-type (match-string 1 annotation
))
777 (annotation-arguments (match-string 2 annotation
))
778 (annotation-rule (assoc annotation-type
779 gdb-annotation-rules
)))
780 ;; Call the handler for this annotation.
782 (funcall (car (cdr annotation-rule
))
783 annotation-arguments
)
784 ;; Else the annotation is not recognized. Ignore it silently,
785 ;; so that GDB can add new annotations without causing
789 ;; Does the remaining text end in a partial line?
790 ;; If it does, then keep part of the burst until we get more.
791 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
794 ;; Everything before the potential marker start can be output.
796 (gdb-concat-output output
797 (substring burst
0 (match-beginning 0))))
799 ;; Everything after, we save, to combine with later input.
800 (setq burst
(substring burst
(match-beginning 0))))
802 ;; In case we know the burst contains no partial annotations:
804 (setq output
(gdb-concat-output output burst
))
807 ;; Save the remaining burst for the next call to this function.
808 (gdb-set-burst burst
)
811 (defun gdb-concat-output (so-far new
)
812 (let ((sink (gdb-get-output-sink )))
814 ((eq sink
'user
) (concat so-far new
))
815 ((or (eq sink
'pre-emacs
) (eq sink
'post-emacs
)) so-far
)
817 (gdb-append-to-partial-output new
)
820 (gdb-append-to-inferior-io new
)
822 (t (error "Bogon output sink %S" sink
)))))
824 (defun gdb-append-to-partial-output (string)
825 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
826 (goto-char (point-max))
829 (defun gdb-clear-partial-output ()
830 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
831 (delete-region (point-min) (point-max))))
833 (defun gdb-append-to-inferior-io (string)
834 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
835 (goto-char (point-max))
836 (insert-before-markers string
))
837 (if (not (string-equal string
""))
838 (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io
))))
840 (defun gdb-clear-inferior-io ()
841 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
842 (delete-region (point-min) (point-max))))
845 ;; One trick is to have a command who's output is always available in a buffer
846 ;; of it's own, and is always up to date. We build several buffers of this
849 ;; There are two aspects to this: gdb has to tell us when the output for that
850 ;; command might have changed, and we have to be able to run the command
851 ;; behind the user's back.
853 ;; The output phasing associated with the variable gdb-output-sink
854 ;; help us to run commands behind the user's back.
856 ;; Below is the code for specificly managing buffers of output from one
860 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
861 ;; It adds an input for the command we are tracking. It should be the
862 ;; annotation rule binding of whatever gdb sends to tell us this command
863 ;; might have changed it's output.
865 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
866 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
867 ;; input in the input queue (see comment about ``gdb communications'' above).
869 (defmacro def-gdb-auto-update-trigger
(name demand-predicate gdb-command
871 `(defun ,name
(&optional ignored
)
872 (if (and (,demand-predicate
)
874 (gdb-get-pending-triggers))))
877 (list ,gdb-command
',output-handler
))
878 (gdb-set-pending-triggers
880 (gdb-get-pending-triggers)))))))
882 (defmacro def-gdb-auto-update-handler
(name trigger buf-key custom-defun
)
884 (gdb-set-pending-triggers
886 (gdb-get-pending-triggers)))
887 (let ((buf (gdb-get-buffer ',buf-key
)))
889 (with-current-buffer buf
891 (buffer-read-only nil
))
892 (delete-region (point-min) (point-max))
893 (insert-buffer-substring (gdb-get-create-buffer
894 'gdb-partial-output-buffer
))
896 ;; put customisation here
899 (defmacro def-gdb-auto-updated-buffer
(buffer-key trigger-name gdb-command
900 output-handler-name custom-defun
)
902 (def-gdb-auto-update-trigger ,trigger-name
903 ;; The demand predicate:
904 (lambda () (gdb-get-buffer ',buffer-key
))
906 ,output-handler-name
)
907 (def-gdb-auto-update-handler ,output-handler-name
908 ,trigger-name
,buffer-key
,custom-defun
)))
912 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
914 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
915 'gdb-breakpoints-buffer-name
916 'gdb-breakpoints-mode
)
918 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
919 ;; This defines the auto update rule for buffers of type
920 ;; `gdb-breakpoints-buffer'.
922 ;; It defines a function to serve as the annotation handler that
923 ;; handles the `foo-invalidated' message. That function is called:
924 gdb-invalidate-breakpoints
926 ;; To update the buffer, this command is sent to gdb.
927 "server info breakpoints\n"
929 ;; This also defines a function to be the handler for the output
930 ;; from the command above. That function will copy the output into
931 ;; the appropriately typed buffer. That function will be called:
932 gdb-info-breakpoints-handler
933 ;; buffer specific functions
934 gdb-info-breakpoints-custom
)
936 (defvar gdb-cdir nil
"Compilation directory.")
938 (defconst breakpoint-xpm-data
"/* XPM */
939 static char *magick[] = {
940 /* columns rows colors chars-per-pixel */
958 "XPM data used for breakpoint icon.")
960 (defconst breakpoint-enabled-pbm-data
963 0 0 0 0 0 0 0 0 0 0 0 0
964 0 0 0 1 1 1 1 1 1 0 0 0
965 0 0 1 1 1 1 1 1 1 1 0 0
966 0 1 1 1 1 1 1 1 1 1 1 0
967 0 1 1 1 1 1 1 1 1 1 1 0
968 0 1 1 1 1 1 1 1 1 1 1 0
969 0 1 1 1 1 1 1 1 1 1 1 0
970 0 1 1 1 1 1 1 1 1 1 1 0
971 0 1 1 1 1 1 1 1 1 1 1 0
972 0 0 1 1 1 1 1 1 1 1 0 0
973 0 0 0 1 1 1 1 1 1 0 0 0
974 0 0 0 0 0 0 0 0 0 0 0 0"
975 "PBM data used for enabled breakpoint icon.")
977 (defconst breakpoint-disabled-pbm-data
980 0 0 0 0 0 0 0 0 0 0 0 0
981 0 0 0 1 0 1 0 1 0 0 0 0
982 0 0 1 0 1 0 1 0 1 0 0 0
983 0 1 0 1 0 1 0 1 0 1 0 0
984 0 0 1 0 1 0 1 0 1 0 1 0
985 0 1 0 1 0 1 0 1 0 1 0 0
986 0 0 1 0 1 0 1 0 1 0 1 0
987 0 1 0 1 0 1 0 1 0 1 0 0
988 0 0 1 0 1 0 1 0 1 0 1 0
989 0 0 0 1 0 1 0 1 0 1 0 0
990 0 0 0 0 1 0 1 0 1 0 0 0
991 0 0 0 0 0 0 0 0 0 0 0 0"
992 "PBM data used for disabled breakpoint icon.")
994 (defvar breakpoint-enabled-icon
995 (find-image `((:type xpm
:data
,breakpoint-xpm-data
)
996 (:type pbm
:data
,breakpoint-enabled-pbm-data
)))
997 "Icon for enabled breakpoint in display margin")
999 (defvar breakpoint-disabled-icon
1000 (find-image `((:type xpm
:data
,breakpoint-xpm-data
:conversion disabled
)
1001 (:type pbm
:data
,breakpoint-disabled-pbm-data
)))
1002 "Icon for disabled breakpoint in display margin")
1004 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1005 (defun gdb-info-breakpoints-custom ()
1006 (let ((flag)(address))
1008 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1009 (dolist (buffer (buffer-list))
1010 (with-current-buffer buffer
1011 (if (and (eq gud-minor-mode
'gdba
)
1012 (not (string-match "^\*" (buffer-name))))
1013 (if (display-images-p)
1014 (remove-images (point-min) (point-max))
1015 (gdb-remove-strings (point-min) (point-max))))))
1016 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer
)
1018 (goto-char (point-min))
1019 (while (< (point) (- (point-max) 1))
1021 (if (looking-at "[^\t].*breakpoint")
1023 (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1024 (setq flag
(char-after (match-beginning 1)))
1026 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t
)
1028 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1029 (let ((line (match-string 2)) (buffer-read-only nil
)
1030 (file (match-string 1)))
1031 (add-text-properties (point-at-bol) (point-at-eol)
1032 '(mouse-face highlight
1033 help-echo
"mouse-2, RET: visit breakpoint"))
1034 (with-current-buffer
1036 (if (file-exists-p file
) file
1037 (expand-file-name file gdb-cdir
)))
1038 (save-current-buffer
1039 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1040 (set (make-local-variable 'tool-bar-map
)
1042 (setq left-margin-width
2)
1043 (if (get-buffer-window (current-buffer))
1044 (set-window-margins (get-buffer-window
1047 right-margin-width
)))
1048 ;; only want one breakpoint icon at each location
1050 (goto-line (string-to-number line
))
1051 (let ((start (progn (beginning-of-line)
1053 (end (progn (end-of-line) (+ (point) 1))))
1054 (if (display-images-p)
1056 (remove-images start end
)
1058 (put-image breakpoint-enabled-icon
1060 "breakpoint icon enabled"
1062 (put-image breakpoint-disabled-icon
1064 "breakpoint icon disabled"
1066 (gdb-remove-strings start end
)
1068 (gdb-put-string "B" (+ start
1))
1069 (gdb-put-string "b" (+ start
1))))))))))))
1071 (if (gdb-get-buffer 'gdb-assembler-buffer
) (gdb-assembler-custom)))
1073 (defun gdb-breakpoints-buffer-name ()
1074 (with-current-buffer gud-comint-buffer
1075 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1077 (defun gdb-display-breakpoints-buffer ()
1080 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1082 (defun gdb-frame-breakpoints-buffer ()
1084 (switch-to-buffer-other-frame
1085 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1087 (defvar gdb-breakpoints-mode-map
1088 (let ((map (make-sparse-keymap))
1089 (menu (make-sparse-keymap "Breakpoints")))
1090 (define-key menu
[toggle] '("Toggle" . gdb-toggle-breakpoint))
1091 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1092 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1094 (suppress-keymap map)
1095 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1096 (define-key map " " 'gdb-toggle-breakpoint)
1097 (define-key map "d" 'gdb-delete-breakpoint)
1098 (define-key map "\r" 'gdb-goto-breakpoint)
1099 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1102 (defun gdb-breakpoints-mode ()
1103 "Major mode for gdb breakpoints.
1105 \\{gdb-breakpoints-mode-map}"
1106 (setq major-mode 'gdb-breakpoints-mode)
1107 (setq mode-name "Breakpoints")
1108 (use-local-map gdb-breakpoints-mode-map)
1109 (setq buffer-read-only t)
1110 (gdb-invalidate-breakpoints))
1112 (defun gdb-toggle-breakpoint ()
1113 "Enable/disable the breakpoint at current line."
1116 (beginning-of-line 1)
1117 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1118 (error "Not recognized as break/watchpoint line")
1122 (if (eq ?y (char-after (match-beginning 2)))
1125 (match-string 1) "\n")
1128 (defun gdb-delete-breakpoint ()
1129 "Delete the breakpoint at current line."
1131 (beginning-of-line 1)
1132 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1133 (error "Not recognized as break/watchpoint line")
1135 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1137 (defvar gdb-source-window nil)
1139 (defun gdb-goto-breakpoint ()
1140 "Display the file in the source buffer at the breakpoint specified on the
1144 (beginning-of-line 1)
1145 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1146 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1147 (if (match-string 2)
1148 (let ((line (match-string 2))
1149 (file (match-string 1)))
1150 (save-selected-window
1151 (select-window gdb-source-window)
1152 (switch-to-buffer (find-file-noselect
1153 (if (file-exists-p file)
1155 (expand-file-name file gdb-cdir))))
1156 (goto-line (string-to-number line))))))
1158 (defun gdb-mouse-goto-breakpoint (event)
1159 "Display the file in the source buffer at the selected breakpoint."
1161 (mouse-set-point event)
1162 (gdb-goto-breakpoint))
1165 ;; Frames buffer. This displays a perpetually correct bactracktrace
1166 ;; (from the command `where').
1168 ;; Alas, if your stack is deep, it is costly.
1170 (gdb-set-buffer-rules 'gdb-stack-buffer
1171 'gdb-stack-buffer-name
1174 (def-gdb-auto-updated-buffer gdb-stack-buffer
1175 gdb-invalidate-frames
1177 gdb-info-frames-handler
1178 gdb-info-frames-custom)
1180 (defun gdb-info-frames-custom ()
1181 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1183 (let ((buffer-read-only nil))
1184 (goto-char (point-min))
1185 (while (< (point) (point-max))
1186 (add-text-properties (point-at-bol) (point-at-eol)
1187 '(mouse-face highlight
1188 help-echo "mouse-2, RET: Select frame"))
1190 (if (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
1191 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
1192 (if (equal (match-string 1) gdb-current-frame)
1193 (put-text-property (point-at-bol) (point-at-eol)
1195 `(:background ,(face-attribute 'default :foreground)
1196 :foreground ,(face-attribute 'default :background)))))
1197 (forward-line 1))))))
1199 (defun gdb-stack-buffer-name ()
1200 (with-current-buffer gud-comint-buffer
1201 (concat "*stack frames of " (gdb-get-target-string) "*")))
1203 (defun gdb-display-stack-buffer ()
1206 (gdb-get-create-buffer 'gdb-stack-buffer)))
1208 (defun gdb-frame-stack-buffer ()
1210 (switch-to-buffer-other-frame
1211 (gdb-get-create-buffer 'gdb-stack-buffer)))
1213 (defvar gdb-frames-mode-map
1214 (let ((map (make-sparse-keymap)))
1215 (suppress-keymap map)
1216 (define-key map "\r" 'gdb-frames-select)
1217 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1220 (defun gdb-frames-mode ()
1221 "Major mode for gdb frames.
1223 \\{gdb-frames-mode-map}"
1224 (setq major-mode 'gdb-frames-mode)
1225 (setq mode-name "Frames")
1226 (setq buffer-read-only t)
1227 (use-local-map gdb-frames-mode-map)
1229 (gdb-invalidate-frames))
1231 (defun gdb-get-frame-number ()
1233 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1234 (n (or (and pos (match-string-no-properties 1)) "0")))
1237 (defun gdb-frames-select ()
1238 "Make the frame on the current line become the current frame and display the
1239 source in the source buffer."
1242 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1243 (gud-display-frame))
1245 (defun gdb-frames-mouse-select (event)
1246 "Make the selected frame become the current frame and display the source in
1249 (mouse-set-point event)
1250 (gdb-frames-select))
1253 ;; Threads buffer. This displays a selectable thread list.
1255 (gdb-set-buffer-rules 'gdb-threads-buffer
1256 'gdb-threads-buffer-name
1259 (def-gdb-auto-updated-buffer gdb-threads-buffer
1260 gdb-invalidate-threads
1262 gdb-info-threads-handler
1263 gdb-info-threads-custom)
1265 (defun gdb-info-threads-custom ()
1266 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1267 (let ((buffer-read-only nil))
1268 (goto-char (point-min))
1269 (while (< (point) (point-max))
1270 (add-text-properties (point-at-bol) (point-at-eol)
1271 '(mouse-face highlight
1272 help-echo "mouse-2, RET: select thread"))
1273 (forward-line 1)))))
1275 (defun gdb-threads-buffer-name ()
1276 (with-current-buffer gud-comint-buffer
1277 (concat "*threads of " (gdb-get-target-string) "*")))
1279 (defun gdb-display-threads-buffer ()
1282 (gdb-get-create-buffer 'gdb-threads-buffer)))
1284 (defun gdb-frame-threads-buffer ()
1286 (switch-to-buffer-other-frame
1287 (gdb-get-create-buffer 'gdb-threads-buffer)))
1289 (defvar gdb-threads-mode-map
1290 (let ((map (make-sparse-keymap)))
1291 (suppress-keymap map)
1292 (define-key map "\r" 'gdb-threads-select)
1293 (define-key map [mouse-2] 'gdb-threads-mouse-select)
1296 (defun gdb-threads-mode ()
1297 "Major mode for gdb frames.
1299 \\{gdb-frames-mode-map}"
1300 (setq major-mode 'gdb-threads-mode)
1301 (setq mode-name "Threads")
1302 (setq buffer-read-only t)
1303 (use-local-map gdb-threads-mode-map)
1304 (gdb-invalidate-threads))
1306 (defun gdb-get-thread-number ()
1308 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1309 (match-string-no-properties 1)))
1312 (defun gdb-threads-select ()
1313 "Make the thread on the current line become the current thread and display the
1314 source in the source buffer."
1317 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1318 (gud-display-frame))
1320 (defun gdb-threads-mouse-select (event)
1321 "Make the selected frame become the current frame and display the source in
1324 (mouse-set-point event)
1325 (gdb-threads-select))
1328 ;; Registers buffer.
1330 (gdb-set-buffer-rules 'gdb-registers-buffer
1331 'gdb-registers-buffer-name
1332 'gdb-registers-mode)
1334 (def-gdb-auto-updated-buffer gdb-registers-buffer
1335 gdb-invalidate-registers
1336 "server info registers\n"
1337 gdb-info-registers-handler
1338 gdb-info-registers-custom)
1340 (defun gdb-info-registers-custom ())
1342 (defvar gdb-registers-mode-map
1343 (let ((map (make-sparse-keymap)))
1344 (suppress-keymap map)
1347 (defun gdb-registers-mode ()
1348 "Major mode for gdb registers.
1350 \\{gdb-registers-mode-map}"
1351 (setq major-mode 'gdb-registers-mode)
1352 (setq mode-name "Registers")
1353 (setq buffer-read-only t)
1354 (use-local-map gdb-registers-mode-map)
1355 (gdb-invalidate-registers))
1357 (defun gdb-registers-buffer-name ()
1358 (with-current-buffer gud-comint-buffer
1359 (concat "*registers of " (gdb-get-target-string) "*")))
1361 (defun gdb-display-registers-buffer ()
1364 (gdb-get-create-buffer 'gdb-registers-buffer)))
1366 (defun gdb-frame-registers-buffer ()
1368 (switch-to-buffer-other-frame
1369 (gdb-get-create-buffer 'gdb-registers-buffer)))
1374 (gdb-set-buffer-rules 'gdb-locals-buffer
1375 'gdb-locals-buffer-name
1378 (def-gdb-auto-updated-buffer gdb-locals-buffer
1379 gdb-invalidate-locals
1380 "server info locals\n"
1381 gdb-info-locals-handler
1382 gdb-info-locals-custom)
1384 ;; Abbreviate for arrays and structures.
1385 ;; These can be expanded using gud-display.
1386 (defun gdb-info-locals-handler nil
1387 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1388 (gdb-get-pending-triggers)))
1389 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1390 (with-current-buffer buf
1391 (goto-char (point-min))
1392 (while (re-search-forward "^ .*\n" nil t)
1393 (replace-match "" nil nil))
1394 (goto-char (point-min))
1395 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1396 (replace-match "(array);\n" nil nil))
1397 (goto-char (point-min))
1398 (while (re-search-forward "{.*=.*\n" nil t)
1399 (replace-match "(structure);\n" nil nil))))
1400 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1401 (and buf (with-current-buffer buf
1403 (buffer-read-only nil))
1404 (delete-region (point-min) (point-max))
1405 (insert-buffer-substring (gdb-get-create-buffer
1406 'gdb-partial-output-buffer))
1408 (run-hooks 'gdb-info-locals-hook))
1410 (defun gdb-info-locals-custom ()
1413 (defvar gdb-locals-mode-map
1414 (let ((map (make-sparse-keymap)))
1415 (suppress-keymap map)
1418 (defun gdb-locals-mode ()
1419 "Major mode for gdb locals.
1421 \\{gdb-locals-mode-map}"
1422 (setq major-mode 'gdb-locals-mode)
1423 (setq mode-name "Locals")
1424 (setq buffer-read-only t)
1425 (use-local-map gdb-locals-mode-map)
1426 (gdb-invalidate-locals))
1428 (defun gdb-locals-buffer-name ()
1429 (with-current-buffer gud-comint-buffer
1430 (concat "*locals of " (gdb-get-target-string) "*")))
1432 (defun gdb-display-locals-buffer ()
1435 (gdb-get-create-buffer 'gdb-locals-buffer)))
1437 (defun gdb-frame-locals-buffer ()
1439 (switch-to-buffer-other-frame
1440 (gdb-get-create-buffer 'gdb-locals-buffer)))
1443 ;;;; Window management
1445 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1446 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1447 ;;; get at the use_time field of a window, I'm not sure there exists a
1448 ;;; more elegant solution without writing C code.
1450 (defun gdb-display-buffer (buf &optional size)
1451 (let ((must-split nil)
1457 (if (or (eq gud-comint-buffer (window-buffer win))
1458 (eq gdb-source-window win))
1459 (set-window-dedicated-p win t))))
1460 (setq answer (get-buffer-window buf))
1462 (let ((window (get-lru-window)))
1465 (set-window-buffer window buf)
1466 (setq answer window))
1467 (setq must-split t)))))
1470 (if (or (eq gud-comint-buffer (window-buffer win))
1471 (eq gdb-source-window win))
1472 (set-window-dedicated-p win nil)))))
1474 (let* ((largest (get-largest-window))
1475 (cur-size (window-height largest))
1476 (new-size (and size (< size cur-size) (- cur-size size))))
1477 (setq answer (split-window largest new-size))
1478 (set-window-buffer answer buf)))
1481 (defun gdb-display-source-buffer (buffer)
1482 (if (eq gdb-selected-view 'source)
1484 (if (window-live-p gdb-source-window)
1485 (set-window-buffer gdb-source-window buffer)
1486 (gdb-display-buffer buffer)
1487 (setq gdb-source-window (get-buffer-window buffer)))
1489 (if (window-live-p gdb-source-window)
1490 (set-window-buffer gdb-source-window
1491 (gdb-get-buffer 'gdb-assembler-buffer))
1492 (let ((buf (gdb-get-buffer 'gdb-assembler-buffer)))
1493 (gdb-display-buffer buf)
1494 (setq gdb-source-window (get-buffer-window buf))))
1498 ;;; Shared keymap initialization:
1500 (let ((menu (make-sparse-keymap "GDB-Frames")))
1501 (define-key gud-menu-map [frames]
1502 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1503 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1504 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1505 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1506 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1507 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1508 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1509 ; (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer))
1512 (let ((menu (make-sparse-keymap "GDB-Windows")))
1513 (define-key gud-menu-map [displays]
1514 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1515 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1516 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1517 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1518 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1519 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1520 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1521 ; (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer))
1524 (let ((menu (make-sparse-keymap "View")))
1525 (define-key gud-menu-map [view]
1526 `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba)))
1527 ; (define-key menu [both] '(menu-item "Both" gdb-view-both
1528 ; :help "Display both source and assembler"
1529 ; :button (:radio . (eq gdb-selected-view 'both))))
1530 (define-key menu [assembler] '(menu-item "Assembler" gdb-view-assembler
1531 :help "Display assembler only"
1532 :button (:radio . (eq gdb-selected-view 'assembler))))
1533 (define-key menu [source] '(menu-item "Source" gdb-view-source-function
1534 :help "Display source only"
1535 :button (:radio . (eq gdb-selected-view 'source)))))
1537 (let ((menu (make-sparse-keymap "GDB-UI")))
1538 (define-key gud-menu-map [ui]
1539 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
1540 (define-key menu [gdb-restore-windows]
1541 '("Restore window layout" . gdb-restore-windows))
1542 (define-key menu [gdb-many-windows]
1543 (menu-bar-make-toggle gdb-many-windows gdb-many-windows
1544 "Display other windows" "Many Windows %s"
1545 "Display locals, stack and breakpoint information")))
1547 (defun gdb-frame-gdb-buffer ()
1549 (switch-to-buffer-other-frame
1550 (gdb-get-create-buffer 'gdba)))
1552 (defun gdb-display-gdb-buffer ()
1555 (gdb-get-create-buffer 'gdba)))
1557 (defvar gdb-main-file nil "Source file from which program execution begins.")
1559 (defun gdb-view-source-function ()
1562 (if gud-last-last-frame
1563 (set-window-buffer gdb-source-window
1564 (gud-find-file (car gud-last-last-frame)))
1565 (set-window-buffer gdb-source-window (gud-find-file gdb-main-file))))
1566 (setq gdb-selected-view 'source))
1568 (defun gdb-view-assembler()
1570 (set-window-buffer gdb-source-window
1571 (gdb-get-create-buffer 'gdb-assembler-buffer))
1572 (setq gdb-selected-view 'assembler))
1574 ;(defun gdb-view-both()
1576 ;(setq gdb-selected-view 'both))
1578 ;; layout for all the windows
1579 (defun gdb-setup-windows ()
1580 (gdb-display-locals-buffer)
1581 (gdb-display-stack-buffer)
1582 (delete-other-windows)
1583 (gdb-display-breakpoints-buffer)
1584 (delete-other-windows)
1585 (switch-to-buffer gud-comint-buffer)
1586 (split-window nil ( / ( * (window-height) 3) 4))
1587 (split-window nil ( / (window-height) 3))
1588 (split-window-horizontally)
1590 (switch-to-buffer (gdb-locals-buffer-name))
1592 (if (and gdb-view-source
1593 (eq gdb-selected-view 'source))
1595 (if gud-last-last-frame
1596 (gud-find-file (car gud-last-last-frame))
1597 (gud-find-file gdb-main-file)))
1598 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
1599 (setq gdb-source-window (get-buffer-window (current-buffer)))
1600 (split-window-horizontally)
1602 (switch-to-buffer (gdb-inferior-io-name))
1604 (switch-to-buffer (gdb-stack-buffer-name))
1605 (split-window-horizontally)
1607 (switch-to-buffer (gdb-breakpoints-buffer-name))
1610 (defcustom gdb-many-windows nil
1611 "Nil means that gdb starts with just two windows : the GUD and
1616 (defun gdb-many-windows (arg)
1617 "Toggle the number of windows in the basic arrangement."
1619 (setq gdb-many-windows
1621 (not gdb-many-windows)
1622 (> (prefix-numeric-value arg) 0)))
1623 (gdb-restore-windows))
1625 (defun gdb-restore-windows ()
1626 "Restore the basic arrangement of windows used by gdba.
1627 This arrangement depends on the value of `gdb-many-windows'."
1629 (if gdb-many-windows
1631 (switch-to-buffer gud-comint-buffer)
1632 (delete-other-windows)
1633 (gdb-setup-windows))
1634 (switch-to-buffer gud-comint-buffer)
1635 (delete-other-windows)
1638 (if (and gdb-view-source
1639 (eq gdb-selected-view 'source))
1641 (if gud-last-last-frame
1642 (gud-find-file (car gud-last-last-frame))
1643 (gud-find-file gdb-main-file)))
1644 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
1645 (setq gdb-source-window (get-buffer-window (current-buffer)))
1649 "Exit a debugging session cleanly by killing the gdb buffers and resetting
1650 the source buffers."
1651 (dolist (buffer (buffer-list))
1652 (if (not (eq buffer gud-comint-buffer))
1653 (with-current-buffer buffer
1654 (if (memq gud-minor-mode '(gdba pdb))
1655 (if (string-match "^\*.+*$" (buffer-name))
1657 (if (display-images-p)
1658 (remove-images (point-min) (point-max))
1659 (gdb-remove-strings (point-min) (point-max)))
1660 (setq left-margin-width 0)
1661 (setq gud-minor-mode nil)
1662 (kill-local-variable 'tool-bar-map)
1663 (setq gud-running nil)
1664 (if (get-buffer-window (current-buffer))
1665 (set-window-margins (get-buffer-window
1668 right-margin-width))))))))
1670 (defun gdb-source-info ()
1671 "Find the source file where the program starts and displays it with related
1673 (goto-char (point-min))
1674 (if (search-forward "directory is " nil t)
1676 (if (looking-at "\\S-*:\\(\\S-*\\)")
1677 (setq gdb-cdir (match-string 1))
1678 (looking-at "\\S-*")
1679 (setq gdb-cdir (match-string 0)))
1680 (search-forward "Located in ")
1681 (looking-at "\\S-*")
1682 (setq gdb-main-file (match-string 0)))
1683 (setq gdb-view-source nil))
1684 (delete-other-windows)
1685 (switch-to-buffer gud-comint-buffer)
1686 (if gdb-many-windows
1688 (gdb-display-breakpoints-buffer)
1689 (delete-other-windows)
1694 (if gud-last-last-frame
1695 (gud-find-file (car gud-last-last-frame))
1696 (gud-find-file gdb-main-file)))
1697 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
1698 (setq gdb-source-window (get-buffer-window (current-buffer)))
1702 (defun gdb-put-string (putstring pos)
1703 "Put string PUTSTRING in front of POS in the current buffer.
1704 PUTSTRING is displayed by putting an overlay into the current buffer with a
1705 `before-string' STRING that has a `display' property whose value is
1707 (let ((gdb-string "x")
1708 (buffer (current-buffer)))
1709 (let ((overlay (make-overlay pos pos buffer))
1710 (prop (list (list 'margin 'left-margin) putstring)))
1711 (put-text-property 0 (length gdb-string) 'display prop gdb-string)
1712 (overlay-put overlay 'put-break t)
1713 (overlay-put overlay 'before-string gdb-string))))
1715 ;;from remove-images
1716 (defun gdb-remove-strings (start end &optional buffer)
1717 "Remove strings between START and END in BUFFER.
1718 Remove only strings that were put in BUFFER with calls to `put-string'.
1719 BUFFER nil or omitted means use the current buffer."
1721 (setq buffer (current-buffer)))
1722 (let ((overlays (overlays-in start end)))
1724 (let ((overlay (car overlays)))
1725 (when (overlay-get overlay 'put-break)
1726 (delete-overlay overlay)))
1727 (setq overlays (cdr overlays)))))
1729 (defun gdb-put-arrow (putstring pos)
1730 "Put arrow string PUTSTRING in the left margin in front of POS
1731 in the current buffer. PUTSTRING is displayed by putting an
1732 overlay into the current buffer with a `before-string'
1733 \"gdb-arrow\" that has a `display' property whose value is
1734 PUTSTRING. POS may be an integer or marker."
1735 (let ((gdb-string "gdb-arrow")
1736 (buffer (current-buffer)))
1737 (let ((overlay (make-overlay pos pos buffer))
1738 (prop (list (list 'margin 'left-margin) putstring)))
1739 (put-text-property 0 (length gdb-string) 'display prop gdb-string)
1740 (overlay-put overlay 'put-arrow t)
1741 (overlay-put overlay 'before-string gdb-string))))
1743 (defun gdb-remove-arrow (&optional buffer)
1744 "Remove arrow in BUFFER.
1745 Remove only images that were put in BUFFER with calls to `put-arrow'.
1746 BUFFER nil or omitted means use the current buffer."
1748 (setq buffer (current-buffer)))
1749 (let ((overlays (overlays-in (point-min) (point-max))))
1751 (let ((overlay (car overlays)))
1752 (when (overlay-get overlay 'put-arrow)
1753 (delete-overlay overlay)))
1754 (setq overlays (cdr overlays)))))
1757 ;; Assembler buffer.
1759 (gdb-set-buffer-rules 'gdb-assembler-buffer
1760 'gdb-assembler-buffer-name
1761 'gdb-assembler-mode)
1763 (def-gdb-auto-updated-buffer gdb-assembler-buffer
1764 gdb-invalidate-assembler
1765 (concat "server disassemble " gdb-current-address "\n")
1766 gdb-assembler-handler
1767 gdb-assembler-custom)
1769 (defun gdb-assembler-custom ()
1770 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
1771 (gdb-arrow-position 1) (address) (flag))
1772 (with-current-buffer buffer
1773 (if (not (equal gdb-current-address "main"))
1776 (goto-char (point-min))
1777 (if (re-search-forward gdb-current-address nil t)
1779 (setq gdb-arrow-position (point))
1780 (gdb-put-arrow "=>" (point))))))
1781 ;; remove all breakpoint-icons in assembler buffer before updating.
1782 (if (display-images-p)
1783 (remove-images (point-min) (point-max))
1784 (gdb-remove-strings (point-min) (point-max))))
1785 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1786 (goto-char (point-min))
1787 (while (< (point) (- (point-max) 1))
1789 (if (looking-at "[^\t].*breakpoint")
1792 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
1793 (setq flag (char-after (match-beginning 1)))
1794 (setq address (match-string 2))
1795 ;; remove leading 0s from output of info break.
1796 (if (string-match "^0+\\(.*\\)" address)
1797 (setq address (match-string 1 address)))
1798 (with-current-buffer buffer
1799 (goto-char (point-min))
1800 (if (re-search-forward address nil t)
1801 (let ((start (progn (beginning-of-line) (- (point) 1)))
1802 (end (progn (end-of-line) (+ (point) 1))))
1803 (if (display-images-p)
1805 (remove-images start end)
1807 (put-image breakpoint-enabled-icon
1809 "breakpoint icon enabled"
1811 (put-image breakpoint-disabled-icon
1813 "breakpoint icon disabled"
1815 (gdb-remove-strings start end)
1817 (gdb-put-string "B" (+ start 1))
1818 (gdb-put-string "b" (+ start 1)))))))))))
1819 (if (not (equal gdb-current-address "main"))
1820 (set-window-point (get-buffer-window buffer) gdb-arrow-position))))
1822 (defvar gdb-assembler-mode-map
1823 (let ((map (make-sparse-keymap)))
1824 (suppress-keymap map)
1827 (defun gdb-assembler-mode ()
1828 "Major mode for viewing code assembler.
1830 \\{gdb-assembler-mode-map}"
1831 (setq major-mode 'gdb-assembler-mode)
1832 (setq mode-name "Assembler")
1833 (setq left-margin-width 2)
1834 (setq fringes-outside-margins t)
1835 (setq buffer-read-only t)
1836 (use-local-map gdb-assembler-mode-map)
1837 (gdb-invalidate-assembler))
1839 (defun gdb-assembler-buffer-name ()
1840 (with-current-buffer gud-comint-buffer
1841 (concat "*Machine Code " (gdb-get-target-string) "*")))
1843 (defun gdb-display-assembler-buffer ()
1846 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1848 (defun gdb-frame-assembler-buffer ()
1850 (switch-to-buffer-other-frame
1851 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1853 ;; modified because if gdb-current-address has changed value a new command
1854 ;; must be enqueued to update the buffer with the new output
1855 (defun gdb-invalidate-assembler (&optional ignored)
1856 (if (gdb-get-buffer 'gdb-assembler-buffer)
1858 (unless (string-equal gdb-current-frame gdb-previous-frame)
1859 (if (or (not (member 'gdb-invalidate-assembler
1860 (gdb-get-pending-triggers)))
1861 (not (string-equal gdb-current-address
1862 gdb-previous-address)))
1864 ;; take previous disassemble command off the queue
1865 (with-current-buffer gud-comint-buffer
1866 (let ((queue (gdb-get-input-queue)) (item))
1867 (dolist (item queue)
1868 (if (equal (cdr item) '(gdb-assembler-handler))
1869 (gdb-set-input-queue
1870 (delete item (gdb-get-input-queue)))))))
1872 (list (concat "server disassemble " gdb-current-address "\n")
1873 'gdb-assembler-handler))
1874 (gdb-set-pending-triggers
1875 (cons 'gdb-invalidate-assembler
1876 (gdb-get-pending-triggers)))
1877 (setq gdb-previous-address gdb-current-address)
1878 (setq gdb-previous-frame gdb-current-frame)))))))
1880 (defun gdb-get-current-frame ()
1881 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
1884 (list (concat "server info frame\n") 'gdb-frame-handler))
1885 (gdb-set-pending-triggers
1886 (cons 'gdb-get-current-frame
1887 (gdb-get-pending-triggers))))))
1889 (defun gdb-frame-handler ()
1890 (gdb-set-pending-triggers
1891 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
1892 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1893 (goto-char (point-min))
1895 (if (looking-at ".*= 0x\\(\\S-*\\) in \\(\\S-*\\)")
1897 (setq gdb-current-frame (match-string 2))
1898 (let ((address (match-string 1)))
1899 ;; remove leading 0s from output of info frame command.
1900 (if (string-match "^0+\\(.*\\)" address)
1901 (setq gdb-current-address
1902 (concat "0x" (match-string 1 address)))
1903 (setq gdb-current-address (concat "0x" address))))
1904 (if (or (if (not (looking-at ".*(\\S-*:[0-9]*)"))
1905 (progn (setq gdb-view-source nil) t))
1906 (eq gdb-selected-view 'assembler))
1910 (gdb-get-create-buffer 'gdb-assembler-buffer))
1911 ;;update with new frame for machine code if necessary
1912 (gdb-invalidate-assembler)))))))
1916 ;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
1917 ;;; gdb-ui.el ends here