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, 2003, 2004 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 has evolved from 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
42 ;; info manual. Some GDB/MI commands are also used through th CLI command
43 ;; 'interpreter mi <mi-command>'.
52 (defvar gdb-current-address
"main" "Initialisation for Assembler buffer.")
53 (defvar gdb-previous-address nil
)
54 (defvar gdb-previous-frame nil
)
55 (defvar gdb-current-frame
"main")
56 (defvar gdb-current-language nil
)
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-buffer-type nil
)
62 (defvar gdb-overlay-arrow-position 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.
123 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
124 (set (make-local-variable 'gud-marker-filter
) 'gud-gdba-marker-filter
)
126 (gud-def gud-break
(if (not (string-equal mode-name
"Machine"))
127 (gud-call "break %f:%l" arg
)
131 (gud-call "break *%a" arg
)))
132 "\C-b" "Set breakpoint at current line or address.")
134 (gud-def gud-remove
(if (not (string-equal mode-name
"Machine"))
135 (gud-call "clear %f:%l" arg
)
139 (gud-call "clear *%a" arg
)))
140 "\C-d" "Remove breakpoint at current line or address.")
142 (gud-def gud-until
(if (not (string-equal mode-name
"Machine"))
143 (gud-call "until %f:%l" arg
)
147 (gud-call "until *%a" arg
)))
148 "\C-u" "Continue to current line or address.")
150 (define-key gud-minor-mode-map
[left-margin mouse-1
]
151 'gdb-mouse-toggle-breakpoint
)
152 (define-key gud-minor-mode-map
[left-fringe mouse-1
]
153 'gdb-mouse-toggle-breakpoint
)
155 (setq comint-input-sender
'gdb-send
)
158 (setq gdb-current-address
"main")
159 (setq gdb-previous-address nil
)
160 (setq gdb-previous-frame nil
)
161 (setq gdb-current-frame
"main")
162 (setq gdb-view-source t
)
163 (setq gdb-selected-view
'source
)
164 (setq gdb-var-list nil
)
165 (setq gdb-var-changed nil
)
166 (setq gdb-first-prompt nil
)
168 (mapc 'make-local-variable gdb-variables
)
169 (setq gdb-buffer-type
'gdba
)
171 (gdb-clear-inferior-io)
173 (if (eq window-system
'w32
)
174 (gdb-enqueue-input (list "set new-console off\n" 'ignore
)))
175 (gdb-enqueue-input (list "set height 0\n" 'ignore
))
176 ;; find source file and compilation directory here
177 (gdb-enqueue-input (list "server list main\n" 'ignore
)) ; C program
178 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore
)) ; Fortran program
179 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info
))
181 (run-hooks 'gdba-mode-hook
))
183 (defcustom gdb-use-colon-colon-notation nil
184 "Non-nil means use FUNCTION::VARIABLE format to display variables in the
190 "Watch expression at point."
193 (let ((expr (tooltip-identifier-from-point (point))))
194 (if (and (string-equal gdb-current-language
"c")
195 gdb-use-colon-colon-notation
)
196 (setq expr
(concat gdb-current-frame
"::" expr
)))
197 (catch 'already-watched
198 (dolist (var gdb-var-list
)
199 (if (string-equal expr
(car var
)) (throw 'already-watched nil
)))
200 (set-text-properties 0 (length expr
) nil expr
)
202 (list (concat "server interpreter mi \"-var-create - * " expr
"\"\n")
203 `(lambda () (gdb-var-create-handler ,expr
))))))
204 (select-window (get-buffer-window gud-comint-buffer
)))
206 (defconst gdb-var-create-regexp
207 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
209 (defun gdb-var-create-handler (expr)
210 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
211 (goto-char (point-min))
212 (if (re-search-forward gdb-var-create-regexp nil t
)
213 (let ((var (list expr
218 (push var gdb-var-list
)
219 (setq speedbar-update-flag t
)
221 (if (equal (nth 2 var
) "0")
223 (list (concat "server interpreter mi \"-var-evaluate-expression "
225 `(lambda () (gdb-var-evaluate-expression-handler
227 (setq gdb-var-changed t
)))
228 (if (re-search-forward "Undefined command" nil t
)
229 (message "Watching expressions requires gdb 6.0 onwards")
230 (message "No symbol %s in current context." expr
)))))
232 (defun gdb-var-evaluate-expression-handler (varnum changed
)
233 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
234 (goto-char (point-min))
235 (re-search-forward ".*value=\"\\(.*?\\)\"" nil t
)
237 (let ((var-list nil
) (num 0))
238 (dolist (var gdb-var-list
)
239 (if (string-equal varnum
(cadr var
))
241 (if changed
(setcar (nthcdr 5 var
) t
))
242 (setcar (nthcdr 4 var
) (match-string 1))
243 (setcar (nthcdr num gdb-var-list
) var
)
244 (throw 'var-found nil
)))
245 (setq num
(+ num
1))))))
246 (setq gdb-var-changed t
))
248 (defun gdb-var-list-children (varnum)
250 (list (concat "server interpreter mi \"-var-list-children " varnum
"\"\n")
251 `(lambda () (gdb-var-list-children-handler ,varnum
)))))
253 (defconst gdb-var-list-children-regexp
254 "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"")
256 (defun gdb-var-list-children-handler (varnum)
257 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
258 (goto-char (point-min))
259 (let ((var-list nil
))
260 (catch 'child-already-watched
261 (dolist (var gdb-var-list
)
262 (if (string-equal varnum
(cadr var
))
265 (while (re-search-forward gdb-var-list-children-regexp nil t
)
266 (let ((varchild (list (match-string 2)
270 (if (looking-at ",type=\"\\(.*?\\)\"")
271 (setcar (nthcdr 3 varchild
) (match-string 1)))
272 (dolist (var1 gdb-var-list
)
273 (if (string-equal (cadr var1
) (cadr varchild
))
274 (throw 'child-already-watched nil
)))
275 (push varchild var-list
)
276 (if (equal (nth 2 varchild
) "0")
280 "server interpreter mi \"-var-evaluate-expression "
281 (nth 1 varchild
) "\"\n")
282 `(lambda () (gdb-var-evaluate-expression-handler
283 ,(nth 1 varchild
) nil
))))))))
284 (push var var-list
)))
285 (setq gdb-var-list
(nreverse var-list
))))))
287 (defun gdb-var-update ()
288 (if (not (member 'gdb-var-update
(gdb-get-pending-triggers)))
290 (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"
291 'gdb-var-update-handler
))
292 (gdb-set-pending-triggers (cons 'gdb-var-update
293 (gdb-get-pending-triggers))))))
295 (defconst gdb-var-update-regexp
"name=\"\\(.*?\\)\"")
297 (defun gdb-var-update-handler ()
298 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
299 (goto-char (point-min))
300 (while (re-search-forward gdb-var-update-regexp nil t
)
301 (let ((varnum (match-string 1)))
303 (list (concat "server interpreter mi \"-var-evaluate-expression "
305 `(lambda () (gdb-var-evaluate-expression-handler
307 (gdb-set-pending-triggers
308 (delq 'gdb-var-update
(gdb-get-pending-triggers))))
310 (defun gdb-var-delete ()
311 "Delete watched expression from the speedbar."
313 (if (with-current-buffer gud-comint-buffer
(eq gud-minor-mode
'gdba
))
314 (let ((text (speedbar-line-text)))
315 (string-match "\\(\\S-+\\)" text
)
316 (let* ((expr (match-string 1 text
))
317 (var (assoc expr gdb-var-list
))
319 (unless (string-match "\\." varnum
)
321 (list (concat "server interpreter mi \"-var-delete "
324 (setq gdb-var-list
(delq var gdb-var-list
))
325 (dolist (varchild gdb-var-list
)
326 (if (string-match (concat (nth 1 var
) "\\.") (nth 1 varchild
))
327 (setq gdb-var-list
(delq varchild gdb-var-list
))))
328 (setq gdb-var-changed t
))))))
330 (defun gdb-edit-value (text token indent
)
331 "Assign a value to a variable displayed in the speedbar"
332 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list
))
333 (varnum (cadr var
)) (value))
334 (setq value
(read-string "New value: "))
336 (list (concat "server interpreter mi \"-var-assign "
337 varnum
" " value
"\"\n")
340 (defcustom gdb-show-changed-values t
341 "Non-nil means use font-lock-warning-face to display values that have
342 recently changed in the speedbar."
346 (defun gdb-speedbar-expand-node (text token indent
)
347 "Expand the node the user clicked on.
348 TEXT is the text of the button we clicked on, a + or - item.
349 TOKEN is data related to this node.
350 INDENT is the current indentation depth."
351 (cond ((string-match "+" text
) ;expand this node
352 (gdb-var-list-children token
))
353 ((string-match "-" text
) ;contract this node
354 (dolist (var gdb-var-list
)
355 (if (string-match (concat token
"\\.") (nth 1 var
))
356 (setq gdb-var-list
(delq var gdb-var-list
))))
357 (setq gdb-var-changed t
))))
360 ;; ======================================================================
362 ;; In this world, there are gdb variables (of unspecified
363 ;; representation) and buffers associated with those objects.
364 ;; The list of variables is built up by the expansions of
367 (defmacro def-gdb-var
(root-symbol &optional default doc
)
368 (let* ((root (symbol-name root-symbol
))
369 (accessor (intern (concat "gdb-get-" root
)))
370 (setter (intern (concat "gdb-set-" root
)))
371 (name (intern (concat "gdb-" root
))))
373 (defvar ,name
,default
,doc
)
374 (if (not (memq ',name gdb-variables
))
375 (push ',name gdb-variables
))
377 (buffer-local-value ',name gud-comint-buffer
))
379 (with-current-buffer gud-comint-buffer
380 (setq ,name val
))))))
382 (def-gdb-var buffer-type nil
383 "One of the symbols bound in gdb-buffer-rules")
385 (def-gdb-var burst
""
386 "A string of characters from gdb that have not yet been processed.")
388 (def-gdb-var input-queue
()
389 "A list of gdb command objects.")
391 (def-gdb-var prompting nil
392 "True when gdb is idle with no pending input.")
394 (def-gdb-var output-sink
'user
395 "The disposition of the output of the current gdb command.
396 Possible values are these symbols:
398 user -- gdb output should be copied to the GUD buffer
401 inferior -- gdb output should be copied to the inferior-io buffer
403 pre-emacs -- output should be ignored util the post-prompt
404 annotation is received. Then the output-sink
406 emacs -- output should be collected in the partial-output-buffer
407 for subsequent processing by a command. This is the
408 disposition of output generated by commands that
409 gdb mode sends to gdb on its own behalf.
410 post-emacs -- ignore input until the prompt annotation is
411 received, then go to USER disposition.
414 (def-gdb-var current-item nil
415 "The most recent command item sent to gdb.")
417 (def-gdb-var pending-triggers
'()
418 "A list of trigger functions that have run later than their output
421 ;; end of gdb variables
423 (defun gdb-get-target-string ()
424 (with-current-buffer gud-comint-buffer
431 ;; Each buffer has a TYPE -- a symbol that identifies the function
432 ;; of that particular buffer.
434 ;; The usual gdb interaction buffer is given the type `gdba' and
435 ;; is constructed specially.
437 ;; Others are constructed by gdb-get-create-buffer and
438 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
440 (defvar gdb-buffer-rules-assoc
'())
442 (defun gdb-get-buffer (key)
443 "Return the gdb buffer tagged with type KEY.
444 The key should be one of the cars in `gdb-buffer-rules-assoc'."
446 (gdb-look-for-tagged-buffer key
(buffer-list))))
448 (defun gdb-get-create-buffer (key)
449 "Create a new gdb buffer of the type specified by KEY.
450 The key should be one of the cars in `gdb-buffer-rules-assoc'."
451 (or (gdb-get-buffer key
)
452 (let* ((rules (assoc key gdb-buffer-rules-assoc
))
453 (name (funcall (gdb-rules-name-maker rules
)))
454 (new (get-buffer-create name
)))
455 (with-current-buffer new
456 ;; FIXME: This should be set after calling the function, since the
457 ;; function should run kill-all-local-variables.
458 (set (make-local-variable 'gdb-buffer-type
) key
)
459 (if (cdr (cdr rules
))
460 (funcall (car (cdr (cdr rules
)))))
461 (set (make-local-variable 'gud-comint-buffer
) gud-comint-buffer
)
462 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
463 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
466 (defun gdb-rules-name-maker (rules) (car (cdr rules
)))
468 (defun gdb-look-for-tagged-buffer (key bufs
)
470 (while (and (not retval
) bufs
)
471 (set-buffer (car bufs
))
472 (if (eq gdb-buffer-type key
)
473 (setq retval
(car bufs
)))
474 (setq bufs
(cdr bufs
)))
478 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
479 ;; at least one and possible more functions. The functions have these
480 ;; roles in defining a buffer type:
482 ;; NAME - Return a name for this buffer type.
484 ;; The remaining function(s) are optional:
486 ;; MODE - called in a new buffer with no arguments, should establish
487 ;; the proper mode for the buffer.
490 (defun gdb-set-buffer-rules (buffer-type &rest rules
)
491 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc
)))
493 (setcdr binding rules
)
494 (push (cons buffer-type rules
)
495 gdb-buffer-rules-assoc
))))
497 ;; GUD buffers are an exception to the rules
498 (gdb-set-buffer-rules 'gdba
'error
)
501 ;; Partial-output buffer : This accumulates output from a command executed on
502 ;; behalf of emacs (rather than the user).
504 (gdb-set-buffer-rules 'gdb-partial-output-buffer
505 'gdb-partial-output-name
)
507 (defun gdb-partial-output-name ()
508 (concat "*partial-output-"
509 (gdb-get-target-string)
513 (gdb-set-buffer-rules 'gdb-inferior-io
514 'gdb-inferior-io-name
515 'gdb-inferior-io-mode
)
517 (defun gdb-inferior-io-name ()
518 (concat "*input/output of "
519 (gdb-get-target-string)
522 (defvar gdb-inferior-io-mode-map
523 (let ((map (make-sparse-keymap)))
524 (define-key map
"\C-c\C-c" 'gdb-inferior-io-interrupt
)
525 (define-key map
"\C-c\C-z" 'gdb-inferior-io-stop
)
526 (define-key map
"\C-c\C-\\" 'gdb-inferior-io-quit
)
527 (define-key map
"\C-c\C-d" 'gdb-inferior-io-eof
)
530 (define-derived-mode gdb-inferior-io-mode comint-mode
"Debuggee I/O"
531 "Major mode for gdb inferior-io."
532 :syntax-table nil
:abbrev-table nil
533 ;; We want to use comint because it has various nifty and familiar
534 ;; features. We don't need a process, but comint wants one, so create
536 (make-comint-in-buffer
537 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
538 (current-buffer) "hexl")
539 (setq comint-input-sender
'gdb-inferior-io-sender
))
541 (defun gdb-inferior-io-sender (proc string
)
542 ;; PROC is the pseudo-process created to satisfy comint.
543 (with-current-buffer (process-buffer proc
)
544 (setq proc
(get-buffer-process gud-comint-buffer
))
545 (process-send-string proc string
)
546 (process-send-string proc
"\n")))
548 (defun gdb-inferior-io-interrupt ()
549 "Interrupt the program being debugged."
552 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
554 (defun gdb-inferior-io-quit ()
555 "Send quit signal to the program being debugged."
558 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
560 (defun gdb-inferior-io-stop ()
561 "Stop the program being debugged."
564 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
566 (defun gdb-inferior-io-eof ()
567 "Send end-of-file to the program being debugged."
570 (get-buffer-process gud-comint-buffer
)))
574 ;; gdb communications
577 ;; INPUT: things sent to gdb
579 ;; The queues are lists. Each element is either a string (indicating user or
580 ;; user-like input) or a list of the form:
582 ;; (INPUT-STRING HANDLER-FN)
584 ;; The handler function will be called from the partial-output buffer when the
585 ;; command completes. This is the way to write commands which invoke gdb
586 ;; commands autonomously.
588 ;; These lists are consumed tail first.
591 (defun gdb-send (proc string
)
592 "A comint send filter for gdb.
593 This filter may simply queue output for a later time."
594 (gdb-enqueue-input (concat string
"\n")))
596 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
597 ;; is a query, or other non-top-level prompt.
599 (defun gdb-enqueue-input (item)
600 (if (gdb-get-prompting)
603 (gdb-set-prompting nil
))
605 (cons item
(gdb-get-input-queue)))))
607 (defun gdb-dequeue-input ()
608 (let ((queue (gdb-get-input-queue)))
610 (let ((last (car (last queue
))))
611 (unless (nbutlast queue
) (gdb-set-input-queue '()))
616 ;; output -- things gdb prints to emacs
618 ;; GDB output is a stream interrupted by annotations.
619 ;; Annotations can be recognized by their beginning
620 ;; with \C-j\C-z\C-z<tag><opt>\C-j
622 ;; The tag is a string obeying symbol syntax.
624 ;; The optional part `<opt>' can be either the empty string
625 ;; or a space followed by more data relating to the annotation.
626 ;; For example, the SOURCE annotation is followed by a filename,
627 ;; line number and various useless goo. This data must not include
631 (defcustom gud-gdba-command-name
"gdb -annotate=3"
632 "Default command to execute an executable under the GDB-UI debugger."
636 (defvar gdb-annotation-rules
637 '(("pre-prompt" gdb-pre-prompt
)
638 ("prompt" gdb-prompt
)
639 ("commands" gdb-subprompt
)
640 ("overload-choice" gdb-subprompt
)
641 ("query" gdb-subprompt
)
642 ("prompt-for-continue" gdb-subprompt
)
643 ("post-prompt" gdb-post-prompt
)
644 ("source" gdb-source
)
645 ("starting" gdb-starting
)
646 ("exited" gdb-stopping
)
647 ("signalled" gdb-stopping
)
648 ("signal" gdb-stopping
)
649 ("breakpoint" gdb-stopping
)
650 ("watchpoint" gdb-stopping
)
651 ("frame-begin" gdb-frame-begin
)
652 ("stopped" gdb-stopped
)
653 ) "An assoc mapping annotation tags to functions which process them.")
655 (defconst gdb-source-spec-regexp
656 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
658 ;; Do not use this except as an annotation handler.
659 (defun gdb-source (args)
660 (string-match gdb-source-spec-regexp args
)
661 ;; Extract the frame position from the marker.
664 (match-string 1 args
)
665 (string-to-int (match-string 2 args
))))
666 (setq gdb-current-address
(match-string 3 args
))
667 (setq gdb-view-source t
))
669 (defun gdb-send-item (item)
670 (gdb-set-current-item item
)
673 (gdb-set-output-sink 'user
)
674 (process-send-string (get-buffer-process gud-comint-buffer
) item
))
676 (gdb-clear-partial-output)
677 (gdb-set-output-sink 'pre-emacs
)
678 (process-send-string (get-buffer-process gud-comint-buffer
)
681 (defun gdb-pre-prompt (ignored)
682 "An annotation handler for `pre-prompt'. This terminates the collection of
683 output from a previous command if that happens to be in effect."
684 (let ((sink (gdb-get-output-sink)))
688 (gdb-set-output-sink 'post-emacs
))
690 (gdb-set-output-sink 'user
)
691 (error "Phase error in gdb-pre-prompt (got %s)" sink
)))))
693 (defun gdb-prompt (ignored)
694 "An annotation handler for `prompt'.
695 This sends the next command (if any) to gdb."
696 (when gdb-first-prompt
(gdb-ann3))
697 (let ((sink (gdb-get-output-sink)))
700 ((eq sink
'post-emacs
)
701 (gdb-set-output-sink 'user
)
703 (car (cdr (gdb-get-current-item)))))
704 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
707 (gdb-set-output-sink 'user
)
708 (error "Phase error in gdb-prompt (got %s)" sink
))))
709 (let ((input (gdb-dequeue-input)))
711 (gdb-send-item input
)
713 (gdb-set-prompting t
)
714 (gud-display-frame)))))
716 (defun gdb-subprompt (ignored)
717 "An annotation handler for non-top-level prompts."
718 (gdb-set-prompting t
))
720 (defun gdb-starting (ignored)
721 "An annotation handler for `starting'. This says that I/O for the
722 subprocess is now the program being debugged, not GDB."
723 (let ((sink (gdb-get-output-sink)))
728 (gdb-set-output-sink 'inferior
)))
729 (t (error "Unexpected `starting' annotation")))))
731 (defun gdb-stopping (ignored)
732 "An annotation handler for `exited' and other annotations which say that I/O
733 for the subprocess is now GDB, not the program being debugged."
734 (let ((sink (gdb-get-output-sink)))
737 (gdb-set-output-sink 'user
))
738 (t (error "Unexpected stopping annotation")))))
740 (defun gdb-frame-begin (ignored)
741 (let ((sink (gdb-get-output-sink)))
744 (gdb-set-output-sink 'user
))
747 (t (error "Unexpected frame-begin annotation (%S)" sink
)))))
749 (defun gdb-stopped (ignored)
750 "An annotation handler for `stopped'. It is just like gdb-stopping, except
751 that if we already set the output sink to 'user in gdb-stopping, that is fine."
752 (setq gud-running nil
)
753 (let ((sink (gdb-get-output-sink)))
756 (gdb-set-output-sink 'user
))
758 (t (error "Unexpected stopped annotation")))))
760 (defun gdb-post-prompt (ignored)
761 "An annotation handler for `post-prompt'. This begins the collection of
762 output from the current command if that happens to be appropriate."
763 (if (not (gdb-get-pending-triggers))
765 (gdb-get-current-frame)
766 (gdb-invalidate-frames)
767 (gdb-invalidate-breakpoints)
768 (gdb-invalidate-assembler)
769 (gdb-invalidate-registers)
770 (gdb-invalidate-locals)
771 (gdb-invalidate-threads)
772 (dolist (frame (frame-list))
773 (when (string-equal (frame-parameter frame
'name
) "Speedbar")
774 (setq gdb-var-changed t
) ; force update
775 (dolist (var gdb-var-list
)
776 (setcar (nthcdr 5 var
) nil
))))
778 (let ((sink (gdb-get-output-sink)))
781 ((eq sink
'pre-emacs
)
782 (gdb-set-output-sink 'emacs
))
784 (gdb-set-output-sink 'user
)
785 (error "Phase error in gdb-post-prompt (got %s)" sink
)))))
787 (defun gud-gdba-marker-filter (string)
788 "A gud marker filter for gdb. Handle a burst of output from GDB."
789 ;; Recall the left over gud-marker-acc from last time
790 (setq gud-marker-acc
(concat gud-marker-acc string
))
791 ;; Start accumulating output for the GUD buffer
794 ;; Process all the complete markers in this chunk.
795 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc
)
796 (let ((annotation (match-string 1 gud-marker-acc
)))
798 ;; Stuff prior to the match is just ordinary output.
799 ;; It is either concatenated to OUTPUT or directed
804 (substring gud-marker-acc
0 (match-beginning 0))))
806 ;; Take that stuff off the gud-marker-acc.
807 (setq gud-marker-acc
(substring gud-marker-acc
(match-end 0)))
809 ;; Parse the tag from the annotation, and maybe its arguments.
810 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation
)
811 (let* ((annotation-type (match-string 1 annotation
))
812 (annotation-arguments (match-string 2 annotation
))
813 (annotation-rule (assoc annotation-type
814 gdb-annotation-rules
)))
815 ;; Call the handler for this annotation.
817 (funcall (car (cdr annotation-rule
))
818 annotation-arguments
)
819 ;; Else the annotation is not recognized. Ignore it silently,
820 ;; so that GDB can add new annotations without causing
824 ;; Does the remaining text end in a partial line?
825 ;; If it does, then keep part of the gud-marker-acc until we get more.
826 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
829 ;; Everything before the potential marker start can be output.
831 (gdb-concat-output output
832 (substring gud-marker-acc
0
833 (match-beginning 0))))
835 ;; Everything after, we save, to combine with later input.
836 (setq gud-marker-acc
(substring gud-marker-acc
(match-beginning 0))))
838 ;; In case we know the gud-marker-acc contains no partial annotations:
840 (setq output
(gdb-concat-output output gud-marker-acc
))
841 (setq gud-marker-acc
"")))
844 (defun gdb-concat-output (so-far new
)
845 (let ((sink (gdb-get-output-sink )))
847 ((eq sink
'user
) (concat so-far new
))
848 ((or (eq sink
'pre-emacs
) (eq sink
'post-emacs
)) so-far
)
850 (gdb-append-to-partial-output new
)
853 (gdb-append-to-inferior-io new
)
855 (t (error "Bogon output sink %S" sink
)))))
857 (defun gdb-append-to-partial-output (string)
858 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
859 (goto-char (point-max))
862 (defun gdb-clear-partial-output ()
863 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
866 (defun gdb-append-to-inferior-io (string)
867 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
868 (goto-char (point-max))
869 (insert-before-markers string
))
870 (if (not (string-equal string
""))
871 (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io
))))
873 (defun gdb-clear-inferior-io ()
874 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
878 ;; One trick is to have a command who's output is always available in a buffer
879 ;; of it's own, and is always up to date. We build several buffers of this
882 ;; There are two aspects to this: gdb has to tell us when the output for that
883 ;; command might have changed, and we have to be able to run the command
884 ;; behind the user's back.
886 ;; The output phasing associated with the variable gdb-output-sink
887 ;; help us to run commands behind the user's back.
889 ;; Below is the code for specificly managing buffers of output from one
893 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
894 ;; It adds an input for the command we are tracking. It should be the
895 ;; annotation rule binding of whatever gdb sends to tell us this command
896 ;; might have changed it's output.
898 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
899 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
900 ;; input in the input queue (see comment about ``gdb communications'' above).
902 (defmacro def-gdb-auto-update-trigger
(name demand-predicate gdb-command
904 `(defun ,name
(&optional ignored
)
905 (if (and (,demand-predicate
)
907 (gdb-get-pending-triggers))))
910 (list ,gdb-command
',output-handler
))
911 (gdb-set-pending-triggers
913 (gdb-get-pending-triggers)))))))
915 (defmacro def-gdb-auto-update-handler
(name trigger buf-key custom-defun
)
917 (gdb-set-pending-triggers
919 (gdb-get-pending-triggers)))
920 (let ((buf (gdb-get-buffer ',buf-key
)))
922 (with-current-buffer buf
924 (buffer-read-only nil
))
926 (insert-buffer-substring (gdb-get-create-buffer
927 'gdb-partial-output-buffer
))
929 ;; put customisation here
932 (defmacro def-gdb-auto-updated-buffer
(buffer-key trigger-name gdb-command
933 output-handler-name custom-defun
)
935 (def-gdb-auto-update-trigger ,trigger-name
936 ;; The demand predicate:
937 (lambda () (gdb-get-buffer ',buffer-key
))
939 ,output-handler-name
)
940 (def-gdb-auto-update-handler ,output-handler-name
941 ,trigger-name
,buffer-key
,custom-defun
)))
945 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
947 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
948 'gdb-breakpoints-buffer-name
949 'gdb-breakpoints-mode
)
951 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
952 ;; This defines the auto update rule for buffers of type
953 ;; `gdb-breakpoints-buffer'.
955 ;; It defines a function to serve as the annotation handler that
956 ;; handles the `foo-invalidated' message. That function is called:
957 gdb-invalidate-breakpoints
959 ;; To update the buffer, this command is sent to gdb.
960 "server info breakpoints\n"
962 ;; This also defines a function to be the handler for the output
963 ;; from the command above. That function will copy the output into
964 ;; the appropriately typed buffer. That function will be called:
965 gdb-info-breakpoints-handler
966 ;; buffer specific functions
967 gdb-info-breakpoints-custom
)
969 (defvar gdb-cdir nil
"Compilation directory.")
971 (defconst breakpoint-xpm-data
"/* XPM */
972 static char *magick[] = {
973 /* columns rows colors chars-per-pixel */
989 "XPM data used for breakpoint icon.")
991 (defconst breakpoint-enabled-pbm-data
994 0 0 0 0 1 1 1 1 0 0 0 0
995 0 0 0 1 1 1 1 1 1 0 0 0
996 0 0 1 1 1 1 1 1 1 1 0 0
997 0 1 1 1 1 1 1 1 1 1 1 0
998 0 1 1 1 1 1 1 1 1 1 1 0
999 0 1 1 1 1 1 1 1 1 1 1 0
1000 0 1 1 1 1 1 1 1 1 1 1 0
1001 0 0 1 1 1 1 1 1 1 1 0 0
1002 0 0 0 1 1 1 1 1 1 0 0 0
1003 0 0 0 0 1 1 1 1 0 0 0 0"
1004 "PBM data used for enabled breakpoint icon.")
1006 (defconst breakpoint-disabled-pbm-data
1018 0 0 0 1 0 1 0 1 0 0"
1019 "PBM data used for disabled breakpoint icon.")
1021 (defvar breakpoint-enabled-icon nil
1022 "Icon for enabled breakpoint in display margin")
1024 (defvar breakpoint-disabled-icon nil
1025 "Icon for disabled breakpoint in display margin")
1027 (defvar breakpoint-bitmap nil
1028 "Bitmap for breakpoint in fringe")
1030 (defface breakpoint-enabled-bitmap-face
1034 "Face for enabled breakpoint icon in fringe.")
1036 (defface breakpoint-disabled-bitmap-face
1039 :foreground
"grey60"))
1040 "Face for disabled breakpoint icon in fringe.")
1043 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1044 (defun gdb-info-breakpoints-custom ()
1045 (let ((flag)(address))
1047 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1048 (dolist (buffer (buffer-list))
1049 (with-current-buffer buffer
1050 (if (and (eq gud-minor-mode
'gdba
)
1051 (not (string-match "^\*" (buffer-name))))
1052 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
1053 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer
)
1055 (goto-char (point-min))
1056 (while (< (point) (- (point-max) 1))
1058 (if (looking-at "[^\t].*breakpoint")
1060 (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1061 (setq flag
(char-after (match-beginning 1)))
1063 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t
)
1065 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1066 (let ((line (match-string 2)) (buffer-read-only nil
)
1067 (file (match-string 1)))
1068 (add-text-properties (point-at-bol) (point-at-eol)
1069 '(mouse-face highlight
1070 help-echo
"mouse-2, RET: visit breakpoint"))
1071 (with-current-buffer
1073 (if (file-exists-p file
) file
1074 (expand-file-name file gdb-cdir
)))
1075 (save-current-buffer
1076 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1077 (set (make-local-variable 'tool-bar-map
)
1079 ;; only want one breakpoint icon at each location
1081 (goto-line (string-to-number line
))
1082 (gdb-put-breakpoint-icon (eq flag ?y
)))))))))
1084 (if (gdb-get-buffer 'gdb-assembler-buffer
) (gdb-assembler-custom)))
1086 (defun gdb-mouse-toggle-breakpoint (event)
1087 "Toggle breakpoint with mouse click in left margin."
1089 (mouse-minibuffer-check event
)
1090 (let ((posn (event-end event
)))
1091 (if (numberp (posn-point posn
))
1092 (with-selected-window (posn-window posn
)
1094 (goto-char (posn-point posn
))
1095 (if (or (posn-object posn
)
1096 (and breakpoint-bitmap
1097 (eq (car (fringe-bitmaps-at-pos (posn-point posn
)))
1098 breakpoint-bitmap
)))
1100 (gud-break nil
)))))))
1102 (defun gdb-breakpoints-buffer-name ()
1103 (with-current-buffer gud-comint-buffer
1104 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1106 (defun gdb-display-breakpoints-buffer ()
1109 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1111 (defun gdb-frame-breakpoints-buffer ()
1113 (switch-to-buffer-other-frame
1114 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1116 (defvar gdb-breakpoints-mode-map
1117 (let ((map (make-sparse-keymap))
1118 (menu (make-sparse-keymap "Breakpoints")))
1119 (define-key menu
[toggle] '("Toggle" . gdb-toggle-breakpoint))
1120 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1121 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1123 (suppress-keymap map)
1124 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1125 (define-key map " " 'gdb-toggle-breakpoint)
1126 (define-key map "d" 'gdb-delete-breakpoint)
1127 (define-key map "\r" 'gdb-goto-breakpoint)
1128 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1131 (defun gdb-breakpoints-mode ()
1132 "Major mode for gdb breakpoints.
1134 \\{gdb-breakpoints-mode-map}"
1135 (setq major-mode 'gdb-breakpoints-mode)
1136 (setq mode-name "Breakpoints")
1137 (use-local-map gdb-breakpoints-mode-map)
1138 (setq buffer-read-only t)
1139 (gdb-invalidate-breakpoints))
1141 (defun gdb-toggle-breakpoint ()
1142 "Enable/disable the breakpoint at current line."
1145 (beginning-of-line 1)
1146 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1147 (error "Not recognized as break/watchpoint line")
1151 (if (eq ?y (char-after (match-beginning 2)))
1154 (match-string 1) "\n")
1157 (defun gdb-delete-breakpoint ()
1158 "Delete the breakpoint at current line."
1160 (beginning-of-line 1)
1161 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1162 (error "Not recognized as break/watchpoint line")
1164 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1166 (defvar gdb-source-window nil)
1168 (defun gdb-goto-breakpoint ()
1169 "Display the file in the source buffer at the breakpoint specified on the
1173 (beginning-of-line 1)
1174 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1175 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1176 (if (match-string 2)
1177 (let ((line (match-string 2))
1178 (file (match-string 1)))
1179 (save-selected-window
1180 (select-window gdb-source-window)
1181 (switch-to-buffer (find-file-noselect
1182 (if (file-exists-p file)
1184 (expand-file-name file gdb-cdir))))
1185 (goto-line (string-to-number line))))))
1187 (defun gdb-mouse-goto-breakpoint (event)
1188 "Display the file in the source buffer at the selected breakpoint."
1190 (mouse-set-point event)
1191 (gdb-goto-breakpoint))
1194 ;; Frames buffer. This displays a perpetually correct bactracktrace
1195 ;; (from the command `where').
1197 ;; Alas, if your stack is deep, it is costly.
1199 (gdb-set-buffer-rules 'gdb-stack-buffer
1200 'gdb-stack-buffer-name
1203 (def-gdb-auto-updated-buffer gdb-stack-buffer
1204 gdb-invalidate-frames
1206 gdb-info-frames-handler
1207 gdb-info-frames-custom)
1209 (defun gdb-info-frames-custom ()
1210 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1212 (let ((buffer-read-only nil))
1213 (goto-char (point-min))
1214 (while (< (point) (point-max))
1215 (add-text-properties (point-at-bol) (point-at-eol)
1216 '(mouse-face highlight
1217 help-echo "mouse-2, RET: Select frame"))
1219 (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
1220 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
1221 (equal (match-string 1) gdb-current-frame))
1222 (put-text-property (point-at-bol) (point-at-eol)
1223 'face '(:inverse-video t)))
1224 (forward-line 1))))))
1226 (defun gdb-stack-buffer-name ()
1227 (with-current-buffer gud-comint-buffer
1228 (concat "*stack frames of " (gdb-get-target-string) "*")))
1230 (defun gdb-display-stack-buffer ()
1233 (gdb-get-create-buffer 'gdb-stack-buffer)))
1235 (defun gdb-frame-stack-buffer ()
1237 (switch-to-buffer-other-frame
1238 (gdb-get-create-buffer 'gdb-stack-buffer)))
1240 (defvar gdb-frames-mode-map
1241 (let ((map (make-sparse-keymap)))
1242 (suppress-keymap map)
1243 (define-key map "\r" 'gdb-frames-select)
1244 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1247 (defun gdb-frames-mode ()
1248 "Major mode for gdb frames.
1250 \\{gdb-frames-mode-map}"
1251 (setq major-mode 'gdb-frames-mode)
1252 (setq mode-name "Frames")
1253 (setq buffer-read-only t)
1254 (use-local-map gdb-frames-mode-map)
1256 (gdb-invalidate-frames))
1258 (defun gdb-get-frame-number ()
1260 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1261 (n (or (and pos (match-string-no-properties 1)) "0")))
1264 (defun gdb-frames-select ()
1265 "Make the frame on the current line become the current frame and display the
1266 source in the source buffer."
1269 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1270 (gud-display-frame))
1272 (defun gdb-frames-mouse-select (event)
1273 "Make the selected frame become the current frame and display the source in
1276 (mouse-set-point event)
1277 (gdb-frames-select))
1280 ;; Threads buffer. This displays a selectable thread list.
1282 (gdb-set-buffer-rules 'gdb-threads-buffer
1283 'gdb-threads-buffer-name
1286 (def-gdb-auto-updated-buffer gdb-threads-buffer
1287 gdb-invalidate-threads
1288 "server info threads\n"
1289 gdb-info-threads-handler
1290 gdb-info-threads-custom)
1292 (defun gdb-info-threads-custom ()
1293 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1294 (let ((buffer-read-only nil))
1295 (goto-char (point-min))
1296 (while (< (point) (point-max))
1297 (add-text-properties (point-at-bol) (point-at-eol)
1298 '(mouse-face highlight
1299 help-echo "mouse-2, RET: select thread"))
1300 (forward-line 1)))))
1302 (defun gdb-threads-buffer-name ()
1303 (with-current-buffer gud-comint-buffer
1304 (concat "*threads of " (gdb-get-target-string) "*")))
1306 (defun gdb-display-threads-buffer ()
1309 (gdb-get-create-buffer 'gdb-threads-buffer)))
1311 (defun gdb-frame-threads-buffer ()
1313 (switch-to-buffer-other-frame
1314 (gdb-get-create-buffer 'gdb-threads-buffer)))
1316 (defvar gdb-threads-mode-map
1317 (let ((map (make-sparse-keymap)))
1318 (suppress-keymap map)
1319 (define-key map "\r" 'gdb-threads-select)
1320 (define-key map [mouse-2] 'gdb-threads-mouse-select)
1323 (defun gdb-threads-mode ()
1324 "Major mode for gdb frames.
1326 \\{gdb-frames-mode-map}"
1327 (setq major-mode 'gdb-threads-mode)
1328 (setq mode-name "Threads")
1329 (setq buffer-read-only t)
1330 (use-local-map gdb-threads-mode-map)
1331 (gdb-invalidate-threads))
1333 (defun gdb-get-thread-number ()
1335 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1336 (match-string-no-properties 1)))
1338 (defun gdb-threads-select ()
1339 "Make the thread on the current line become the current thread and display the
1340 source in the source buffer."
1343 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1344 (gud-display-frame))
1346 (defun gdb-threads-mouse-select (event)
1347 "Make the selected frame become the current frame and display the source in
1350 (mouse-set-point event)
1351 (gdb-threads-select))
1354 ;; Registers buffer.
1356 (gdb-set-buffer-rules 'gdb-registers-buffer
1357 'gdb-registers-buffer-name
1358 'gdb-registers-mode)
1360 (def-gdb-auto-updated-buffer gdb-registers-buffer
1361 gdb-invalidate-registers
1362 "server info registers\n"
1363 gdb-info-registers-handler
1364 gdb-info-registers-custom)
1366 (defun gdb-info-registers-custom ())
1368 (defvar gdb-registers-mode-map
1369 (let ((map (make-sparse-keymap)))
1370 (suppress-keymap map)
1373 (defun gdb-registers-mode ()
1374 "Major mode for gdb registers.
1376 \\{gdb-registers-mode-map}"
1377 (setq major-mode 'gdb-registers-mode)
1378 (setq mode-name "Registers")
1379 (setq buffer-read-only t)
1380 (use-local-map gdb-registers-mode-map)
1381 (gdb-invalidate-registers))
1383 (defun gdb-registers-buffer-name ()
1384 (with-current-buffer gud-comint-buffer
1385 (concat "*registers of " (gdb-get-target-string) "*")))
1387 (defun gdb-display-registers-buffer ()
1390 (gdb-get-create-buffer 'gdb-registers-buffer)))
1392 (defun gdb-frame-registers-buffer ()
1394 (switch-to-buffer-other-frame
1395 (gdb-get-create-buffer 'gdb-registers-buffer)))
1400 (gdb-set-buffer-rules 'gdb-locals-buffer
1401 'gdb-locals-buffer-name
1404 (def-gdb-auto-updated-buffer gdb-locals-buffer
1405 gdb-invalidate-locals
1406 "server info locals\n"
1407 gdb-info-locals-handler
1408 gdb-info-locals-custom)
1410 ;; Abbreviate for arrays and structures.
1411 ;; These can be expanded using gud-display.
1412 (defun gdb-info-locals-handler nil
1413 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1414 (gdb-get-pending-triggers)))
1415 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1416 (with-current-buffer buf
1417 (goto-char (point-min))
1418 (while (re-search-forward "^ .*\n" nil t)
1419 (replace-match "" nil nil))
1420 (goto-char (point-min))
1421 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1422 (replace-match "(array);\n" nil nil))
1423 (goto-char (point-min))
1424 (while (re-search-forward "{.*=.*\n" nil t)
1425 (replace-match "(structure);\n" nil nil))))
1426 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1427 (and buf (with-current-buffer buf
1429 (buffer-read-only nil))
1430 (delete-region (point-min) (point-max))
1431 (insert-buffer-substring (gdb-get-create-buffer
1432 'gdb-partial-output-buffer))
1434 (run-hooks 'gdb-info-locals-hook))
1436 (defun gdb-info-locals-custom ()
1439 (defvar gdb-locals-mode-map
1440 (let ((map (make-sparse-keymap)))
1441 (suppress-keymap map)
1444 (defun gdb-locals-mode ()
1445 "Major mode for gdb locals.
1447 \\{gdb-locals-mode-map}"
1448 (setq major-mode 'gdb-locals-mode)
1449 (setq mode-name "Locals")
1450 (setq buffer-read-only t)
1451 (use-local-map gdb-locals-mode-map)
1452 (gdb-invalidate-locals))
1454 (defun gdb-locals-buffer-name ()
1455 (with-current-buffer gud-comint-buffer
1456 (concat "*locals of " (gdb-get-target-string) "*")))
1458 (defun gdb-display-locals-buffer ()
1461 (gdb-get-create-buffer 'gdb-locals-buffer)))
1463 (defun gdb-frame-locals-buffer ()
1465 (switch-to-buffer-other-frame
1466 (gdb-get-create-buffer 'gdb-locals-buffer)))
1469 ;;;; Window management
1471 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1472 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1473 ;;; get at the use_time field of a window, I'm not sure there exists a
1474 ;;; more elegant solution without writing C code.
1476 (defun gdb-display-buffer (buf &optional size)
1477 (let ((must-split nil)
1483 (if (or (eq gud-comint-buffer (window-buffer win))
1484 (eq gdb-source-window win))
1485 (set-window-dedicated-p win t))))
1486 (setq answer (get-buffer-window buf))
1488 (let ((window (get-lru-window)))
1491 (set-window-buffer window buf)
1492 (setq answer window))
1493 (setq must-split t)))))
1496 (if (or (eq gud-comint-buffer (window-buffer win))
1497 (eq gdb-source-window win))
1498 (set-window-dedicated-p win nil)))))
1500 (let* ((largest (get-largest-window))
1501 (cur-size (window-height largest))
1502 (new-size (and size (< size cur-size) (- cur-size size))))
1503 (setq answer (split-window largest new-size))
1504 (set-window-buffer answer buf)))
1507 (defun gdb-display-source-buffer (buffer)
1508 (if (eq gdb-selected-view 'source)
1510 (if (window-live-p gdb-source-window)
1511 (set-window-buffer gdb-source-window buffer)
1512 (gdb-display-buffer buffer)
1513 (setq gdb-source-window (get-buffer-window buffer)))
1515 (if (window-live-p gdb-source-window)
1516 (set-window-buffer gdb-source-window
1517 (gdb-get-buffer 'gdb-assembler-buffer))
1518 (let ((buf (gdb-get-buffer 'gdb-assembler-buffer)))
1519 (gdb-display-buffer buf)
1520 (setq gdb-source-window (get-buffer-window buf))))
1524 ;;; Shared keymap initialization:
1526 (let ((menu (make-sparse-keymap "GDB-Frames")))
1527 (define-key gud-menu-map [frames]
1528 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1529 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1530 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1531 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1532 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1533 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1534 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1535 ; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
1538 (let ((menu (make-sparse-keymap "GDB-Windows")))
1539 (define-key gud-menu-map [displays]
1540 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1541 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1542 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1543 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1544 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1545 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1546 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1547 ; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1550 (let ((menu (make-sparse-keymap "View")))
1551 (define-key gud-menu-map [view]
1552 `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba)))
1553 ; (define-key menu [both] '(menu-item "Both" gdb-view-both
1554 ; :help "Display both source and assembler"
1555 ; :button (:radio . (eq gdb-selected-view 'both))))
1556 (define-key menu [assembler] '(menu-item "Machine" gdb-view-assembler
1557 :help "Display assembler only"
1558 :button (:radio . (eq gdb-selected-view 'assembler))))
1559 (define-key menu [source] '(menu-item "Source" gdb-view-source-function
1560 :help "Display source only"
1561 :button (:radio . (eq gdb-selected-view 'source)))))
1563 (let ((menu (make-sparse-keymap "GDB-UI")))
1564 (define-key gud-menu-map [ui]
1565 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
1566 (define-key menu [gdb-restore-windows]
1567 '("Restore window layout" . gdb-restore-windows))
1568 (define-key menu [gdb-many-windows]
1569 (menu-bar-make-toggle gdb-many-windows gdb-many-windows
1570 "Display other windows" "Many Windows %s"
1571 "Display locals, stack and breakpoint information")))
1573 (defun gdb-frame-gdb-buffer ()
1575 (switch-to-buffer-other-frame
1576 (gdb-get-create-buffer 'gdba)))
1578 (defun gdb-display-gdb-buffer ()
1581 (gdb-get-create-buffer 'gdba)))
1583 (defvar gdb-main-file nil "Source file from which program execution begins.")
1585 (defun gdb-view-source-function ()
1588 (if gud-last-last-frame
1589 (set-window-buffer gdb-source-window
1590 (gud-find-file (car gud-last-last-frame)))
1591 (set-window-buffer gdb-source-window (gud-find-file gdb-main-file))))
1592 (setq gdb-selected-view 'source))
1594 (defun gdb-view-assembler()
1596 (set-window-buffer gdb-source-window
1597 (gdb-get-create-buffer 'gdb-assembler-buffer))
1598 (setq gdb-selected-view 'assembler))
1600 ;(defun gdb-view-both()
1602 ;(setq gdb-selected-view 'both))
1604 ;; layout for all the windows
1605 (defun gdb-setup-windows ()
1606 (gdb-display-locals-buffer)
1607 (gdb-display-stack-buffer)
1608 (delete-other-windows)
1609 (gdb-display-breakpoints-buffer)
1610 (delete-other-windows)
1611 (switch-to-buffer gud-comint-buffer)
1612 (split-window nil ( / ( * (window-height) 3) 4))
1613 (split-window nil ( / (window-height) 3))
1614 (split-window-horizontally)
1616 (switch-to-buffer (gdb-locals-buffer-name))
1619 (if (and gdb-view-source
1620 (eq gdb-selected-view 'source))
1621 (if gud-last-last-frame
1622 (gud-find-file (car gud-last-last-frame))
1623 (gud-find-file gdb-main-file))
1624 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1625 (setq gdb-source-window (get-buffer-window (current-buffer)))
1626 (split-window-horizontally)
1628 (switch-to-buffer (gdb-inferior-io-name))
1630 (switch-to-buffer (gdb-stack-buffer-name))
1631 (split-window-horizontally)
1633 (switch-to-buffer (gdb-breakpoints-buffer-name))
1636 (defcustom gdb-many-windows nil
1637 "Nil means that gdb starts with just two windows : the GUD and
1642 (defun gdb-many-windows (arg)
1643 "Toggle the number of windows in the basic arrangement."
1645 (setq gdb-many-windows
1647 (not gdb-many-windows)
1648 (> (prefix-numeric-value arg) 0)))
1649 (gdb-restore-windows))
1651 (defun gdb-restore-windows ()
1652 "Restore the basic arrangement of windows used by gdba.
1653 This arrangement depends on the value of `gdb-many-windows'."
1655 (if gdb-many-windows
1657 (switch-to-buffer gud-comint-buffer)
1658 (delete-other-windows)
1659 (gdb-setup-windows))
1660 (switch-to-buffer gud-comint-buffer)
1661 (delete-other-windows)
1665 (if (and gdb-view-source
1666 (eq gdb-selected-view 'source))
1667 (if gud-last-last-frame
1668 (gud-find-file (car gud-last-last-frame))
1669 (gud-find-file gdb-main-file))
1670 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1671 (setq gdb-source-window (get-buffer-window (current-buffer)))
1675 "Exit a debugging session cleanly by killing the gdb buffers and resetting
1676 the source buffers."
1677 (dolist (buffer (buffer-list))
1678 (if (not (eq buffer gud-comint-buffer))
1679 (with-current-buffer buffer
1680 (if (memq gud-minor-mode '(gdba pdb))
1681 (if (string-match "^\*.+*$" (buffer-name))
1683 (gdb-remove-breakpoint-icons (point-min) (point-max) t)
1684 (setq gud-minor-mode nil)
1685 (kill-local-variable 'tool-bar-map)
1686 (setq gud-running nil))))))
1687 (when (markerp gdb-overlay-arrow-position)
1688 (move-marker gdb-overlay-arrow-position nil)
1689 (setq gdb-overlay-arrow-position nil))
1690 (setq overlay-arrow-variable-list
1691 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)))
1693 (defun gdb-source-info ()
1694 "Find the source file where the program starts and displays it with related
1696 (goto-char (point-min))
1697 (if (search-forward "directory is " nil t)
1698 (if (looking-at "\\S-*:\\(\\S-*\\)")
1699 (setq gdb-cdir (match-string 1))
1700 (looking-at "\\S-*")
1701 (setq gdb-cdir (match-string 0))))
1702 (if (search-forward "Located in " nil t)
1703 (if (looking-at "\\S-*")
1704 (setq gdb-main-file (match-string 0)))
1705 (setq gdb-view-source nil))
1706 (delete-other-windows)
1707 (switch-to-buffer gud-comint-buffer)
1708 (if gdb-many-windows
1710 (gdb-display-breakpoints-buffer)
1711 (delete-other-windows)
1716 (gud-find-file gdb-main-file)
1717 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1718 (setq gdb-source-window (get-buffer-window (current-buffer)))
1722 (defun gdb-put-string (putstring pos &optional dprop)
1723 "Put string PUTSTRING in front of POS in the current buffer.
1724 PUTSTRING is displayed by putting an overlay into the current buffer with a
1725 `before-string' STRING that has a `display' property whose value is
1727 (let ((gdb-string "x")
1728 (buffer (current-buffer)))
1729 (let ((overlay (make-overlay pos pos buffer))
1731 (list (list 'margin 'left-margin) putstring))))
1732 (put-text-property 0 (length gdb-string) 'display prop gdb-string)
1733 (overlay-put overlay 'put-break t)
1734 (overlay-put overlay 'before-string gdb-string))))
1736 ;;from remove-images
1737 (defun gdb-remove-strings (start end &optional buffer)
1738 "Remove strings between START and END in BUFFER.
1739 Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
1740 BUFFER nil or omitted means use the current buffer."
1742 (setq buffer (current-buffer)))
1743 (let ((overlays (overlays-in start end)))
1745 (let ((overlay (car overlays)))
1746 (when (overlay-get overlay 'put-break)
1747 (delete-overlay overlay)))
1748 (setq overlays (cdr overlays)))))
1750 (defun gdb-put-breakpoint-icon (enabled)
1751 (let ((start (progn (beginning-of-line) (- (point) 1)))
1752 (end (progn (end-of-line) (+ (point) 1))))
1753 (gdb-remove-breakpoint-icons start end)
1754 (if (display-images-p)
1755 (if (>= (car (window-fringes)) 8)
1759 ,(or breakpoint-bitmap
1760 (setq breakpoint-bitmap
1761 (define-fringe-bitmap
1762 "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")))
1764 'breakpoint-enabled-bitmap-face
1765 'breakpoint-disabled-bitmap-face)))
1766 (when (< left-margin-width 2)
1767 (save-current-buffer
1768 (setq left-margin-width 2)
1769 (if (get-buffer-window (current-buffer))
1770 (set-window-margins (get-buffer-window
1773 right-margin-width))))
1776 (or breakpoint-enabled-icon
1777 (setq breakpoint-enabled-icon
1778 (find-image `((:type xpm :data
1779 ,breakpoint-xpm-data
1780 :ascent 100 :pointer hand)
1782 ,breakpoint-enabled-pbm-data
1783 :ascent 100 :pointer hand)))))
1784 (or breakpoint-disabled-icon
1785 (setq breakpoint-disabled-icon
1786 (find-image `((:type xpm :data
1787 ,breakpoint-xpm-data
1788 :conversion disabled
1791 ,breakpoint-disabled-pbm-data
1793 (+ start 1) nil 'left-margin))
1794 (when (< left-margin-width 2)
1795 (save-current-buffer
1796 (setq left-margin-width 2)
1797 (if (get-buffer-window (current-buffer))
1798 (set-window-margins (get-buffer-window
1801 right-margin-width))))
1802 (gdb-put-string (if enabled "B" "b") (1+ start)))))
1804 (defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
1805 (gdb-remove-strings start end)
1806 (if (display-images-p)
1807 (remove-images start end))
1809 (setq left-margin-width 0)
1810 (if (get-buffer-window (current-buffer))
1811 (set-window-margins (get-buffer-window
1814 right-margin-width))))
1818 ;; Assembler buffer.
1820 (gdb-set-buffer-rules 'gdb-assembler-buffer
1821 'gdb-assembler-buffer-name
1822 'gdb-assembler-mode)
1824 (def-gdb-auto-updated-buffer gdb-assembler-buffer
1825 gdb-invalidate-assembler
1826 (concat "server disassemble " gdb-current-address "\n")
1827 gdb-assembler-handler
1828 gdb-assembler-custom)
1830 (defun gdb-assembler-custom ()
1831 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
1832 (pos 1) (address) (flag))
1833 (with-current-buffer buffer
1834 (if (not (equal gdb-current-address "main"))
1836 (goto-char (point-min))
1837 (if (re-search-forward gdb-current-address nil t)
1841 (or gdb-overlay-arrow-position
1842 (setq gdb-overlay-arrow-position (make-marker)))
1843 (set-marker gdb-overlay-arrow-position
1844 (point) (current-buffer))))))
1845 ;; remove all breakpoint-icons in assembler buffer before updating.
1846 (gdb-remove-breakpoint-icons (point-min) (point-max)))
1847 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1848 (goto-char (point-min))
1849 (while (< (point) (- (point-max) 1))
1851 (if (looking-at "[^\t].*breakpoint")
1854 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
1855 (setq flag (char-after (match-beginning 1)))
1856 (setq address (match-string 2))
1857 ;; remove leading 0s from output of info break.
1858 (if (string-match "^0+\\(.*\\)" address)
1859 (setq address (match-string 1 address)))
1860 (with-current-buffer buffer
1861 (goto-char (point-min))
1862 (if (re-search-forward address nil t)
1863 (gdb-put-breakpoint-icon (eq flag ?y))))))))
1864 (if (not (equal gdb-current-address "main"))
1865 (set-window-point (get-buffer-window buffer) pos))))
1867 (defvar gdb-assembler-mode-map
1868 (let ((map (make-sparse-keymap)))
1869 (suppress-keymap map)
1872 (defun gdb-assembler-mode ()
1873 "Major mode for viewing code assembler.
1875 \\{gdb-assembler-mode-map}"
1876 (setq major-mode 'gdb-assembler-mode)
1877 (setq mode-name "Machine")
1878 (setq gdb-overlay-arrow-position nil)
1879 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
1880 (put 'gdb-overlay-arrow-position 'overlay-arrow-string "=>")
1881 (setq fringes-outside-margins t)
1882 (setq buffer-read-only t)
1883 (use-local-map gdb-assembler-mode-map)
1884 (gdb-invalidate-assembler))
1886 (defun gdb-assembler-buffer-name ()
1887 (with-current-buffer gud-comint-buffer
1888 (concat "*Machine Code " (gdb-get-target-string) "*")))
1890 (defun gdb-display-assembler-buffer ()
1893 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1895 (defun gdb-frame-assembler-buffer ()
1897 (switch-to-buffer-other-frame
1898 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1900 ;; modified because if gdb-current-address has changed value a new command
1901 ;; must be enqueued to update the buffer with the new output
1902 (defun gdb-invalidate-assembler (&optional ignored)
1903 (if (gdb-get-buffer 'gdb-assembler-buffer)
1905 (unless (string-equal gdb-current-frame gdb-previous-frame)
1906 (if (or (not (member 'gdb-invalidate-assembler
1907 (gdb-get-pending-triggers)))
1908 (not (string-equal gdb-current-address
1909 gdb-previous-address)))
1911 ;; take previous disassemble command off the queue
1912 (with-current-buffer gud-comint-buffer
1913 (let ((queue (gdb-get-input-queue)) (item))
1914 (dolist (item queue)
1915 (if (equal (cdr item) '(gdb-assembler-handler))
1916 (gdb-set-input-queue
1917 (delete item (gdb-get-input-queue)))))))
1919 (list (concat "server disassemble " gdb-current-address "\n")
1920 'gdb-assembler-handler))
1921 (gdb-set-pending-triggers
1922 (cons 'gdb-invalidate-assembler
1923 (gdb-get-pending-triggers)))
1924 (setq gdb-previous-address gdb-current-address)
1925 (setq gdb-previous-frame gdb-current-frame)))))))
1927 (defun gdb-get-current-frame ()
1928 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
1931 (list (concat "server info frame\n") 'gdb-frame-handler))
1932 (gdb-set-pending-triggers
1933 (cons 'gdb-get-current-frame
1934 (gdb-get-pending-triggers))))))
1936 (defun gdb-frame-handler ()
1937 (gdb-set-pending-triggers
1938 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
1939 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1940 (goto-char (point-min))
1942 (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*\\)")
1944 (setq gdb-current-frame (match-string 2))
1945 (let ((address (match-string 1)))
1946 ;; remove leading 0s from output of info frame command.
1947 (if (string-match "^0+\\(.*\\)" address)
1948 (setq gdb-current-address
1949 (concat "0x" (match-string 1 address)))
1950 (setq gdb-current-address (concat "0x" address))))
1951 (if (or (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t))
1952 (progn (setq gdb-view-source nil) t))
1953 (eq gdb-selected-view 'assembler))
1957 (gdb-get-create-buffer 'gdb-assembler-buffer))
1958 ;;update with new frame for machine code if necessary
1959 (gdb-invalidate-assembler))))))
1960 (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
1961 (setq gdb-current-language (match-string 1))))
1965 ;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
1966 ;;; gdb-ui.el ends here