1 ;;; gdb-ui.el --- User Interface for running GDB
3 ;; Author: Nick Roberts <nickrob@gnu.org>
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, if
32 ;; required, and displays expressions and their current values in their own
33 ;; buffers. It also uses features of Emacs 21 such as the display margin for
34 ;; breakpoints, and the toolbar (see the GDB Graphical Interface section in
35 ;; the Emacs info manual).
37 ;; Start the debugger with M-x gdba.
39 ;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim
40 ;; Kingdon and uses GDB's annotation interface. You don't need to know about
41 ;; annotations to use this mode as a debugger, but if you are interested
42 ;; developing the mode itself, then see the Annotations section in the GDB
43 ;; info manual. Some GDB/MI commands are also used through th CLI command
44 ;; 'interpreter mi <mi-command>'.
53 (defvar gdb-current-address
"main" "Initialisation for Assembler buffer.")
54 (defvar gdb-previous-address nil
)
55 (defvar gdb-previous-frame nil
)
56 (defvar gdb-current-frame
"main")
57 (defvar gdb-current-language nil
)
58 (defvar gdb-view-source t
"Non-nil means that source code can be viewed.")
59 (defvar gdb-selected-view
'source
"Code type that user wishes to view.")
60 (defvar gdb-var-list nil
"List of variables in watch window")
61 (defvar gdb-var-changed nil
"Non-nil means that gdb-var-list has changed.")
62 (defvar gdb-buffer-type nil
)
63 (defvar gdb-overlay-arrow-position nil
)
64 (defvar gdb-variables
'()
65 "A list of variables that are local to the GUD buffer.")
68 (defun gdba (command-line)
69 "Run gdb on program FILE in buffer *gud-FILE*.
70 The directory containing FILE becomes the initial working directory
71 and source-file directory for your debugger.
73 If `gdb-many-windows' is nil (the default value) then gdb just
74 pops up the GUD buffer unless `gdb-show-main' is t. In this case
75 it starts with two windows: one displaying the GUD buffer and the
76 other with the source file with the main routine of the debugee.
78 If `gdb-many-windows' is t, regardless of the value of
79 `gdb-show-main', the layout below will appear unless
80 `gdb-use-inferior-io-buffer' is nil when the source buffer
81 occupies the full width of the frame. Keybindings are given in
84 Watch expressions appear in the speedbar/slowbar.
86 The following interactive lisp functions help control operation :
88 `gdb-many-windows' - Toggle the number of windows gdb uses.
89 `gdb-restore-windows' - To restore the window layout.
91 See Info node `(emacs)GDB Graphical Interface' for a more
92 detailed description of this mode.
95 ---------------------------------------------------------------------
97 ---------------------------------------------------------------------
98 GUD buffer (I/O of GDB) | Locals buffer
102 ---------------------------------------------------------------------
103 Source buffer | Input/Output (of debugee) buffer
111 ---------------------------------------------------------------------
112 Stack buffer | Breakpoints buffer
113 RET gdb-frames-select | SPC gdb-toggle-breakpoint
114 | RET gdb-goto-breakpoint
115 | d gdb-delete-breakpoint
116 ---------------------------------------------------------------------
119 (interactive (list (gud-query-cmdline 'gdba
)))
121 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
125 (defvar gdb-debug-log nil
)
127 (defcustom gdb-enable-debug-log nil
128 "Non-nil means record the process input and output in `gdb-debug-log'."
132 (defcustom gdb-use-inferior-io-buffer nil
133 "Non-nil means display output from the inferior in a separate buffer."
138 (setq gdb-debug-log nil
)
139 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
140 (set (make-local-variable 'gud-marker-filter
) 'gud-gdba-marker-filter
)
142 (gud-def gud-break
(if (not (string-equal mode-name
"Machine"))
143 (gud-call "break %f:%l" arg
)
147 (gud-call "break *%a" arg
)))
148 "\C-b" "Set breakpoint at current line or address.")
150 (gud-def gud-remove
(if (not (string-equal mode-name
"Machine"))
151 (gud-call "clear %f:%l" arg
)
155 (gud-call "clear *%a" arg
)))
156 "\C-d" "Remove breakpoint at current line or address.")
158 (gud-def gud-until
(if (not (string-equal mode-name
"Machine"))
159 (gud-call "until %f:%l" arg
)
163 (gud-call "until *%a" arg
)))
164 "\C-u" "Continue to current line or address.")
166 (define-key gud-minor-mode-map
[left-margin mouse-1
]
167 'gdb-mouse-toggle-breakpoint
)
168 (define-key gud-minor-mode-map
[left-fringe mouse-1
]
169 'gdb-mouse-toggle-breakpoint
)
171 (setq comint-input-sender
'gdb-send
)
174 (setq gdb-current-address
"main")
175 (setq gdb-previous-address nil
)
176 (setq gdb-previous-frame nil
)
177 (setq gdb-current-frame
"main")
178 (setq gdb-view-source t
)
179 (setq gdb-selected-view
'source
)
180 (setq gdb-var-list nil
)
181 (setq gdb-var-changed nil
)
182 (setq gdb-first-prompt nil
)
184 (mapc 'make-local-variable gdb-variables
)
185 (setq gdb-buffer-type
'gdba
)
187 (if gdb-use-inferior-io-buffer
(gdb-clear-inferior-io))
189 (if (eq window-system
'w32
)
190 (gdb-enqueue-input (list "set new-console off\n" 'ignore
)))
191 (gdb-enqueue-input (list "set height 0\n" 'ignore
))
192 ;; find source file and compilation directory here
193 (gdb-enqueue-input (list "server list main\n" 'ignore
)) ; C program
194 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore
)) ; Fortran program
195 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info
))
197 (run-hooks 'gdba-mode-hook
))
199 (defcustom gdb-use-colon-colon-notation nil
200 "Non-nil means use FUNCTION::VARIABLE format to display variables in the
206 "Watch expression at point."
209 (let ((expr (tooltip-identifier-from-point (point))))
210 (if (and (string-equal gdb-current-language
"c")
211 gdb-use-colon-colon-notation
)
212 (setq expr
(concat gdb-current-frame
"::" expr
)))
213 (catch 'already-watched
214 (dolist (var gdb-var-list
)
215 (if (string-equal expr
(car var
)) (throw 'already-watched nil
)))
216 (set-text-properties 0 (length expr
) nil expr
)
218 (list (concat "server interpreter mi \"-var-create - * " expr
"\"\n")
219 `(lambda () (gdb-var-create-handler ,expr
))))))
220 (select-window (get-buffer-window gud-comint-buffer
)))
222 (defun gdb-goto-info ()
224 (select-frame (make-frame))
226 (Info-goto-node "(emacs)GDB Graphical Interface"))
228 (defconst gdb-var-create-regexp
229 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
231 (defun gdb-var-create-handler (expr)
232 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
233 (goto-char (point-min))
234 (if (re-search-forward gdb-var-create-regexp nil t
)
235 (let ((var (list expr
240 (push var gdb-var-list
)
241 (setq speedbar-update-flag t
)
243 (if (equal (nth 2 var
) "0")
245 (list (concat "server interpreter mi \"-var-evaluate-expression "
247 `(lambda () (gdb-var-evaluate-expression-handler
249 (setq gdb-var-changed t
)))
250 (if (re-search-forward "Undefined command" nil t
)
251 (message "Watching expressions requires gdb 6.0 onwards")
252 (message "No symbol %s in current context." expr
)))))
254 (defun gdb-var-evaluate-expression-handler (varnum changed
)
255 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
256 (goto-char (point-min))
257 (re-search-forward ".*value=\"\\(.*?\\)\"" nil t
)
259 (let ((var-list nil
) (num 0))
260 (dolist (var gdb-var-list
)
261 (if (string-equal varnum
(cadr var
))
263 (if changed
(setcar (nthcdr 5 var
) t
))
264 (setcar (nthcdr 4 var
) (match-string 1))
265 (setcar (nthcdr num gdb-var-list
) var
)
266 (throw 'var-found nil
)))
267 (setq num
(+ num
1))))))
268 (setq gdb-var-changed t
))
270 (defun gdb-var-list-children (varnum)
272 (list (concat "server interpreter mi \"-var-list-children " varnum
"\"\n")
273 `(lambda () (gdb-var-list-children-handler ,varnum
)))))
275 (defconst gdb-var-list-children-regexp
276 "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"")
278 (defun gdb-var-list-children-handler (varnum)
279 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
280 (goto-char (point-min))
281 (let ((var-list nil
))
282 (catch 'child-already-watched
283 (dolist (var gdb-var-list
)
284 (if (string-equal varnum
(cadr var
))
287 (while (re-search-forward gdb-var-list-children-regexp nil t
)
288 (let ((varchild (list (match-string 2)
292 (if (looking-at ",type=\"\\(.*?\\)\"")
293 (setcar (nthcdr 3 varchild
) (match-string 1)))
294 (dolist (var1 gdb-var-list
)
295 (if (string-equal (cadr var1
) (cadr varchild
))
296 (throw 'child-already-watched nil
)))
297 (push varchild var-list
)
298 (if (equal (nth 2 varchild
) "0")
302 "server interpreter mi \"-var-evaluate-expression "
303 (nth 1 varchild
) "\"\n")
304 `(lambda () (gdb-var-evaluate-expression-handler
305 ,(nth 1 varchild
) nil
))))))))
306 (push var var-list
)))
307 (setq gdb-var-list
(nreverse var-list
))))))
309 (defun gdb-var-update ()
310 (if (not (member 'gdb-var-update
(gdb-get-pending-triggers)))
312 (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"
313 'gdb-var-update-handler
))
314 (gdb-set-pending-triggers (cons 'gdb-var-update
315 (gdb-get-pending-triggers))))))
317 (defconst gdb-var-update-regexp
"name=\"\\(.*?\\)\"")
319 (defun gdb-var-update-handler ()
320 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
321 (goto-char (point-min))
322 (while (re-search-forward gdb-var-update-regexp nil t
)
323 (let ((varnum (match-string 1)))
325 (list (concat "server interpreter mi \"-var-evaluate-expression "
327 `(lambda () (gdb-var-evaluate-expression-handler
329 (gdb-set-pending-triggers
330 (delq 'gdb-var-update
(gdb-get-pending-triggers))))
332 (defun gdb-var-delete ()
333 "Delete watched expression from the speedbar."
335 (if (with-current-buffer gud-comint-buffer
(eq gud-minor-mode
'gdba
))
336 (let ((text (speedbar-line-text)))
337 (string-match "\\(\\S-+\\)" text
)
338 (let* ((expr (match-string 1 text
))
339 (var (assoc expr gdb-var-list
))
341 (unless (string-match "\\." varnum
)
343 (list (concat "server interpreter mi \"-var-delete "
346 (setq gdb-var-list
(delq var gdb-var-list
))
347 (dolist (varchild gdb-var-list
)
348 (if (string-match (concat (nth 1 var
) "\\.") (nth 1 varchild
))
349 (setq gdb-var-list
(delq varchild gdb-var-list
))))
350 (setq gdb-var-changed t
))))))
352 (defun gdb-edit-value (text token indent
)
353 "Assign a value to a variable displayed in the speedbar"
354 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list
))
355 (varnum (cadr var
)) (value))
356 (setq value
(read-string "New value: "))
358 (list (concat "server interpreter mi \"-var-assign "
359 varnum
" " value
"\"\n")
362 (defcustom gdb-show-changed-values t
363 "Non-nil means use font-lock-warning-face to display values that have
364 recently changed in the speedbar."
368 (defun gdb-speedbar-expand-node (text token indent
)
369 "Expand the node the user clicked on.
370 TEXT is the text of the button we clicked on, a + or - item.
371 TOKEN is data related to this node.
372 INDENT is the current indentation depth."
373 (cond ((string-match "+" text
) ;expand this node
374 (gdb-var-list-children token
))
375 ((string-match "-" text
) ;contract this node
376 (dolist (var gdb-var-list
)
377 (if (string-match (concat token
"\\.") (nth 1 var
))
378 (setq gdb-var-list
(delq var gdb-var-list
))))
379 (setq gdb-var-changed t
))))
382 ;; ======================================================================
384 ;; In this world, there are gdb variables (of unspecified
385 ;; representation) and buffers associated with those objects.
386 ;; The list of variables is built up by the expansions of
389 (defmacro def-gdb-var
(root-symbol &optional default doc
)
390 (let* ((root (symbol-name root-symbol
))
391 (accessor (intern (concat "gdb-get-" root
)))
392 (setter (intern (concat "gdb-set-" root
)))
393 (name (intern (concat "gdb-" root
))))
395 (defvar ,name
,default
,doc
)
396 (if (not (memq ',name gdb-variables
))
397 (push ',name gdb-variables
))
399 (buffer-local-value ',name gud-comint-buffer
))
401 (with-current-buffer gud-comint-buffer
402 (setq ,name val
))))))
404 (def-gdb-var buffer-type nil
405 "One of the symbols bound in `gdb-buffer-rules'.")
407 (def-gdb-var burst
""
408 "A string of characters from gdb that have not yet been processed.")
410 (def-gdb-var input-queue
()
411 "A list of gdb command objects.")
413 (def-gdb-var prompting nil
414 "True when gdb is idle with no pending input.")
416 (def-gdb-var output-sink
'user
417 "The disposition of the output of the current gdb command.
418 Possible values are these symbols:
420 user -- gdb output should be copied to the GUD buffer
423 inferior -- gdb output should be copied to the inferior-io buffer
425 pre-emacs -- output should be ignored util the post-prompt
426 annotation is received. Then the output-sink
428 emacs -- output should be collected in the partial-output-buffer
429 for subsequent processing by a command. This is the
430 disposition of output generated by commands that
431 gdb mode sends to gdb on its own behalf.
432 post-emacs -- ignore output until the prompt annotation is
433 received, then go to USER disposition.
436 (def-gdb-var current-item nil
437 "The most recent command item sent to gdb.")
439 (def-gdb-var pending-triggers
'()
440 "A list of trigger functions that have run later than their output
443 ;; end of gdb variables
445 (defun gdb-get-target-string ()
446 (with-current-buffer gud-comint-buffer
453 ;; Each buffer has a TYPE -- a symbol that identifies the function
454 ;; of that particular buffer.
456 ;; The usual gdb interaction buffer is given the type `gdba' and
457 ;; is constructed specially.
459 ;; Others are constructed by gdb-get-create-buffer and
460 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
462 (defvar gdb-buffer-rules-assoc
'())
464 (defun gdb-get-buffer (key)
465 "Return the gdb buffer tagged with type KEY.
466 The key should be one of the cars in `gdb-buffer-rules-assoc'."
468 (gdb-look-for-tagged-buffer key
(buffer-list))))
470 (defun gdb-get-create-buffer (key)
471 "Create a new gdb buffer of the type specified by KEY.
472 The key should be one of the cars in `gdb-buffer-rules-assoc'."
473 (or (gdb-get-buffer key
)
474 (let* ((rules (assoc key gdb-buffer-rules-assoc
))
475 (name (funcall (gdb-rules-name-maker rules
)))
476 (new (get-buffer-create name
)))
477 (with-current-buffer new
478 ;; FIXME: This should be set after calling the function, since the
479 ;; function should run kill-all-local-variables.
480 (set (make-local-variable 'gdb-buffer-type
) key
)
481 (if (cdr (cdr rules
))
482 (funcall (car (cdr (cdr rules
)))))
483 (set (make-local-variable 'gud-comint-buffer
) gud-comint-buffer
)
484 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
485 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
488 (defun gdb-rules-name-maker (rules) (car (cdr rules
)))
490 (defun gdb-look-for-tagged-buffer (key bufs
)
492 (while (and (not retval
) bufs
)
493 (set-buffer (car bufs
))
494 (if (eq gdb-buffer-type key
)
495 (setq retval
(car bufs
)))
496 (setq bufs
(cdr bufs
)))
500 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
501 ;; at least one and possible more functions. The functions have these
502 ;; roles in defining a buffer type:
504 ;; NAME - Return a name for this buffer type.
506 ;; The remaining function(s) are optional:
508 ;; MODE - called in a new buffer with no arguments, should establish
509 ;; the proper mode for the buffer.
512 (defun gdb-set-buffer-rules (buffer-type &rest rules
)
513 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc
)))
515 (setcdr binding rules
)
516 (push (cons buffer-type rules
)
517 gdb-buffer-rules-assoc
))))
519 ;; GUD buffers are an exception to the rules
520 (gdb-set-buffer-rules 'gdba
'error
)
523 ;; Partial-output buffer : This accumulates output from a command executed on
524 ;; behalf of emacs (rather than the user).
526 (gdb-set-buffer-rules 'gdb-partial-output-buffer
527 'gdb-partial-output-name
)
529 (defun gdb-partial-output-name ()
530 (concat "*partial-output-"
531 (gdb-get-target-string)
535 (gdb-set-buffer-rules 'gdb-inferior-io
536 'gdb-inferior-io-name
537 'gdb-inferior-io-mode
)
539 (defun gdb-inferior-io-name ()
540 (concat "*input/output of "
541 (gdb-get-target-string)
544 (defvar gdb-inferior-io-mode-map
545 (let ((map (make-sparse-keymap)))
546 (define-key map
"\C-c\C-c" 'gdb-inferior-io-interrupt
)
547 (define-key map
"\C-c\C-z" 'gdb-inferior-io-stop
)
548 (define-key map
"\C-c\C-\\" 'gdb-inferior-io-quit
)
549 (define-key map
"\C-c\C-d" 'gdb-inferior-io-eof
)
552 (define-derived-mode gdb-inferior-io-mode comint-mode
"Debuggee I/O"
553 "Major mode for gdb inferior-io."
554 :syntax-table nil
:abbrev-table nil
555 ;; We want to use comint because it has various nifty and familiar
556 ;; features. We don't need a process, but comint wants one, so create
558 (make-comint-in-buffer
559 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
560 (current-buffer) "hexl")
561 (setq comint-input-sender
'gdb-inferior-io-sender
))
563 (defun gdb-inferior-io-sender (proc string
)
564 ;; PROC is the pseudo-process created to satisfy comint.
565 (with-current-buffer (process-buffer proc
)
566 (setq proc
(get-buffer-process gud-comint-buffer
))
567 (process-send-string proc string
)
568 (process-send-string proc
"\n")))
570 (defun gdb-inferior-io-interrupt ()
571 "Interrupt the program being debugged."
574 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
576 (defun gdb-inferior-io-quit ()
577 "Send quit signal to the program being debugged."
580 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
582 (defun gdb-inferior-io-stop ()
583 "Stop the program being debugged."
586 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
588 (defun gdb-inferior-io-eof ()
589 "Send end-of-file to the program being debugged."
592 (get-buffer-process gud-comint-buffer
)))
596 ;; gdb communications
599 ;; INPUT: things sent to gdb
601 ;; The queues are lists. Each element is either a string (indicating user or
602 ;; user-like input) or a list of the form:
604 ;; (INPUT-STRING HANDLER-FN)
606 ;; The handler function will be called from the partial-output buffer when the
607 ;; command completes. This is the way to write commands which invoke gdb
608 ;; commands autonomously.
610 ;; These lists are consumed tail first.
613 (defun gdb-send (proc string
)
614 "A comint send filter for gdb.
615 This filter may simply queue output for a later time."
617 (process-send-string proc
(concat string
"\n"))
618 (gdb-enqueue-input (concat string
"\n"))))
620 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
621 ;; is a query, or other non-top-level prompt.
623 (defun gdb-enqueue-input (item)
624 (if (gdb-get-prompting)
627 (gdb-set-prompting nil
))
629 (cons item
(gdb-get-input-queue)))))
631 (defun gdb-dequeue-input ()
632 (let ((queue (gdb-get-input-queue)))
634 (let ((last (car (last queue
))))
635 (unless (nbutlast queue
) (gdb-set-input-queue '()))
640 ;; output -- things gdb prints to emacs
642 ;; GDB output is a stream interrupted by annotations.
643 ;; Annotations can be recognized by their beginning
644 ;; with \C-j\C-z\C-z<tag><opt>\C-j
646 ;; The tag is a string obeying symbol syntax.
648 ;; The optional part `<opt>' can be either the empty string
649 ;; or a space followed by more data relating to the annotation.
650 ;; For example, the SOURCE annotation is followed by a filename,
651 ;; line number and various useless goo. This data must not include
655 (defcustom gud-gdba-command-name
"gdb -annotate=3"
656 "Default command to execute an executable under the GDB-UI debugger."
660 (defvar gdb-annotation-rules
661 '(("pre-prompt" gdb-pre-prompt
)
662 ("prompt" gdb-prompt
)
663 ("commands" gdb-subprompt
)
664 ("overload-choice" gdb-subprompt
)
665 ("query" gdb-subprompt
)
666 ("prompt-for-continue" gdb-subprompt
)
667 ("post-prompt" gdb-post-prompt
)
668 ("source" gdb-source
)
669 ("starting" gdb-starting
)
670 ("exited" gdb-stopping
)
671 ("signalled" gdb-stopping
)
672 ("signal" gdb-stopping
)
673 ("breakpoint" gdb-stopping
)
674 ("watchpoint" gdb-stopping
)
675 ("frame-begin" gdb-frame-begin
)
676 ("stopped" gdb-stopped
)
677 ) "An assoc mapping annotation tags to functions which process them.")
679 (defconst gdb-source-spec-regexp
680 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
682 ;; Do not use this except as an annotation handler.
683 (defun gdb-source (args)
684 (string-match gdb-source-spec-regexp args
)
685 ;; Extract the frame position from the marker.
688 (match-string 1 args
)
689 (string-to-int (match-string 2 args
))))
690 (setq gdb-current-address
(match-string 3 args
))
691 (setq gdb-view-source t
)
692 ;; cover for auto-display output which comes *before*
693 ;; stopped annotation
694 (if (eq (gdb-get-output-sink) 'inferior
) (gdb-set-output-sink 'user
)))
696 (defun gdb-send-item (item)
697 (if gdb-enable-debug-log
(push (cons 'send item
) gdb-debug-log
))
698 (gdb-set-current-item item
)
701 (gdb-set-output-sink 'user
)
702 (process-send-string (get-buffer-process gud-comint-buffer
) item
))
704 (gdb-clear-partial-output)
705 (gdb-set-output-sink 'pre-emacs
)
706 (process-send-string (get-buffer-process gud-comint-buffer
)
709 (defun gdb-pre-prompt (ignored)
710 "An annotation handler for `pre-prompt'. This terminates the collection of
711 output from a previous command if that happens to be in effect."
712 (let ((sink (gdb-get-output-sink)))
716 (gdb-set-output-sink 'post-emacs
))
718 (gdb-set-output-sink 'user
)
719 (error "Phase error in gdb-pre-prompt (got %s)" sink
)))))
721 (defun gdb-prompt (ignored)
722 "An annotation handler for `prompt'.
723 This sends the next command (if any) to gdb."
724 (when gdb-first-prompt
(gdb-ann3))
725 (let ((sink (gdb-get-output-sink)))
728 ((eq sink
'post-emacs
)
729 (gdb-set-output-sink 'user
)
731 (car (cdr (gdb-get-current-item)))))
732 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
735 (gdb-set-output-sink 'user
)
736 (error "Phase error in gdb-prompt (got %s)" sink
))))
737 (let ((input (gdb-dequeue-input)))
739 (gdb-send-item input
)
741 (gdb-set-prompting t
)
742 (gud-display-frame)))))
744 (defun gdb-subprompt (ignored)
745 "An annotation handler for non-top-level prompts."
746 (gdb-set-prompting t
))
748 (defun gdb-starting (ignored)
749 "An annotation handler for `starting'. This says that I/O for the
750 subprocess is now the program being debugged, not GDB."
751 (let ((sink (gdb-get-output-sink)))
756 (if gdb-use-inferior-io-buffer
757 (gdb-set-output-sink 'inferior
))))
758 (t (error "Unexpected `starting' annotation")))))
760 (defun gdb-stopping (ignored)
761 "An annotation handler for `exited' and other annotations which say that I/O
762 for the subprocess is now GDB, not the program being debugged."
763 (if gdb-use-inferior-io-buffer
764 (let ((sink (gdb-get-output-sink)))
767 (gdb-set-output-sink 'user
))
768 (t (error "Unexpected stopping annotation"))))))
770 (defun gdb-frame-begin (ignored)
771 (let ((sink (gdb-get-output-sink)))
774 (gdb-set-output-sink 'user
))
777 (t (error "Unexpected frame-begin annotation (%S)" sink
)))))
779 (defun gdb-stopped (ignored)
780 "An annotation handler for `stopped'. It is just like gdb-stopping, except
781 that if we already set the output sink to 'user in gdb-stopping, that is fine."
782 (setq gud-running nil
)
783 (let ((sink (gdb-get-output-sink)))
786 (gdb-set-output-sink 'user
))
788 (t (error "Unexpected stopped annotation")))))
790 (defun gdb-post-prompt (ignored)
791 "An annotation handler for `post-prompt'. This begins the collection of
792 output from the current command if that happens to be appropriate."
793 (if (not (gdb-get-pending-triggers))
795 (gdb-get-current-frame)
796 (gdb-invalidate-frames)
797 (gdb-invalidate-breakpoints)
798 (gdb-invalidate-assembler)
799 (gdb-invalidate-registers)
800 (gdb-invalidate-locals)
801 (gdb-invalidate-threads)
802 (unless (eq system-type
'darwin
) ;Breaks on Darwin's GDB-5.3.
803 ;; FIXME: with GDB-6 on Darwin, this might very well work.
804 (dolist (frame (frame-list))
805 (when (string-equal (frame-parameter frame
'name
) "Speedbar")
806 (setq gdb-var-changed t
) ; force update
807 (dolist (var gdb-var-list
)
808 (setcar (nthcdr 5 var
) nil
))))
810 (let ((sink (gdb-get-output-sink)))
813 ((eq sink
'pre-emacs
)
814 (gdb-set-output-sink 'emacs
))
816 (gdb-set-output-sink 'user
)
817 (error "Phase error in gdb-post-prompt (got %s)" sink
)))))
819 (defun gud-gdba-marker-filter (string)
820 "A gud marker filter for gdb. Handle a burst of output from GDB."
821 (if gdb-enable-debug-log
(push (cons 'recv string
) gdb-debug-log
))
822 ;; Recall the left over gud-marker-acc from last time
823 (setq gud-marker-acc
(concat gud-marker-acc string
))
824 ;; Start accumulating output for the GUD buffer
827 ;; Process all the complete markers in this chunk.
828 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc
)
829 (let ((annotation (match-string 1 gud-marker-acc
)))
831 ;; Stuff prior to the match is just ordinary output.
832 ;; It is either concatenated to OUTPUT or directed
837 (substring gud-marker-acc
0 (match-beginning 0))))
839 ;; Take that stuff off the gud-marker-acc.
840 (setq gud-marker-acc
(substring gud-marker-acc
(match-end 0)))
842 ;; Parse the tag from the annotation, and maybe its arguments.
843 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation
)
844 (let* ((annotation-type (match-string 1 annotation
))
845 (annotation-arguments (match-string 2 annotation
))
846 (annotation-rule (assoc annotation-type
847 gdb-annotation-rules
)))
848 ;; Call the handler for this annotation.
850 (funcall (car (cdr annotation-rule
))
851 annotation-arguments
)
852 ;; Else the annotation is not recognized. Ignore it silently,
853 ;; so that GDB can add new annotations without causing
857 ;; Does the remaining text end in a partial line?
858 ;; If it does, then keep part of the gud-marker-acc until we get more.
859 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
862 ;; Everything before the potential marker start can be output.
864 (gdb-concat-output output
865 (substring gud-marker-acc
0
866 (match-beginning 0))))
868 ;; Everything after, we save, to combine with later input.
869 (setq gud-marker-acc
(substring gud-marker-acc
(match-beginning 0))))
871 ;; In case we know the gud-marker-acc contains no partial annotations:
873 (setq output
(gdb-concat-output output gud-marker-acc
))
874 (setq gud-marker-acc
"")))
877 (defun gdb-concat-output (so-far new
)
878 (let ((sink (gdb-get-output-sink )))
880 ((eq sink
'user
) (concat so-far new
))
881 ((or (eq sink
'pre-emacs
) (eq sink
'post-emacs
)) so-far
)
883 (gdb-append-to-partial-output new
)
886 (gdb-append-to-inferior-io new
)
888 (t (error "Bogon output sink %S" sink
)))))
890 (defun gdb-append-to-partial-output (string)
891 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
892 (goto-char (point-max))
895 (defun gdb-clear-partial-output ()
896 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
899 (defun gdb-append-to-inferior-io (string)
900 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
901 (goto-char (point-max))
902 (insert-before-markers string
))
903 (if (not (string-equal string
""))
904 (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io
))))
906 (defun gdb-clear-inferior-io ()
907 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
911 ;; One trick is to have a command who's output is always available in a buffer
912 ;; of it's own, and is always up to date. We build several buffers of this
915 ;; There are two aspects to this: gdb has to tell us when the output for that
916 ;; command might have changed, and we have to be able to run the command
917 ;; behind the user's back.
919 ;; The output phasing associated with the variable gdb-output-sink
920 ;; help us to run commands behind the user's back.
922 ;; Below is the code for specificly managing buffers of output from one
926 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
927 ;; It adds an input for the command we are tracking. It should be the
928 ;; annotation rule binding of whatever gdb sends to tell us this command
929 ;; might have changed it's output.
931 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
932 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
933 ;; input in the input queue (see comment about ``gdb communications'' above).
935 (defmacro def-gdb-auto-update-trigger
(name demand-predicate gdb-command
937 `(defun ,name
(&optional ignored
)
938 (if (and (,demand-predicate
)
940 (gdb-get-pending-triggers))))
943 (list ,gdb-command
',output-handler
))
944 (gdb-set-pending-triggers
946 (gdb-get-pending-triggers)))))))
948 (defmacro def-gdb-auto-update-handler
(name trigger buf-key custom-defun
)
950 (gdb-set-pending-triggers
952 (gdb-get-pending-triggers)))
953 (let ((buf (gdb-get-buffer ',buf-key
)))
955 (with-current-buffer buf
957 (buffer-read-only nil
))
959 (insert-buffer-substring (gdb-get-create-buffer
960 'gdb-partial-output-buffer
))
962 ;; put customisation here
965 (defmacro def-gdb-auto-updated-buffer
(buffer-key trigger-name gdb-command
966 output-handler-name custom-defun
)
968 (def-gdb-auto-update-trigger ,trigger-name
969 ;; The demand predicate:
970 (lambda () (gdb-get-buffer ',buffer-key
))
972 ,output-handler-name
)
973 (def-gdb-auto-update-handler ,output-handler-name
974 ,trigger-name
,buffer-key
,custom-defun
)))
978 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
980 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
981 'gdb-breakpoints-buffer-name
982 'gdb-breakpoints-mode
)
984 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
985 ;; This defines the auto update rule for buffers of type
986 ;; `gdb-breakpoints-buffer'.
988 ;; It defines a function to serve as the annotation handler that
989 ;; handles the `foo-invalidated' message. That function is called:
990 gdb-invalidate-breakpoints
992 ;; To update the buffer, this command is sent to gdb.
993 "server info breakpoints\n"
995 ;; This also defines a function to be the handler for the output
996 ;; from the command above. That function will copy the output into
997 ;; the appropriately typed buffer. That function will be called:
998 gdb-info-breakpoints-handler
999 ;; buffer specific functions
1000 gdb-info-breakpoints-custom
)
1002 (defvar gdb-cdir nil
"Compilation directory.")
1004 (defconst breakpoint-xpm-data
"/* XPM */
1005 static char *magick[] = {
1006 /* columns rows colors chars-per-pixel */
1022 "XPM data used for breakpoint icon.")
1024 (defconst breakpoint-enabled-pbm-data
1027 0 0 0 0 1 1 1 1 0 0 0 0
1028 0 0 0 1 1 1 1 1 1 0 0 0
1029 0 0 1 1 1 1 1 1 1 1 0 0
1030 0 1 1 1 1 1 1 1 1 1 1 0
1031 0 1 1 1 1 1 1 1 1 1 1 0
1032 0 1 1 1 1 1 1 1 1 1 1 0
1033 0 1 1 1 1 1 1 1 1 1 1 0
1034 0 0 1 1 1 1 1 1 1 1 0 0
1035 0 0 0 1 1 1 1 1 1 0 0 0
1036 0 0 0 0 1 1 1 1 0 0 0 0"
1037 "PBM data used for enabled breakpoint icon.")
1039 (defconst breakpoint-disabled-pbm-data
1051 0 0 0 1 0 1 0 1 0 0"
1052 "PBM data used for disabled breakpoint icon.")
1054 (defvar breakpoint-enabled-icon nil
1055 "Icon for enabled breakpoint in display margin")
1057 (defvar breakpoint-disabled-icon nil
1058 "Icon for disabled breakpoint in display margin")
1060 (defvar breakpoint-bitmap nil
1061 "Bitmap for breakpoint in fringe")
1063 (defface breakpoint-enabled-bitmap-face
1067 "Face for enabled breakpoint icon in fringe.")
1069 (defface breakpoint-disabled-bitmap-face
1072 :foreground
"grey60"))
1073 "Face for disabled breakpoint icon in fringe.")
1076 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1077 (defun gdb-info-breakpoints-custom ()
1078 (let ((flag)(address))
1080 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1081 (dolist (buffer (buffer-list))
1082 (with-current-buffer buffer
1083 (if (and (eq gud-minor-mode
'gdba
)
1084 (not (string-match "^\*" (buffer-name))))
1085 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
1086 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer
)
1088 (goto-char (point-min))
1089 (while (< (point) (- (point-max) 1))
1091 (if (looking-at "[^\t].*breakpoint")
1093 (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1094 (setq flag
(char-after (match-beginning 1)))
1096 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t
)
1098 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1099 (let ((line (match-string 2)) (buffer-read-only nil
)
1100 (file (match-string 1)))
1101 (add-text-properties (point-at-bol) (point-at-eol)
1102 '(mouse-face highlight
1103 help-echo
"mouse-2, RET: visit breakpoint"))
1104 (with-current-buffer
1106 (if (file-exists-p file
) file
1107 (expand-file-name file gdb-cdir
)))
1108 (save-current-buffer
1109 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1110 (set (make-local-variable 'tool-bar-map
)
1112 ;; only want one breakpoint icon at each location
1114 (goto-line (string-to-number line
))
1115 (gdb-put-breakpoint-icon (eq flag ?y
)))))))))
1117 (if (gdb-get-buffer 'gdb-assembler-buffer
) (gdb-assembler-custom)))
1119 (defun gdb-mouse-toggle-breakpoint (event)
1120 "Toggle breakpoint with mouse click in left margin."
1122 (mouse-minibuffer-check event
)
1123 (let ((posn (event-end event
)))
1124 (if (numberp (posn-point posn
))
1125 (with-selected-window (posn-window posn
)
1127 (goto-char (posn-point posn
))
1128 (if (or (posn-object posn
)
1129 (and breakpoint-bitmap
1130 (eq (car (fringe-bitmaps-at-pos (posn-point posn
)))
1131 breakpoint-bitmap
)))
1133 (gud-break nil
)))))))
1135 (defun gdb-breakpoints-buffer-name ()
1136 (with-current-buffer gud-comint-buffer
1137 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1139 (defun gdb-display-breakpoints-buffer ()
1142 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1144 (defconst gdb-frame-parameters
1145 '((height .
12) (width .
60)
1147 (tool-bar-lines . nil
)
1148 (menu-bar-lines . nil
)
1149 (minibuffer . nil
)))
1151 (defun gdb-frame-breakpoints-buffer ()
1153 (select-frame (make-frame gdb-frame-parameters
))
1154 (switch-to-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer
))
1155 (set-window-dedicated-p (get-buffer-window (current-buffer)) t
))
1157 (defvar gdb-breakpoints-mode-map
1158 (let ((map (make-sparse-keymap))
1159 (menu (make-sparse-keymap "Breakpoints")))
1160 (define-key menu
[toggle] '("Toggle" . gdb-toggle-breakpoint))
1161 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1162 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1164 (suppress-keymap map)
1165 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1166 (define-key map " " 'gdb-toggle-breakpoint)
1167 (define-key map "d" 'gdb-delete-breakpoint)
1168 (define-key map "\r" 'gdb-goto-breakpoint)
1169 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1172 (defun gdb-breakpoints-mode ()
1173 "Major mode for gdb breakpoints.
1175 \\{gdb-breakpoints-mode-map}"
1176 (setq major-mode 'gdb-breakpoints-mode)
1177 (setq mode-name "Breakpoints")
1178 (use-local-map gdb-breakpoints-mode-map)
1179 (setq buffer-read-only t)
1180 (gdb-invalidate-breakpoints))
1182 (defun gdb-toggle-breakpoint ()
1183 "Enable/disable the breakpoint at current line."
1186 (beginning-of-line 1)
1187 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1188 (error "Not recognized as break/watchpoint line")
1192 (if (eq ?y (char-after (match-beginning 2)))
1195 (match-string 1) "\n")
1198 (defun gdb-delete-breakpoint ()
1199 "Delete the breakpoint at current line."
1201 (beginning-of-line 1)
1202 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1203 (error "Not recognized as break/watchpoint line")
1205 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1207 (defun gdb-goto-breakpoint ()
1208 "Display the file in the source buffer at the breakpoint specified on the
1212 (beginning-of-line 1)
1213 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1214 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1215 (if (match-string 2)
1216 (let ((line (match-string 2))
1217 (file (match-string 1)))
1218 (save-selected-window
1219 (gdb-display-buffer (find-file-noselect
1220 (if (file-exists-p file)
1222 (expand-file-name file gdb-cdir))))
1223 (goto-line (string-to-number line))))))
1225 (defun gdb-mouse-goto-breakpoint (event)
1226 "Display the file in the source buffer at the selected breakpoint."
1228 (mouse-set-point event)
1229 (gdb-goto-breakpoint))
1232 ;; Frames buffer. This displays a perpetually correct bactracktrace
1233 ;; (from the command `where').
1235 ;; Alas, if your stack is deep, it is costly.
1237 (gdb-set-buffer-rules 'gdb-stack-buffer
1238 'gdb-stack-buffer-name
1241 (def-gdb-auto-updated-buffer gdb-stack-buffer
1242 gdb-invalidate-frames
1244 gdb-info-frames-handler
1245 gdb-info-frames-custom)
1247 (defun gdb-info-frames-custom ()
1248 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1250 (let ((buffer-read-only nil))
1251 (goto-char (point-min))
1252 (while (< (point) (point-max))
1253 (add-text-properties (point-at-bol) (point-at-eol)
1254 '(mouse-face highlight
1255 help-echo "mouse-2, RET: Select frame"))
1257 (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
1258 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
1259 (equal (match-string 1) gdb-current-frame))
1260 (put-text-property (point-at-bol) (point-at-eol)
1261 'face '(:inverse-video t)))
1262 (forward-line 1))))))
1264 (defun gdb-stack-buffer-name ()
1265 (with-current-buffer gud-comint-buffer
1266 (concat "*stack frames of " (gdb-get-target-string) "*")))
1268 (defun gdb-display-stack-buffer ()
1271 (gdb-get-create-buffer 'gdb-stack-buffer)))
1273 (defun gdb-frame-stack-buffer ()
1275 (select-frame (make-frame gdb-frame-parameters))
1276 (switch-to-buffer (gdb-get-create-buffer 'gdb-stack-buffer))
1277 (set-window-dedicated-p (get-buffer-window (current-buffer)) t))
1279 (defvar gdb-frames-mode-map
1280 (let ((map (make-sparse-keymap)))
1281 (suppress-keymap map)
1282 (define-key map "\r" 'gdb-frames-select)
1283 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1286 (defun gdb-frames-mode ()
1287 "Major mode for gdb frames.
1289 \\{gdb-frames-mode-map}"
1290 (setq major-mode 'gdb-frames-mode)
1291 (setq mode-name "Frames")
1292 (setq buffer-read-only t)
1293 (use-local-map gdb-frames-mode-map)
1295 (gdb-invalidate-frames))
1297 (defun gdb-get-frame-number ()
1299 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1300 (n (or (and pos (match-string-no-properties 1)) "0")))
1303 (defun gdb-frames-select ()
1304 "Make the frame on the current line become the current frame and display the
1305 source in the source buffer."
1308 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1309 (gud-display-frame))
1311 (defun gdb-frames-mouse-select (event)
1312 "Make the selected frame become the current frame and display the source in
1315 (mouse-set-point event)
1316 (gdb-frames-select))
1319 ;; Threads buffer. This displays a selectable thread list.
1321 (gdb-set-buffer-rules 'gdb-threads-buffer
1322 'gdb-threads-buffer-name
1325 (def-gdb-auto-updated-buffer gdb-threads-buffer
1326 gdb-invalidate-threads
1327 "server info threads\n"
1328 gdb-info-threads-handler
1329 gdb-info-threads-custom)
1331 (defun gdb-info-threads-custom ()
1332 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1333 (let ((buffer-read-only nil))
1334 (goto-char (point-min))
1335 (while (< (point) (point-max))
1336 (add-text-properties (point-at-bol) (point-at-eol)
1337 '(mouse-face highlight
1338 help-echo "mouse-2, RET: select thread"))
1339 (forward-line 1)))))
1341 (defun gdb-threads-buffer-name ()
1342 (with-current-buffer gud-comint-buffer
1343 (concat "*threads of " (gdb-get-target-string) "*")))
1345 (defun gdb-display-threads-buffer ()
1348 (gdb-get-create-buffer 'gdb-threads-buffer)))
1350 (defun gdb-frame-threads-buffer ()
1352 (select-frame (make-frame gdb-frame-parameters))
1353 (switch-to-buffer (gdb-get-create-buffer 'gdb-threads-buffer))
1354 (set-window-dedicated-p (get-buffer-window (current-buffer)) t))
1356 (defvar gdb-threads-mode-map
1357 (let ((map (make-sparse-keymap)))
1358 (suppress-keymap map)
1359 (define-key map "\r" 'gdb-threads-select)
1360 (define-key map [mouse-2] 'gdb-threads-mouse-select)
1363 (defun gdb-threads-mode ()
1364 "Major mode for gdb frames.
1366 \\{gdb-frames-mode-map}"
1367 (setq major-mode 'gdb-threads-mode)
1368 (setq mode-name "Threads")
1369 (setq buffer-read-only t)
1370 (use-local-map gdb-threads-mode-map)
1371 (gdb-invalidate-threads))
1373 (defun gdb-get-thread-number ()
1375 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1376 (match-string-no-properties 1)))
1378 (defun gdb-threads-select ()
1379 "Make the thread on the current line become the current thread and display the
1380 source in the source buffer."
1383 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1384 (gud-display-frame))
1386 (defun gdb-threads-mouse-select (event)
1387 "Make the selected frame become the current frame and display the source in
1390 (mouse-set-point event)
1391 (gdb-threads-select))
1394 ;; Registers buffer.
1396 (gdb-set-buffer-rules 'gdb-registers-buffer
1397 'gdb-registers-buffer-name
1398 'gdb-registers-mode)
1400 (def-gdb-auto-updated-buffer gdb-registers-buffer
1401 gdb-invalidate-registers
1402 "server info registers\n"
1403 gdb-info-registers-handler
1404 gdb-info-registers-custom)
1406 (defun gdb-info-registers-custom ())
1408 (defvar gdb-registers-mode-map
1409 (let ((map (make-sparse-keymap)))
1410 (suppress-keymap map)
1413 (defun gdb-registers-mode ()
1414 "Major mode for gdb registers.
1416 \\{gdb-registers-mode-map}"
1417 (setq major-mode 'gdb-registers-mode)
1418 (setq mode-name "Registers")
1419 (setq buffer-read-only t)
1420 (use-local-map gdb-registers-mode-map)
1421 (gdb-invalidate-registers))
1423 (defun gdb-registers-buffer-name ()
1424 (with-current-buffer gud-comint-buffer
1425 (concat "*registers of " (gdb-get-target-string) "*")))
1427 (defun gdb-display-registers-buffer ()
1430 (gdb-get-create-buffer 'gdb-registers-buffer)))
1432 (defun gdb-frame-registers-buffer ()
1434 (select-frame (make-frame gdb-frame-parameters))
1435 (switch-to-buffer (gdb-get-create-buffer 'gdb-registers-buffer))
1436 (set-window-dedicated-p (get-buffer-window (current-buffer)) t))
1441 (gdb-set-buffer-rules 'gdb-locals-buffer
1442 'gdb-locals-buffer-name
1445 (def-gdb-auto-updated-buffer gdb-locals-buffer
1446 gdb-invalidate-locals
1447 "server info locals\n"
1448 gdb-info-locals-handler
1449 gdb-info-locals-custom)
1451 ;; Abbreviate for arrays and structures.
1452 ;; These can be expanded using gud-display.
1453 (defun gdb-info-locals-handler nil
1454 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1455 (gdb-get-pending-triggers)))
1456 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1457 (with-current-buffer buf
1458 (goto-char (point-min))
1459 (while (re-search-forward "^ .*\n" nil t)
1460 (replace-match "" nil nil))
1461 (goto-char (point-min))
1462 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1463 (replace-match "(array);\n" nil nil))
1464 (goto-char (point-min))
1465 (while (re-search-forward "{.*=.*\n" nil t)
1466 (replace-match "(structure);\n" nil nil))))
1467 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1468 (and buf (with-current-buffer buf
1470 (buffer-read-only nil))
1471 (delete-region (point-min) (point-max))
1472 (insert-buffer-substring (gdb-get-create-buffer
1473 'gdb-partial-output-buffer))
1475 (run-hooks 'gdb-info-locals-hook))
1477 (defun gdb-info-locals-custom ()
1480 (defvar gdb-locals-mode-map
1481 (let ((map (make-sparse-keymap)))
1482 (suppress-keymap map)
1485 (defun gdb-locals-mode ()
1486 "Major mode for gdb locals.
1488 \\{gdb-locals-mode-map}"
1489 (setq major-mode 'gdb-locals-mode)
1490 (setq mode-name "Locals")
1491 (setq buffer-read-only t)
1492 (use-local-map gdb-locals-mode-map)
1493 (gdb-invalidate-locals))
1495 (defun gdb-locals-buffer-name ()
1496 (with-current-buffer gud-comint-buffer
1497 (concat "*locals of " (gdb-get-target-string) "*")))
1499 (defun gdb-display-locals-buffer ()
1502 (gdb-get-create-buffer 'gdb-locals-buffer)))
1504 (defun gdb-frame-locals-buffer ()
1506 (select-frame (make-frame gdb-frame-parameters))
1507 (switch-to-buffer (gdb-get-create-buffer 'gdb-locals-buffer))
1508 (set-window-dedicated-p (get-buffer-window (current-buffer)) t))
1511 ;;;; Window management
1513 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1514 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1515 ;;; get at the use_time field of a window, I'm not sure there exists a
1516 ;;; more elegant solution without writing C code.
1518 (defun gdb-display-buffer (buf &optional size)
1519 (let ((must-split nil)
1525 (if (eq gud-comint-buffer (window-buffer win))
1526 (set-window-dedicated-p win t))))
1527 (setq answer (get-buffer-window buf))
1529 (let ((window (get-lru-window 'visible)))
1532 (set-window-buffer window buf)
1533 (setq answer window))
1534 (setq must-split t)))))
1537 (if (eq gud-comint-buffer (window-buffer win))
1538 (set-window-dedicated-p win nil)))))
1540 (let* ((largest (get-largest-window 'visible))
1541 (cur-size (window-height largest))
1542 (new-size (and size (< size cur-size) (- cur-size size))))
1543 (setq answer (split-window largest new-size))
1544 (set-window-buffer answer buf)))
1547 (defun gdb-display-source-buffer (buffer)
1548 (if (eq gdb-selected-view 'source)
1549 (gdb-display-buffer buffer)
1550 (gdb-display-buffer (gdb-get-buffer 'gdb-assembler-buffer)))
1551 (get-buffer-window buffer))
1554 ;;; Shared keymap initialization:
1556 (let ((menu (make-sparse-keymap "GDB-Frames")))
1557 (define-key gud-menu-map [frames]
1558 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1559 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1560 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1561 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1562 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1563 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1564 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1565 ; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
1568 (let ((menu (make-sparse-keymap "GDB-Windows")))
1569 (define-key gud-menu-map [displays]
1570 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1571 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1572 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1573 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1574 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1575 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1576 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1577 ; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1580 (let ((menu (make-sparse-keymap "View")))
1581 (define-key gud-menu-map [view]
1582 `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba)))
1583 ; (define-key menu [both] '(menu-item "Both" gdb-view-both
1584 ; :help "Display both source and assembler"
1585 ; :button (:radio . (eq gdb-selected-view 'both))))
1586 (define-key menu [assembler] '(menu-item "Machine" gdb-view-assembler
1587 :help "Display assembler only"
1588 :button (:radio . (eq gdb-selected-view 'assembler))))
1589 (define-key menu [source] '(menu-item "Source" gdb-view-source-function
1590 :help "Display source only"
1591 :button (:radio . (eq gdb-selected-view 'source)))))
1593 (let ((menu (make-sparse-keymap "GDB-UI")))
1594 (define-key gud-menu-map [ui]
1595 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
1596 (define-key menu [gdb-restore-windows]
1597 '("Restore window layout" . gdb-restore-windows))
1598 (define-key menu [gdb-many-windows]
1599 (menu-bar-make-toggle gdb-many-windows gdb-many-windows
1600 "Display other windows" "Many Windows %s"
1601 "Display locals, stack and breakpoint information")))
1603 (defun gdb-frame-gdb-buffer ()
1605 (select-frame (make-frame gdb-frame-parameters))
1606 (switch-to-buffer (gdb-get-create-buffer 'gdba))
1607 (set-window-dedicated-p (get-buffer-window (current-buffer)) t))
1609 (defun gdb-display-gdb-buffer ()
1612 (gdb-get-create-buffer 'gdba)))
1614 (defvar gdb-main-file nil "Source file from which program execution begins.")
1616 (defun gdb-view-source-function ()
1620 (if gud-last-last-frame
1621 (gud-find-file (car gud-last-last-frame))
1622 (gud-find-file gdb-main-file))))
1623 (setq gdb-selected-view 'source))
1625 (defun gdb-view-assembler()
1627 (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
1628 (gdb-invalidate-assembler)
1629 (setq gdb-selected-view 'assembler))
1631 ;(defun gdb-view-both()
1633 ;(setq gdb-selected-view 'both))
1635 (defcustom gdb-show-main nil
1636 "Nil means don't display source file containing the main routine."
1640 (defun gdb-setup-windows ()
1641 "Layout the window pattern for gdb-many-windows."
1642 (gdb-display-locals-buffer)
1643 (gdb-display-stack-buffer)
1644 (delete-other-windows)
1645 (gdb-display-breakpoints-buffer)
1646 (delete-other-windows)
1647 (switch-to-buffer gud-comint-buffer)
1648 (split-window nil ( / ( * (window-height) 3) 4))
1649 (split-window nil ( / (window-height) 3))
1650 (split-window-horizontally)
1652 (switch-to-buffer (gdb-locals-buffer-name))
1655 (if (and gdb-view-source
1656 (eq gdb-selected-view 'source))
1657 (if gud-last-last-frame
1658 (gud-find-file (car gud-last-last-frame))
1659 (gud-find-file gdb-main-file))
1660 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1661 (when gdb-use-inferior-io-buffer
1662 (split-window-horizontally)
1664 (switch-to-buffer (gdb-inferior-io-name)))
1666 (switch-to-buffer (gdb-stack-buffer-name))
1667 (split-window-horizontally)
1669 (switch-to-buffer (gdb-breakpoints-buffer-name))
1672 (defcustom gdb-many-windows nil
1673 "Nil (the default value) means just pop up the GUD buffer
1674 unless `gdb-show-main' is t. In this case it starts with two
1675 windows: one displaying the GUD buffer and the other with the
1676 source file with the main routine of the debugee. Non-nil means
1677 display the layout shown for `gdba'."
1681 (defun gdb-many-windows (arg)
1682 "Toggle the number of windows in the basic arrangement."
1684 (setq gdb-many-windows
1686 (not gdb-many-windows)
1687 (> (prefix-numeric-value arg) 0)))
1689 (gdb-restore-windows)
1692 (defun gdb-restore-windows ()
1693 "Restore the basic arrangement of windows used by gdba.
1694 This arrangement depends on the value of `gdb-many-windows'."
1696 (if gdb-many-windows
1698 (switch-to-buffer gud-comint-buffer)
1699 (delete-other-windows)
1700 (gdb-setup-windows))
1701 (switch-to-buffer gud-comint-buffer)
1702 (delete-other-windows)
1706 (if (and gdb-view-source
1707 (eq gdb-selected-view 'source))
1708 (if gud-last-last-frame
1709 (gud-find-file (car gud-last-last-frame))
1710 (gud-find-file gdb-main-file))
1711 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1715 "Exit a debugging session cleanly by killing the gdb buffers and resetting
1716 the source buffers."
1717 (dolist (buffer (buffer-list))
1718 (if (not (eq buffer gud-comint-buffer))
1719 (with-current-buffer buffer
1720 (if (memq gud-minor-mode '(gdba pdb))
1721 (if (string-match "^\*.+*$" (buffer-name))
1723 (gdb-remove-breakpoint-icons (point-min) (point-max) t)
1724 (setq gud-minor-mode nil)
1725 (kill-local-variable 'tool-bar-map)
1726 (setq gud-running nil))))))
1727 (when (markerp gdb-overlay-arrow-position)
1728 (move-marker gdb-overlay-arrow-position nil)
1729 (setq gdb-overlay-arrow-position nil))
1730 (setq overlay-arrow-variable-list
1731 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)))
1733 (defun gdb-source-info ()
1734 "Find the source file where the program starts and displays it with related
1736 (goto-char (point-min))
1737 (if (search-forward "directory is " nil t)
1738 (if (looking-at "\\S-*:\\(\\S-*\\)")
1739 (setq gdb-cdir (match-string 1))
1740 (looking-at "\\S-*")
1741 (setq gdb-cdir (match-string 0))))
1742 (if (search-forward "Located in " nil t)
1743 (if (looking-at "\\S-*")
1744 (setq gdb-main-file (match-string 0)))
1745 (setq gdb-view-source nil))
1746 (if gdb-many-windows
1748 (gdb-get-create-buffer 'gdb-breakpoints-buffer)
1750 (switch-to-buffer gud-comint-buffer)
1751 (delete-other-windows)
1756 (gud-find-file gdb-main-file)
1757 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1761 (defun gdb-put-string (putstring pos &optional dprop)
1762 "Put string PUTSTRING in front of POS in the current buffer.
1763 PUTSTRING is displayed by putting an overlay into the current buffer with a
1764 `before-string' STRING that has a `display' property whose value is
1766 (let ((gdb-string "x")
1767 (buffer (current-buffer)))
1768 (let ((overlay (make-overlay pos pos buffer))
1770 (list (list 'margin 'left-margin) putstring))))
1771 (put-text-property 0 (length gdb-string) 'display prop gdb-string)
1772 (overlay-put overlay 'put-break t)
1773 (overlay-put overlay 'before-string gdb-string))))
1775 ;;from remove-images
1776 (defun gdb-remove-strings (start end &optional buffer)
1777 "Remove strings between START and END in BUFFER.
1778 Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
1779 BUFFER nil or omitted means use the current buffer."
1781 (setq buffer (current-buffer)))
1782 (let ((overlays (overlays-in start end)))
1784 (let ((overlay (car overlays)))
1785 (when (overlay-get overlay 'put-break)
1786 (delete-overlay overlay)))
1787 (setq overlays (cdr overlays)))))
1789 (defun gdb-put-breakpoint-icon (enabled)
1790 (let ((start (progn (beginning-of-line) (- (point) 1)))
1791 (end (progn (end-of-line) (+ (point) 1))))
1792 (gdb-remove-breakpoint-icons start end)
1793 (if (display-images-p)
1794 (if (>= (car (window-fringes)) 8)
1798 ,(or breakpoint-bitmap
1799 (setq breakpoint-bitmap
1800 (define-fringe-bitmap
1801 "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")))
1803 'breakpoint-enabled-bitmap-face
1804 'breakpoint-disabled-bitmap-face)))
1805 (when (< left-margin-width 2)
1806 (save-current-buffer
1807 (setq left-margin-width 2)
1808 (if (get-buffer-window (current-buffer))
1809 (set-window-margins (get-buffer-window
1812 right-margin-width))))
1815 (or breakpoint-enabled-icon
1816 (setq breakpoint-enabled-icon
1817 (find-image `((:type xpm :data
1818 ,breakpoint-xpm-data
1819 :ascent 100 :pointer hand)
1821 ,breakpoint-enabled-pbm-data
1822 :ascent 100 :pointer hand)))))
1823 (or breakpoint-disabled-icon
1824 (setq breakpoint-disabled-icon
1825 (find-image `((:type xpm :data
1826 ,breakpoint-xpm-data
1827 :conversion disabled
1830 ,breakpoint-disabled-pbm-data
1832 (+ start 1) nil 'left-margin))
1833 (when (< left-margin-width 2)
1834 (save-current-buffer
1835 (setq left-margin-width 2)
1836 (if (get-buffer-window (current-buffer))
1837 (set-window-margins (get-buffer-window
1840 right-margin-width))))
1841 (gdb-put-string (if enabled "B" "b") (1+ start)))))
1843 (defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
1844 (gdb-remove-strings start end)
1845 (if (display-images-p)
1846 (remove-images start end))
1848 (setq left-margin-width 0)
1849 (if (get-buffer-window (current-buffer))
1850 (set-window-margins (get-buffer-window
1853 right-margin-width))))
1857 ;; Assembler buffer.
1859 (gdb-set-buffer-rules 'gdb-assembler-buffer
1860 'gdb-assembler-buffer-name
1861 'gdb-assembler-mode)
1863 (def-gdb-auto-updated-buffer gdb-assembler-buffer
1864 gdb-invalidate-assembler
1865 (concat "server disassemble " gdb-current-address "\n")
1866 gdb-assembler-handler
1867 gdb-assembler-custom)
1869 (defun gdb-assembler-custom ()
1870 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
1871 (pos 1) (address) (flag))
1872 (with-current-buffer buffer
1873 (if (not (equal gdb-current-address "main"))
1875 (goto-char (point-min))
1876 (if (re-search-forward gdb-current-address nil t)
1880 (or gdb-overlay-arrow-position
1881 (setq gdb-overlay-arrow-position (make-marker)))
1882 (set-marker gdb-overlay-arrow-position
1883 (point) (current-buffer))))))
1884 ;; remove all breakpoint-icons in assembler buffer before updating.
1885 (gdb-remove-breakpoint-icons (point-min) (point-max)))
1886 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1887 (goto-char (point-min))
1888 (while (< (point) (- (point-max) 1))
1890 (if (looking-at "[^\t].*breakpoint")
1893 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
1894 (setq flag (char-after (match-beginning 1)))
1895 (setq address (match-string 2))
1896 ;; remove leading 0s from output of info break.
1897 (if (string-match "^0+\\(.*\\)" address)
1898 (setq address (match-string 1 address)))
1899 (with-current-buffer buffer
1900 (goto-char (point-min))
1901 (if (re-search-forward address nil t)
1902 (gdb-put-breakpoint-icon (eq flag ?y))))))))
1903 (if (not (equal gdb-current-address "main"))
1904 (set-window-point (get-buffer-window buffer) pos))))
1906 (defvar gdb-assembler-mode-map
1907 (let ((map (make-sparse-keymap)))
1908 (suppress-keymap map)
1911 (defun gdb-assembler-mode ()
1912 "Major mode for viewing code assembler.
1914 \\{gdb-assembler-mode-map}"
1915 (setq major-mode 'gdb-assembler-mode)
1916 (setq mode-name "Machine")
1917 (setq gdb-overlay-arrow-position nil)
1918 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
1919 (put 'gdb-overlay-arrow-position 'overlay-arrow-string "=>")
1920 (setq fringes-outside-margins t)
1921 (setq buffer-read-only t)
1922 (use-local-map gdb-assembler-mode-map)
1923 (gdb-invalidate-assembler))
1925 (defun gdb-assembler-buffer-name ()
1926 (with-current-buffer gud-comint-buffer
1927 (concat "*Machine Code " (gdb-get-target-string) "*")))
1929 (defun gdb-display-assembler-buffer ()
1932 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1934 (defun gdb-frame-assembler-buffer ()
1936 (select-frame (make-frame gdb-frame-parameters))
1937 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
1938 (set-window-dedicated-p (get-buffer-window (current-buffer)) t))
1940 ;; modified because if gdb-current-address has changed value a new command
1941 ;; must be enqueued to update the buffer with the new output
1942 (defun gdb-invalidate-assembler (&optional ignored)
1943 (if (gdb-get-buffer 'gdb-assembler-buffer)
1945 (unless (string-equal gdb-current-frame gdb-previous-frame)
1946 (if (or (not (member 'gdb-invalidate-assembler
1947 (gdb-get-pending-triggers)))
1948 (not (string-equal gdb-current-address
1949 gdb-previous-address)))
1951 ;; take previous disassemble command off the queue
1952 (with-current-buffer gud-comint-buffer
1953 (let ((queue (gdb-get-input-queue)) (item))
1954 (dolist (item queue)
1955 (if (equal (cdr item) '(gdb-assembler-handler))
1956 (gdb-set-input-queue
1957 (delete item (gdb-get-input-queue)))))))
1959 (list (concat "server disassemble " gdb-current-address "\n")
1960 'gdb-assembler-handler))
1961 (gdb-set-pending-triggers
1962 (cons 'gdb-invalidate-assembler
1963 (gdb-get-pending-triggers)))
1964 (setq gdb-previous-address gdb-current-address)
1965 (setq gdb-previous-frame gdb-current-frame)))))))
1967 (defun gdb-get-current-frame ()
1968 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
1971 (list (concat "server info frame\n") 'gdb-frame-handler))
1972 (gdb-set-pending-triggers
1973 (cons 'gdb-get-current-frame
1974 (gdb-get-pending-triggers))))))
1976 (defun gdb-frame-handler ()
1977 (gdb-set-pending-triggers
1978 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
1979 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1980 (goto-char (point-min))
1982 (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? ")
1984 (setq gdb-current-frame (match-string 2))
1985 (let ((address (match-string 1)))
1986 ;; remove leading 0s from output of info frame command.
1987 (if (string-match "^0+\\(.*\\)" address)
1988 (setq gdb-current-address
1989 (concat "0x" (match-string 1 address)))
1990 (setq gdb-current-address (concat "0x" address))))
1991 (if (or (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t))
1992 (progn (setq gdb-view-source nil) t))
1993 (eq gdb-selected-view 'assembler))
1996 (gdb-get-create-buffer 'gdb-assembler-buffer))
1997 ;;update with new frame for machine code if necessary
1998 (gdb-invalidate-assembler))))))
1999 (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
2000 (setq gdb-current-language (match-string 1))))
2004 ;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
2005 ;;; gdb-ui.el ends here