1 ;;; gdb-ui.el --- User Interface for running GDB
3 ;; Author: Nick Roberts <nick@nick.uklinux.net>
5 ;; Keywords: unix, tools
7 ;; Copyright (C) 2002 Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; This mode acts as a graphical user interface to GDB. You can interact with
29 ;; GDB through the GUD buffer in the usual way, but there are also further
30 ;; buffers which control the execution and describe the state of your program.
31 ;; It separates the input/output of your program from that of GDB and displays
32 ;; expressions and their current values in their own buffers. It also uses
33 ;; features of Emacs 21 such as the display margin for breakpoints, and the
34 ;; toolbar (see the GDB Graphical Interface section in the Emacs info manual).
36 ;; Start the debugger with M-x gdba.
38 ;; This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim
39 ;; Kingdon and uses GDB's annotation interface. You don't need to know about
40 ;; annotations to use this mode as a debugger, but if you are interested
41 ;; developing the mode itself, then see the Annotations section in the GDB
45 ;; Does not auto-display arrays of structures or structures containing arrays.
46 ;; On MS Windows, Gdb 5.1.1 from MinGW 2.0 does not flush the output from the
53 (defcustom gdb-window-height
20
54 "Number of lines in a frame for a displayed expression in GDB-UI."
58 (defcustom gdb-window-width
30
59 "Width of a frame for a displayed expression in GDB-UI."
63 (defvar gdb-current-address
"main" "Initialisation for Assembler buffer.")
64 (defvar gdb-previous-address nil
)
65 (defvar gdb-previous-frame nil
)
66 (defvar gdb-current-frame
"main")
67 (defvar gdb-display-in-progress nil
)
69 (defvar gdb-view-source t
"Non-nil means that source code can be viewed")
70 (defvar gdb-selected-view
'source
"Code type that user wishes to view")
71 (defvar gdb-buffer-type nil
)
72 (defvar gdb-variables
'()
73 "A list of variables that are local to the GUD buffer.")
77 (defun gdba (command-line)
78 "Run gdb on program FILE in buffer *gud-FILE*.
79 The directory containing FILE becomes the initial working directory
80 and source-file directory for your debugger.
82 If `gdb-many-windows' is nil (the default value) then gdb starts with
83 just two windows : the GUD and the source buffer. If it is t the
84 following layout will appear (keybindings given in relevant buffer) :
86 ---------------------------------------------------------------------
88 ---------------------------------------------------------------------
89 GUD buffer (I/O of GDB) | Locals buffer
93 ---------------------------------------------------------------------
94 Source buffer | Input/Output (of debuggee) buffer
102 ---------------------------------------------------------------------
103 Stack buffer | Breakpoints buffer
104 RET gdb-frames-select | SPC gdb-toggle-breakpoint
105 | RET gdb-goto-breakpoint
106 | d gdb-delete-breakpoint
107 ---------------------------------------------------------------------
109 All the buffers share the toolbar and source should always display in the same
110 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
111 icons are displayed both by setting a break with gud-break and by typing break
114 This works best (depending on the size of your monitor) using most of the
117 Displayed expressions appear in separate frames. Arrays may be displayed
118 as slices and visualised using the graph program from plotutils if installed.
119 Pointers in structures may be followed in a tree-like fashion.
121 The following interactive lisp functions help control operation :
123 `gdb-many-windows' - Toggle the number of windows gdb uses.
124 `gdb-restore-windows' - To restore the window layout.
125 `gdb-quit' - To delete (most) of the buffers used by GDB-UI and
128 (interactive (list (gud-query-cmdline 'gdba
)))
130 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
133 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
134 (set (make-local-variable 'gud-marker-filter
) 'gud-gdba-marker-filter
)
136 (gud-def gud-break
(if (not (string-equal mode-name
"Assembler"))
137 (gud-call "break %f:%l" arg
)
141 (gud-call "break *%a" arg
)))
142 "\C-b" "Set breakpoint at current line or address.")
144 (gud-def gud-remove
(if (not (string-equal mode-name
"Assembler"))
145 (gud-call "clear %f:%l" arg
)
149 (gud-call "clear *%a" arg
)))
150 "\C-d" "Remove breakpoint at current line or address.")
152 (gud-def gud-until
(if (not (string-equal mode-name
"Assembler"))
153 (gud-call "until %f:%l" arg
)
157 (gud-call "until *%a" arg
)))
158 "\C-u" "Continue to current line or address.")
160 (setq comint-input-sender
'gdb-send
)
163 (setq gdb-current-address
"main")
164 (setq gdb-previous-address nil
)
165 (setq gdb-previous-frame nil
)
166 (setq gdb-current-frame
"main")
167 (setq gdb-display-in-progress nil
)
169 (setq gdb-view-source t
)
170 (setq gdb-selected-view
'source
)
172 (mapc 'make-local-variable gdb-variables
)
173 (setq gdb-buffer-type
'gdba
)
175 (gdb-clear-inferior-io)
177 (if (eq window-system
'w32
)
178 (gdb-enqueue-input (list "set new-console off\n" 'ignore
)))
179 (gdb-enqueue-input (list "set height 0\n" 'ignore
))
180 ;; find source file and compilation directory here
181 (gdb-enqueue-input (list "server list main\n" 'ignore
)) ; C program
182 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore
)) ; Fortran program
183 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info
))
185 (run-hooks 'gdba-mode-hook
))
187 (defun gud-display ()
188 "Auto-display (possibly dereferenced) C expression at point."
191 (let ((expr (gud-find-c-expr)))
193 (list (concat "server ptype " expr
"\n")
194 `(lambda () (gud-display1 ,expr
)))))))
196 (defun gud-display1 (expr)
197 (goto-char (point-min))
198 (if (looking-at "No symbol")
200 (gdb-set-output-sink 'user
)
201 (gud-call (concat "server ptype " expr
)))
202 (goto-char (- (point-max) 1))
203 (if (equal (char-before) (string-to-char "\*"))
205 (list (concat "display* " expr
"\n") 'ignore
))
207 (list (concat "display " expr
"\n") 'ignore
)))))
209 ; this would messy because these bindings don't work with M-x gdb
210 ; (define-key global-map "\C-x\C-a\C-a" 'gud-display)
211 ; (define-key gud-minor-mode-map "\C-c\C-a" 'gud-display)
215 ;; ======================================================================
217 ;; In this world, there are gdb variables (of unspecified
218 ;; representation) and buffers associated with those objects.
219 ;; The list of variables is built up by the expansions of
222 (defmacro def-gdb-var
(root-symbol &optional default doc
)
223 (let* ((root (symbol-name root-symbol
))
224 (accessor (intern (concat "gdb-get-" root
)))
225 (setter (intern (concat "gdb-set-" root
)))
226 (name (intern (concat "gdb-" root
))))
228 (defvar ,name
,default
,doc
)
229 (if (not (memq ',name gdb-variables
))
230 (push ',name gdb-variables
))
232 (buffer-local-value ',name gud-comint-buffer
))
234 (with-current-buffer gud-comint-buffer
235 (setq ,name val
))))))
237 (def-gdb-var buffer-type nil
238 "One of the symbols bound in gdb-buffer-rules")
240 (def-gdb-var burst
""
241 "A string of characters from gdb that have not yet been processed.")
243 (def-gdb-var input-queue
()
244 "A list of high priority gdb command objects.")
246 (def-gdb-var idle-input-queue
()
247 "A list of low priority gdb command objects.")
249 (def-gdb-var prompting nil
250 "True when gdb is idle with no pending input.")
252 (def-gdb-var output-sink
'user
253 "The disposition of the output of the current gdb command.
254 Possible values are these symbols:
256 user -- gdb output should be copied to the GUD buffer
259 inferior -- gdb output should be copied to the inferior-io buffer
261 pre-emacs -- output should be ignored util the post-prompt
262 annotation is received. Then the output-sink
264 emacs -- output should be collected in the partial-output-buffer
265 for subsequent processing by a command. This is the
266 disposition of output generated by commands that
267 gdb mode sends to gdb on its own behalf.
268 post-emacs -- ignore input until the prompt annotation is
269 received, then go to USER disposition.
272 (def-gdb-var current-item nil
273 "The most recent command item sent to gdb.")
275 (def-gdb-var pending-triggers
'()
276 "A list of trigger functions that have run later than their output
279 ;; end of gdb variables
281 (defun gdb-get-target-string ()
282 (with-current-buffer gud-comint-buffer
289 ;; Each buffer has a TYPE -- a symbol that identifies the function
290 ;; of that particular buffer.
292 ;; The usual gdb interaction buffer is given the type `gdba' and
293 ;; is constructed specially.
295 ;; Others are constructed by gdb-get-create-buffer and
296 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
298 (defvar gdb-buffer-rules-assoc
'())
300 (defun gdb-get-buffer (key)
301 "Return the gdb buffer tagged with type KEY.
302 The key should be one of the cars in `gdb-buffer-rules-assoc'."
304 (gdb-look-for-tagged-buffer key
(buffer-list))))
306 (defun gdb-get-create-buffer (key)
307 "Create a new gdb buffer of the type specified by KEY.
308 The key should be one of the cars in `gdb-buffer-rules-assoc'."
309 (or (gdb-get-buffer key
)
310 (let* ((rules (assoc key gdb-buffer-rules-assoc
))
311 (name (funcall (gdb-rules-name-maker rules
)))
312 (new (get-buffer-create name
)))
313 (with-current-buffer new
314 ;; FIXME: This should be set after calling the function, since the
315 ;; function should run kill-all-local-variables.
316 (set (make-local-variable 'gdb-buffer-type
) key
)
317 (if (cdr (cdr rules
))
318 (funcall (car (cdr (cdr rules
)))))
319 (set (make-local-variable 'gud-comint-buffer
) gud-comint-buffer
)
320 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
321 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
324 (defun gdb-rules-name-maker (rules) (car (cdr rules
)))
326 (defun gdb-look-for-tagged-buffer (key bufs
)
328 (while (and (not retval
) bufs
)
329 (set-buffer (car bufs
))
330 (if (eq gdb-buffer-type key
)
331 (setq retval
(car bufs
)))
332 (setq bufs
(cdr bufs
)))
336 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
337 ;; at least one and possible more functions. The functions have these
338 ;; roles in defining a buffer type:
340 ;; NAME - Return a name for this buffer type.
342 ;; The remaining function(s) are optional:
344 ;; MODE - called in a new buffer with no arguments, should establish
345 ;; the proper mode for the buffer.
348 (defun gdb-set-buffer-rules (buffer-type &rest rules
)
349 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc
)))
351 (setcdr binding rules
)
352 (push (cons buffer-type rules
)
353 gdb-buffer-rules-assoc
))))
355 ;; GUD buffers are an exception to the rules
356 (gdb-set-buffer-rules 'gdba
'error
)
359 ;; Partial-output buffer : This accumulates output from a command executed on
360 ;; behalf of emacs (rather than the user).
362 (gdb-set-buffer-rules 'gdb-partial-output-buffer
363 'gdb-partial-output-name
)
365 (defun gdb-partial-output-name ()
366 (concat "*partial-output-"
367 (gdb-get-target-string)
371 (gdb-set-buffer-rules 'gdb-inferior-io
372 'gdb-inferior-io-name
373 'gdb-inferior-io-mode
)
375 (defun gdb-inferior-io-name ()
376 (concat "*input/output of "
377 (gdb-get-target-string)
380 (defvar gdb-inferior-io-mode-map
381 (let ((map (make-sparse-keymap)))
382 (define-key map
"\C-c\C-c" 'gdb-inferior-io-interrupt
)
383 (define-key map
"\C-c\C-z" 'gdb-inferior-io-stop
)
384 (define-key map
"\C-c\C-\\" 'gdb-inferior-io-quit
)
385 (define-key map
"\C-c\C-d" 'gdb-inferior-io-eof
)
388 (define-derived-mode gdb-inferior-io-mode comint-mode
"Debuggee I/O"
389 "Major mode for gdb inferior-io."
390 :syntax-table nil
:abbrev-table nil
391 ;; We want to use comint because it has various nifty and familiar
392 ;; features. We don't need a process, but comint wants one, so create
394 (make-comint-in-buffer
395 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
396 (current-buffer) "hexl")
397 (setq comint-input-sender
'gdb-inferior-io-sender
))
399 (defun gdb-inferior-io-sender (proc string
)
400 ;; PROC is the pseudo-process created to satisfy comint.
401 (with-current-buffer (process-buffer proc
)
402 (setq proc
(get-buffer-process gud-comint-buffer
))
403 (process-send-string proc string
)
404 (process-send-string proc
"\n")))
406 (defun gdb-inferior-io-interrupt ()
407 "Interrupt the program being debugged."
410 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
412 (defun gdb-inferior-io-quit ()
413 "Send quit signal to the program being debugged."
416 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
418 (defun gdb-inferior-io-stop ()
419 "Stop the program being debugged."
422 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
424 (defun gdb-inferior-io-eof ()
425 "Send end-of-file to the program being debugged."
428 (get-buffer-process gud-comint-buffer
)))
432 ;; gdb communications
435 ;; INPUT: things sent to gdb
437 ;; There is a high and low priority input queue. Low priority input is sent
438 ;; only when the high priority queue is idle.
440 ;; The queues are lists. Each element is either a string (indicating user or
441 ;; user-like input) or a list of the form:
443 ;; (INPUT-STRING HANDLER-FN)
445 ;; The handler function will be called from the partial-output buffer when the
446 ;; command completes. This is the way to write commands which invoke gdb
447 ;; commands autonomously.
449 ;; These lists are consumed tail first.
452 (defun gdb-send (proc string
)
453 "A comint send filter for gdb.
454 This filter may simply queue output for a later time."
455 (gdb-enqueue-input (concat string
"\n")))
457 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
458 ;; is a query, or other non-top-level prompt. To guarantee stuff will get
459 ;; sent to the top-level prompt, currently it must be put in the idle queue.
461 ;; [This should encourage gdb extensions that invoke gdb commands to let
462 ;; the user go first; it is not a bug. -t]
465 (defun gdb-enqueue-input (item)
466 (if (gdb-get-prompting)
469 (gdb-set-prompting nil
))
471 (cons item
(gdb-get-input-queue)))))
473 (defun gdb-dequeue-input ()
474 (let ((queue (gdb-get-input-queue)))
476 (if (not (cdr queue
))
477 (let ((answer (car queue
)))
478 (gdb-set-input-queue '())
480 (gdb-take-last-elt queue
)))))
482 (defun gdb-enqueue-idle-input (item)
483 (if (and (gdb-get-prompting)
484 (not (gdb-get-input-queue)))
487 (gdb-set-prompting nil
))
488 (gdb-set-idle-input-queue
489 (cons item
(gdb-get-idle-input-queue)))))
491 (defun gdb-dequeue-idle-input ()
492 (let ((queue (gdb-get-idle-input-queue)))
494 (if (not (cdr queue
))
495 (let ((answer (car queue
)))
496 (gdb-set-idle-input-queue '())
498 (gdb-take-last-elt queue
)))))
500 ;; Don't use this in general.
501 (defun gdb-take-last-elt (l)
503 (gdb-take-last-elt (cdr l
))
504 (let ((answer (car (cdr l
))))
510 ;; output -- things gdb prints to emacs
512 ;; GDB output is a stream interrupted by annotations.
513 ;; Annotations can be recognized by their beginning
514 ;; with \C-j\C-z\C-z<tag><opt>\C-j
516 ;; The tag is a string obeying symbol syntax.
518 ;; The optional part `<opt>' can be either the empty string
519 ;; or a space followed by more data relating to the annotation.
520 ;; For example, the SOURCE annotation is followed by a filename,
521 ;; line number and various useless goo. This data must not include
525 (defcustom gud-gdba-command-name
"gdb -annotate=2 -noasync"
526 "Default command to execute an executable under the GDB-UI debugger."
530 (defvar gdb-annotation-rules
531 '(("pre-prompt" gdb-pre-prompt
)
532 ("prompt" gdb-prompt
)
533 ("commands" gdb-subprompt
)
534 ("overload-choice" gdb-subprompt
)
535 ("query" gdb-subprompt
)
536 ("prompt-for-continue" gdb-subprompt
)
537 ("post-prompt" gdb-post-prompt
)
538 ("source" gdb-source
)
539 ("starting" gdb-starting
)
540 ("exited" gdb-stopping
)
541 ("signalled" gdb-stopping
)
542 ("signal" gdb-stopping
)
543 ("breakpoint" gdb-stopping
)
544 ("watchpoint" gdb-stopping
)
545 ("frame-begin" gdb-frame-begin
)
546 ("stopped" gdb-stopped
)
547 ("display-begin" gdb-display-begin
)
548 ("display-end" gdb-display-end
)
549 ; GDB commands info stack, info locals and frame generate an error-begin
550 ; annotation at start when there is no stack but this is a quirk/bug in
552 ; ("error-begin" gdb-error-begin)
553 ("display-number-end" gdb-display-number-end
)
554 ("array-section-begin" gdb-array-section-begin
)
555 ("array-section-end" gdb-array-section-end
)
557 ("field-begin" gdb-field-begin
)
558 ("field-end" gdb-field-end
)
559 ) "An assoc mapping annotation tags to functions which process them.")
561 (defun gdb-ignore-annotation (args)
564 (defconst gdb-source-spec-regexp
565 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
567 ;; Do not use this except as an annotation handler.
568 (defun gdb-source (args)
569 (string-match gdb-source-spec-regexp args
)
570 ;; Extract the frame position from the marker.
573 (match-string 1 args
)
574 (string-to-int (match-string 2 args
))))
575 (setq gdb-current-address
(match-string 3 args
))
576 (setq gdb-view-source t
)
577 ;;update with new frame for machine code if necessary
578 (gdb-invalidate-assembler))
580 (defun gdb-send-item (item)
581 (gdb-set-current-item item
)
584 (gdb-set-output-sink 'user
)
585 (process-send-string (get-buffer-process gud-comint-buffer
) item
))
587 (gdb-clear-partial-output)
588 (gdb-set-output-sink 'pre-emacs
)
589 (process-send-string (get-buffer-process gud-comint-buffer
)
592 (defun gdb-pre-prompt (ignored)
593 "An annotation handler for `pre-prompt'. This terminates the collection of
594 output from a previous command if that happens to be in effect."
595 (let ((sink (gdb-get-output-sink)))
599 (gdb-set-output-sink 'post-emacs
)
601 (car (cdr (gdb-get-current-item)))))
603 (set-buffer (gdb-get-create-buffer
604 'gdb-partial-output-buffer
))
607 (gdb-set-output-sink 'user
)
608 (error "Phase error in gdb-pre-prompt (got %s)" sink
)))))
610 (defun gdb-prompt (ignored)
611 "An annotation handler for `prompt'.
612 This sends the next command (if any) to gdb."
613 (let ((sink (gdb-get-output-sink)))
616 ((eq sink
'post-emacs
)
617 (gdb-set-output-sink 'user
))
619 (gdb-set-output-sink 'user
)
620 (error "Phase error in gdb-prompt (got %s)" sink
))))
621 (let ((highest (gdb-dequeue-input)))
623 (gdb-send-item highest
)
624 (let ((lowest (gdb-dequeue-idle-input)))
626 (gdb-send-item lowest
)
628 (gdb-set-prompting t
)
629 (gud-display-frame)))))))
631 (defun gdb-subprompt (ignored)
632 "An annotation handler for non-top-level prompts."
633 (let ((highest (gdb-dequeue-input)))
635 (gdb-send-item highest
)
636 (gdb-set-prompting t
))))
638 (defun gdb-starting (ignored)
639 "An annotation handler for `starting'. This says that I/O for the
640 subprocess is now the program being debugged, not GDB."
641 (let ((sink (gdb-get-output-sink)))
646 (gdb-set-output-sink 'inferior
)))
647 (t (error "Unexpected `starting' annotation")))))
649 (defun gdb-stopping (ignored)
650 "An annotation handler for `exited' and other annotations which say that I/O
651 for the subprocess is now GDB, not the program being debugged."
652 (let ((sink (gdb-get-output-sink)))
655 (gdb-set-output-sink 'user
))
656 (t (error "Unexpected stopping annotation")))))
658 (defun gdb-frame-begin (ignored)
659 (let ((sink (gdb-get-output-sink)))
662 (gdb-set-output-sink 'user
))
665 (t (error "Unexpected frame-begin annotation (%S)" sink
)))))
667 (defun gdb-stopped (ignored)
668 "An annotation handler for `stopped'. It is just like gdb-stopping, except
669 that if we already set the output sink to 'user in gdb-stopping, that is fine."
670 (setq gud-running nil
)
671 (let ((sink (gdb-get-output-sink)))
674 (gdb-set-output-sink 'user
))
676 (t (error "Unexpected stopped annotation")))))
678 (defun gdb-post-prompt (ignored)
679 "An annotation handler for `post-prompt'. This begins the collection of
680 output from the current command if that happens to be appropriate."
681 (if (not (gdb-get-pending-triggers))
683 (gdb-get-current-frame)
684 (gdb-invalidate-frames)
685 (gdb-invalidate-breakpoints)
686 (gdb-invalidate-assembler)
687 (gdb-invalidate-registers)
688 (gdb-invalidate-locals)
689 (gdb-invalidate-display)
690 (gdb-invalidate-threads)))
691 (let ((sink (gdb-get-output-sink)))
694 ((eq sink
'pre-emacs
)
695 (gdb-set-output-sink 'emacs
))
697 (gdb-set-output-sink 'user
)
698 (error "Phase error in gdb-post-prompt (got %s)" sink
)))))
700 ;; If we get an error whilst evaluating one of the expressions
701 ;; we won't get the display-end annotation. Set the sink back to
702 ;; user to make sure that the error message is seen.
703 ;; NOT USED: see annotation-rules for reason.
704 ;(defun gdb-error-begin (ignored)
705 ; (gdb-set-output-sink 'user))
707 (defun gdb-display-begin (ignored)
708 (gdb-set-output-sink 'emacs
)
709 (gdb-clear-partial-output)
710 (setq gdb-display-in-progress t
))
712 (defvar gdb-expression-buffer-name nil
)
713 (defvar gdb-display-number nil
)
714 (defvar gdb-dive-display-number nil
)
716 (defun gdb-display-number-end (ignored)
717 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer
))
718 (setq gdb-display-number
(buffer-string))
719 (setq gdb-expression-buffer-name
720 (concat "*display " gdb-display-number
"*"))
723 (set-buffer (window-buffer))
726 (let ((number gdb-display-number
))
728 (set-buffer (get-buffer-create gdb-expression-buffer-name
)))
729 (gdb-expressions-mode)
730 (setq gdb-dive-display-number number
)))
731 (set-buffer (get-buffer-create gdb-expression-buffer-name
))
732 (if (display-graphic-p)
734 (dolist (frame (frame-list))
735 (if (string-equal (frame-parameter frame
'name
)
736 gdb-expression-buffer-name
)
737 (throw 'frame-exists nil
)))
738 (gdb-expressions-mode)
739 (make-frame `((height .
,gdb-window-height
)
740 (width .
,gdb-window-width
)
741 (tool-bar-lines . nil
)
742 (menu-bar-lines . nil
)
743 (minibuffer . nil
))))
744 (gdb-expressions-mode)
745 (gdb-display-buffer (get-buffer gdb-expression-buffer-name
)))))
746 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer
))
749 (defvar gdb-nesting-level nil
)
750 (defvar gdb-expression nil
)
751 (defvar gdb-point nil
)
752 (defvar gdb-annotation-arg nil
)
754 (defun gdb-delete-line ()
755 "Delete the current line."
756 (delete-region (line-beginning-position) (line-beginning-position 2)))
758 (defun gdb-display-end (ignored)
759 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer
))
760 (goto-char (point-min))
761 (search-forward ": ")
762 (looking-at "\\(.*?\\) =")
764 (gdb-temp-value (match-string 1)))
765 ;;move * to front of expression if necessary
766 (if (looking-at ".*\\*")
769 (setq gdb-temp-value
(substring gdb-temp-value
1 nil
))))
770 (with-current-buffer gdb-expression-buffer-name
771 (setq gdb-expression gdb-temp-value
)
772 (if (not (string-match "::" gdb-expression
))
773 (setq gdb-expression
(concat char gdb-current-frame
774 "::" gdb-expression
))
775 ;;else put * back on if necessary
776 (setq gdb-expression
(concat char gdb-expression
)))
777 (if (not header-line-format
)
778 (setq header-line-format
(concat "-- " gdb-expression
" %-")))))
781 (if (not (re-search-forward "##" nil t
))
783 (with-current-buffer gdb-expression-buffer-name
784 (let ((buffer-read-only nil
))
785 (delete-region (point-min) (point-max))
786 (insert-buffer-substring
787 (gdb-get-buffer 'gdb-partial-output-buffer
)))))
788 ;; display expression name...
789 (goto-char (point-min))
790 (let ((start (progn (point)))
791 (end (progn (end-of-line) (point))))
792 (with-current-buffer gdb-expression-buffer-name
793 (let ((buffer-read-only nil
))
794 (delete-region (point-min) (point-max))
795 (insert-buffer-substring (gdb-get-buffer
796 'gdb-partial-output-buffer
)
799 (goto-char (point-min))
800 (re-search-forward "##" nil t
)
801 (setq gdb-nesting-level
0)
802 (if (looking-at "array-section-begin")
805 (setq gdb-point
(point))
807 (if (looking-at "field-begin \\(.\\)")
809 (setq gdb-annotation-arg
(match-string 1))
810 (gdb-field-format-begin))))
811 (with-current-buffer gdb-expression-buffer-name
812 (if gdb-dive-display-number
814 (let ((buffer-read-only nil
))
815 (goto-char (point-max))
817 (insert-text-button "[back]" 'type
'gdb-display-back
)))))
818 (gdb-clear-partial-output)
819 (gdb-set-output-sink 'user
)
820 (setq gdb-display-in-progress nil
))
822 (define-button-type 'gdb-display-back
823 'help-echo
(purecopy "mouse-2, RET: go back to previous display buffer")
824 'action
(lambda (button) (gdb-display-go-back)))
826 (defun gdb-display-go-back ()
827 ;; delete display so they don't accumulate and delete buffer
828 (let ((number gdb-display-number
))
830 (list (concat "server delete display " number
"\n") 'ignore
))
831 (switch-to-buffer (concat "*display " gdb-dive-display-number
"*"))
832 (kill-buffer (get-buffer (concat "*display " number
"*")))))
834 ;; prefix annotations with ## and process whole output in one chunk
835 ;; in gdb-partial-output-buffer (to allow recursion).
837 ;; array-section flags are just removed again but after counting. They
838 ;; might also be useful for arrays of structures and structures with arrays.
839 (defun gdb-array-section-begin (args)
840 (if gdb-display-in-progress
842 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer
)
843 (goto-char (point-max))
844 (insert (concat "\n##array-section-begin " args
"\n"))))))
846 (defun gdb-array-section-end (ignored)
847 (if gdb-display-in-progress
849 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer
)
850 (goto-char (point-max))
851 (insert "\n##array-section-end\n")))))
853 (defun gdb-field-begin (args)
854 (if gdb-display-in-progress
856 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer
)
857 (goto-char (point-max))
858 (insert (concat "\n##field-begin " args
"\n"))))))
860 (defun gdb-field-end (ignored)
861 (if gdb-display-in-progress
863 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer
)
864 (goto-char (point-max))
865 (insert "\n##field-end\n")))))
867 (defun gdb-elt (ignored)
868 (if gdb-display-in-progress
870 (goto-char (point-max))
871 (insert "\n##elt\n"))))
873 (defun gdb-field-format-begin ()
874 ;; get rid of ##field-begin
877 (setq gdb-nesting-level
(+ gdb-nesting-level
1))
878 (while (re-search-forward "##" nil t
)
879 ;; keep making recursive calls...
880 (if (looking-at "field-begin \\(.\\)")
882 (setq gdb-annotation-arg
(match-string 1))
883 (gdb-field-format-begin)))
885 (if (looking-at "field-end") (gdb-field-format-end))))
887 (defun gdb-field-format-end ()
888 ;; get rid of ##field-end and `,' or `}'
891 (setq gdb-nesting-level
(- gdb-nesting-level
1)))
894 (let ((map (make-sparse-keymap)))
895 (define-key map
[mouse-2
] 'gdb-dive
)
896 (define-key map
[S-mouse-2
] 'gdb-dive-new-frame
)
899 (defun gdb-dive (event)
900 "Dive into structure."
903 (gdb-dive-new-frame event
))
905 (defun gdb-dive-new-frame (event)
906 "Dive into structure and display in a new frame."
909 (mouse-set-point event
)
910 (let ((point (point)) (gdb-full-expression gdb-expression
)
911 (end (progn (end-of-line) (point)))
912 (gdb-part-expression "") (gdb-last-field nil
) (gdb-display-char nil
))
914 (if (looking-at "\*") (setq gdb-display-char
"*"))
915 (re-search-forward "\\(\\S-+\\) = " end t
)
916 (setq gdb-last-field
(match-string-no-properties 1))
917 (goto-char (match-beginning 1))
918 (let ((last-column (current-column)))
919 (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t
)
920 (goto-char (match-beginning 1))
921 (if (and (< (current-column) last-column
)
922 (> (count-lines 1 (point)) 1))
924 (setq gdb-part-expression
925 (concat "." (match-string-no-properties 1)
926 gdb-part-expression
))
927 (setq last-column
(current-column))))))
928 ;; * not needed for components of a pointer to a structure in gdb
929 (if (string-equal "*" (substring gdb-full-expression
0 1))
930 (setq gdb-full-expression
(substring gdb-full-expression
1 nil
)))
931 (setq gdb-full-expression
932 (concat gdb-full-expression gdb-part-expression
"." gdb-last-field
))
934 (list (concat "server display" gdb-display-char
935 " " gdb-full-expression
"\n")
938 (defun gdb-insert-field ()
939 (let ((start (progn (point)))
940 (end (progn (next-line) (point)))
942 (with-current-buffer gdb-expression-buffer-name
943 (let ((buffer-read-only nil
))
944 (if (string-equal gdb-annotation-arg
"\*") (insert "\*"))
945 (while (<= num gdb-nesting-level
)
947 (setq num
(+ num
1)))
948 (insert-buffer-substring (gdb-get-buffer
949 'gdb-partial-output-buffer
)
951 (put-text-property (- (point) (- end start
)) (- (point) 1)
952 'mouse-face
'highlight
)
953 (put-text-property (- (point) (- end start
)) (- (point) 1)
954 'local-map gdb-dive-map
)))
955 (delete-region start end
)))
957 (defvar gdb-values nil
)
959 (defun gdb-array-format ()
960 (while (re-search-forward "##" nil t
)
961 ;; keep making recursive calls...
962 (if (looking-at "array-section-begin")
964 ;;get rid of ##array-section-begin
966 (setq gdb-nesting-level
(+ gdb-nesting-level
1))
968 ;;until *matching* array-section-end is found
969 (if (looking-at "array-section-end")
970 (if (eq gdb-nesting-level
0)
972 (let ((values (buffer-substring gdb-point
(- (point) 2))))
973 (with-current-buffer gdb-expression-buffer-name
975 (concat "{" (replace-regexp-in-string "\n" "" values
)
977 (gdb-array-format1))))
978 ;;else get rid of ##array-section-end etc
980 (setq gdb-nesting-level
(- gdb-nesting-level
1))
981 (gdb-array-format)))))
983 (defvar gdb-array-start nil
)
984 (defvar gdb-array-stop nil
)
986 (defvar gdb-array-slice-map
987 (let ((map (make-sparse-keymap)))
988 (define-key map
"\r" 'gdb-array-slice
)
989 (define-key map
[mouse-2
] 'gdb-mouse-array-slice
)
992 (defun gdb-mouse-array-slice (event)
993 "Select an array slice to display."
995 (mouse-set-point event
)
998 (defun gdb-array-slice ()
1001 (let ((n -
1) (stop 0) (start 0) (point (point)))
1003 (while (search-forward "[" point t
)
1005 (setq start
(string-to-int (read-string "Start index: ")))
1006 (aset gdb-array-start n start
)
1007 (setq stop
(string-to-int (read-string "Stop index: ")))
1008 (aset gdb-array-stop n stop
)))
1009 (gdb-array-format1))
1011 (defvar gdb-display-string nil
)
1012 (defvar gdb-array-size nil
)
1014 (defun gdb-array-format1 ()
1015 (setq gdb-display-string
"")
1016 (let ((buffer-read-only nil
))
1017 (delete-region (point-min) (point-max))
1018 (let ((gdb-value-list (split-string gdb-values
", ")))
1019 (string-match "\\({+\\)" (car gdb-value-list
))
1020 (let* ((depth (- (match-end 1) (match-beginning 1)))
1021 (indices (make-vector depth
'0))
1022 (index 0) (num 0) (array-start "")
1023 (array-stop "") (array-slice "") (array-range nil
)
1024 (flag t
) (indices-string ""))
1025 (dolist (gdb-value gdb-value-list
)
1026 (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value
)
1028 (while (< num depth
)
1029 (setq indices-string
1030 (concat indices-string
1031 "[" (int-to-string (aref indices num
)) "]"))
1032 (if (not (= (aref gdb-array-start num
) -
1))
1033 (if (or (< (aref indices num
) (aref gdb-array-start num
))
1034 (> (aref indices num
) (aref gdb-array-stop num
)))
1036 (aset gdb-array-size num
(aref indices num
)))
1037 (setq num
(+ num
1)))
1039 (let ((gdb-display-value (match-string 1 gdb-value
)))
1040 (setq gdb-display-string
(concat gdb-display-string
" "
1043 (concat indices-string
"\t" gdb-display-value
"\n"))))
1044 (setq indices-string
"")
1046 ;; 0<= index < depth, start at right : (- depth 1)
1047 (setq index
(- (- depth
1)
1048 (- (match-end 2) (match-beginning 2))))
1049 ;;don't set for very last brackets
1051 (aset indices index
(+ 1 (aref indices index
)))
1052 (setq num
(+ 1 index
))
1053 (while (< num depth
)
1054 (aset indices num
0)
1055 (setq num
(+ num
1)))))
1057 (while (< num depth
)
1058 (if (= (aref gdb-array-start num
) -
1)
1060 (aset gdb-array-start num
0)
1061 (aset gdb-array-stop num
(aref indices num
))))
1062 (setq array-start
(int-to-string (aref gdb-array-start num
)))
1063 (setq array-stop
(int-to-string (aref gdb-array-stop num
)))
1064 (setq array-range
(concat "[" array-start
1065 ":" array-stop
"]"))
1066 (put-text-property 1 (+ (length array-start
)
1067 (length array-stop
) 2)
1068 'mouse-face
'highlight array-range
)
1069 (put-text-property 1 (+ (length array-start
)
1070 (length array-stop
) 2)
1071 'local-map gdb-array-slice-map array-range
)
1072 (goto-char (point-min))
1073 (setq array-slice
(concat array-slice array-range
))
1074 (setq num
(+ num
1)))
1075 (goto-char (point-min))
1076 (insert "Array Size : ")
1078 (while (< num depth
)
1081 (int-to-string (+ (aref gdb-array-size num
) 1)) "]"))
1082 (setq num
(+ num
1)))
1084 (concat "\n Slice : " array-slice
"\n\nIndex\tValues\n\n"))))))
1086 (defun gud-gdba-marker-filter (string)
1087 "A gud marker filter for gdb. Handle a burst of output from GDB."
1089 ;; Recall the left over burst from last time
1090 (burst (concat (gdb-get-burst) string
))
1091 ;; Start accumulating output for the GUD buffer
1094 ;; Process all the complete markers in this chunk.
1095 (while (string-match "\n\032\032\\(.*\\)\n" burst
)
1096 (let ((annotation (match-string 1 burst
)))
1098 ;; Stuff prior to the match is just ordinary output.
1099 ;; It is either concatenated to OUTPUT or directed
1104 (substring burst
0 (match-beginning 0))))
1106 ;; Take that stuff off the burst.
1107 (setq burst
(substring burst
(match-end 0)))
1109 ;; Parse the tag from the annotation, and maybe its arguments.
1110 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation
)
1111 (let* ((annotation-type (match-string 1 annotation
))
1112 (annotation-arguments (match-string 2 annotation
))
1113 (annotation-rule (assoc annotation-type
1114 gdb-annotation-rules
)))
1115 ;; Call the handler for this annotation.
1117 (funcall (car (cdr annotation-rule
))
1118 annotation-arguments
)
1119 ;; Else the annotation is not recognized. Ignore it silently,
1120 ;; so that GDB can add new annotations without causing
1124 ;; Does the remaining text end in a partial line?
1125 ;; If it does, then keep part of the burst until we get more.
1126 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1129 ;; Everything before the potential marker start can be output.
1131 (gdb-concat-output output
1132 (substring burst
0 (match-beginning 0))))
1134 ;; Everything after, we save, to combine with later input.
1135 (setq burst
(substring burst
(match-beginning 0))))
1137 ;; In case we know the burst contains no partial annotations:
1139 (setq output
(gdb-concat-output output burst
))
1142 ;; Save the remaining burst for the next call to this function.
1143 (gdb-set-burst burst
)
1146 (defun gdb-concat-output (so-far new
)
1147 (let ((sink (gdb-get-output-sink )))
1149 ((eq sink
'user
) (concat so-far new
))
1150 ((or (eq sink
'pre-emacs
) (eq sink
'post-emacs
)) so-far
)
1152 (gdb-append-to-partial-output new
)
1154 ((eq sink
'inferior
)
1155 (gdb-append-to-inferior-io new
)
1157 (t (error "Bogon output sink %S" sink
)))))
1159 (defun gdb-append-to-partial-output (string)
1160 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
1161 (goto-char (point-max))
1164 (defun gdb-clear-partial-output ()
1165 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer
)
1166 (delete-region (point-min) (point-max))))
1168 (defun gdb-append-to-inferior-io (string)
1169 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
1170 (goto-char (point-max))
1171 (insert-before-markers string
))
1172 (if (not (string-equal string
""))
1173 (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io
))))
1175 (defun gdb-clear-inferior-io ()
1176 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io
)
1177 (delete-region (point-min) (point-max))))
1180 ;; One trick is to have a command who's output is always available in a buffer
1181 ;; of it's own, and is always up to date. We build several buffers of this
1184 ;; There are two aspects to this: gdb has to tell us when the output for that
1185 ;; command might have changed, and we have to be able to run the command
1186 ;; behind the user's back.
1188 ;; The idle input queue and the output phasing associated with the variable
1189 ;; gdb-output-sink help us to run commands behind the user's back.
1191 ;; Below is the code for specificly managing buffers of output from one
1195 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1196 ;; It adds an idle input for the command we are tracking. It should be the
1197 ;; annotation rule binding of whatever gdb sends to tell us this command
1198 ;; might have changed it's output.
1200 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1201 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1202 ;; input in the input queue (see comment about ``gdb communications'' above).
1204 (defmacro def-gdb-auto-update-trigger
(name demand-predicate gdb-command
1206 `(defun ,name
(&optional ignored
)
1207 (if (and (,demand-predicate
)
1209 (gdb-get-pending-triggers))))
1211 (gdb-enqueue-idle-input
1212 (list ,gdb-command
',output-handler
))
1213 (gdb-set-pending-triggers
1215 (gdb-get-pending-triggers)))))))
1217 (defmacro def-gdb-auto-update-handler
(name trigger buf-key custom-defun
)
1219 (gdb-set-pending-triggers
1221 (gdb-get-pending-triggers)))
1222 (let ((buf (gdb-get-buffer ',buf-key
)))
1224 (with-current-buffer buf
1226 (buffer-read-only nil
))
1227 (delete-region (point-min) (point-max))
1228 (insert-buffer-substring (gdb-get-create-buffer
1229 'gdb-partial-output-buffer
))
1231 ;; put customisation here
1234 (defmacro def-gdb-auto-updated-buffer
(buffer-key trigger-name gdb-command
1235 output-handler-name custom-defun
)
1237 (def-gdb-auto-update-trigger ,trigger-name
1238 ;; The demand predicate:
1239 (lambda () (gdb-get-buffer ',buffer-key
))
1241 ,output-handler-name
)
1242 (def-gdb-auto-update-handler ,output-handler-name
1243 ,trigger-name
,buffer-key
,custom-defun
)))
1247 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
1249 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
1250 'gdb-breakpoints-buffer-name
1251 'gdb-breakpoints-mode
)
1253 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1254 ;; This defines the auto update rule for buffers of type
1255 ;; `gdb-breakpoints-buffer'.
1257 ;; It defines a function to serve as the annotation handler that
1258 ;; handles the `foo-invalidated' message. That function is called:
1259 gdb-invalidate-breakpoints
1261 ;; To update the buffer, this command is sent to gdb.
1262 "server info breakpoints\n"
1264 ;; This also defines a function to be the handler for the output
1265 ;; from the command above. That function will copy the output into
1266 ;; the appropriately typed buffer. That function will be called:
1267 gdb-info-breakpoints-handler
1268 ;; buffer specific functions
1269 gdb-info-breakpoints-custom
)
1271 (defvar gdb-cdir nil
"Compilation directory.")
1273 (defconst breakpoint-xpm-data
"/* XPM */
1274 static char *magick[] = {
1275 /* columns rows colors chars-per-pixel */
1293 "XPM data used for breakpoint icon.")
1295 (defconst breakpoint-enabled-pbm-data
1298 0 0 0 0 0 0 0 0 0 0 0 0
1299 0 0 0 1 1 1 1 1 1 0 0 0
1300 0 0 1 1 1 1 1 1 1 1 0 0
1301 0 1 1 1 1 1 1 1 1 1 1 0
1302 0 1 1 1 1 1 1 1 1 1 1 0
1303 0 1 1 1 1 1 1 1 1 1 1 0
1304 0 1 1 1 1 1 1 1 1 1 1 0
1305 0 1 1 1 1 1 1 1 1 1 1 0
1306 0 1 1 1 1 1 1 1 1 1 1 0
1307 0 0 1 1 1 1 1 1 1 1 0 0
1308 0 0 0 1 1 1 1 1 1 0 0 0
1309 0 0 0 0 0 0 0 0 0 0 0 0"
1310 "PBM data used for enabled breakpoint icon.")
1312 (defconst breakpoint-disabled-pbm-data
1315 0 0 0 0 0 0 0 0 0 0 0 0
1316 0 0 0 1 0 1 0 1 0 0 0 0
1317 0 0 1 0 1 0 1 0 1 0 0 0
1318 0 1 0 1 0 1 0 1 0 1 0 0
1319 0 0 1 0 1 0 1 0 1 0 1 0
1320 0 1 0 1 0 1 0 1 0 1 0 0
1321 0 0 1 0 1 0 1 0 1 0 1 0
1322 0 1 0 1 0 1 0 1 0 1 0 0
1323 0 0 1 0 1 0 1 0 1 0 1 0
1324 0 0 0 1 0 1 0 1 0 1 0 0
1325 0 0 0 0 1 0 1 0 1 0 0 0
1326 0 0 0 0 0 0 0 0 0 0 0 0"
1327 "PBM data used for disabled breakpoint icon.")
1329 (defvar breakpoint-enabled-icon
1330 (find-image `((:type xpm
:data
,breakpoint-xpm-data
)
1331 (:type pbm
:data
,breakpoint-enabled-pbm-data
)))
1332 "Icon for enabled breakpoint in display margin")
1334 (defvar breakpoint-disabled-icon
1335 (find-image `((:type xpm
:data
,breakpoint-xpm-data
:conversion disabled
)
1336 (:type pbm
:data
,breakpoint-disabled-pbm-data
)))
1337 "Icon for disabled breakpoint in display margin")
1339 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1340 (defun gdb-info-breakpoints-custom ()
1341 (let ((flag)(address))
1343 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1344 (dolist (buffer (buffer-list))
1345 (with-current-buffer buffer
1346 (if (and (eq gud-minor-mode
'gdba
)
1347 (not (string-match "^\*" (buffer-name))))
1348 (if (eq window-system
'x
)
1349 (remove-images (point-min) (point-max))
1350 (gdb-remove-strings (point-min) (point-max))))))
1351 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer
)
1353 (goto-char (point-min))
1354 (while (< (point) (- (point-max) 1))
1356 (if (looking-at "[^\t].*breakpoint")
1358 (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1359 (setq flag
(char-after (match-beginning 1)))
1361 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t
)
1363 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1364 (let ((line (match-string 2)) (buffer-read-only nil
)
1365 (file (match-string 1)))
1366 (put-text-property (progn (beginning-of-line) (point))
1367 (progn (end-of-line) (point))
1368 'mouse-face
'highlight
)
1369 (with-current-buffer
1371 (if (file-exists-p file
) file
1372 (expand-file-name file gdb-cdir
)))
1373 (save-current-buffer
1374 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1375 (set (make-local-variable 'tool-bar-map
)
1377 (setq left-margin-width
2)
1378 (if (get-buffer-window (current-buffer))
1379 (set-window-margins (get-buffer-window
1382 right-margin-width
)))
1383 ;; only want one breakpoint icon at each location
1385 (goto-line (string-to-number line
))
1386 (let ((start (progn (beginning-of-line)
1388 (end (progn (end-of-line) (+ (point) 1))))
1389 (if (eq window-system
'x
)
1391 (remove-images start end
)
1393 (put-image breakpoint-enabled-icon
1395 "breakpoint icon enabled"
1397 (put-image breakpoint-disabled-icon
1399 "breakpoint icon disabled"
1401 (gdb-remove-strings start end
)
1403 (gdb-put-string "B" (+ start
1))
1404 (gdb-put-string "b" (+ start
1))))))))))))
1407 (defun gdb-breakpoints-buffer-name ()
1408 (with-current-buffer gud-comint-buffer
1409 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1411 (defun gdb-display-breakpoints-buffer ()
1414 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1416 (defun gdb-frame-breakpoints-buffer ()
1418 (switch-to-buffer-other-frame
1419 (gdb-get-create-buffer 'gdb-breakpoints-buffer
)))
1421 (defvar gdb-breakpoints-mode-map
1422 (let ((map (make-sparse-keymap))
1423 (menu (make-sparse-keymap "Breakpoints")))
1424 (define-key menu
[toggle] '("Toggle" . gdb-toggle-breakpoint))
1425 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1426 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1428 (suppress-keymap map)
1429 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1430 (define-key map " " 'gdb-toggle-breakpoint)
1431 (define-key map "d" 'gdb-delete-breakpoint)
1432 (define-key map "\r" 'gdb-goto-breakpoint)
1433 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1436 (defun gdb-breakpoints-mode ()
1437 "Major mode for gdb breakpoints.
1439 \\{gdb-breakpoints-mode-map}"
1440 (setq major-mode 'gdb-breakpoints-mode)
1441 (setq mode-name "Breakpoints")
1442 (use-local-map gdb-breakpoints-mode-map)
1443 (setq buffer-read-only t)
1444 (gdb-invalidate-breakpoints))
1446 (defun gdb-toggle-breakpoint ()
1447 "Enable/disable the breakpoint at current line."
1450 (beginning-of-line 1)
1451 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1452 (error "Not recognized as break/watchpoint line")
1456 (if (eq ?y (char-after (match-beginning 2)))
1459 (match-string 1) "\n")
1462 (defun gdb-delete-breakpoint ()
1463 "Delete the breakpoint at current line."
1465 (beginning-of-line 1)
1466 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1467 (error "Not recognized as break/watchpoint line")
1469 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1471 (defvar gdb-source-window nil)
1473 (defun gdb-goto-breakpoint ()
1474 "Display the file in the source buffer at the breakpoint specified on the
1478 (beginning-of-line 1)
1479 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1480 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1481 (if (match-string 2)
1482 (let ((line (match-string 2))
1483 (file (match-string 1)))
1484 (save-selected-window
1485 (select-window gdb-source-window)
1486 (switch-to-buffer (find-file-noselect
1487 (if (file-exists-p file)
1489 (expand-file-name file gdb-cdir))))
1490 (goto-line (string-to-number line))))))
1491 ;; I'll get this to work one day!
1492 ;; (defun gdb-goto-breakpoint ()
1493 ;; "Display the file in the source buffer at the breakpoint specified on the
1497 ;; (let ((eol (progn (end-of-line) (point))))
1498 ;; (beginning-of-line 1)
1499 ;; (if (re-search-forward "\\(\\S-*\\):\\([0-9]+\\)" eol t)
1500 ;; (let ((line (match-string 2))
1501 ;; (file (match-string 1)))
1502 ;; (save-selected-window
1503 ;; (select-window gdb-source-window)
1504 ;; (switch-to-buffer (find-file-noselect
1505 ;; (if (file-exists-p file)
1507 ;; (expand-file-name file gdb-cdir))))
1508 ;; (goto-line (string-to-number line))))))
1509 ;; (let ((eol (progn (end-of-line) (point))))
1510 ;; (beginning-of-line 1)
1511 ;; (if (re-search-forward "<\\(\\S-*?\\)\\(\\+*[0-9]*\\)>" eol t)
1512 ;; (save-selected-window
1513 ;; (select-window gdb-source-window)
1514 ;; (gdb-get-create-buffer 'gdb-assembler-buffer)
1515 ;; (gdb-enqueue-input
1516 ;; (list (concat "server disassemble " (match-string 1) "\n")
1517 ;; 'gdb-assembler-handler))
1518 ;; (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
1519 ;; (re-search-forward
1520 ;; (concat (match-string 1) (match-string 2)))))))))
1522 (defun gdb-mouse-goto-breakpoint (event)
1523 "Display the file in the source buffer at the selected breakpoint."
1525 (mouse-set-point event)
1526 (gdb-goto-breakpoint))
1529 ;; Frames buffer. This displays a perpetually correct bactracktrace
1530 ;; (from the command `where').
1532 ;; Alas, if your stack is deep, it is costly.
1534 (gdb-set-buffer-rules 'gdb-stack-buffer
1535 'gdb-stack-buffer-name
1538 (def-gdb-auto-updated-buffer gdb-stack-buffer
1539 gdb-invalidate-frames
1541 gdb-info-frames-handler
1542 gdb-info-frames-custom)
1544 (defun gdb-info-frames-custom ()
1545 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1547 (let ((buffer-read-only nil))
1548 (goto-char (point-min))
1549 (while (< (point) (point-max))
1550 (put-text-property (progn (beginning-of-line) (point))
1551 (progn (end-of-line) (point))
1552 'mouse-face 'highlight)
1554 (if (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
1555 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
1556 (if (equal (match-string 1) gdb-current-frame)
1557 (put-text-property (progn (beginning-of-line) (point))
1558 (progn (end-of-line) (point))
1560 `(:background ,(face-attribute 'default :foreground)
1561 :foreground ,(face-attribute 'default :background)))))
1562 (forward-line 1))))))
1564 (defun gdb-stack-buffer-name ()
1565 (with-current-buffer gud-comint-buffer
1566 (concat "*stack frames of " (gdb-get-target-string) "*")))
1568 (defun gdb-display-stack-buffer ()
1571 (gdb-get-create-buffer 'gdb-stack-buffer)))
1573 (defun gdb-frame-stack-buffer ()
1575 (switch-to-buffer-other-frame
1576 (gdb-get-create-buffer 'gdb-stack-buffer)))
1578 (defvar gdb-frames-mode-map
1579 (let ((map (make-sparse-keymap)))
1580 (suppress-keymap map)
1581 (define-key map "\r" 'gdb-frames-select)
1582 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1585 (defun gdb-frames-mode ()
1586 "Major mode for gdb frames.
1588 \\{gdb-frames-mode-map}"
1589 (setq major-mode 'gdb-frames-mode)
1590 (setq mode-name "Frames")
1591 (setq buffer-read-only t)
1592 (use-local-map gdb-frames-mode-map)
1594 (gdb-invalidate-frames))
1596 (defun gdb-get-frame-number ()
1598 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1599 (n (or (and pos (match-string-no-properties 1)) "0")))
1602 (defun gdb-frames-select ()
1603 "Make the frame on the current line become the current frame and display the
1604 source in the source buffer."
1607 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1608 (gud-display-frame))
1610 (defun gdb-frames-mouse-select (event)
1611 "Make the selected frame become the current frame and display the source in
1614 (mouse-set-point event)
1615 (gdb-frames-select))
1618 ;; Threads buffer. This displays a selectable thread list.
1620 (gdb-set-buffer-rules 'gdb-threads-buffer
1621 'gdb-threads-buffer-name
1624 (def-gdb-auto-updated-buffer gdb-threads-buffer
1625 gdb-invalidate-threads
1627 gdb-info-threads-handler
1628 gdb-info-threads-custom)
1630 (defun gdb-info-threads-custom ()
1631 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1632 (let ((buffer-read-only nil))
1633 (goto-char (point-min))
1634 (while (< (point) (point-max))
1635 (put-text-property (progn (beginning-of-line) (point))
1636 (progn (end-of-line) (point))
1637 'mouse-face 'highlight)
1638 (forward-line 1)))))
1640 (defun gdb-threads-buffer-name ()
1641 (with-current-buffer gud-comint-buffer
1642 (concat "*threads of " (gdb-get-target-string) "*")))
1644 (defun gdb-display-threads-buffer ()
1647 (gdb-get-create-buffer 'gdb-threads-buffer)))
1649 (defun gdb-frame-threads-buffer ()
1651 (switch-to-buffer-other-frame
1652 (gdb-get-create-buffer 'gdb-threads-buffer)))
1654 (defvar gdb-threads-mode-map
1655 (let ((map (make-sparse-keymap)))
1656 (suppress-keymap map)
1657 (define-key map "\r" 'gdb-threads-select)
1658 (define-key map [mouse-2] 'gdb-threads-mouse-select)
1661 (defun gdb-threads-mode ()
1662 "Major mode for gdb frames.
1664 \\{gdb-frames-mode-map}"
1665 (setq major-mode 'gdb-threads-mode)
1666 (setq mode-name "Threads")
1667 (setq buffer-read-only t)
1668 (use-local-map gdb-threads-mode-map)
1669 (gdb-invalidate-threads))
1671 (defun gdb-get-thread-number ()
1673 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1674 (match-string-no-properties 1)))
1677 (defun gdb-threads-select ()
1678 "Make the thread on the current line become the current thread and display the
1679 source in the source buffer."
1682 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1683 (gud-display-frame))
1685 (defun gdb-threads-mouse-select (event)
1686 "Make the selected frame become the current frame and display the source in
1689 (mouse-set-point event)
1690 (gdb-threads-select))
1693 ;; Registers buffer.
1695 (gdb-set-buffer-rules 'gdb-registers-buffer
1696 'gdb-registers-buffer-name
1697 'gdb-registers-mode)
1699 (def-gdb-auto-updated-buffer gdb-registers-buffer
1700 gdb-invalidate-registers
1701 "server info registers\n"
1702 gdb-info-registers-handler
1703 gdb-info-registers-custom)
1705 (defun gdb-info-registers-custom ())
1707 (defvar gdb-registers-mode-map
1708 (let ((map (make-sparse-keymap)))
1709 (suppress-keymap map)
1712 (defun gdb-registers-mode ()
1713 "Major mode for gdb registers.
1715 \\{gdb-registers-mode-map}"
1716 (setq major-mode 'gdb-registers-mode)
1717 (setq mode-name "Registers")
1718 (setq buffer-read-only t)
1719 (use-local-map gdb-registers-mode-map)
1720 (gdb-invalidate-registers))
1722 (defun gdb-registers-buffer-name ()
1723 (with-current-buffer gud-comint-buffer
1724 (concat "*registers of " (gdb-get-target-string) "*")))
1726 (defun gdb-display-registers-buffer ()
1729 (gdb-get-create-buffer 'gdb-registers-buffer)))
1731 (defun gdb-frame-registers-buffer ()
1733 (switch-to-buffer-other-frame
1734 (gdb-get-create-buffer 'gdb-registers-buffer)))
1739 (gdb-set-buffer-rules 'gdb-locals-buffer
1740 'gdb-locals-buffer-name
1743 (def-gdb-auto-updated-buffer gdb-locals-buffer
1744 gdb-invalidate-locals
1745 "server info locals\n"
1746 gdb-info-locals-handler
1747 gdb-info-locals-custom)
1749 ;; Abbreviate for arrays and structures.
1750 ;; These can be expanded using gud-display.
1751 (defun gdb-info-locals-handler nil
1752 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1753 (gdb-get-pending-triggers)))
1754 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1755 (with-current-buffer buf
1756 (goto-char (point-min))
1757 (while (re-search-forward "^ .*\n" nil t)
1758 (replace-match "" nil nil))
1759 (goto-char (point-min))
1760 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1761 (replace-match "(array);\n" nil nil))
1762 (goto-char (point-min))
1763 (while (re-search-forward "{.*=.*\n" nil t)
1764 (replace-match "(structure);\n" nil nil))))
1765 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1766 (and buf (with-current-buffer buf
1768 (buffer-read-only nil))
1769 (delete-region (point-min) (point-max))
1770 (insert-buffer-substring (gdb-get-create-buffer
1771 'gdb-partial-output-buffer))
1773 (run-hooks 'gdb-info-locals-hook))
1775 (defun gdb-info-locals-custom ()
1778 (defvar gdb-locals-mode-map
1779 (let ((map (make-sparse-keymap)))
1780 (suppress-keymap map)
1783 (defun gdb-locals-mode ()
1784 "Major mode for gdb locals.
1786 \\{gdb-locals-mode-map}"
1787 (setq major-mode 'gdb-locals-mode)
1788 (setq mode-name "Locals")
1789 (setq buffer-read-only t)
1790 (use-local-map gdb-locals-mode-map)
1791 (gdb-invalidate-locals))
1793 (defun gdb-locals-buffer-name ()
1794 (with-current-buffer gud-comint-buffer
1795 (concat "*locals of " (gdb-get-target-string) "*")))
1797 (defun gdb-display-locals-buffer ()
1800 (gdb-get-create-buffer 'gdb-locals-buffer)))
1802 (defun gdb-frame-locals-buffer ()
1804 (switch-to-buffer-other-frame
1805 (gdb-get-create-buffer 'gdb-locals-buffer)))
1808 ;; Display expression buffer.
1810 (gdb-set-buffer-rules 'gdb-display-buffer
1811 'gdb-display-buffer-name
1814 (def-gdb-auto-updated-buffer gdb-display-buffer
1815 ;; `gdb-display-buffer'.
1816 gdb-invalidate-display
1817 "server info display\n"
1818 gdb-info-display-handler
1819 gdb-info-display-custom)
1821 (defun gdb-info-display-custom ()
1822 (let ((display-list nil))
1823 (with-current-buffer (gdb-get-buffer 'gdb-display-buffer)
1824 (goto-char (point-min))
1825 (while (< (point) (- (point-max) 1))
1827 (if (looking-at "\\([0-9]+\\): \\([ny]\\)")
1829 (cons (string-to-int (match-string 1)) display-list)))
1831 (if (not (display-graphic-p))
1833 (dolist (buffer (buffer-list))
1834 (if (string-match "\\*display \\([0-9]+\\)\\*" (buffer-name buffer))
1837 (match-string 1 (buffer-name buffer))))
1838 (if (not (memq (string-to-int number) display-list))
1840 (get-buffer (concat "*display " number "*")))))))))
1841 (gdb-delete-frames display-list))))
1843 (defun gdb-delete-frames (display-list)
1844 (dolist (frame (frame-list))
1845 (let ((frame-name (frame-parameter frame 'name)))
1846 (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name)
1848 (let ((number (match-string 1 frame-name)))
1849 (if (not (memq (string-to-int number) display-list))
1851 (get-buffer (concat "*display " number "*")))
1852 (delete-frame frame)))))))))
1854 (defvar gdb-display-mode-map
1855 (let ((map (make-sparse-keymap))
1856 (menu (make-sparse-keymap "Display")))
1857 (define-key menu [toggle] '("Toggle" . gdb-toggle-display
))
1858 (define-key menu
[delete] '("Delete" . gdb-delete-display))
1860 (suppress-keymap map)
1861 (define-key map [menu-bar display] (cons "Display" menu))
1862 (define-key map " " 'gdb-toggle-display)
1863 (define-key map "d" 'gdb-delete-display)
1866 (defun gdb-display-mode ()
1867 "Major mode for gdb display.
1869 \\{gdb-display-mode-map}"
1870 (setq major-mode 'gdb-display-mode)
1871 (setq mode-name "Display")
1872 (setq buffer-read-only t)
1873 (use-local-map gdb-display-mode-map)
1874 (gdb-invalidate-display))
1876 (defun gdb-display-buffer-name ()
1877 (with-current-buffer gud-comint-buffer
1878 (concat "*Displayed expressions of " (gdb-get-target-string) "*")))
1880 (defun gdb-display-display-buffer ()
1883 (gdb-get-create-buffer 'gdb-display-buffer)))
1885 (defun gdb-frame-display-buffer ()
1887 (switch-to-buffer-other-frame
1888 (gdb-get-create-buffer 'gdb-display-buffer)))
1890 (defun gdb-toggle-display ()
1891 "Enable/disable the displayed expression at current line."
1894 (beginning-of-line 1)
1895 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1896 (error "No expression on this line")
1900 (if (eq ?y (char-after (match-beginning 2)))
1901 "server disable display "
1902 "server enable display ")
1903 (match-string 1) "\n")
1906 (defun gdb-delete-display ()
1907 "Delete the displayed expression at current line."
1909 (with-current-buffer (gdb-get-buffer 'gdb-display-buffer)
1910 (beginning-of-line 1)
1911 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1912 (error "No expression on this line")
1913 (let ((number (match-string 1)))
1915 (list (concat "server delete display " number "\n") 'ignore))))))
1917 (defvar gdb-expressions-mode-map
1918 (let ((map (make-sparse-keymap)))
1919 (suppress-keymap map)
1920 (define-key map "v" 'gdb-array-visualise)
1921 (define-key map "q" 'gdb-delete-expression)
1922 (define-key map [mouse-3] 'gdb-expressions-popup-menu)
1925 (defvar gdb-expressions-mode-menu
1926 '("GDB Expressions Commands"
1928 ["Visualise" gdb-array-visualise t]
1929 ["Delete" gdb-delete-expression t])
1930 "Menu for `gdb-expressions-mode'.")
1932 (defun gdb-expressions-popup-menu (event)
1933 "Explicit Popup menu as this buffer doesn't have a menubar."
1935 (mouse-set-point event)
1936 (popup-menu gdb-expressions-mode-menu))
1938 (defun gdb-expressions-mode ()
1939 "Major mode for display expressions.
1941 \\{gdb-expressions-mode-map}"
1942 (setq major-mode 'gdb-expressions-mode)
1943 (setq mode-name "Expressions")
1944 (use-local-map gdb-expressions-mode-map)
1945 (make-local-variable 'gdb-display-number)
1946 (make-local-variable 'gdb-values)
1947 (make-local-variable 'gdb-expression)
1948 (set (make-local-variable 'gdb-display-string) nil)
1949 (set (make-local-variable 'gdb-dive-display-number) nil)
1950 (set (make-local-variable 'gud-minor-mode) 'gdba)
1951 (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1))
1952 (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1))
1953 (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1))
1954 (setq buffer-read-only t))
1957 ;;;; Window management
1959 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1960 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1961 ;;; get at the use_time field of a window, I'm not sure there exists a
1962 ;;; more elegant solution without writing C code.
1964 (defun gdb-display-buffer (buf &optional size)
1965 (let ((must-split nil)
1971 (if (or (eq gud-comint-buffer (window-buffer win))
1972 (eq gdb-source-window win))
1973 (set-window-dedicated-p win t))))
1974 (setq answer (get-buffer-window buf))
1976 (let ((window (get-lru-window)))
1979 (set-window-buffer window buf)
1980 (setq answer window))
1981 (setq must-split t)))))
1984 (if (or (eq gud-comint-buffer (window-buffer win))
1985 (eq gdb-source-window win))
1986 (set-window-dedicated-p win nil)))))
1988 (let* ((largest (get-largest-window))
1989 (cur-size (window-height largest))
1990 (new-size (and size (< size cur-size) (- cur-size size))))
1991 (setq answer (split-window largest new-size))
1992 (set-window-buffer answer buf)))
1995 (defun gdb-display-source-buffer (buffer)
1996 (if (eq gdb-selected-view 'source)
1997 (set-window-buffer gdb-source-window buffer)
1998 (set-window-buffer gdb-source-window
1999 (gdb-get-buffer 'gdb-assembler-buffer)))
2003 ;;; Shared keymap initialization:
2005 (define-key gud-menu-map [gdb-many-windows]
2006 (menu-bar-make-toggle gdb-many-windows gdb-many-windows
2007 "Display other windows" "Many Windows %s"
2008 "Display locals, stack and breakpoint information"))
2010 (let ((menu (make-sparse-keymap "GDB-Frames")))
2011 (define-key gud-menu-map [frames]
2012 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
2013 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
2014 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
2015 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
2016 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
2017 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
2018 (define-key menu [display] '("Display" . gdb-frame-display-buffer))
2019 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
2020 ; (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer))
2023 (let ((menu (make-sparse-keymap "GDB-Windows")))
2024 (define-key gud-menu-map [displays]
2025 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
2026 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
2027 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
2028 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
2029 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
2030 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
2031 (define-key menu [display] '("Display" . gdb-display-display-buffer))
2032 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
2033 ; (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer))
2036 (let ((menu (make-sparse-keymap "View")))
2037 (define-key gud-menu-map [view] `(menu-item "View" ,menu))
2038 ; (define-key menu [both] '(menu-item "Both" gdb-view-both
2039 ; :help "Display both source and assembler"
2040 ; :button (:radio . (eq gdb-selected-view 'both))))
2041 (define-key menu [assembler] '(menu-item "Assembler" gdb-view-assembler
2042 :help "Display assembler only"
2043 :button (:radio . (eq gdb-selected-view 'assembler))))
2044 (define-key menu [source] '(menu-item "Source" gdb-view-source-function
2045 :help "Display source only"
2046 :button (:radio . (eq gdb-selected-view 'source)))))
2048 (defun gdb-frame-gdb-buffer ()
2050 (switch-to-buffer-other-frame
2051 (gdb-get-create-buffer 'gdba)))
2053 (defun gdb-display-gdb-buffer ()
2056 (gdb-get-create-buffer 'gdba)))
2058 (defvar gdb-main-file nil "Source file from which program execution begins.")
2060 (defun gdb-view-source-function ()
2063 (if gud-last-last-frame
2064 (set-window-buffer gdb-source-window
2065 (gud-find-file (car gud-last-last-frame)))
2066 (set-window-buffer gdb-source-window (gud-find-file gdb-main-file))))
2067 (setq gdb-selected-view 'source))
2069 (defun gdb-view-assembler()
2071 (set-window-buffer gdb-source-window
2072 (gdb-get-create-buffer 'gdb-assembler-buffer))
2073 (setq gdb-selected-view 'assembler))
2075 ;(defun gdb-view-both()
2077 ;(setq gdb-selected-view 'both))
2079 ;; layout for all the windows
2080 (defun gdb-setup-windows ()
2081 (gdb-display-locals-buffer)
2082 (gdb-display-stack-buffer)
2083 (delete-other-windows)
2084 (gdb-display-breakpoints-buffer)
2085 (gdb-display-display-buffer)
2086 (delete-other-windows)
2087 (switch-to-buffer gud-comint-buffer)
2088 (split-window nil ( / ( * (window-height) 3) 4))
2089 (split-window nil ( / (window-height) 3))
2090 (split-window-horizontally)
2092 (switch-to-buffer (gdb-locals-buffer-name))
2096 (if gud-last-last-frame
2097 (gud-find-file (car gud-last-last-frame))
2098 (gud-find-file gdb-main-file)))
2099 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
2100 (setq gdb-source-window (get-buffer-window (current-buffer)))
2101 (split-window-horizontally)
2103 (switch-to-buffer (gdb-inferior-io-name))
2105 (switch-to-buffer (gdb-stack-buffer-name))
2106 (split-window-horizontally)
2108 (switch-to-buffer (gdb-breakpoints-buffer-name))
2111 (defcustom gdb-many-windows nil
2112 "Nil means that gdb starts with just two windows : the GUD and
2117 (defun gdb-many-windows (arg)
2118 "Toggle the number of windows in the basic arrangement."
2120 (setq gdb-many-windows
2122 (not gdb-many-windows)
2123 (> (prefix-numeric-value arg) 0)))
2124 (gdb-restore-windows))
2126 (defun gdb-restore-windows ()
2127 "Restore the basic arrangement of windows used by gdba.
2128 This arrangement depends on the value of `gdb-many-windows'."
2130 (if gdb-many-windows
2132 (switch-to-buffer gud-comint-buffer)
2133 (delete-other-windows)
2134 (gdb-setup-windows))
2135 (switch-to-buffer gud-comint-buffer)
2136 (delete-other-windows)
2141 (if gud-last-last-frame
2142 (gud-find-file (car gud-last-last-frame))
2143 (gud-find-file gdb-main-file)))
2144 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
2145 (setq gdb-source-window (get-buffer-window (current-buffer)))
2149 "Exit a debugging session cleanly by killing the gdb buffers and resetting
2150 the source buffers."
2151 (gdb-delete-frames '())
2152 (dolist (buffer (buffer-list))
2153 (if (not (eq buffer gud-comint-buffer))
2154 (with-current-buffer buffer
2155 (if (eq gud-minor-mode 'gdba)
2156 (if (string-match "^\*.+*$" (buffer-name))
2158 (if (eq window-system 'x)
2159 (remove-images (point-min) (point-max))
2160 (gdb-remove-strings (point-min) (point-max)))
2161 (setq left-margin-width 0)
2162 (setq gud-minor-mode nil)
2163 (kill-local-variable 'tool-bar-map)
2164 (setq gud-running nil)
2165 (if (get-buffer-window (current-buffer))
2166 (set-window-margins (get-buffer-window
2169 right-margin-width))))))))
2171 (defun gdb-source-info ()
2172 "Find the source file where the program starts and displays it with related
2174 (goto-char (point-min))
2175 (if (search-forward "directory is " nil t)
2177 (if (looking-at "\\S-*:\\(\\S-*\\)")
2178 (setq gdb-cdir (match-string 1))
2179 (looking-at "\\S-*")
2180 (setq gdb-cdir (match-string 0)))
2181 (search-forward "Located in ")
2182 (looking-at "\\S-*")
2183 (setq gdb-main-file (match-string 0)))
2184 (setq gdb-view-source nil))
2185 (delete-other-windows)
2186 (switch-to-buffer gud-comint-buffer)
2187 (if gdb-many-windows
2189 (gdb-display-breakpoints-buffer)
2190 (gdb-display-display-buffer)
2191 (delete-other-windows)
2196 (if gud-last-last-frame
2197 (gud-find-file (car gud-last-last-frame))
2198 (gud-find-file gdb-main-file)))
2199 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
2200 (gdb-invalidate-assembler))
2201 (setq gdb-source-window (get-buffer-window (current-buffer)))
2205 (defun gdb-put-string (putstring pos)
2206 "Put string PUTSTRING in front of POS in the current buffer.
2207 PUTSTRING is displayed by putting an overlay into the current buffer with a
2208 `before-string' STRING that has a `display' property whose value is
2211 (let ((buffer (current-buffer)))
2212 (setq string (copy-sequence string))
2213 (let ((overlay (make-overlay pos pos buffer))
2214 (prop (list (list 'margin 'left-margin) putstring)))
2215 (put-text-property 0 (length string) 'display prop string)
2216 (overlay-put overlay 'put-break t)
2217 (overlay-put overlay 'before-string string))))
2219 ;;from remove-images
2220 (defun gdb-remove-strings (start end &optional buffer)
2221 "Remove strings between START and END in BUFFER.
2222 Remove only strings that were put in BUFFER with calls to `put-string'.
2223 BUFFER nil or omitted means use the current buffer."
2225 (setq buffer (current-buffer)))
2226 (let ((overlays (overlays-in start end)))
2228 (let ((overlay (car overlays)))
2229 (when (overlay-get overlay 'put-break)
2230 (delete-overlay overlay)))
2231 (setq overlays (cdr overlays)))))
2233 (defun gdb-put-arrow (putstring pos)
2234 "Put arrow string PUTSTRING in the left margin in front of POS
2235 in the current buffer. PUTSTRING is displayed by putting an
2236 overlay into the current buffer with a `before-string'
2237 \"gdb-arrow\" that has a `display' property whose value is
2238 PUTSTRING. STRING is defaulted if you omit it. POS may be an
2240 (setq string "gdb-arrow")
2241 (let ((buffer (current-buffer)))
2242 (setq string (copy-sequence string))
2243 (let ((overlay (make-overlay pos pos buffer))
2244 (prop (list (list 'margin 'left-margin) putstring)))
2245 (put-text-property 0 (length string) 'display prop string)
2246 (overlay-put overlay 'put-arrow t)
2247 (overlay-put overlay 'before-string string))))
2249 (defun gdb-remove-arrow (&optional buffer)
2250 "Remove arrow in BUFFER.
2251 Remove only images that were put in BUFFER with calls to `put-arrow'.
2252 BUFFER nil or omitted means use the current buffer."
2254 (setq buffer (current-buffer)))
2255 (let ((overlays (overlays-in (point-min) (point-max))))
2257 (let ((overlay (car overlays)))
2258 (when (overlay-get overlay 'put-arrow)
2259 (delete-overlay overlay)))
2260 (setq overlays (cdr overlays)))))
2262 (defun gdb-array-visualise ()
2263 "Visualise arrays and slices using graph program from plotutils."
2265 (when (and (display-graphic-p) gdb-display-string)
2267 (catch 'multi-dimensional
2268 (while (eq (aref gdb-array-start n) (aref gdb-array-stop n))
2271 (while (< m (length gdb-array-start))
2272 (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m)))
2275 t `(,(concat "Only one dimensional data can be visualised.\n"
2276 "Use an array slice to reduce the number of\n"
2277 "dimensions") ("OK" t)))
2278 (throw 'multi-dimensional nil))
2280 (shell-command (concat "echo" gdb-display-string " | graph -a 1 "
2281 (int-to-string (aref gdb-array-start n))
2283 (int-to-string (aref gdb-array-start n))
2285 (int-to-string (aref gdb-array-stop n))
2288 (defun gdb-delete-expression ()
2289 "Delete displayed expression and its frame."
2292 (list (concat "server delete display " gdb-display-number "\n")
2296 ;; Assembler buffer.
2298 (gdb-set-buffer-rules 'gdb-assembler-buffer
2299 'gdb-assembler-buffer-name
2300 'gdb-assembler-mode)
2302 (def-gdb-auto-updated-buffer gdb-assembler-buffer
2303 gdb-invalidate-assembler
2304 (concat "server disassemble " gdb-current-address "\n")
2305 gdb-assembler-handler
2306 gdb-assembler-custom)
2308 (defun gdb-assembler-custom ()
2309 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
2310 (gdb-arrow-position 1) (address) (flag))
2311 (with-current-buffer buffer
2312 (if (not (equal gdb-current-address "main"))
2315 (goto-char (point-min))
2316 (if (re-search-forward gdb-current-address nil t)
2318 (setq gdb-arrow-position (point))
2319 (gdb-put-arrow "=>" (point))))))
2320 ;; remove all breakpoint-icons in assembler buffer before updating.
2321 (if (eq window-system 'x)
2322 (remove-images (point-min) (point-max))
2323 (gdb-remove-strings (point-min) (point-max))))
2324 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
2325 (goto-char (point-min))
2326 (while (< (point) (- (point-max) 1))
2328 (if (looking-at "[^\t].*breakpoint")
2331 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
2332 (setq flag (char-after (match-beginning 1)))
2333 (setq address (match-string 2))
2334 ;; remove leading 0s from output of info break.
2335 (if (string-match "^0+\\(.*\\)" address)
2336 (setq address (match-string 1 address)))
2337 (with-current-buffer buffer
2338 (goto-char (point-min))
2339 (if (re-search-forward address nil t)
2340 (let ((start (progn (beginning-of-line) (- (point) 1)))
2341 (end (progn (end-of-line) (+ (point) 1))))
2342 (if (eq window-system 'x)
2344 (remove-images start end)
2346 (put-image breakpoint-enabled-icon
2348 "breakpoint icon enabled"
2350 (put-image breakpoint-disabled-icon
2352 "breakpoint icon disabled"
2354 (gdb-remove-strings start end)
2356 (gdb-put-string "B" (+ start 1))
2357 (gdb-put-string "b" (+ start 1)))))))))))
2358 (if (not (equal gdb-current-address "main"))
2359 (set-window-point (get-buffer-window buffer) gdb-arrow-position))))
2361 (defvar gdb-assembler-mode-map
2362 (let ((map (make-sparse-keymap)))
2363 (suppress-keymap map)
2366 (defun gdb-assembler-mode ()
2367 "Major mode for viewing code assembler.
2369 \\{gdb-assembler-mode-map}"
2370 (setq major-mode 'gdb-assembler-mode)
2371 (setq mode-name "Assembler")
2372 (setq left-margin-width 2)
2373 (setq fringes-outside-margins t)
2374 (setq buffer-read-only t)
2375 (use-local-map gdb-assembler-mode-map)
2376 (gdb-invalidate-assembler)
2377 (gdb-invalidate-breakpoints))
2379 (defun gdb-assembler-buffer-name ()
2380 (with-current-buffer gud-comint-buffer
2381 (concat "*Machine Code " (gdb-get-target-string) "*")))
2383 (defun gdb-display-assembler-buffer ()
2386 (gdb-get-create-buffer 'gdb-assembler-buffer)))
2388 (defun gdb-frame-assembler-buffer ()
2390 (switch-to-buffer-other-frame
2391 (gdb-get-create-buffer 'gdb-assembler-buffer)))
2393 ;; modified because if gdb-current-address has changed value a new command
2394 ;; must be enqueued to update the buffer with the new output
2395 (defun gdb-invalidate-assembler (&optional ignored)
2396 (if (gdb-get-buffer 'gdb-assembler-buffer)
2398 (if (string-equal gdb-current-frame gdb-previous-frame)
2399 (gdb-assembler-custom)
2400 (if (or (not (member 'gdb-invalidate-assembler
2401 (gdb-get-pending-triggers)))
2402 (not (string-equal gdb-current-address
2403 gdb-previous-address)))
2405 ;; take previous disassemble command off the queue
2406 (with-current-buffer gud-comint-buffer
2407 (let ((queue (gdb-get-idle-input-queue)) (item))
2408 (dolist (item queue)
2409 (if (equal (cdr item) '(gdb-assembler-handler))
2410 (gdb-set-idle-input-queue
2411 (delete item (gdb-get-idle-input-queue)))))))
2412 (gdb-enqueue-idle-input
2413 (list (concat "server disassemble " gdb-current-address "\n")
2414 'gdb-assembler-handler))
2415 (gdb-set-pending-triggers
2416 (cons 'gdb-invalidate-assembler
2417 (gdb-get-pending-triggers)))
2418 (setq gdb-previous-address gdb-current-address)
2419 (setq gdb-previous-frame gdb-current-frame)))))))
2421 (defun gdb-get-current-frame ()
2422 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
2424 (gdb-enqueue-idle-input
2425 (list (concat "server info frame\n") 'gdb-frame-handler))
2426 (gdb-set-pending-triggers
2427 (cons 'gdb-get-current-frame
2428 (gdb-get-pending-triggers))))))
2430 (defun gdb-frame-handler ()
2431 (gdb-set-pending-triggers
2432 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
2433 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
2434 (goto-char (point-min))
2436 (if (looking-at ".*= 0x\\(\\S-*\\) in \\(\\S-*\\)")
2438 (setq gdb-current-frame (match-string 2))
2439 (let ((address (match-string 1)))
2440 ;; remove leading 0s from output of info frame command.
2441 (if (string-match "^0+\\(.*\\)" address)
2442 (setq gdb-current-address
2443 (concat "0x" (match-string 1 address)))
2444 (setq gdb-current-address (concat "0x" address))))
2445 (if (or (if (not (looking-at ".*(\\S-*:[0-9]*)"))
2446 (progn (setq gdb-view-source nil) t))
2447 (eq gdb-selected-view 'assembler))
2451 (gdb-get-create-buffer 'gdb-assembler-buffer))
2452 (gdb-invalidate-assembler)))))))
2456 ;;; gdb-ui.el ends here