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 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-variables
'()
63 "A list of variables that are local to the GUD buffer.")
66 (defun gdba (command-line)
67 "Run gdb on program FILE in buffer *gud-FILE*.
68 The directory containing FILE becomes the initial working directory
69 and source-file directory for your debugger.
71 If `gdb-many-windows' is nil (the default value) then gdb starts with
72 just two windows : the GUD and the source buffer. If it is t the
73 following layout will appear (keybindings given in relevant buffer) :
75 ---------------------------------------------------------------------
77 ---------------------------------------------------------------------
78 GUD buffer (I/O of GDB) | Locals buffer
82 ---------------------------------------------------------------------
83 Source buffer | Input/Output (of debuggee) buffer
91 ---------------------------------------------------------------------
92 Stack buffer | Breakpoints buffer
93 RET gdb-frames-select | SPC gdb-toggle-breakpoint
94 | RET gdb-goto-breakpoint
95 | d gdb-delete-breakpoint
96 ---------------------------------------------------------------------
98 All the buffers share the toolbar and source should always display in the same
99 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
100 icons are displayed both by setting a break with gud-break and by typing break
103 This works best (depending on the size of your monitor) using most of the
106 Displayed expressions appear in separate frames. Arrays may be displayed
107 as slices and visualised using the graph program from plotutils if installed.
108 Pointers in structures may be followed in a tree-like fashion.
110 The following interactive lisp functions help control operation :
112 `gdb-many-windows' - Toggle the number of windows gdb uses.
113 `gdb-restore-windows' - To restore the window layout."
115 (interactive (list (gud-query-cmdline 'gdba
)))
117 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
120 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
121 (set (make-local-variable 'gud-marker-filter
) 'gud-gdba-marker-filter
)
123 (gud-def gud-break
(if (not (string-equal mode-name
"Machine"))
124 (gud-call "break %f:%l" arg
)
128 (gud-call "break *%a" arg
)))
129 "\C-b" "Set breakpoint at current line or address.")
131 (gud-def gud-remove
(if (not (string-equal mode-name
"Machine"))
132 (gud-call "clear %f:%l" arg
)
136 (gud-call "clear *%a" arg
)))
137 "\C-d" "Remove breakpoint at current line or address.")
139 (gud-def gud-until
(if (not (string-equal mode-name
"Machine"))
140 (gud-call "until %f:%l" arg
)
144 (gud-call "until *%a" arg
)))
145 "\C-u" "Continue to current line or address.")
147 (define-key gud-minor-mode-map
[left-margin mouse-1
]
148 'gdb-mouse-toggle-breakpoint
)
149 (define-key gud-minor-mode-map
[left-fringe mouse-1
]
150 'gdb-mouse-toggle-breakpoint
)
152 (setq comint-input-sender
'gdb-send
)
155 (setq gdb-current-address
"main")
156 (setq gdb-previous-address nil
)
157 (setq gdb-previous-frame nil
)
158 (setq gdb-current-frame
"main")
159 (setq gdb-view-source t
)
160 (setq gdb-selected-view
'source
)
161 (setq gdb-var-list nil
)
162 (setq gdb-var-changed nil
)
163 (setq gdb-first-pre-prompt nil
)
165 (mapc 'make-local-variable gdb-variables
)
166 (setq gdb-buffer-type
'gdba
)
168 (gdb-clear-inferior-io)
170 (if (eq window-system
'w32
)
171 (gdb-enqueue-input (list "set new-console off\n" 'ignore
)))
172 (gdb-enqueue-input (list "set height 0\n" 'ignore
))
173 ;; find source file and compilation directory here
174 (gdb-enqueue-input (list "server list main\n" 'ignore
)) ; C program
175 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore
)) ; Fortran program
176 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info
))
178 (run-hooks 'gdba-mode-hook
))
180 (defcustom gdb-use-colon-colon-notation t
181 "Non-nil means use FUNCTION::VARIABLE format to display variables in the
187 "Watch expression at point."
189 (let ((expr (tooltip-identifier-from-point (point))))
190 (if (and (string-equal gdb-current-language
"c")
191 gdb-use-colon-colon-notation
)
192 (setq expr
(concat gdb-current-frame
"::" expr
)))
193 (catch 'already-watched
194 (dolist (var gdb-var-list
)
195 (if (string-equal expr
(car var
)) (throw 'already-watched nil
)))
196 (set-text-properties 0 (length expr
) nil expr
)
198 (list (concat "server interpreter mi \"-var-create - * " expr
"\"\n")
199 `(lambda () (gdb-var-create-handler ,expr
))))))
200 (select-window (get-buffer-window gud-comint-buffer
)))
202 (defconst gdb-var-create-regexp
203 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
205 (defun gdb-var-create-handler (expr)
206 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
207 (goto-char (point-min))
208 (if (re-search-forward gdb-var-create-regexp nil t
)
209 (let ((var (list expr
214 (push var gdb-var-list
)
216 (if (equal (nth 2 var
) "0")
218 (list (concat "server interpreter mi \"-var-evaluate-expression "
220 `(lambda () (gdb-var-evaluate-expression-handler
222 (setq gdb-var-changed t
)))
223 (if (re-search-forward "Undefined command" nil t
)
224 (message "Watching expressions requires gdb 6.0 onwards")
225 (message "No symbol %s in current context." expr
)))))
227 (defun gdb-var-evaluate-expression-handler (varnum changed
)
228 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
229 (goto-char (point-min))
230 (re-search-forward ".*value=\"\\(.*?\\)\"" nil t
)
232 (let ((var-list nil
) (num 0))
233 (dolist (var gdb-var-list
)
234 (if (string-equal varnum
(cadr var
))
236 (if changed
(setcar (nthcdr 5 var
) t
))
237 (setcar (nthcdr 4 var
) (match-string 1))
238 (setcar (nthcdr num gdb-var-list
) var
)
239 (throw 'var-found nil
)))
240 (setq num
(+ num
1))))))
241 (setq gdb-var-changed t
))
243 (defun gdb-var-list-children (varnum)
245 (list (concat "server interpreter mi \"-var-list-children " varnum
"\"\n")
246 `(lambda () (gdb-var-list-children-handler ,varnum
)))))
248 (defconst gdb-var-list-children-regexp
249 "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
251 (defun gdb-var-list-children-handler (varnum)
252 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
253 (goto-char (point-min))
254 (let ((var-list nil
))
255 (catch 'child-already-watched
256 (dolist (var gdb-var-list
)
257 (if (string-equal varnum
(cadr var
))
260 (while (re-search-forward gdb-var-list-children-regexp nil t
)
261 (let ((varchild (list (match-string 2)
267 (dolist (var1 gdb-var-list
)
268 (if (string-equal (cadr var1
) (cadr varchild
))
269 (throw 'child-already-watched nil
)))
270 (push varchild var-list
)
271 (if (equal (nth 2 varchild
) "0")
275 "server interpreter mi \"-var-evaluate-expression "
276 (nth 1 varchild
) "\"\n")
277 `(lambda () (gdb-var-evaluate-expression-handler
278 ,(nth 1 varchild
) nil
))))))))
279 (push var var-list
)))
280 (setq gdb-var-list
(nreverse var-list
))))))
282 (defun gdb-var-update ()
283 (if (not (member 'gdb-var-update
(gdb-get-pending-triggers)))
285 (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"
286 'gdb-var-update-handler
))
287 (gdb-set-pending-triggers (cons 'gdb-var-update
288 (gdb-get-pending-triggers))))))
290 (defconst gdb-var-update-regexp
"name=\"\\(.*?\\)\"")
292 (defun gdb-var-update-handler ()
293 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
294 (goto-char (point-min))
295 (while (re-search-forward gdb-var-update-regexp nil t
)
296 (let ((varnum (match-string 1)))
298 (list (concat "server interpreter mi \"-var-evaluate-expression "
300 `(lambda () (gdb-var-evaluate-expression-handler
302 (gdb-set-pending-triggers
303 (delq 'gdb-var-update
(gdb-get-pending-triggers))))
305 (defun gdb-var-delete (text token indent
)
306 "Delete watched expression."
309 (string-match "\\(\\S-+\\)" text
)
310 (let* ((expr (match-string 1 text
))
311 (var (assoc expr gdb-var-list
))
314 (list (concat "server interpreter mi \"-var-delete " varnum
"\"\n")
316 (setq gdb-var-list
(delq var gdb-var-list
))
317 (dolist (varchild gdb-var-list
)
318 (if (string-match (concat (nth 1 var
) "\\.") (nth 1 varchild
))
319 (setq gdb-var-list
(delq varchild gdb-var-list
)))))
320 (setq gdb-var-changed t
)))
322 (defun gdb-edit-value (text token indent
)
323 "Assign a value to a variable displayed in the speedbar"
325 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list
))
326 (varnum (cadr var
)) (value))
327 (setq value
(read-string "New value: "))
329 (list (concat "server interpreter mi \"-var-assign "
330 varnum
" " value
"\"\n")
333 (defcustom gdb-show-changed-values t
334 "Non-nil means use font-lock-warning-face to display values that have
335 recently changed in the speedbar."
339 (defun gdb-speedbar-expand-node (text token indent
)
340 "Expand the node the user clicked on.
341 TEXT is the text of the button we clicked on, a + or - item.
342 TOKEN is data related to this node.
343 INDENT is the current indentation depth."
344 (cond ((string-match "+" text
) ;expand this node
345 (gdb-var-list-children token
))
346 ((string-match "-" text
) ;contract this node
347 (dolist (var gdb-var-list
)
348 (if (string-match (concat token
"\\.") (nth 1 var
))
349 (setq gdb-var-list
(delq var gdb-var-list
))))
350 (setq gdb-var-changed t
))))
353 ;; ======================================================================
355 ;; In this world, there are gdb variables (of unspecified
356 ;; representation) and buffers associated with those objects.
357 ;; The list of variables is built up by the expansions of
360 (defmacro def-gdb-var
(root-symbol &optional default doc
)
361 (let* ((root (symbol-name root-symbol
))
362 (accessor (intern (concat "gdb-get-" root
)))
363 (setter (intern (concat "gdb-set-" root
)))
364 (name (intern (concat "gdb-" root
))))
366 (defvar ,name
,default
,doc
)
367 (if (not (memq ',name gdb-variables
))
368 (push ',name gdb-variables
))
370 (buffer-local-value ',name gud-comint-buffer
))
372 (with-current-buffer gud-comint-buffer
373 (setq ,name val
))))))
375 (def-gdb-var buffer-type nil
376 "One of the symbols bound in gdb-buffer-rules")
378 (def-gdb-var burst
""
379 "A string of characters from gdb that have not yet been processed.")
381 (def-gdb-var input-queue
()
382 "A list of gdb command objects.")
384 (def-gdb-var prompting nil
385 "True when gdb is idle with no pending input.")
387 (def-gdb-var output-sink
'user
388 "The disposition of the output of the current gdb command.
389 Possible values are these symbols:
391 user -- gdb output should be copied to the GUD buffer
394 inferior -- gdb output should be copied to the inferior-io buffer
396 pre-emacs -- output should be ignored util the post-prompt
397 annotation is received. Then the output-sink
399 emacs -- output should be collected in the partial-output-buffer
400 for subsequent processing by a command. This is the
401 disposition of output generated by commands that
402 gdb mode sends to gdb on its own behalf.
403 post-emacs -- ignore input until the prompt annotation is
404 received, then go to USER disposition.
407 (def-gdb-var current-item nil
408 "The most recent command item sent to gdb.")
410 (def-gdb-var pending-triggers
'()
411 "A list of trigger functions that have run later than their output
414 ;; end of gdb variables
416 (defun gdb-get-target-string ()
417 (with-current-buffer gud-comint-buffer
424 ;; Each buffer has a TYPE -- a symbol that identifies the function
425 ;; of that particular buffer.
427 ;; The usual gdb interaction buffer is given the type `gdba' and
428 ;; is constructed specially.
430 ;; Others are constructed by gdb-get-create-buffer and
431 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
433 (defvar gdb-buffer-rules-assoc
'())
435 (defun gdb-get-buffer (key)
436 "Return the gdb buffer tagged with type KEY.
437 The key should be one of the cars in `gdb-buffer-rules-assoc'."
439 (gdb-look-for-tagged-buffer key
(buffer-list))))
441 (defun gdb-get-create-buffer (key)
442 "Create a new gdb buffer of the type specified by KEY.
443 The key should be one of the cars in `gdb-buffer-rules-assoc'."
444 (or (gdb-get-buffer key
)
445 (let* ((rules (assoc key gdb-buffer-rules-assoc
))
446 (name (funcall (gdb-rules-name-maker rules
)))
447 (new (get-buffer-create name
)))
448 (with-current-buffer new
449 ;; FIXME: This should be set after calling the function, since the
450 ;; function should run kill-all-local-variables.
451 (set (make-local-variable 'gdb-buffer-type
) key
)
452 (if (cdr (cdr rules
))
453 (funcall (car (cdr (cdr rules
)))))
454 (set (make-local-variable 'gud-comint-buffer
) gud-comint-buffer
)
455 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
456 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
459 (defun gdb-rules-name-maker (rules) (car (cdr rules
)))
461 (defun gdb-look-for-tagged-buffer (key bufs
)
463 (while (and (not retval
) bufs
)
464 (set-buffer (car bufs
))
465 (if (eq gdb-buffer-type key
)
466 (setq retval
(car bufs
)))
467 (setq bufs
(cdr bufs
)))
471 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
472 ;; at least one and possible more functions. The functions have these
473 ;; roles in defining a buffer type:
475 ;; NAME - Return a name for this buffer type.
477 ;; The remaining function(s) are optional:
479 ;; MODE - called in a new buffer with no arguments, should establish
480 ;; the proper mode for the buffer.
483 (defun gdb-set-buffer-rules (buffer-type &rest rules
)
484 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc
)))
486 (setcdr binding rules
)
487 (push (cons buffer-type rules
)
488 gdb-buffer-rules-assoc
))))
490 ;; GUD buffers are an exception to the rules
491 (gdb-set-buffer-rules 'gdba
'error
)
494 ;; Partial-output buffer : This accumulates output from a command executed on
495 ;; behalf of emacs (rather than the user).
497 (gdb-set-buffer-rules 'gdb-partial-output-buffer
498 'gdb-partial-output-name
)
500 (defun gdb-partial-output-name ()
501 (concat "*partial-output-"
502 (gdb-get-target-string)
506 (gdb-set-buffer-rules 'gdb-inferior-io
507 'gdb-inferior-io-name
508 'gdb-inferior-io-mode
)
510 (defun gdb-inferior-io-name ()
511 (concat "*input/output of "
512 (gdb-get-target-string)
515 (defvar gdb-inferior-io-mode-map
516 (let ((map (make-sparse-keymap)))
517 (define-key map
"\C-c\C-c" 'gdb-inferior-io-interrupt
)
518 (define-key map
"\C-c\C-z" 'gdb-inferior-io-stop
)
519 (define-key map
"\C-c\C-\\" 'gdb-inferior-io-quit
)
520 (define-key map
"\C-c\C-d" 'gdb-inferior-io-eof
)
523 (define-derived-mode gdb-inferior-io-mode comint-mode
"Debuggee I/O"
524 "Major mode for gdb inferior-io."
525 :syntax-table nil
:abbrev-table nil
526 ;; We want to use comint because it has various nifty and familiar
527 ;; features. We don't need a process, but comint wants one, so create
529 (make-comint-in-buffer
530 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
531 (current-buffer) "hexl")
532 (setq comint-input-sender
'gdb-inferior-io-sender
))
534 (defun gdb-inferior-io-sender (proc string
)
535 ;; PROC is the pseudo-process created to satisfy comint.
536 (with-current-buffer (process-buffer proc
)
537 (setq proc
(get-buffer-process gud-comint-buffer
))
538 (process-send-string proc string
)
539 (process-send-string proc
"\n")))
541 (defun gdb-inferior-io-interrupt ()
542 "Interrupt the program being debugged."
545 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
547 (defun gdb-inferior-io-quit ()
548 "Send quit signal to the program being debugged."
551 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
553 (defun gdb-inferior-io-stop ()
554 "Stop the program being debugged."
557 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
559 (defun gdb-inferior-io-eof ()
560 "Send end-of-file to the program being debugged."
563 (get-buffer-process gud-comint-buffer
)))
567 ;; gdb communications
570 ;; INPUT: things sent to gdb
572 ;; The queues are lists. Each element is either a string (indicating user or
573 ;; user-like input) or a list of the form:
575 ;; (INPUT-STRING HANDLER-FN)
577 ;; The handler function will be called from the partial-output buffer when the
578 ;; command completes. This is the way to write commands which invoke gdb
579 ;; commands autonomously.
581 ;; These lists are consumed tail first.
584 (defun gdb-send (proc string
)
585 "A comint send filter for gdb.
586 This filter may simply queue output for a later time."
587 (gdb-enqueue-input (concat string
"\n")))
589 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
590 ;; is a query, or other non-top-level prompt.
592 (defun gdb-enqueue-input (item)
593 (if (gdb-get-prompting)
596 (gdb-set-prompting nil
))
598 (cons item
(gdb-get-input-queue)))))
600 (defun gdb-dequeue-input ()
601 (let ((queue (gdb-get-input-queue)))
603 (let ((last (car (last queue
))))
604 (unless (nbutlast queue
) (gdb-set-input-queue '()))
609 ;; output -- things gdb prints to emacs
611 ;; GDB output is a stream interrupted by annotations.
612 ;; Annotations can be recognized by their beginning
613 ;; with \C-j\C-z\C-z<tag><opt>\C-j
615 ;; The tag is a string obeying symbol syntax.
617 ;; The optional part `<opt>' can be either the empty string
618 ;; or a space followed by more data relating to the annotation.
619 ;; For example, the SOURCE annotation is followed by a filename,
620 ;; line number and various useless goo. This data must not include
624 (defcustom gud-gdba-command-name
"gdb -annotate=3"
625 "Default command to execute an executable under the GDB-UI debugger."
629 (defvar gdb-annotation-rules
630 '(("pre-prompt" gdb-pre-prompt
)
631 ("prompt" gdb-prompt
)
632 ("commands" gdb-subprompt
)
633 ("overload-choice" gdb-subprompt
)
634 ("query" gdb-subprompt
)
635 ("prompt-for-continue" gdb-subprompt
)
636 ("post-prompt" gdb-post-prompt
)
637 ("source" gdb-source
)
638 ("starting" gdb-starting
)
639 ("exited" gdb-stopping
)
640 ("signalled" gdb-stopping
)
641 ("signal" gdb-stopping
)
642 ("breakpoint" gdb-stopping
)
643 ("watchpoint" gdb-stopping
)
644 ("frame-begin" gdb-frame-begin
)
645 ("stopped" gdb-stopped
)
646 ) "An assoc mapping annotation tags to functions which process them.")
648 (defconst gdb-source-spec-regexp
649 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
651 ;; Do not use this except as an annotation handler.
652 (defun gdb-source (args)
653 (string-match gdb-source-spec-regexp args
)
654 ;; Extract the frame position from the marker.
657 (match-string 1 args
)
658 (string-to-int (match-string 2 args
))))
659 (setq gdb-current-address
(match-string 3 args
))
660 (setq gdb-view-source t
))
662 (defun gdb-send-item (item)
663 (gdb-set-current-item item
)
666 (gdb-set-output-sink 'user
)
667 (process-send-string (get-buffer-process gud-comint-buffer
) item
))
669 (gdb-clear-partial-output)
670 (gdb-set-output-sink 'pre-emacs
)
671 (process-send-string (get-buffer-process gud-comint-buffer
)
674 (defun gdb-pre-prompt (ignored)
675 "An annotation handler for `pre-prompt'. This terminates the collection of
676 output from a previous command if that happens to be in effect."
677 (let ((sink (gdb-get-output-sink)))
681 (gdb-set-output-sink 'post-emacs
))
683 (gdb-set-output-sink 'user
)
684 (error "Phase error in gdb-pre-prompt (got %s)" sink
)))))
686 (defun gdb-prompt (ignored)
687 "An annotation handler for `prompt'.
688 This sends the next command (if any) to gdb."
689 (when gdb-first-pre-prompt
691 (setq gdb-first-pre-prompt nil
))
692 (let ((sink (gdb-get-output-sink)))
695 ((eq sink
'post-emacs
)
696 (gdb-set-output-sink 'user
)
698 (car (cdr (gdb-get-current-item)))))
699 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
702 (gdb-set-output-sink 'user
)
703 (error "Phase error in gdb-prompt (got %s)" sink
))))
704 (let ((input (gdb-dequeue-input)))
706 (gdb-send-item input
)
708 (gdb-set-prompting t
)
709 (gud-display-frame)))))
712 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
713 (set (make-local-variable 'gud-marker-filter
) 'gud-gdba-marker-filter
)
715 (gud-def gud-break
(if (not (string-equal mode-name
"Machine"))
716 (gud-call "break %f:%l" arg
)
720 (gud-call "break *%a" arg
)))
721 "\C-b" "Set breakpoint at current line or address.")
723 (gud-def gud-remove
(if (not (string-equal mode-name
"Machine"))
724 (gud-call "clear %f:%l" arg
)
728 (gud-call "clear *%a" arg
)))
729 "\C-d" "Remove breakpoint at current line or address.")
731 (gud-def gud-until
(if (not (string-equal mode-name
"Machine"))
732 (gud-call "until %f:%l" arg
)
736 (gud-call "until *%a" arg
)))
737 "\C-u" "Continue to current line or address.")
739 (define-key gud-minor-mode-map
[left-margin mouse-1
]
740 'gdb-mouse-toggle-breakpoint
)
741 (define-key gud-minor-mode-map
[left-fringe mouse-1
]
742 'gdb-mouse-toggle-breakpoint
)
744 (setq comint-input-sender
'gdb-send
)
747 (setq gdb-current-address
"main")
748 (setq gdb-previous-address nil
)
749 (setq gdb-previous-frame nil
)
750 (setq gdb-current-frame
"main")
751 (setq gdb-view-source t
)
752 (setq gdb-selected-view
'source
)
753 (setq gdb-var-list nil
)
754 (setq gdb-var-changed nil
)
756 (mapc 'make-local-variable gdb-variables
)
757 (setq gdb-buffer-type
'gdba
)
759 (gdb-clear-inferior-io)
761 (if (eq window-system
'w32
)
762 (gdb-enqueue-input (list "set new-console off\n" 'ignore
)))
763 (gdb-enqueue-input (list "set height 0\n" 'ignore
))
764 ;; find source file and compilation directory here
765 (gdb-enqueue-input (list "server list main\n" 'ignore
)) ; C program
766 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore
)) ; Fortran program
767 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info
))
769 (run-hooks 'gdba-mode-hook
))
771 (defun gdb-subprompt (ignored)
772 "An annotation handler for non-top-level prompts."
773 (gdb-set-prompting t
))
775 (defun gdb-starting (ignored)
776 "An annotation handler for `starting'. This says that I/O for the
777 subprocess is now the program being debugged, not GDB."
778 (let ((sink (gdb-get-output-sink)))
783 (gdb-set-output-sink 'inferior
)))
784 (t (error "Unexpected `starting' annotation")))))
786 (defun gdb-stopping (ignored)
787 "An annotation handler for `exited' and other annotations which say that I/O
788 for the subprocess is now GDB, not the program being debugged."
789 (let ((sink (gdb-get-output-sink)))
792 (gdb-set-output-sink 'user
))
793 (t (error "Unexpected stopping annotation")))))
795 (defun gdb-frame-begin (ignored)
796 (let ((sink (gdb-get-output-sink)))
799 (gdb-set-output-sink 'user
))
802 (t (error "Unexpected frame-begin annotation (%S)" sink
)))))
804 (defun gdb-stopped (ignored)
805 "An annotation handler for `stopped'. It is just like gdb-stopping, except
806 that if we already set the output sink to 'user in gdb-stopping, that is fine."
807 (setq gud-running nil
)
808 (let ((sink (gdb-get-output-sink)))
811 (gdb-set-output-sink 'user
))
813 (t (error "Unexpected stopped annotation")))))
815 (defun gdb-post-prompt (ignored)
816 "An annotation handler for `post-prompt'. This begins the collection of
817 output from the current command if that happens to be appropriate."
818 (if (not (gdb-get-pending-triggers))
820 (gdb-get-current-frame)
821 (gdb-invalidate-frames)
822 (gdb-invalidate-breakpoints)
823 (gdb-invalidate-assembler)
824 (gdb-invalidate-registers)
825 (gdb-invalidate-locals)
826 (gdb-invalidate-threads)
827 (dolist (frame (frame-list))
828 (when (string-equal (frame-parameter frame
'name
) "Speedbar")
829 (setq gdb-var-changed t
) ; force update
830 (dolist (var gdb-var-list
)
831 (setcar (nthcdr 5 var
) nil
))))
833 (let ((sink (gdb-get-output-sink)))
836 ((eq sink
'pre-emacs
)
837 (gdb-set-output-sink 'emacs
))
839 (gdb-set-output-sink 'user
)
840 (error "Phase error in gdb-post-prompt (got %s)" sink
)))))
842 (defun gud-gdba-marker-filter (string)
843 "A gud marker filter for gdb. Handle a burst of output from GDB."
844 ;; Recall the left over gud-marker-acc from last time
845 (setq gud-marker-acc
(concat gud-marker-acc string
))
846 ;; Start accumulating output for the GUD buffer
849 ;; Process all the complete markers in this chunk.
850 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc
)
851 (let ((annotation (match-string 1 gud-marker-acc
)))
853 ;; Stuff prior to the match is just ordinary output.
854 ;; It is either concatenated to OUTPUT or directed
859 (substring gud-marker-acc
0 (match-beginning 0))))
861 ;; Take that stuff off the gud-marker-acc.
862 (setq gud-marker-acc
(substring gud-marker-acc
(match-end 0)))
864 ;; Parse the tag from the annotation, and maybe its arguments.
865 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation
)
866 (let* ((annotation-type (match-string 1 annotation
))
867 (annotation-arguments (match-string 2 annotation
))
868 (annotation-rule (assoc annotation-type
869 gdb-annotation-rules
)))
870 ;; Call the handler for this annotation.
872 (funcall (car (cdr annotation-rule
))
873 annotation-arguments
)
874 ;; Else the annotation is not recognized. Ignore it silently,
875 ;; so that GDB can add new annotations without causing
879 ;; Does the remaining text end in a partial line?
880 ;; If it does, then keep part of the gud-marker-acc until we get more.
881 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
884 ;; Everything before the potential marker start can be output.
886 (gdb-concat-output output
887 (substring gud-marker-acc
0
888 (match-beginning 0))))
890 ;; Everything after, we save, to combine with later input.
891 (setq gud-marker-acc
(substring gud-marker-acc
(match-beginning 0))))
893 ;; In case we know the gud-marker-acc contains no partial annotations:
895 (setq output
(gdb-concat-output output gud-marker-acc
))
896 (setq gud-marker-acc
"")))
899 (defun gdb-concat-output (so-far new
)
900 (let ((sink (gdb-get-output-sink )))
902 ((eq sink
'user
) (concat so-far new
))
903 ((or (eq sink
'pre-emacs
) (eq sink
'post-emacs
)) so-far
)
905 (gdb-append-to-partial-output new
)
908 (gdb-append-to-inferior-io new
)
910 (t (error "Bogon output sink %S" sink
)))))
912 (defun gdb-append-to-partial-output (string)
913 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
914 (goto-char (point-max))
917 (defun gdb-clear-partial-output ()
918 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
921 (defun gdb-append-to-inferior-io (string)
922 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
923 (goto-char (point-max))
924 (insert-before-markers string
))
925 (if (not (string-equal string
""))
926 (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io
))))
928 (defun gdb-clear-inferior-io ()
929 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
933 ;; One trick is to have a command who's output is always available in a buffer
934 ;; of it's own, and is always up to date. We build several buffers of this
937 ;; There are two aspects to this: gdb has to tell us when the output for that
938 ;; command might have changed, and we have to be able to run the command
939 ;; behind the user's back.
941 ;; The output phasing associated with the variable gdb-output-sink
942 ;; help us to run commands behind the user's back.
944 ;; Below is the code for specificly managing buffers of output from one
948 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
949 ;; It adds an input for the command we are tracking. It should be the
950 ;; annotation rule binding of whatever gdb sends to tell us this command
951 ;; might have changed it's output.
953 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
954 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
955 ;; input in the input queue (see comment about ``gdb communications'' above).
957 (defmacro def-gdb-auto-update-trigger
(name demand-predicate gdb-command
959 `(defun ,name
(&optional ignored
)
960 (if (and (,demand-predicate
)
962 (gdb-get-pending-triggers))))
965 (list ,gdb-command
',output-handler
))
966 (gdb-set-pending-triggers
968 (gdb-get-pending-triggers)))))))
970 (defmacro def-gdb-auto-update-handler
(name trigger buf-key custom-defun
)
972 (gdb-set-pending-triggers
974 (gdb-get-pending-triggers)))
975 (let ((buf (gdb-get-buffer ',buf-key
)))
977 (with-current-buffer buf
979 (buffer-read-only nil
))
981 (insert-buffer-substring (gdb-get-create-buffer
982 'gdb-partial-output-buffer
))
984 ;; put customisation here
987 (defmacro def-gdb-auto-updated-buffer
(buffer-key trigger-name gdb-command
988 output-handler-name custom-defun
)
990 (def-gdb-auto-update-trigger ,trigger-name
991 ;; The demand predicate:
992 (lambda () (gdb-get-buffer ',buffer-key
))
994 ,output-handler-name
)
995 (def-gdb-auto-update-handler ,output-handler-name
996 ,trigger-name
,buffer-key
,custom-defun
)))
1000 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
1002 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
1003 'gdb-breakpoints-buffer-name
1004 'gdb-breakpoints-mode
)
1006 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1007 ;; This defines the auto update rule for buffers of type
1008 ;; `gdb-breakpoints-buffer'.
1010 ;; It defines a function to serve as the annotation handler that
1011 ;; handles the `foo-invalidated' message. That function is called:
1012 gdb-invalidate-breakpoints
1014 ;; To update the buffer, this command is sent to gdb.
1015 "server info breakpoints\n"
1017 ;; This also defines a function to be the handler for the output
1018 ;; from the command above. That function will copy the output into
1019 ;; the appropriately typed buffer. That function will be called:
1020 gdb-info-breakpoints-handler
1021 ;; buffer specific functions
1022 gdb-info-breakpoints-custom
)
1024 (defvar gdb-cdir nil
"Compilation directory.")
1026 (defconst breakpoint-xpm-data
"/* XPM */
1027 static char *magick[] = {
1028 /* columns rows colors chars-per-pixel */
1044 "XPM data used for breakpoint icon.")
1046 (defconst breakpoint-enabled-pbm-data
1049 0 0 0 0 1 1 1 1 0 0 0 0
1050 0 0 0 1 1 1 1 1 1 0 0 0
1051 0 0 1 1 1 1 1 1 1 1 0 0
1052 0 1 1 1 1 1 1 1 1 1 1 0
1053 0 1 1 1 1 1 1 1 1 1 1 0
1054 0 1 1 1 1 1 1 1 1 1 1 0
1055 0 1 1 1 1 1 1 1 1 1 1 0
1056 0 0 1 1 1 1 1 1 1 1 0 0
1057 0 0 0 1 1 1 1 1 1 0 0 0
1058 0 0 0 0 1 1 1 1 0 0 0 0"
1059 "PBM data used for enabled breakpoint icon.")
1061 (defconst breakpoint-disabled-pbm-data
1073 0 0 0 1 0 1 0 1 0 0"
1074 "PBM data used for disabled breakpoint icon.")
1076 (defvar breakpoint-enabled-icon
1077 (find-image `((:type xpm
:data
,breakpoint-xpm-data
:ascent
100)
1078 (:type pbm
:data
,breakpoint-enabled-pbm-data
:ascent
100)))
1079 "Icon for enabled breakpoint in display margin")
1081 (defvar breakpoint-disabled-icon
1082 (find-image `((:type xpm
:data
,breakpoint-xpm-data
:conversion disabled
:ascent
100)
1083 (:type pbm
:data
,breakpoint-disabled-pbm-data
:ascent
100)))
1084 "Icon for disabled breakpoint in display margin")
1086 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1087 (defun gdb-info-breakpoints-custom ()
1088 (let ((flag)(address))
1090 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1091 (dolist (buffer (buffer-list))
1092 (with-current-buffer buffer
1093 (if (and (eq gud-minor-mode
'gdba
)
1094 (not (string-match "^\*" (buffer-name))))
1095 (if (display-images-p)
1096 (remove-images (point-min) (point-max))
1097 (gdb-remove-strings (point-min) (point-max))))))
1098 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer
)
1100 (goto-char (point-min))
1101 (while (< (point) (- (point-max) 1))
1103 (if (looking-at "[^\t].*breakpoint")
1105 (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1106 (setq flag
(char-after (match-beginning 1)))
1108 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t
)
1110 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1111 (let ((line (match-string 2)) (buffer-read-only nil
)
1112 (file (match-string 1)))
1113 (add-text-properties (point-at-bol) (point-at-eol)
1114 '(mouse-face highlight
1115 help-echo
"mouse-2, RET: visit breakpoint"))
1116 (with-current-buffer
1118 (if (file-exists-p file
) file
1119 (expand-file-name file gdb-cdir
)))
1120 (save-current-buffer
1121 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1122 (set (make-local-variable 'tool-bar-map
)
1124 (setq left-margin-width
2)
1125 (if (get-buffer-window (current-buffer))
1126 (set-window-margins (get-buffer-window
1129 right-margin-width
)))
1130 ;; only want one breakpoint icon at each location
1132 (goto-line (string-to-number line
))
1133 (let ((start (progn (beginning-of-line)
1135 (end (progn (end-of-line) (+ (point) 1))))
1136 (if (display-images-p)
1138 (remove-images start end
)
1140 (put-image breakpoint-enabled-icon
1142 "breakpoint icon enabled"
1144 (put-image breakpoint-disabled-icon
1146 "breakpoint icon disabled"
1148 (gdb-remove-strings start end
)
1150 (gdb-put-string "B" (+ start
1))
1151 (gdb-put-string "b" (+ start
1))))))))))))
1153 (if (gdb-get-buffer 'gdb-assembler-buffer
) (gdb-assembler-custom)))
1155 (defun gdb-mouse-toggle-breakpoint (event)
1156 "Toggle breakpoint with mouse click in left margin."
1158 (mouse-minibuffer-check event
)
1159 (let ((posn (event-end event
)))
1160 (message "pt=%S posn=%S" (posn-point posn
) posn
)
1161 (if (numberp (posn-point posn
))
1162 (with-selected-window (posn-window posn
)
1164 (goto-char (posn-point posn
))
1165 (if (posn-object posn
)
1167 (gud-break nil
)))))))
1169 (defun gdb-breakpoints-buffer-name ()
1170 (with-current-buffer gud-comint-buffer
1171 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1173 (defun gdb-display-breakpoints-buffer ()
1176 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1178 (defun gdb-frame-breakpoints-buffer ()
1180 (switch-to-buffer-other-frame
1181 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1183 (defvar gdb-breakpoints-mode-map
1184 (let ((map (make-sparse-keymap))
1185 (menu (make-sparse-keymap "Breakpoints")))
1186 (define-key menu
[toggle] '("Toggle" . gdb-toggle-breakpoint))
1187 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1188 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1190 (suppress-keymap map)
1191 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1192 (define-key map " " 'gdb-toggle-breakpoint)
1193 (define-key map "d" 'gdb-delete-breakpoint)
1194 (define-key map "\r" 'gdb-goto-breakpoint)
1195 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1198 (defun gdb-breakpoints-mode ()
1199 "Major mode for gdb breakpoints.
1201 \\{gdb-breakpoints-mode-map}"
1202 (setq major-mode 'gdb-breakpoints-mode)
1203 (setq mode-name "Breakpoints")
1204 (use-local-map gdb-breakpoints-mode-map)
1205 (setq buffer-read-only t)
1206 (gdb-invalidate-breakpoints))
1208 (defun gdb-toggle-breakpoint ()
1209 "Enable/disable the breakpoint at current line."
1212 (beginning-of-line 1)
1213 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1214 (error "Not recognized as break/watchpoint line")
1218 (if (eq ?y (char-after (match-beginning 2)))
1221 (match-string 1) "\n")
1224 (defun gdb-delete-breakpoint ()
1225 "Delete the breakpoint at current line."
1227 (beginning-of-line 1)
1228 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1229 (error "Not recognized as break/watchpoint line")
1231 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1233 (defvar gdb-source-window nil)
1235 (defun gdb-goto-breakpoint ()
1236 "Display the file in the source buffer at the breakpoint specified on the
1240 (beginning-of-line 1)
1241 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1242 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1243 (if (match-string 2)
1244 (let ((line (match-string 2))
1245 (file (match-string 1)))
1246 (save-selected-window
1247 (select-window gdb-source-window)
1248 (switch-to-buffer (find-file-noselect
1249 (if (file-exists-p file)
1251 (expand-file-name file gdb-cdir))))
1252 (goto-line (string-to-number line))))))
1254 (defun gdb-mouse-goto-breakpoint (event)
1255 "Display the file in the source buffer at the selected breakpoint."
1257 (mouse-set-point event)
1258 (gdb-goto-breakpoint))
1261 ;; Frames buffer. This displays a perpetually correct bactracktrace
1262 ;; (from the command `where').
1264 ;; Alas, if your stack is deep, it is costly.
1266 (gdb-set-buffer-rules 'gdb-stack-buffer
1267 'gdb-stack-buffer-name
1270 (def-gdb-auto-updated-buffer gdb-stack-buffer
1271 gdb-invalidate-frames
1273 gdb-info-frames-handler
1274 gdb-info-frames-custom)
1276 (defun gdb-info-frames-custom ()
1277 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1279 (let ((buffer-read-only nil))
1280 (goto-char (point-min))
1281 (while (< (point) (point-max))
1282 (add-text-properties (point-at-bol) (point-at-eol)
1283 '(mouse-face highlight
1284 help-echo "mouse-2, RET: Select frame"))
1286 (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
1287 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
1288 (equal (match-string 1) gdb-current-frame))
1289 (put-text-property (point-at-bol) (point-at-eol)
1290 'face '(:inverse-video t)))
1291 (forward-line 1))))))
1293 (defun gdb-stack-buffer-name ()
1294 (with-current-buffer gud-comint-buffer
1295 (concat "*stack frames of " (gdb-get-target-string) "*")))
1297 (defun gdb-display-stack-buffer ()
1300 (gdb-get-create-buffer 'gdb-stack-buffer)))
1302 (defun gdb-frame-stack-buffer ()
1304 (switch-to-buffer-other-frame
1305 (gdb-get-create-buffer 'gdb-stack-buffer)))
1307 (defvar gdb-frames-mode-map
1308 (let ((map (make-sparse-keymap)))
1309 (suppress-keymap map)
1310 (define-key map "\r" 'gdb-frames-select)
1311 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1314 (defun gdb-frames-mode ()
1315 "Major mode for gdb frames.
1317 \\{gdb-frames-mode-map}"
1318 (setq major-mode 'gdb-frames-mode)
1319 (setq mode-name "Frames")
1320 (setq buffer-read-only t)
1321 (use-local-map gdb-frames-mode-map)
1323 (gdb-invalidate-frames))
1325 (defun gdb-get-frame-number ()
1327 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1328 (n (or (and pos (match-string-no-properties 1)) "0")))
1331 (defun gdb-frames-select ()
1332 "Make the frame on the current line become the current frame and display the
1333 source in the source buffer."
1336 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1337 (gud-display-frame))
1339 (defun gdb-frames-mouse-select (event)
1340 "Make the selected frame become the current frame and display the source in
1343 (mouse-set-point event)
1344 (gdb-frames-select))
1347 ;; Threads buffer. This displays a selectable thread list.
1349 (gdb-set-buffer-rules 'gdb-threads-buffer
1350 'gdb-threads-buffer-name
1353 (def-gdb-auto-updated-buffer gdb-threads-buffer
1354 gdb-invalidate-threads
1355 "server info threads\n"
1356 gdb-info-threads-handler
1357 gdb-info-threads-custom)
1359 (defun gdb-info-threads-custom ()
1360 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1361 (let ((buffer-read-only nil))
1362 (goto-char (point-min))
1363 (while (< (point) (point-max))
1364 (add-text-properties (point-at-bol) (point-at-eol)
1365 '(mouse-face highlight
1366 help-echo "mouse-2, RET: select thread"))
1367 (forward-line 1)))))
1369 (defun gdb-threads-buffer-name ()
1370 (with-current-buffer gud-comint-buffer
1371 (concat "*threads of " (gdb-get-target-string) "*")))
1373 (defun gdb-display-threads-buffer ()
1376 (gdb-get-create-buffer 'gdb-threads-buffer)))
1378 (defun gdb-frame-threads-buffer ()
1380 (switch-to-buffer-other-frame
1381 (gdb-get-create-buffer 'gdb-threads-buffer)))
1383 (defvar gdb-threads-mode-map
1384 (let ((map (make-sparse-keymap)))
1385 (suppress-keymap map)
1386 (define-key map "\r" 'gdb-threads-select)
1387 (define-key map [mouse-2] 'gdb-threads-mouse-select)
1390 (defun gdb-threads-mode ()
1391 "Major mode for gdb frames.
1393 \\{gdb-frames-mode-map}"
1394 (setq major-mode 'gdb-threads-mode)
1395 (setq mode-name "Threads")
1396 (setq buffer-read-only t)
1397 (use-local-map gdb-threads-mode-map)
1398 (gdb-invalidate-threads))
1400 (defun gdb-get-thread-number ()
1402 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1403 (match-string-no-properties 1)))
1405 (defun gdb-threads-select ()
1406 "Make the thread on the current line become the current thread and display the
1407 source in the source buffer."
1410 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1411 (gud-display-frame))
1413 (defun gdb-threads-mouse-select (event)
1414 "Make the selected frame become the current frame and display the source in
1417 (mouse-set-point event)
1418 (gdb-threads-select))
1421 ;; Registers buffer.
1423 (gdb-set-buffer-rules 'gdb-registers-buffer
1424 'gdb-registers-buffer-name
1425 'gdb-registers-mode)
1427 (def-gdb-auto-updated-buffer gdb-registers-buffer
1428 gdb-invalidate-registers
1429 "server info registers\n"
1430 gdb-info-registers-handler
1431 gdb-info-registers-custom)
1433 (defun gdb-info-registers-custom ())
1435 (defvar gdb-registers-mode-map
1436 (let ((map (make-sparse-keymap)))
1437 (suppress-keymap map)
1440 (defun gdb-registers-mode ()
1441 "Major mode for gdb registers.
1443 \\{gdb-registers-mode-map}"
1444 (setq major-mode 'gdb-registers-mode)
1445 (setq mode-name "Registers")
1446 (setq buffer-read-only t)
1447 (use-local-map gdb-registers-mode-map)
1448 (gdb-invalidate-registers))
1450 (defun gdb-registers-buffer-name ()
1451 (with-current-buffer gud-comint-buffer
1452 (concat "*registers of " (gdb-get-target-string) "*")))
1454 (defun gdb-display-registers-buffer ()
1457 (gdb-get-create-buffer 'gdb-registers-buffer)))
1459 (defun gdb-frame-registers-buffer ()
1461 (switch-to-buffer-other-frame
1462 (gdb-get-create-buffer 'gdb-registers-buffer)))
1467 (gdb-set-buffer-rules 'gdb-locals-buffer
1468 'gdb-locals-buffer-name
1471 (def-gdb-auto-updated-buffer gdb-locals-buffer
1472 gdb-invalidate-locals
1473 "server info locals\n"
1474 gdb-info-locals-handler
1475 gdb-info-locals-custom)
1477 ;; Abbreviate for arrays and structures.
1478 ;; These can be expanded using gud-display.
1479 (defun gdb-info-locals-handler nil
1480 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1481 (gdb-get-pending-triggers)))
1482 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1483 (with-current-buffer buf
1484 (goto-char (point-min))
1485 (while (re-search-forward "^ .*\n" nil t)
1486 (replace-match "" nil nil))
1487 (goto-char (point-min))
1488 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1489 (replace-match "(array);\n" nil nil))
1490 (goto-char (point-min))
1491 (while (re-search-forward "{.*=.*\n" nil t)
1492 (replace-match "(structure);\n" nil nil))))
1493 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1494 (and buf (with-current-buffer buf
1496 (buffer-read-only nil))
1497 (delete-region (point-min) (point-max))
1498 (insert-buffer-substring (gdb-get-create-buffer
1499 'gdb-partial-output-buffer))
1501 (run-hooks 'gdb-info-locals-hook))
1503 (defun gdb-info-locals-custom ()
1506 (defvar gdb-locals-mode-map
1507 (let ((map (make-sparse-keymap)))
1508 (suppress-keymap map)
1511 (defun gdb-locals-mode ()
1512 "Major mode for gdb locals.
1514 \\{gdb-locals-mode-map}"
1515 (setq major-mode 'gdb-locals-mode)
1516 (setq mode-name "Locals")
1517 (setq buffer-read-only t)
1518 (use-local-map gdb-locals-mode-map)
1519 (gdb-invalidate-locals))
1521 (defun gdb-locals-buffer-name ()
1522 (with-current-buffer gud-comint-buffer
1523 (concat "*locals of " (gdb-get-target-string) "*")))
1525 (defun gdb-display-locals-buffer ()
1528 (gdb-get-create-buffer 'gdb-locals-buffer)))
1530 (defun gdb-frame-locals-buffer ()
1532 (switch-to-buffer-other-frame
1533 (gdb-get-create-buffer 'gdb-locals-buffer)))
1536 ;;;; Window management
1538 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1539 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1540 ;;; get at the use_time field of a window, I'm not sure there exists a
1541 ;;; more elegant solution without writing C code.
1543 (defun gdb-display-buffer (buf &optional size)
1544 (let ((must-split nil)
1550 (if (or (eq gud-comint-buffer (window-buffer win))
1551 (eq gdb-source-window win))
1552 (set-window-dedicated-p win t))))
1553 (setq answer (get-buffer-window buf))
1555 (let ((window (get-lru-window)))
1558 (set-window-buffer window buf)
1559 (setq answer window))
1560 (setq must-split t)))))
1563 (if (or (eq gud-comint-buffer (window-buffer win))
1564 (eq gdb-source-window win))
1565 (set-window-dedicated-p win nil)))))
1567 (let* ((largest (get-largest-window))
1568 (cur-size (window-height largest))
1569 (new-size (and size (< size cur-size) (- cur-size size))))
1570 (setq answer (split-window largest new-size))
1571 (set-window-buffer answer buf)))
1574 (defun gdb-display-source-buffer (buffer)
1575 (if (eq gdb-selected-view 'source)
1577 (if (window-live-p gdb-source-window)
1578 (set-window-buffer gdb-source-window buffer)
1579 (gdb-display-buffer buffer)
1580 (setq gdb-source-window (get-buffer-window buffer)))
1582 (if (window-live-p gdb-source-window)
1583 (set-window-buffer gdb-source-window
1584 (gdb-get-buffer 'gdb-assembler-buffer))
1585 (let ((buf (gdb-get-buffer 'gdb-assembler-buffer)))
1586 (gdb-display-buffer buf)
1587 (setq gdb-source-window (get-buffer-window buf))))
1591 ;;; Shared keymap initialization:
1593 (let ((menu (make-sparse-keymap "GDB-Frames")))
1594 (define-key gud-menu-map [frames]
1595 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1596 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1597 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1598 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1599 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1600 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1601 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1602 ; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
1605 (let ((menu (make-sparse-keymap "GDB-Windows")))
1606 (define-key gud-menu-map [displays]
1607 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1608 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1609 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1610 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1611 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1612 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1613 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1614 ; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1617 (let ((menu (make-sparse-keymap "View")))
1618 (define-key gud-menu-map [view]
1619 `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba)))
1620 ; (define-key menu [both] '(menu-item "Both" gdb-view-both
1621 ; :help "Display both source and assembler"
1622 ; :button (:radio . (eq gdb-selected-view 'both))))
1623 (define-key menu [assembler] '(menu-item "Machine" gdb-view-assembler
1624 :help "Display assembler only"
1625 :button (:radio . (eq gdb-selected-view 'assembler))))
1626 (define-key menu [source] '(menu-item "Source" gdb-view-source-function
1627 :help "Display source only"
1628 :button (:radio . (eq gdb-selected-view 'source)))))
1630 (let ((menu (make-sparse-keymap "GDB-UI")))
1631 (define-key gud-menu-map [ui]
1632 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
1633 (define-key menu [gdb-restore-windows]
1634 '("Restore window layout" . gdb-restore-windows))
1635 (define-key menu [gdb-many-windows]
1636 (menu-bar-make-toggle gdb-many-windows gdb-many-windows
1637 "Display other windows" "Many Windows %s"
1638 "Display locals, stack and breakpoint information")))
1640 (defun gdb-frame-gdb-buffer ()
1642 (switch-to-buffer-other-frame
1643 (gdb-get-create-buffer 'gdba)))
1645 (defun gdb-display-gdb-buffer ()
1648 (gdb-get-create-buffer 'gdba)))
1650 (defvar gdb-main-file nil "Source file from which program execution begins.")
1652 (defun gdb-view-source-function ()
1655 (if gud-last-last-frame
1656 (set-window-buffer gdb-source-window
1657 (gud-find-file (car gud-last-last-frame)))
1658 (set-window-buffer gdb-source-window (gud-find-file gdb-main-file))))
1659 (setq gdb-selected-view 'source))
1661 (defun gdb-view-assembler()
1663 (set-window-buffer gdb-source-window
1664 (gdb-get-create-buffer 'gdb-assembler-buffer))
1665 (setq gdb-selected-view 'assembler))
1667 ;(defun gdb-view-both()
1669 ;(setq gdb-selected-view 'both))
1671 ;; layout for all the windows
1672 (defun gdb-setup-windows ()
1673 (gdb-display-locals-buffer)
1674 (gdb-display-stack-buffer)
1675 (delete-other-windows)
1676 (gdb-display-breakpoints-buffer)
1677 (delete-other-windows)
1678 (switch-to-buffer gud-comint-buffer)
1679 (split-window nil ( / ( * (window-height) 3) 4))
1680 (split-window nil ( / (window-height) 3))
1681 (split-window-horizontally)
1683 (switch-to-buffer (gdb-locals-buffer-name))
1685 (if (and gdb-view-source
1686 (eq gdb-selected-view 'source))
1688 (if gud-last-last-frame
1689 (gud-find-file (car gud-last-last-frame))
1690 (gud-find-file gdb-main-file)))
1691 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
1692 (setq gdb-source-window (get-buffer-window (current-buffer)))
1693 (split-window-horizontally)
1695 (switch-to-buffer (gdb-inferior-io-name))
1697 (switch-to-buffer (gdb-stack-buffer-name))
1698 (split-window-horizontally)
1700 (switch-to-buffer (gdb-breakpoints-buffer-name))
1703 (defcustom gdb-many-windows nil
1704 "Nil means that gdb starts with just two windows : the GUD and
1709 (defun gdb-many-windows (arg)
1710 "Toggle the number of windows in the basic arrangement."
1712 (setq gdb-many-windows
1714 (not gdb-many-windows)
1715 (> (prefix-numeric-value arg) 0)))
1716 (gdb-restore-windows))
1718 (defun gdb-restore-windows ()
1719 "Restore the basic arrangement of windows used by gdba.
1720 This arrangement depends on the value of `gdb-many-windows'."
1722 (if gdb-many-windows
1724 (switch-to-buffer gud-comint-buffer)
1725 (delete-other-windows)
1726 (gdb-setup-windows))
1727 (switch-to-buffer gud-comint-buffer)
1728 (delete-other-windows)
1731 (if (and gdb-view-source
1732 (eq gdb-selected-view 'source))
1734 (if gud-last-last-frame
1735 (gud-find-file (car gud-last-last-frame))
1736 (gud-find-file gdb-main-file)))
1737 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
1738 (setq gdb-source-window (get-buffer-window (current-buffer)))
1742 "Exit a debugging session cleanly by killing the gdb buffers and resetting
1743 the source buffers."
1744 (dolist (buffer (buffer-list))
1745 (if (not (eq buffer gud-comint-buffer))
1746 (with-current-buffer buffer
1747 (if (memq gud-minor-mode '(gdba pdb))
1748 (if (string-match "^\*.+*$" (buffer-name))
1750 (if (display-images-p)
1751 (remove-images (point-min) (point-max))
1752 (gdb-remove-strings (point-min) (point-max)))
1753 (setq left-margin-width 0)
1754 (setq gud-minor-mode nil)
1755 (kill-local-variable 'tool-bar-map)
1756 (setq gud-running nil)
1757 (if (get-buffer-window (current-buffer))
1758 (set-window-margins (get-buffer-window
1761 right-margin-width))))))))
1763 (defun gdb-source-info ()
1764 "Find the source file where the program starts and displays it with related
1766 (goto-char (point-min))
1767 (if (search-forward "directory is " nil t)
1769 (if (looking-at "\\S-*:\\(\\S-*\\)")
1770 (setq gdb-cdir (match-string 1))
1771 (looking-at "\\S-*")
1772 (setq gdb-cdir (match-string 0)))
1773 (search-forward "Located in ")
1774 (looking-at "\\S-*")
1775 (setq gdb-main-file (match-string 0)))
1776 (setq gdb-view-source nil))
1777 (delete-other-windows)
1778 (switch-to-buffer gud-comint-buffer)
1779 (if gdb-many-windows
1781 (gdb-display-breakpoints-buffer)
1782 (delete-other-windows)
1787 (if gud-last-last-frame
1788 (gud-find-file (car gud-last-last-frame))
1789 (gud-find-file gdb-main-file)))
1790 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
1791 (setq gdb-source-window (get-buffer-window (current-buffer)))
1795 (defun gdb-put-string (putstring pos)
1796 "Put string PUTSTRING in front of POS in the current buffer.
1797 PUTSTRING is displayed by putting an overlay into the current buffer with a
1798 `before-string' STRING that has a `display' property whose value is
1800 (let ((gdb-string "x")
1801 (buffer (current-buffer)))
1802 (let ((overlay (make-overlay pos pos buffer))
1803 (prop (list (list 'margin 'left-margin) putstring)))
1804 (put-text-property 0 (length gdb-string) 'display prop gdb-string)
1805 (overlay-put overlay 'put-break t)
1806 (overlay-put overlay 'before-string gdb-string))))
1808 ;;from remove-images
1809 (defun gdb-remove-strings (start end &optional buffer)
1810 "Remove strings between START and END in BUFFER.
1811 Remove only strings that were put in BUFFER with calls to `put-string'.
1812 BUFFER nil or omitted means use the current buffer."
1814 (setq buffer (current-buffer)))
1815 (let ((overlays (overlays-in start end)))
1817 (let ((overlay (car overlays)))
1818 (when (overlay-get overlay 'put-break)
1819 (delete-overlay overlay)))
1820 (setq overlays (cdr overlays)))))
1822 (defun gdb-put-arrow (putstring pos)
1823 "Put arrow string PUTSTRING in the left margin in front of POS
1824 in the current buffer. PUTSTRING is displayed by putting an
1825 overlay into the current buffer with a `before-string'
1826 \"gdb-arrow\" that has a `display' property whose value is
1827 PUTSTRING. POS may be an integer or marker."
1828 (let ((gdb-string "gdb-arrow")
1829 (buffer (current-buffer)))
1830 (let ((overlay (make-overlay pos pos buffer))
1831 (prop (list (list 'margin 'left-margin) putstring)))
1832 (put-text-property 0 (length gdb-string) 'display prop gdb-string)
1833 (overlay-put overlay 'put-arrow t)
1834 (overlay-put overlay 'before-string gdb-string))))
1836 (defun gdb-remove-arrow (&optional buffer)
1837 "Remove arrow in BUFFER.
1838 Remove only images that were put in BUFFER with calls to `put-arrow'.
1839 BUFFER nil or omitted means use the current buffer."
1841 (setq buffer (current-buffer)))
1842 (let ((overlays (overlays-in (point-min) (point-max))))
1844 (let ((overlay (car overlays)))
1845 (when (overlay-get overlay 'put-arrow)
1846 (delete-overlay overlay)))
1847 (setq overlays (cdr overlays)))))
1850 ;; Assembler buffer.
1852 (gdb-set-buffer-rules 'gdb-assembler-buffer
1853 'gdb-assembler-buffer-name
1854 'gdb-assembler-mode)
1856 (def-gdb-auto-updated-buffer gdb-assembler-buffer
1857 gdb-invalidate-assembler
1858 (concat "server disassemble " gdb-current-address "\n")
1859 gdb-assembler-handler
1860 gdb-assembler-custom)
1862 (defun gdb-assembler-custom ()
1863 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
1864 (gdb-arrow-position 1) (address) (flag))
1865 (with-current-buffer buffer
1866 (if (not (equal gdb-current-address "main"))
1869 (goto-char (point-min))
1870 (if (re-search-forward gdb-current-address nil t)
1872 (setq gdb-arrow-position (point))
1873 (gdb-put-arrow "=>" (point))))))
1874 ;; remove all breakpoint-icons in assembler buffer before updating.
1875 (if (display-images-p)
1876 (remove-images (point-min) (point-max))
1877 (gdb-remove-strings (point-min) (point-max))))
1878 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1879 (goto-char (point-min))
1880 (while (< (point) (- (point-max) 1))
1882 (if (looking-at "[^\t].*breakpoint")
1885 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
1886 (setq flag (char-after (match-beginning 1)))
1887 (setq address (match-string 2))
1888 ;; remove leading 0s from output of info break.
1889 (if (string-match "^0+\\(.*\\)" address)
1890 (setq address (match-string 1 address)))
1891 (with-current-buffer buffer
1892 (goto-char (point-min))
1893 (if (re-search-forward address nil t)
1894 (let ((start (progn (beginning-of-line) (- (point) 1)))
1895 (end (progn (end-of-line) (+ (point) 1))))
1896 (if (display-images-p)
1898 (remove-images start end)
1900 (put-image breakpoint-enabled-icon
1902 "breakpoint icon enabled"
1904 (put-image breakpoint-disabled-icon
1906 "breakpoint icon disabled"
1908 (gdb-remove-strings start end)
1910 (gdb-put-string "B" (+ start 1))
1911 (gdb-put-string "b" (+ start 1)))))))))))
1912 (if (not (equal gdb-current-address "main"))
1913 (set-window-point (get-buffer-window buffer) gdb-arrow-position))))
1915 (defvar gdb-assembler-mode-map
1916 (let ((map (make-sparse-keymap)))
1917 (suppress-keymap map)
1920 (defun gdb-assembler-mode ()
1921 "Major mode for viewing code assembler.
1923 \\{gdb-assembler-mode-map}"
1924 (setq major-mode 'gdb-assembler-mode)
1925 (setq mode-name "Machine")
1926 (setq left-margin-width 2)
1927 (setq fringes-outside-margins t)
1928 (setq buffer-read-only t)
1929 (use-local-map gdb-assembler-mode-map)
1930 (gdb-invalidate-assembler))
1932 (defun gdb-assembler-buffer-name ()
1933 (with-current-buffer gud-comint-buffer
1934 (concat "*Machine Code " (gdb-get-target-string) "*")))
1936 (defun gdb-display-assembler-buffer ()
1939 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1941 (defun gdb-frame-assembler-buffer ()
1943 (switch-to-buffer-other-frame
1944 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1946 ;; modified because if gdb-current-address has changed value a new command
1947 ;; must be enqueued to update the buffer with the new output
1948 (defun gdb-invalidate-assembler (&optional ignored)
1949 (if (gdb-get-buffer 'gdb-assembler-buffer)
1951 (unless (string-equal gdb-current-frame gdb-previous-frame)
1952 (if (or (not (member 'gdb-invalidate-assembler
1953 (gdb-get-pending-triggers)))
1954 (not (string-equal gdb-current-address
1955 gdb-previous-address)))
1957 ;; take previous disassemble command off the queue
1958 (with-current-buffer gud-comint-buffer
1959 (let ((queue (gdb-get-input-queue)) (item))
1960 (dolist (item queue)
1961 (if (equal (cdr item) '(gdb-assembler-handler))
1962 (gdb-set-input-queue
1963 (delete item (gdb-get-input-queue)))))))
1965 (list (concat "server disassemble " gdb-current-address "\n")
1966 'gdb-assembler-handler))
1967 (gdb-set-pending-triggers
1968 (cons 'gdb-invalidate-assembler
1969 (gdb-get-pending-triggers)))
1970 (setq gdb-previous-address gdb-current-address)
1971 (setq gdb-previous-frame gdb-current-frame)))))))
1973 (defun gdb-get-current-frame ()
1974 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
1977 (list (concat "server info frame\n") 'gdb-frame-handler))
1978 (gdb-set-pending-triggers
1979 (cons 'gdb-get-current-frame
1980 (gdb-get-pending-triggers))))))
1982 (defun gdb-frame-handler ()
1983 (gdb-set-pending-triggers
1984 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
1985 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1986 (goto-char (point-min))
1988 (if (looking-at ".*= 0x\\(\\S-*\\) in \\(\\S-*\\)")
1990 (setq gdb-current-frame (match-string 2))
1991 (let ((address (match-string 1)))
1992 ;; remove leading 0s from output of info frame command.
1993 (if (string-match "^0+\\(.*\\)" address)
1994 (setq gdb-current-address
1995 (concat "0x" (match-string 1 address)))
1996 (setq gdb-current-address (concat "0x" address))))
1997 (if (or (if (not (looking-at ".*(\\S-*:[0-9]*)"))
1998 (progn (setq gdb-view-source nil) t))
1999 (eq gdb-selected-view 'assembler))
2003 (gdb-get-create-buffer 'gdb-assembler-buffer))
2004 ;;update with new frame for machine code if necessary
2005 (gdb-invalidate-assembler))))))
2007 (if (looking-at " source language \\(\\S-*\\)\.")
2008 (setq gdb-current-language (match-string 1))))
2012 ;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
2013 ;;; gdb-ui.el ends here