1 ;;; gdb-ui.el --- User Interface for running GDB
3 ;; Author: Nick Roberts <nick@nick.uklinux.net>
5 ;; Keywords: unix, tools
7 ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; This mode acts as a graphical user interface to GDB. You can interact with
29 ;; GDB through the GUD buffer in the usual way, but there are also further
30 ;; buffers which control the execution and describe the state of your program.
31 ;; It separates the input/output of your program from that of GDB, 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 the layout below will appear
79 regardless of the value of `gdb-show-main' 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 ---------------------------------------------------------------------
86 ---------------------------------------------------------------------
87 GUD buffer (I/O of GDB) | Locals buffer
91 ---------------------------------------------------------------------
92 Source buffer | Input/Output (of debugee) buffer
100 ---------------------------------------------------------------------
101 Stack buffer | Breakpoints buffer
102 RET gdb-frames-select | SPC gdb-toggle-breakpoint
103 | RET gdb-goto-breakpoint
104 | d gdb-delete-breakpoint
105 ---------------------------------------------------------------------
107 All the buffers share the toolbar and source should always display in the same
108 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
109 icons are displayed both by setting a break with gud-break and by typing break
112 This works best (depending on the size of your monitor) using most of the
115 Displayed expressions appear in separate frames. Arrays may be displayed
116 as slices and visualised using the graph program from plotutils if installed.
117 Pointers in structures may be followed in a tree-like fashion.
119 The following interactive lisp functions help control operation :
121 `gdb-many-windows' - Toggle the number of windows gdb uses.
122 `gdb-restore-windows' - To restore the window layout."
124 (interactive (list (gud-query-cmdline 'gdba)))
126 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
130 (defvar gdb-debug-log nil)
132 (defcustom gdb-enable-debug-log nil
133 "Non-nil means record the process input and output in `gdb-debug-log'."
137 (defcustom gdb-use-inferior-io-buffer nil
138 "Non-nil means display output from the inferior in a separate buffer."
143 (setq gdb-debug-log nil)
144 (set (make-local-variable 'gud-minor-mode) 'gdba)
145 (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)
147 (gud-def gud-break (if (not (string-equal mode-name "Machine"))
148 (gud-call "break %f:%l" arg)
152 (gud-call "break *%a" arg)))
153 "\C-b" "Set breakpoint at current line or address.")
155 (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
156 (gud-call "clear %f:%l" arg)
160 (gud-call "clear *%a" arg)))
161 "\C-d" "Remove breakpoint at current line or address.")
163 (gud-def gud-until (if (not (string-equal mode-name "Machine"))
164 (gud-call "until %f:%l" arg)
168 (gud-call "until *%a" arg)))
169 "\C-u" "Continue to current line or address.")
171 (define-key gud-minor-mode-map [left-margin mouse-1]
172 'gdb-mouse-toggle-breakpoint)
173 (define-key gud-minor-mode-map [left-fringe mouse-1]
174 'gdb-mouse-toggle-breakpoint)
176 (setq comint-input-sender 'gdb-send)
179 (setq gdb-current-address "main")
180 (setq gdb-previous-address nil)
181 (setq gdb-previous-frame nil)
182 (setq gdb-current-frame "main")
183 (setq gdb-view-source t)
184 (setq gdb-selected-view 'source)
185 (setq gdb-var-list nil)
186 (setq gdb-var-changed nil)
187 (setq gdb-first-prompt nil)
189 (mapc 'make-local-variable gdb-variables)
190 (setq gdb-buffer-type 'gdba)
192 (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io))
194 (if (eq window-system 'w32)
195 (gdb-enqueue-input (list "set new-console off\n" 'ignore)))
196 (gdb-enqueue-input (list "set height 0\n" 'ignore))
197 ;; find source file and compilation directory here
198 (gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program
199 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program
200 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))
202 (run-hooks 'gdba-mode-hook))
204 (defcustom gdb-use-colon-colon-notation nil
205 "Non-nil means use FUNCTION::VARIABLE format to display variables in the
211 "Watch expression at point."
214 (let ((expr (tooltip-identifier-from-point (point))))
215 (if (and (string-equal gdb-current-language "c")
216 gdb-use-colon-colon-notation)
217 (setq expr (concat gdb-current-frame "::" expr)))
218 (catch 'already-watched
219 (dolist (var gdb-var-list)
220 (if (string-equal expr (car var)) (throw 'already-watched nil)))
221 (set-text-properties 0 (length expr) nil expr)
223 (list (concat "server interpreter mi \"-var-create - * " expr "\"\n")
224 `(lambda () (gdb-var-create-handler ,expr))))))
225 (select-window (get-buffer-window gud-comint-buffer)))
227 (defconst gdb-var-create-regexp
228 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
230 (defun gdb-var-create-handler (expr)
231 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
232 (goto-char (point-min))
233 (if (re-search-forward gdb-var-create-regexp nil t)
234 (let ((var (list expr
239 (push var gdb-var-list)
240 (setq speedbar-update-flag t)
242 (if (equal (nth 2 var) "0")
244 (list (concat "server interpreter mi \"-var-evaluate-expression "
246 `(lambda () (gdb-var-evaluate-expression-handler
248 (setq gdb-var-changed t)))
249 (if (re-search-forward "Undefined command" nil t)
250 (message "Watching expressions requires gdb 6.0 onwards")
251 (message "No symbol %s in current context." expr)))))
253 (defun gdb-var-evaluate-expression-handler (varnum changed)
254 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
255 (goto-char (point-min))
256 (re-search-forward ".*value=\"\\(.*?\\)\"" nil t)
258 (let ((var-list nil) (num 0))
259 (dolist (var gdb-var-list)
260 (if (string-equal varnum (cadr var))
262 (if changed (setcar (nthcdr 5 var) t))
263 (setcar (nthcdr 4 var) (match-string 1))
264 (setcar (nthcdr num gdb-var-list) var)
265 (throw 'var-found nil)))
266 (setq num (+ num 1))))))
267 (setq gdb-var-changed t))
269 (defun gdb-var-list-children (varnum)
271 (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n")
272 `(lambda () (gdb-var-list-children-handler ,varnum)))))
274 (defconst gdb-var-list-children-regexp
275 "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"")
277 (defun gdb-var-list-children-handler (varnum)
278 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
279 (goto-char (point-min))
280 (let ((var-list nil))
281 (catch 'child-already-watched
282 (dolist (var gdb-var-list)
283 (if (string-equal varnum (cadr var))
286 (while (re-search-forward gdb-var-list-children-regexp nil t)
287 (let ((varchild (list (match-string 2)
291 (if (looking-at ",type=\"\\(.*?\\)\"")
292 (setcar (nthcdr 3 varchild) (match-string 1)))
293 (dolist (var1 gdb-var-list)
294 (if (string-equal (cadr var1) (cadr varchild))
295 (throw 'child-already-watched nil)))
296 (push varchild var-list)
297 (if (equal (nth 2 varchild) "0")
301 "server interpreter mi \"-var-evaluate-expression "
302 (nth 1 varchild) "\"\n")
303 `(lambda () (gdb-var-evaluate-expression-handler
304 ,(nth 1 varchild) nil))))))))
305 (push var var-list)))
306 (setq gdb-var-list (nreverse var-list))))))
308 (defun gdb-var-update ()
309 (if (not (member 'gdb-var-update (gdb-get-pending-triggers)))
311 (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n"
312 'gdb-var-update-handler))
313 (gdb-set-pending-triggers (cons 'gdb-var-update
314 (gdb-get-pending-triggers))))))
316 (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")
318 (defun gdb-var-update-handler ()
319 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
320 (goto-char (point-min))
321 (while (re-search-forward gdb-var-update-regexp nil t)
322 (let ((varnum (match-string 1)))
324 (list (concat "server interpreter mi \"-var-evaluate-expression "
326 `(lambda () (gdb-var-evaluate-expression-handler
328 (gdb-set-pending-triggers
329 (delq 'gdb-var-update (gdb-get-pending-triggers))))
331 (defun gdb-var-delete ()
332 "Delete watched expression from the speedbar."
334 (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
335 (let ((text (speedbar-line-text)))
336 (string-match "\\(\\S-+\\)" text)
337 (let* ((expr (match-string 1 text))
338 (var (assoc expr gdb-var-list))
340 (unless (string-match "\\." varnum)
342 (list (concat "server interpreter mi \"-var-delete "
345 (setq gdb-var-list (delq var gdb-var-list))
346 (dolist (varchild gdb-var-list)
347 (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild))
348 (setq gdb-var-list (delq varchild gdb-var-list))))
349 (setq gdb-var-changed t))))))
351 (defun gdb-edit-value (text token indent)
352 "Assign a value to a variable displayed in the speedbar"
353 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
354 (varnum (cadr var)) (value))
355 (setq value (read-string "New value: "))
357 (list (concat "server interpreter mi \"-var-assign "
358 varnum " " value "\"\n")
361 (defcustom gdb-show-changed-values t
362 "Non-nil means use font-lock-warning-face to display values that have
363 recently changed in the speedbar."
367 (defun gdb-speedbar-expand-node (text token indent)
368 "Expand the node the user clicked on.
369 TEXT is the text of the button we clicked on, a + or - item.
370 TOKEN is data related to this node.
371 INDENT is the current indentation depth."
372 (cond ((string-match "+" text) ;expand this node
373 (gdb-var-list-children token))
374 ((string-match "-" text) ;contract this node
375 (dolist (var gdb-var-list)
376 (if (string-match (concat token "\\.") (nth 1 var))
377 (setq gdb-var-list (delq var gdb-var-list))))
378 (setq gdb-var-changed t))))
381 ;; ======================================================================
383 ;; In this world, there are gdb variables (of unspecified
384 ;; representation) and buffers associated with those objects.
385 ;; The list of variables is built up by the expansions of
388 (defmacro def-gdb-var (root-symbol &optional default doc)
389 (let* ((root (symbol-name root-symbol))
390 (accessor (intern (concat "gdb-get-" root)))
391 (setter (intern (concat "gdb-set-" root)))
392 (name (intern (concat "gdb-" root))))
394 (defvar ,name ,default ,doc)
395 (if (not (memq ',name gdb-variables))
396 (push ',name gdb-variables))
398 (buffer-local-value ',name gud-comint-buffer))
400 (with-current-buffer gud-comint-buffer
401 (setq ,name val))))))
403 (def-gdb-var buffer-type nil
404 "One of the symbols bound in `gdb-buffer-rules'.")
406 (def-gdb-var burst ""
407 "A string of characters from gdb that have not yet been processed.")
409 (def-gdb-var input-queue ()
410 "A list of gdb command objects.")
412 (def-gdb-var prompting nil
413 "True when gdb is idle with no pending input.")
415 (def-gdb-var output-sink 'user
416 "The disposition of the output of the current gdb command.
417 Possible values are these symbols:
419 user -- gdb output should be copied to the GUD buffer
422 inferior -- gdb output should be copied to the inferior-io buffer
424 pre-emacs -- output should be ignored util the post-prompt
425 annotation is received. Then the output-sink
427 emacs -- output should be collected in the partial-output-buffer
428 for subsequent processing by a command. This is the
429 disposition of output generated by commands that
430 gdb mode sends to gdb on its own behalf.
431 post-emacs -- ignore output until the prompt annotation is
432 received, then go to USER disposition.
435 (def-gdb-var current-item nil
436 "The most recent command item sent to gdb.")
438 (def-gdb-var pending-triggers '()
439 "A list of trigger functions that have run later than their output
442 ;; end of gdb variables
444 (defun gdb-get-target-string ()
445 (with-current-buffer gud-comint-buffer
452 ;; Each buffer has a TYPE -- a symbol that identifies the function
453 ;; of that particular buffer.
455 ;; The usual gdb interaction buffer is given the type `gdba' and
456 ;; is constructed specially.
458 ;; Others are constructed by gdb-get-create-buffer and
459 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
461 (defvar gdb-buffer-rules-assoc '())
463 (defun gdb-get-buffer (key)
464 "Return the gdb buffer tagged with type KEY.
465 The key should be one of the cars in `gdb-buffer-rules-assoc'."
467 (gdb-look-for-tagged-buffer key (buffer-list))))
469 (defun gdb-get-create-buffer (key)
470 "Create a new gdb buffer of the type specified by KEY.
471 The key should be one of the cars in `gdb-buffer-rules-assoc'."
472 (or (gdb-get-buffer key)
473 (let* ((rules (assoc key gdb-buffer-rules-assoc))
474 (name (funcall (gdb-rules-name-maker rules)))
475 (new (get-buffer-create name)))
476 (with-current-buffer new
477 ;; FIXME: This should be set after calling the function, since the
478 ;; function should run kill-all-local-variables.
479 (set (make-local-variable 'gdb-buffer-type) key)
480 (if (cdr (cdr rules))
481 (funcall (car (cdr (cdr rules)))))
482 (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer)
483 (set (make-local-variable 'gud-minor-mode) 'gdba)
484 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
487 (defun gdb-rules-name-maker (rules) (car (cdr rules)))
489 (defun gdb-look-for-tagged-buffer (key bufs)
491 (while (and (not retval) bufs)
492 (set-buffer (car bufs))
493 (if (eq gdb-buffer-type key)
494 (setq retval (car bufs)))
495 (setq bufs (cdr bufs)))
499 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
500 ;; at least one and possible more functions. The functions have these
501 ;; roles in defining a buffer type:
503 ;; NAME - Return a name for this buffer type.
505 ;; The remaining function(s) are optional:
507 ;; MODE - called in a new buffer with no arguments, should establish
508 ;; the proper mode for the buffer.
511 (defun gdb-set-buffer-rules (buffer-type &rest rules)
512 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc)))
514 (setcdr binding rules)
515 (push (cons buffer-type rules)
516 gdb-buffer-rules-assoc))))
518 ;; GUD buffers are an exception to the rules
519 (gdb-set-buffer-rules 'gdba 'error)
522 ;; Partial-output buffer : This accumulates output from a command executed on
523 ;; behalf of emacs (rather than the user).
525 (gdb-set-buffer-rules 'gdb-partial-output-buffer
526 'gdb-partial-output-name)
528 (defun gdb-partial-output-name ()
529 (concat "*partial-output-"
530 (gdb-get-target-string)
534 (gdb-set-buffer-rules 'gdb-inferior-io
535 'gdb-inferior-io-name
536 'gdb-inferior-io-mode)
538 (defun gdb-inferior-io-name ()
539 (concat "*input/output of "
540 (gdb-get-target-string)
543 (defvar gdb-inferior-io-mode-map
544 (let ((map (make-sparse-keymap)))
545 (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt)
546 (define-key map "\C-c\C-z" 'gdb-inferior-io-stop)
547 (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit)
548 (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
551 (define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O"
552 "Major mode for gdb inferior-io."
553 :syntax-table nil :abbrev-table nil
554 ;; We want to use comint because it has various nifty and familiar
555 ;; features. We don't need a process, but comint wants one, so create
557 (make-comint-in-buffer
558 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
559 (current-buffer) "hexl")
560 (setq comint-input-sender 'gdb-inferior-io-sender))
562 (defun gdb-inferior-io-sender (proc string)
563 ;; PROC is the pseudo-process created to satisfy comint.
564 (with-current-buffer (process-buffer proc)
565 (setq proc (get-buffer-process gud-comint-buffer))
566 (process-send-string proc string)
567 (process-send-string proc "\n")))
569 (defun gdb-inferior-io-interrupt ()
570 "Interrupt the program being debugged."
573 (get-buffer-process gud-comint-buffer) comint-ptyp))
575 (defun gdb-inferior-io-quit ()
576 "Send quit signal to the program being debugged."
579 (get-buffer-process gud-comint-buffer) comint-ptyp))
581 (defun gdb-inferior-io-stop ()
582 "Stop the program being debugged."
585 (get-buffer-process gud-comint-buffer) comint-ptyp))
587 (defun gdb-inferior-io-eof ()
588 "Send end-of-file to the program being debugged."
591 (get-buffer-process gud-comint-buffer)))
595 ;; gdb communications
598 ;; INPUT: things sent to gdb
600 ;; The queues are lists. Each element is either a string (indicating user or
601 ;; user-like input) or a list of the form:
603 ;; (INPUT-STRING HANDLER-FN)
605 ;; The handler function will be called from the partial-output buffer when the
606 ;; command completes. This is the way to write commands which invoke gdb
607 ;; commands autonomously.
609 ;; These lists are consumed tail first.
612 (defun gdb-send (proc string)
613 "A comint send filter for gdb.
614 This filter may simply queue output for a later time."
616 (process-send-string proc (concat string "\n"))
617 (gdb-enqueue-input (concat string "\n"))))
619 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
620 ;; is a query, or other non-top-level prompt.
622 (defun gdb-enqueue-input (item)
623 (if (gdb-get-prompting)
626 (gdb-set-prompting nil))
628 (cons item (gdb-get-input-queue)))))
630 (defun gdb-dequeue-input ()
631 (let ((queue (gdb-get-input-queue)))
633 (let ((last (car (last queue))))
634 (unless (nbutlast queue) (gdb-set-input-queue '()))
639 ;; output -- things gdb prints to emacs
641 ;; GDB output is a stream interrupted by annotations.
642 ;; Annotations can be recognized by their beginning
643 ;; with \C-j\C-z\C-z<tag><opt>\C-j
645 ;; The tag is a string obeying symbol syntax.
647 ;; The optional part `<opt>' can be either the empty string
648 ;; or a space followed by more data relating to the annotation.
649 ;; For example, the SOURCE annotation is followed by a filename,
650 ;; line number and various useless goo. This data must not include
654 (defcustom gud-gdba-command-name "gdb -annotate=3"
655 "Default command to execute an executable under the GDB-UI debugger."
659 (defvar gdb-annotation-rules
660 '(("pre-prompt" gdb-pre-prompt)
661 ("prompt" gdb-prompt)
662 ("commands" gdb-subprompt)
663 ("overload-choice" gdb-subprompt)
664 ("query" gdb-subprompt)
665 ("prompt-for-continue" gdb-subprompt)
666 ("post-prompt" gdb-post-prompt)
667 ("source" gdb-source)
668 ("starting" gdb-starting)
669 ("exited" gdb-stopping)
670 ("signalled" gdb-stopping)
671 ("signal" gdb-stopping)
672 ("breakpoint" gdb-stopping)
673 ("watchpoint" gdb-stopping)
674 ("frame-begin" gdb-frame-begin)
675 ("stopped" gdb-stopped)
676 ) "An assoc mapping annotation tags to functions which process them.")
678 (defconst gdb-source-spec-regexp
679 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
681 ;; Do not use this except as an annotation handler.
682 (defun gdb-source (args)
683 (string-match gdb-source-spec-regexp args)
684 ;; Extract the frame position from the marker.
687 (match-string 1 args)
688 (string-to-int (match-string 2 args))))
689 (setq gdb-current-address (match-string 3 args))
690 (setq gdb-view-source t)
691 ;; cover for auto-display output which comes *before*
692 ;; stopped annotation
693 (if (eq (gdb-get-output-sink) 'inferior) (gdb-set-output-sink 'user)))
695 (defun gdb-send-item (item)
696 (if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log))
697 (gdb-set-current-item item)
700 (gdb-set-output-sink 'user)
701 (process-send-string (get-buffer-process gud-comint-buffer) item))
703 (gdb-clear-partial-output)
704 (gdb-set-output-sink 'pre-emacs)
705 (process-send-string (get-buffer-process gud-comint-buffer)
708 (defun gdb-pre-prompt (ignored)
709 "An annotation handler for `pre-prompt'. This terminates the collection of
710 output from a previous command if that happens to be in effect."
711 (let ((sink (gdb-get-output-sink)))
715 (gdb-set-output-sink 'post-emacs))
717 (gdb-set-output-sink 'user)
718 (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
720 (defun gdb-prompt (ignored)
721 "An annotation handler for `prompt'.
722 This sends the next command (if any) to gdb."
723 (when gdb-first-prompt (gdb-ann3))
724 (let ((sink (gdb-get-output-sink)))
727 ((eq sink 'post-emacs)
728 (gdb-set-output-sink 'user)
730 (car (cdr (gdb-get-current-item)))))
731 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
734 (gdb-set-output-sink 'user)
735 (error "Phase error in gdb-prompt (got %s)" sink))))
736 (let ((input (gdb-dequeue-input)))
738 (gdb-send-item input)
740 (gdb-set-prompting t)
741 (gud-display-frame)))))
743 (defun gdb-subprompt (ignored)
744 "An annotation handler for non-top-level prompts."
745 (gdb-set-prompting t))
747 (defun gdb-starting (ignored)
748 "An annotation handler for `starting'. This says that I/O for the
749 subprocess is now the program being debugged, not GDB."
750 (let ((sink (gdb-get-output-sink)))
755 (if gdb-use-inferior-io-buffer
756 (gdb-set-output-sink 'inferior))))
757 (t (error "Unexpected `starting' annotation")))))
759 (defun gdb-stopping (ignored)
760 "An annotation handler for `exited' and other annotations which say that I/O
761 for the subprocess is now GDB, not the program being debugged."
762 (if gdb-use-inferior-io-buffer
763 (let ((sink (gdb-get-output-sink)))
766 (gdb-set-output-sink 'user))
767 (t (error "Unexpected stopping annotation"))))))
769 (defun gdb-frame-begin (ignored)
770 (let ((sink (gdb-get-output-sink)))
773 (gdb-set-output-sink 'user))
776 (t (error "Unexpected frame-begin annotation (%S)" sink)))))
778 (defun gdb-stopped (ignored)
779 "An annotation handler for `stopped'. It is just like gdb-stopping, except
780 that if we already set the output sink to 'user in gdb-stopping, that is fine."
781 (setq gud-running nil)
782 (let ((sink (gdb-get-output-sink)))
785 (gdb-set-output-sink 'user))
787 (t (error "Unexpected stopped annotation")))))
789 (defun gdb-post-prompt (ignored)
790 "An annotation handler for `post-prompt'. This begins the collection of
791 output from the current command if that happens to be appropriate."
792 (if (not (gdb-get-pending-triggers))
794 (gdb-get-current-frame)
795 (gdb-invalidate-frames)
796 (gdb-invalidate-breakpoints)
797 (gdb-invalidate-assembler)
798 (gdb-invalidate-registers)
799 (gdb-invalidate-locals)
800 (gdb-invalidate-threads)
801 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
802 ;; FIXME: with GDB-6 on Darwin, this might very well work.
803 (dolist (frame (frame-list))
804 (when (string-equal (frame-parameter frame 'name) "Speedbar")
805 (setq gdb-var-changed t) ; force update
806 (dolist (var gdb-var-list)
807 (setcar (nthcdr 5 var) nil))))
809 (let ((sink (gdb-get-output-sink)))
812 ((eq sink 'pre-emacs)
813 (gdb-set-output-sink 'emacs))
815 (gdb-set-output-sink 'user)
816 (error "Phase error in gdb-post-prompt (got %s)" sink)))))
818 (defun gud-gdba-marker-filter (string)
819 "A gud marker filter for gdb. Handle a burst of output from GDB."
820 (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
821 ;; Recall the left over gud-marker-acc from last time
822 (setq gud-marker-acc (concat gud-marker-acc string))
823 ;; Start accumulating output for the GUD buffer
826 ;; Process all the complete markers in this chunk.
827 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
828 (let ((annotation (match-string 1 gud-marker-acc)))
830 ;; Stuff prior to the match is just ordinary output.
831 ;; It is either concatenated to OUTPUT or directed
836 (substring gud-marker-acc 0 (match-beginning 0))))
838 ;; Take that stuff off the gud-marker-acc.
839 (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
841 ;; Parse the tag from the annotation, and maybe its arguments.
842 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
843 (let* ((annotation-type (match-string 1 annotation))
844 (annotation-arguments (match-string 2 annotation))
845 (annotation-rule (assoc annotation-type
846 gdb-annotation-rules)))
847 ;; Call the handler for this annotation.
849 (funcall (car (cdr annotation-rule))
850 annotation-arguments)
851 ;; Else the annotation is not recognized. Ignore it silently,
852 ;; so that GDB can add new annotations without causing
856 ;; Does the remaining text end in a partial line?
857 ;; If it does, then keep part of the gud-marker-acc until we get more.
858 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
861 ;; Everything before the potential marker start can be output.
863 (gdb-concat-output output
864 (substring gud-marker-acc 0
865 (match-beginning 0))))
867 ;; Everything after, we save, to combine with later input.
868 (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0))))
870 ;; In case we know the gud-marker-acc contains no partial annotations:
872 (setq output (gdb-concat-output output gud-marker-acc))
873 (setq gud-marker-acc "")))
876 (defun gdb-concat-output (so-far new)
877 (let ((sink (gdb-get-output-sink )))
879 ((eq sink 'user) (concat so-far new))
880 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
882 (gdb-append-to-partial-output new)
885 (gdb-append-to-inferior-io new)
887 (t (error "Bogon output sink %S" sink)))))
889 (defun gdb-append-to-partial-output (string)
890 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
891 (goto-char (point-max))
894 (defun gdb-clear-partial-output ()
895 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
898 (defun gdb-append-to-inferior-io (string)
899 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
900 (goto-char (point-max))
901 (insert-before-markers string))
902 (if (not (string-equal string ""))
903 (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io))))
905 (defun gdb-clear-inferior-io ()
906 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
910 ;; One trick is to have a command who's output is always available in a buffer
911 ;; of it's own, and is always up to date. We build several buffers of this
914 ;; There are two aspects to this: gdb has to tell us when the output for that
915 ;; command might have changed, and we have to be able to run the command
916 ;; behind the user's back.
918 ;; The output phasing associated with the variable gdb-output-sink
919 ;; help us to run commands behind the user's back.
921 ;; Below is the code for specificly managing buffers of output from one
925 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
926 ;; It adds an input for the command we are tracking. It should be the
927 ;; annotation rule binding of whatever gdb sends to tell us this command
928 ;; might have changed it's output.
930 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
931 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
932 ;; input in the input queue (see comment about ``gdb communications'' above).
934 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command
936 `(defun ,name (&optional ignored)
937 (if (and (,demand-predicate)
939 (gdb-get-pending-triggers))))
942 (list ,gdb-command ',output-handler))
943 (gdb-set-pending-triggers
945 (gdb-get-pending-triggers)))))))
947 (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
949 (gdb-set-pending-triggers
951 (gdb-get-pending-triggers)))
952 (let ((buf (gdb-get-buffer ',buf-key)))
954 (with-current-buffer buf
956 (buffer-read-only nil))
958 (insert-buffer-substring (gdb-get-create-buffer
959 'gdb-partial-output-buffer))
961 ;; put customisation here
964 (defmacro def-gdb-auto-updated-buffer (buffer-key trigger-name gdb-command
965 output-handler-name custom-defun)
967 (def-gdb-auto-update-trigger ,trigger-name
968 ;; The demand predicate:
969 (lambda () (gdb-get-buffer ',buffer-key))
971 ,output-handler-name)
972 (def-gdb-auto-update-handler ,output-handler-name
973 ,trigger-name ,buffer-key ,custom-defun)))
977 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
979 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
980 'gdb-breakpoints-buffer-name
981 'gdb-breakpoints-mode)
983 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
984 ;; This defines the auto update rule for buffers of type
985 ;; `gdb-breakpoints-buffer'.
987 ;; It defines a function to serve as the annotation handler that
988 ;; handles the `foo-invalidated' message. That function is called:
989 gdb-invalidate-breakpoints
991 ;; To update the buffer, this command is sent to gdb.
992 "server info breakpoints\n"
994 ;; This also defines a function to be the handler for the output
995 ;; from the command above. That function will copy the output into
996 ;; the appropriately typed buffer. That function will be called:
997 gdb-info-breakpoints-handler
998 ;; buffer specific functions
999 gdb-info-breakpoints-custom)
1001 (defvar gdb-cdir nil "Compilation directory.")
1003 (defconst breakpoint-xpm-data "/* XPM */
1004 static char *magick[] = {
1005 /* columns rows colors chars-per-pixel */
1021 "XPM data used for breakpoint icon.")
1023 (defconst breakpoint-enabled-pbm-data
1026 0 0 0 0 1 1 1 1 0 0 0 0
1027 0 0 0 1 1 1 1 1 1 0 0 0
1028 0 0 1 1 1 1 1 1 1 1 0 0
1029 0 1 1 1 1 1 1 1 1 1 1 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 0 1 1 1 1 1 1 1 1 0 0
1034 0 0 0 1 1 1 1 1 1 0 0 0
1035 0 0 0 0 1 1 1 1 0 0 0 0"
1036 "PBM data used for enabled breakpoint icon.")
1038 (defconst breakpoint-disabled-pbm-data
1050 0 0 0 1 0 1 0 1 0 0"
1051 "PBM data used for disabled breakpoint icon.")
1053 (defvar breakpoint-enabled-icon nil
1054 "Icon for enabled breakpoint in display margin")
1056 (defvar breakpoint-disabled-icon nil
1057 "Icon for disabled breakpoint in display margin")
1059 (defvar breakpoint-bitmap nil
1060 "Bitmap for breakpoint in fringe")
1062 (defface breakpoint-enabled-bitmap-face
1066 "Face for enabled breakpoint icon in fringe.")
1068 (defface breakpoint-disabled-bitmap-face
1071 :foreground "grey60"))
1072 "Face for disabled breakpoint icon in fringe.")
1075 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1076 (defun gdb-info-breakpoints-custom ()
1077 (let ((flag)(address))
1079 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1080 (dolist (buffer (buffer-list))
1081 (with-current-buffer buffer
1082 (if (and (eq gud-minor-mode 'gdba)
1083 (not (string-match "^\*" (buffer-name))))
1084 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
1085 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1087 (goto-char (point-min))
1088 (while (< (point) (- (point-max) 1))
1090 (if (looking-at "[^\t].*breakpoint")
1092 (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1093 (setq flag (char-after (match-beginning 1)))
1095 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1097 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1098 (let ((line (match-string 2)) (buffer-read-only nil)
1099 (file (match-string 1)))
1100 (add-text-properties (point-at-bol) (point-at-eol)
1101 '(mouse-face highlight
1102 help-echo "mouse-2, RET: visit breakpoint"))
1103 (with-current-buffer
1105 (if (file-exists-p file) file
1106 (expand-file-name file gdb-cdir)))
1107 (save-current-buffer
1108 (set (make-local-variable 'gud-minor-mode) 'gdba)
1109 (set (make-local-variable 'tool-bar-map)
1111 ;; only want one breakpoint icon at each location
1113 (goto-line (string-to-number line))
1114 (gdb-put-breakpoint-icon (eq flag ?y)))))))))
1117 (defun gdb-mouse-toggle-breakpoint (event)
1118 "Toggle breakpoint with mouse click in left margin."
1120 (mouse-minibuffer-check event)
1121 (let ((posn (event-end event)))
1122 (if (numberp (posn-point posn))
1123 (with-selected-window (posn-window posn)
1125 (goto-char (posn-point posn))
1126 (if (or (posn-object posn)
1127 (and breakpoint-bitmap
1128 (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
1129 breakpoint-bitmap)))
1131 (gud-break nil)))))))
1133 (defun gdb-breakpoints-buffer-name ()
1134 (with-current-buffer gud-comint-buffer
1135 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1137 (defun gdb-display-breakpoints-buffer ()
1140 (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
1142 (defun gdb-frame-breakpoints-buffer ()
1144 (switch-to-buffer-other-frame
1145 (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
1147 (defvar gdb-breakpoints-mode-map
1148 (let ((map (make-sparse-keymap))
1149 (menu (make-sparse-keymap "Breakpoints")))
1150 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
1151 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1152 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1154 (suppress-keymap map)
1155 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1156 (define-key map " " 'gdb-toggle-breakpoint)
1157 (define-key map "d" 'gdb-delete-breakpoint)
1158 (define-key map "\r" 'gdb-goto-breakpoint)
1159 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1162 (defun gdb-breakpoints-mode ()
1163 "Major mode for gdb breakpoints.
1165 \\{gdb-breakpoints-mode-map}"
1166 (setq major-mode 'gdb-breakpoints-mode)
1167 (setq mode-name "Breakpoints")
1168 (use-local-map gdb-breakpoints-mode-map)
1169 (setq buffer-read-only t)
1170 (gdb-invalidate-breakpoints))
1172 (defun gdb-toggle-breakpoint ()
1173 "Enable/disable the breakpoint at current line."
1176 (beginning-of-line 1)
1177 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1178 (error "Not recognized as break/watchpoint line")
1182 (if (eq ?y (char-after (match-beginning 2)))
1185 (match-string 1) "\n")
1188 (defun gdb-delete-breakpoint ()
1189 "Delete the breakpoint at current line."
1191 (beginning-of-line 1)
1192 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1193 (error "Not recognized as break/watchpoint line")
1195 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1197 (defun gdb-goto-breakpoint ()
1198 "Display the file in the source buffer at the breakpoint specified on the
1202 (beginning-of-line 1)
1203 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1204 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1205 (if (match-string 2)
1206 (let ((line (match-string 2))
1207 (file (match-string 1)))
1208 (save-selected-window
1209 (gdb-display-buffer (find-file-noselect
1210 (if (file-exists-p file)
1212 (expand-file-name file gdb-cdir))))
1213 (goto-line (string-to-number line))))))
1215 (defun gdb-mouse-goto-breakpoint (event)
1216 "Display the file in the source buffer at the selected breakpoint."
1218 (mouse-set-point event)
1219 (gdb-goto-breakpoint))
1222 ;; Frames buffer. This displays a perpetually correct bactracktrace
1223 ;; (from the command `where').
1225 ;; Alas, if your stack is deep, it is costly.
1227 (gdb-set-buffer-rules 'gdb-stack-buffer
1228 'gdb-stack-buffer-name
1231 (def-gdb-auto-updated-buffer gdb-stack-buffer
1232 gdb-invalidate-frames
1234 gdb-info-frames-handler
1235 gdb-info-frames-custom)
1237 (defun gdb-info-frames-custom ()
1238 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1240 (let ((buffer-read-only nil))
1241 (goto-char (point-min))
1242 (while (< (point) (point-max))
1243 (add-text-properties (point-at-bol) (point-at-eol)
1244 '(mouse-face highlight
1245 help-echo "mouse-2, RET: Select frame"))
1247 (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
1248 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
1249 (equal (match-string 1) gdb-current-frame))
1250 (put-text-property (point-at-bol) (point-at-eol)
1251 'face '(:inverse-video t)))
1252 (forward-line 1))))))
1254 (defun gdb-stack-buffer-name ()
1255 (with-current-buffer gud-comint-buffer
1256 (concat "*stack frames of " (gdb-get-target-string) "*")))
1258 (defun gdb-display-stack-buffer ()
1261 (gdb-get-create-buffer 'gdb-stack-buffer)))
1263 (defun gdb-frame-stack-buffer ()
1265 (switch-to-buffer-other-frame
1266 (gdb-get-create-buffer 'gdb-stack-buffer)))
1268 (defvar gdb-frames-mode-map
1269 (let ((map (make-sparse-keymap)))
1270 (suppress-keymap map)
1271 (define-key map "\r" 'gdb-frames-select)
1272 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1275 (defun gdb-frames-mode ()
1276 "Major mode for gdb frames.
1278 \\{gdb-frames-mode-map}"
1279 (setq major-mode 'gdb-frames-mode)
1280 (setq mode-name "Frames")
1281 (setq buffer-read-only t)
1282 (use-local-map gdb-frames-mode-map)
1284 (gdb-invalidate-frames))
1286 (defun gdb-get-frame-number ()
1288 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1289 (n (or (and pos (match-string-no-properties 1)) "0")))
1292 (defun gdb-frames-select ()
1293 "Make the frame on the current line become the current frame and display the
1294 source in the source buffer."
1297 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1298 (gud-display-frame))
1300 (defun gdb-frames-mouse-select (event)
1301 "Make the selected frame become the current frame and display the source in
1304 (mouse-set-point event)
1305 (gdb-frames-select))
1308 ;; Threads buffer. This displays a selectable thread list.
1310 (gdb-set-buffer-rules 'gdb-threads-buffer
1311 'gdb-threads-buffer-name
1314 (def-gdb-auto-updated-buffer gdb-threads-buffer
1315 gdb-invalidate-threads
1316 "server info threads\n"
1317 gdb-info-threads-handler
1318 gdb-info-threads-custom)
1320 (defun gdb-info-threads-custom ()
1321 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1322 (let ((buffer-read-only nil))
1323 (goto-char (point-min))
1324 (while (< (point) (point-max))
1325 (add-text-properties (point-at-bol) (point-at-eol)
1326 '(mouse-face highlight
1327 help-echo "mouse-2, RET: select thread"))
1328 (forward-line 1)))))
1330 (defun gdb-threads-buffer-name ()
1331 (with-current-buffer gud-comint-buffer
1332 (concat "*threads of " (gdb-get-target-string) "*")))
1334 (defun gdb-display-threads-buffer ()
1337 (gdb-get-create-buffer 'gdb-threads-buffer)))
1339 (defun gdb-frame-threads-buffer ()
1341 (switch-to-buffer-other-frame
1342 (gdb-get-create-buffer 'gdb-threads-buffer)))
1344 (defvar gdb-threads-mode-map
1345 (let ((map (make-sparse-keymap)))
1346 (suppress-keymap map)
1347 (define-key map "\r" 'gdb-threads-select)
1348 (define-key map [mouse-2] 'gdb-threads-mouse-select)
1351 (defun gdb-threads-mode ()
1352 "Major mode for gdb frames.
1354 \\{gdb-frames-mode-map}"
1355 (setq major-mode 'gdb-threads-mode)
1356 (setq mode-name "Threads")
1357 (setq buffer-read-only t)
1358 (use-local-map gdb-threads-mode-map)
1359 (gdb-invalidate-threads))
1361 (defun gdb-get-thread-number ()
1363 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1364 (match-string-no-properties 1)))
1366 (defun gdb-threads-select ()
1367 "Make the thread on the current line become the current thread and display the
1368 source in the source buffer."
1371 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1372 (gud-display-frame))
1374 (defun gdb-threads-mouse-select (event)
1375 "Make the selected frame become the current frame and display the source in
1378 (mouse-set-point event)
1379 (gdb-threads-select))
1382 ;; Registers buffer.
1384 (gdb-set-buffer-rules 'gdb-registers-buffer
1385 'gdb-registers-buffer-name
1386 'gdb-registers-mode)
1388 (def-gdb-auto-updated-buffer gdb-registers-buffer
1389 gdb-invalidate-registers
1390 "server info registers\n"
1391 gdb-info-registers-handler
1392 gdb-info-registers-custom)
1394 (defun gdb-info-registers-custom ())
1396 (defvar gdb-registers-mode-map
1397 (let ((map (make-sparse-keymap)))
1398 (suppress-keymap map)
1401 (defun gdb-registers-mode ()
1402 "Major mode for gdb registers.
1404 \\{gdb-registers-mode-map}"
1405 (setq major-mode 'gdb-registers-mode)
1406 (setq mode-name "Registers")
1407 (setq buffer-read-only t)
1408 (use-local-map gdb-registers-mode-map)
1409 (gdb-invalidate-registers))
1411 (defun gdb-registers-buffer-name ()
1412 (with-current-buffer gud-comint-buffer
1413 (concat "*registers of " (gdb-get-target-string) "*")))
1415 (defun gdb-display-registers-buffer ()
1418 (gdb-get-create-buffer 'gdb-registers-buffer)))
1420 (defun gdb-frame-registers-buffer ()
1422 (switch-to-buffer-other-frame
1423 (gdb-get-create-buffer 'gdb-registers-buffer)))
1428 (gdb-set-buffer-rules 'gdb-locals-buffer
1429 'gdb-locals-buffer-name
1432 (def-gdb-auto-updated-buffer gdb-locals-buffer
1433 gdb-invalidate-locals
1434 "server info locals\n"
1435 gdb-info-locals-handler
1436 gdb-info-locals-custom)
1438 ;; Abbreviate for arrays and structures.
1439 ;; These can be expanded using gud-display.
1440 (defun gdb-info-locals-handler nil
1441 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1442 (gdb-get-pending-triggers)))
1443 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1444 (with-current-buffer buf
1445 (goto-char (point-min))
1446 (while (re-search-forward "^ .*\n" nil t)
1447 (replace-match "" nil nil))
1448 (goto-char (point-min))
1449 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1450 (replace-match "(array);\n" nil nil))
1451 (goto-char (point-min))
1452 (while (re-search-forward "{.*=.*\n" nil t)
1453 (replace-match "(structure);\n" nil nil))))
1454 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1455 (and buf (with-current-buffer buf
1457 (buffer-read-only nil))
1458 (delete-region (point-min) (point-max))
1459 (insert-buffer-substring (gdb-get-create-buffer
1460 'gdb-partial-output-buffer))
1462 (run-hooks 'gdb-info-locals-hook))
1464 (defun gdb-info-locals-custom ()
1467 (defvar gdb-locals-mode-map
1468 (let ((map (make-sparse-keymap)))
1469 (suppress-keymap map)
1472 (defun gdb-locals-mode ()
1473 "Major mode for gdb locals.
1475 \\{gdb-locals-mode-map}"
1476 (setq major-mode 'gdb-locals-mode)
1477 (setq mode-name "Locals")
1478 (setq buffer-read-only t)
1479 (use-local-map gdb-locals-mode-map)
1480 (gdb-invalidate-locals))
1482 (defun gdb-locals-buffer-name ()
1483 (with-current-buffer gud-comint-buffer
1484 (concat "*locals of " (gdb-get-target-string) "*")))
1486 (defun gdb-display-locals-buffer ()
1489 (gdb-get-create-buffer 'gdb-locals-buffer)))
1491 (defun gdb-frame-locals-buffer ()
1493 (switch-to-buffer-other-frame
1494 (gdb-get-create-buffer 'gdb-locals-buffer)))
1497 ;;;; Window management
1499 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1500 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1501 ;;; get at the use_time field of a window, I'm not sure there exists a
1502 ;;; more elegant solution without writing C code.
1504 (defun gdb-display-buffer (buf &optional size)
1505 (let ((must-split nil)
1511 (if (eq gud-comint-buffer (window-buffer win))
1512 (set-window-dedicated-p win t))))
1513 (setq answer (get-buffer-window buf))
1515 (let ((window (get-lru-window)))
1518 (set-window-buffer window buf)
1519 (setq answer window))
1520 (setq must-split t)))))
1523 (if (eq gud-comint-buffer (window-buffer win))
1524 (set-window-dedicated-p win nil)))))
1526 (let* ((largest (get-largest-window))
1527 (cur-size (window-height largest))
1528 (new-size (and size (< size cur-size) (- cur-size size))))
1529 (setq answer (split-window largest new-size))
1530 (set-window-buffer answer buf)))
1533 (defun gdb-display-source-buffer (buffer)
1534 (if (eq gdb-selected-view 'source)
1536 (gdb-display-buffer buffer)
1537 (get-buffer-window buffer))
1538 (gdb-display-buffer (gdb-get-buffer 'gdb-assembler-buffer))
1542 ;;; Shared keymap initialization:
1544 (let ((menu (make-sparse-keymap "GDB-Frames")))
1545 (define-key gud-menu-map [frames]
1546 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1547 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1548 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1549 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1550 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1551 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1552 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1553 ; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
1556 (let ((menu (make-sparse-keymap "GDB-Windows")))
1557 (define-key gud-menu-map [displays]
1558 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1559 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1560 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1561 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1562 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1563 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1564 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1565 ; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1568 (let ((menu (make-sparse-keymap "View")))
1569 (define-key gud-menu-map [view]
1570 `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba)))
1571 ; (define-key menu [both] '(menu-item "Both" gdb-view-both
1572 ; :help "Display both source and assembler"
1573 ; :button (:radio . (eq gdb-selected-view 'both))))
1574 (define-key menu [assembler] '(menu-item "Machine" gdb-view-assembler
1575 :help "Display assembler only"
1576 :button (:radio . (eq gdb-selected-view 'assembler))))
1577 (define-key menu [source] '(menu-item "Source" gdb-view-source-function
1578 :help "Display source only"
1579 :button (:radio . (eq gdb-selected-view 'source)))))
1581 (let ((menu (make-sparse-keymap "GDB-UI")))
1582 (define-key gud-menu-map [ui]
1583 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
1584 (define-key menu [gdb-restore-windows]
1585 '("Restore window layout" . gdb-restore-windows))
1586 (define-key menu [gdb-many-windows]
1587 (menu-bar-make-toggle gdb-many-windows gdb-many-windows
1588 "Display other windows" "Many Windows %s"
1589 "Display locals, stack and breakpoint information")))
1591 (defun gdb-frame-gdb-buffer ()
1593 (switch-to-buffer-other-frame
1594 (gdb-get-create-buffer 'gdba)))
1596 (defun gdb-display-gdb-buffer ()
1599 (gdb-get-create-buffer 'gdba)))
1601 (defvar gdb-main-file nil "Source file from which program execution begins.")
1603 (defun gdb-view-source-function ()
1607 (if gud-last-last-frame
1608 (gud-find-file (car gud-last-last-frame))
1609 (gud-find-file gdb-main-file))))
1610 (setq gdb-selected-view 'source))
1612 (defun gdb-view-assembler()
1614 (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
1615 (setq gdb-selected-view 'assembler))
1617 ;(defun gdb-view-both()
1619 ;(setq gdb-selected-view 'both))
1621 (defcustom gdb-show-main nil
1622 "Nil means don't display source file containing the main routine."
1626 (defun gdb-setup-windows ()
1627 "Layout the window pattern for gdb-many-windows."
1628 (gdb-display-locals-buffer)
1629 (gdb-display-stack-buffer)
1630 (delete-other-windows)
1631 (gdb-display-breakpoints-buffer)
1632 (delete-other-windows)
1633 (switch-to-buffer gud-comint-buffer)
1634 (split-window nil ( / ( * (window-height) 3) 4))
1635 (split-window nil ( / (window-height) 3))
1636 (split-window-horizontally)
1638 (switch-to-buffer (gdb-locals-buffer-name))
1641 (if (and gdb-view-source
1642 (eq gdb-selected-view 'source))
1643 (if gud-last-last-frame
1644 (gud-find-file (car gud-last-last-frame))
1645 (gud-find-file gdb-main-file))
1646 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1647 (when gdb-use-inferior-io-buffer
1648 (split-window-horizontally)
1650 (switch-to-buffer (gdb-inferior-io-name)))
1652 (switch-to-buffer (gdb-stack-buffer-name))
1653 (split-window-horizontally)
1655 (switch-to-buffer (gdb-breakpoints-buffer-name))
1658 (defcustom gdb-many-windows nil
1659 "Nil (the default value) means just pops up the GUD buffer
1660 unless `gdb-show-main' is t. In this case it starts with two
1661 windows: one displaying the GUD buffer and the other with the
1662 source file with the main routine of the debugee. Non-nil means
1663 display the layout shown for `gdba'."
1667 (defun gdb-many-windows (arg)
1668 "Toggle the number of windows in the basic arrangement."
1670 (setq gdb-many-windows
1672 (not gdb-many-windows)
1673 (> (prefix-numeric-value arg) 0)))
1675 (gdb-restore-windows)
1678 (defun gdb-restore-windows ()
1679 "Restore the basic arrangement of windows used by gdba.
1680 This arrangement depends on the value of `gdb-many-windows'."
1682 (if gdb-many-windows
1684 (switch-to-buffer gud-comint-buffer)
1685 (delete-other-windows)
1686 (gdb-setup-windows))
1687 (switch-to-buffer gud-comint-buffer)
1688 (delete-other-windows)
1692 (if (and gdb-view-source
1693 (eq gdb-selected-view 'source))
1694 (if gud-last-last-frame
1695 (gud-find-file (car gud-last-last-frame))
1696 (gud-find-file gdb-main-file))
1697 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1701 "Exit a debugging session cleanly by killing the gdb buffers and resetting
1702 the source buffers."
1703 (dolist (buffer (buffer-list))
1704 (if (not (eq buffer gud-comint-buffer))
1705 (with-current-buffer buffer
1706 (if (memq gud-minor-mode '(gdba pdb))
1707 (if (string-match "^\*.+*$" (buffer-name))
1709 (gdb-remove-breakpoint-icons (point-min) (point-max) t)
1710 (setq gud-minor-mode nil)
1711 (kill-local-variable 'tool-bar-map)
1712 (setq gud-running nil))))))
1713 (when (markerp gdb-overlay-arrow-position)
1714 (move-marker gdb-overlay-arrow-position nil)
1715 (setq gdb-overlay-arrow-position nil))
1716 (setq overlay-arrow-variable-list
1717 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)))
1719 (defun gdb-source-info ()
1720 "Find the source file where the program starts and displays it with related
1722 (goto-char (point-min))
1723 (if (search-forward "directory is " nil t)
1724 (if (looking-at "\\S-*:\\(\\S-*\\)")
1725 (setq gdb-cdir (match-string 1))
1726 (looking-at "\\S-*")
1727 (setq gdb-cdir (match-string 0))))
1728 (if (search-forward "Located in " nil t)
1729 (if (looking-at "\\S-*")
1730 (setq gdb-main-file (match-string 0)))
1731 (setq gdb-view-source nil))
1732 (if gdb-many-windows
1734 (gdb-get-create-buffer 'gdb-breakpoints-buffer)
1736 (switch-to-buffer gud-comint-buffer)
1737 (delete-other-windows)
1742 (gud-find-file gdb-main-file)
1743 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1747 (defun gdb-put-string (putstring pos &optional dprop)
1748 "Put string PUTSTRING in front of POS in the current buffer.
1749 PUTSTRING is displayed by putting an overlay into the current buffer with a
1750 `before-string' STRING that has a `display' property whose value is
1752 (let ((gdb-string "x")
1753 (buffer (current-buffer)))
1754 (let ((overlay (make-overlay pos pos buffer))
1756 (list (list 'margin 'left-margin) putstring))))
1757 (put-text-property 0 (length gdb-string) 'display prop gdb-string)
1758 (overlay-put overlay 'put-break t)
1759 (overlay-put overlay 'before-string gdb-string))))
1761 ;;from remove-images
1762 (defun gdb-remove-strings (start end &optional buffer)
1763 "Remove strings between START and END in BUFFER.
1764 Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
1765 BUFFER nil or omitted means use the current buffer."
1767 (setq buffer (current-buffer)))
1768 (let ((overlays (overlays-in start end)))
1770 (let ((overlay (car overlays)))
1771 (when (overlay-get overlay 'put-break)
1772 (delete-overlay overlay)))
1773 (setq overlays (cdr overlays)))))
1775 (defun gdb-put-breakpoint-icon (enabled)
1776 (let ((start (progn (beginning-of-line) (- (point) 1)))
1777 (end (progn (end-of-line) (+ (point) 1))))
1778 (gdb-remove-breakpoint-icons start end)
1779 (if (display-images-p)
1780 (if (>= (car (window-fringes)) 8)
1784 ,(or breakpoint-bitmap
1785 (setq breakpoint-bitmap
1786 (define-fringe-bitmap
1787 "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")))
1789 'breakpoint-enabled-bitmap-face
1790 'breakpoint-disabled-bitmap-face)))
1791 (when (< left-margin-width 2)
1792 (save-current-buffer
1793 (setq left-margin-width 2)
1794 (if (get-buffer-window (current-buffer))
1795 (set-window-margins (get-buffer-window
1798 right-margin-width))))
1801 (or breakpoint-enabled-icon
1802 (setq breakpoint-enabled-icon
1803 (find-image `((:type xpm :data
1804 ,breakpoint-xpm-data
1805 :ascent 100 :pointer hand)
1807 ,breakpoint-enabled-pbm-data
1808 :ascent 100 :pointer hand)))))
1809 (or breakpoint-disabled-icon
1810 (setq breakpoint-disabled-icon
1811 (find-image `((:type xpm :data
1812 ,breakpoint-xpm-data
1813 :conversion disabled
1816 ,breakpoint-disabled-pbm-data
1818 (+ start 1) nil 'left-margin))
1819 (when (< left-margin-width 2)
1820 (save-current-buffer
1821 (setq left-margin-width 2)
1822 (if (get-buffer-window (current-buffer))
1823 (set-window-margins (get-buffer-window
1826 right-margin-width))))
1827 (gdb-put-string (if enabled "B" "b") (1+ start)))))
1829 (defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
1830 (gdb-remove-strings start end)
1831 (if (display-images-p)
1832 (remove-images start end))
1834 (setq left-margin-width 0)
1835 (if (get-buffer-window (current-buffer))
1836 (set-window-margins (get-buffer-window
1839 right-margin-width))))
1843 ;; Assembler buffer.
1845 (gdb-set-buffer-rules 'gdb-assembler-buffer
1846 'gdb-assembler-buffer-name
1847 'gdb-assembler-mode)
1849 (def-gdb-auto-updated-buffer gdb-assembler-buffer
1850 gdb-invalidate-assembler
1851 (concat "server disassemble " gdb-current-address "\n")
1852 gdb-assembler-handler
1853 gdb-assembler-custom)
1855 (defun gdb-assembler-custom ()
1856 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
1857 (pos 1) (address) (flag))
1858 (with-current-buffer buffer
1859 (if (not (equal gdb-current-address "main"))
1861 (goto-char (point-min))
1862 (if (re-search-forward gdb-current-address nil t)
1866 (or gdb-overlay-arrow-position
1867 (setq gdb-overlay-arrow-position (make-marker)))
1868 (set-marker gdb-overlay-arrow-position
1869 (point) (current-buffer))))))
1870 ;; remove all breakpoint-icons in assembler buffer before updating.
1871 (gdb-remove-breakpoint-icons (point-min) (point-max)))
1872 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1873 (goto-char (point-min))
1874 (while (< (point) (- (point-max) 1))
1876 (if (looking-at "[^\t].*breakpoint")
1879 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
1880 (setq flag (char-after (match-beginning 1)))
1881 (setq address (match-string 2))
1882 ;; remove leading 0s from output of info break.
1883 (if (string-match "^0+\\(.*\\)" address)
1884 (setq address (match-string 1 address)))
1885 (with-current-buffer buffer
1886 (goto-char (point-min))
1887 (if (re-search-forward address nil t)
1888 (gdb-put-breakpoint-icon (eq flag ?y))))))))
1889 (if (not (equal gdb-current-address "main"))
1890 (set-window-point (get-buffer-window buffer) pos))))
1892 (defvar gdb-assembler-mode-map
1893 (let ((map (make-sparse-keymap)))
1894 (suppress-keymap map)
1897 (defun gdb-assembler-mode ()
1898 "Major mode for viewing code assembler.
1900 \\{gdb-assembler-mode-map}"
1901 (setq major-mode 'gdb-assembler-mode)
1902 (setq mode-name "Machine")
1903 (setq gdb-overlay-arrow-position nil)
1904 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
1905 (put 'gdb-overlay-arrow-position 'overlay-arrow-string "=>")
1906 (setq fringes-outside-margins t)
1907 (setq buffer-read-only t)
1908 (use-local-map gdb-assembler-mode-map)
1909 (gdb-invalidate-assembler))
1911 (defun gdb-assembler-buffer-name ()
1912 (with-current-buffer gud-comint-buffer
1913 (concat "*Machine Code " (gdb-get-target-string) "*")))
1915 (defun gdb-display-assembler-buffer ()
1918 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1920 (defun gdb-frame-assembler-buffer ()
1922 (switch-to-buffer-other-frame
1923 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1925 ;; modified because if gdb-current-address has changed value a new command
1926 ;; must be enqueued to update the buffer with the new output
1927 (defun gdb-invalidate-assembler (&optional ignored)
1928 (if (gdb-get-buffer 'gdb-assembler-buffer)
1930 (unless (string-equal gdb-current-frame gdb-previous-frame)
1931 (if (or (not (member 'gdb-invalidate-assembler
1932 (gdb-get-pending-triggers)))
1933 (not (string-equal gdb-current-address
1934 gdb-previous-address)))
1936 ;; take previous disassemble command off the queue
1937 (with-current-buffer gud-comint-buffer
1938 (let ((queue (gdb-get-input-queue)) (item))
1939 (dolist (item queue)
1940 (if (equal (cdr item) '(gdb-assembler-handler))
1941 (gdb-set-input-queue
1942 (delete item (gdb-get-input-queue)))))))
1944 (list (concat "server disassemble " gdb-current-address "\n")
1945 'gdb-assembler-handler))
1946 (gdb-set-pending-triggers
1947 (cons 'gdb-invalidate-assembler
1948 (gdb-get-pending-triggers)))
1949 (setq gdb-previous-address gdb-current-address)
1950 (setq gdb-previous-frame gdb-current-frame)))))))
1952 (defun gdb-get-current-frame ()
1953 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
1956 (list (concat "server info frame\n") 'gdb-frame-handler))
1957 (gdb-set-pending-triggers
1958 (cons 'gdb-get-current-frame
1959 (gdb-get-pending-triggers))))))
1961 (defun gdb-frame-handler ()
1962 (gdb-set-pending-triggers
1963 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
1964 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1965 (goto-char (point-min))
1967 (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*\\)")
1969 (setq gdb-current-frame (match-string 2))
1970 (let ((address (match-string 1)))
1971 ;; remove leading 0s from output of info frame command.
1972 (if (string-match "^0+\\(.*\\)" address)
1973 (setq gdb-current-address
1974 (concat "0x" (match-string 1 address)))
1975 (setq gdb-current-address (concat "0x" address))))
1976 (if (or (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t))
1977 (progn (setq gdb-view-source nil) t))
1978 (eq gdb-selected-view 'assembler))
1981 (gdb-get-create-buffer 'gdb-assembler-buffer))
1982 ;;update with new frame for machine code if necessary
1983 (gdb-invalidate-assembler))))))
1984 (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
1985 (setq gdb-current-language (match-string 1))))
1989 ;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
1990 ;;; gdb-ui.el ends here