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 ;; Extension of gdba.el written by Jim Kingdon from gdb 5.0
34 (defvar gdb-main-or-pc nil
"Initialisation for Assembler buffer.")
35 (defvar gdb-current-address nil
)
36 (defvar gdb-display-in-progress nil
)
40 (defun gdba (command-line)
41 "Run gdb on program FILE in buffer *gud-FILE*.
42 The directory containing FILE becomes the initial working directory
43 and source-file directory for your debugger.
45 If `gdb-many-windows' is nil (the default value) then gdb starts with
46 just two windows : the GUD and the source buffer. If it is t the
47 following layout will appear (keybindings given in relevant buffer) :
49 ---------------------------------------------------------------------
51 ---------------------------------------------------------------------
52 GUD buffer (I/O of GDB) | Locals buffer
56 ---------------------------------------------------------------------
57 Source buffer | Input/Output (of debuggee) buffer
65 ---------------------------------------------------------------------
66 Stack buffer | Breakpoints buffer
67 \[mouse-2\] gdb-frames-mouse-select | SPC gdb-toggle-bp-this-line
68 | g gdb-goto-bp-this-line
69 | d gdb-delete-bp-this-line
70 ---------------------------------------------------------------------
72 All the buffers share the toolbar and source should always display in the same
73 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
74 icons are displayed both by setting a break with gud-break and by typing break
77 This works best (depending on the size of your monitor) using most of the
80 Displayed expressions appear in separate frames. Arrays may be displayed
81 as slices and visualised using the graph program from plotutils if installed.
82 Pointers in structures may be followed in a tree-like fashion.
84 The following interactive lisp functions help control operation :
86 `gdb-many-windows' - Toggle the number of windows gdb uses.
87 `gdb-restore-windows' - To restore the window layout.
88 `gdb-quit' - To delete (most) of the buffers used by GDB-UI and
91 (interactive (list (gud-query-cmdline 'gdba
)))
93 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
96 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
97 (set (make-local-variable 'gud-marker-filter
) 'gdba-marker-filter
)
99 (gud-def gud-break
(if (not (string-equal mode-name
"Assembler"))
100 (gud-call "break %f:%l" arg
)
104 (gud-call "break *%a" arg
)))
105 "\C-b" "Set breakpoint at current line or address.")
107 (gud-def gud-remove
(if (not (string-equal mode-name
"Assembler"))
108 (gud-call "clear %f:%l" arg
)
112 (gud-call "clear *%a" arg
)))
113 "\C-d" "Remove breakpoint at current line or address.")
115 (setq comint-input-sender
'gdb-send
)
118 (setq gdb-main-or-pc
"main")
119 (setq gdb-current-address nil
)
120 (setq gdb-display-in-progress nil
)
124 (gdb-clear-inferior-io)
126 ;; find source file and compilation directory here
127 (gdb-instance-enqueue-idle-input (list "server list\n" 'ignore
))
128 (gdb-instance-enqueue-idle-input (list "server info source\n"
131 (run-hooks 'gdba-mode-hook
))
133 (defun gud-display ()
134 "Display (possibly dereferenced) C expression at point."
137 (let ((expr (gud-find-c-expr)))
138 (gdb-instance-enqueue-idle-input
139 (list (concat "server whatis " expr
"\n")
140 `(lambda () (gud-display1 ,expr
)))))))
142 (defun gud-display1 (expr)
143 (goto-char (point-min))
144 (if (re-search-forward "\*" nil t
)
145 (gdb-instance-enqueue-idle-input
146 (list (concat "server display* " expr
"\n") 'ignore
))
147 (gdb-instance-enqueue-idle-input
148 (list (concat "server display " expr
"\n") 'ignore
))))
151 ;; The completion process filter is installed temporarily to slurp the
152 ;; output of GDB up to the next prompt and build the completion list.
153 ;; It must also handle annotations.
156 ;; ======================================================================
158 ;; In this world, there are gdb instance objects (of unspecified
159 ;; representation) and buffers associated with those objects.
163 ;; gdb-instance objects
166 (defvar gdb-instance-variables
'()
167 "A list of variables that are local to the GUD buffer associated
168 with a gdb instance.")
170 ;;; The list of instance variables is built up by the expansions of
174 (defmacro def-gdb-var
(root-symbol &optional default doc
)
175 (let* ((root (symbol-name root-symbol
))
176 (accessor (intern (concat "gdb-instance-" root
)))
177 (setter (intern (concat "set-gdb-instance-" root
)))
178 (name (intern (concat "gdb-" root
))))
180 (defvar ,name
,default
,doc
)
181 (if (not (memq ',name gdb-instance-variables
))
182 (push ',name gdb-instance-variables
))
184 (buffer-local-value ',name gud-comint-buffer
))
186 (with-current-buffer gud-comint-buffer
187 (setq ,name val
))))))
189 (def-gdb-var buffer-type nil
190 "One of the symbols bound in gdb-instance-buffer-rules")
192 (def-gdb-var burst
""
193 "A string of characters from gdb that have not yet been processed.")
195 (def-gdb-var input-queue
()
196 "A list of high priority gdb command objects.")
198 (def-gdb-var idle-input-queue
()
199 "A list of low priority gdb command objects.")
201 (def-gdb-var prompting nil
202 "True when gdb is idle with no pending input.")
204 (def-gdb-var output-sink
'user
205 "The disposition of the output of the current gdb command.
206 Possible values are these symbols:
208 user -- gdb output should be copied to the GUD buffer
211 inferior -- gdb output should be copied to the inferior-io buffer
213 pre-emacs -- output should be ignored util the post-prompt
214 annotation is received. Then the output-sink
216 emacs -- output should be collected in the partial-output-buffer
217 for subsequent processing by a command. This is the
218 disposition of output generated by commands that
219 gdb mode sends to gdb on its own behalf.
220 post-emacs -- ignore input until the prompt annotation is
221 received, then go to USER disposition.
224 (def-gdb-var current-item nil
225 "The most recent command item sent to gdb.")
227 (def-gdb-var pending-triggers
'()
228 "A list of trigger functions that have run later than their output
231 (defun in-gdb-instance-context (form)
232 "Funcall FORM in the GUD buffer."
233 (with-current-buffer gud-comint-buffer
236 ;; end of instance vars
238 (defun gdb-make-instance ()
239 "Create a gdb instance object from the current buffer."
240 (mapc 'make-local-variable gdb-instance-variables
)
241 (setq gdb-buffer-type
'gdba
))
243 (defun gdb-instance-target-string ()
244 "The apparent name of the program being debugged by a gdb instance.
245 For sure this the root string used in smashing together the gdb
246 buffer's name, even if that doesn't happen to be the name of a
248 (in-gdb-instance-context (lambda () gud-target-name
)))
255 ;; More than one buffer can be associated with a gdb instance.
257 ;; Each buffer has a TYPE -- a symbol that identifies the function
258 ;; of that particular buffer.
260 ;; The usual gdb interaction buffer is given the type `gdba' and
261 ;; is constructed specially.
263 ;; Others are constructed by gdb-get-create-instance-buffer and
264 ;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc
266 (defvar gdb-instance-buffer-rules-assoc
'())
268 (defun gdb-get-instance-buffer (key)
269 "Return the instance buffer tagged with type KEY.
270 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
272 (gdb-look-for-tagged-buffer key
(buffer-list))))
274 (defun gdb-get-create-instance-buffer (key)
275 "Create a new gdb instance buffer of the type specified by KEY.
276 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
277 (or (gdb-get-instance-buffer key
)
278 (let* ((rules (assoc key gdb-instance-buffer-rules-assoc
))
279 (name (funcall (gdb-rules-name-maker rules
)))
280 (new (get-buffer-create name
)))
281 (with-current-buffer new
282 ;; FIXME: This should be set after calling the function, since the
283 ;; function should run kill-all-local-variables.
284 (set (make-local-variable 'gdb-buffer-type
) key
)
285 (if (cdr (cdr rules
))
286 (funcall (car (cdr (cdr rules
)))))
287 (set (make-local-variable 'gud-comint-buffer
) gud-comint-buffer
)
288 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
289 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
292 (defun gdb-rules-name-maker (rules) (car (cdr rules
)))
294 (defun gdb-look-for-tagged-buffer (key bufs
)
296 (while (and (not retval
) bufs
)
297 (set-buffer (car bufs
))
298 (if (eq gdb-buffer-type key
)
299 (setq retval
(car bufs
)))
300 (setq bufs
(cdr bufs
)))
304 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
305 ;; at least one and possible more functions. The functions have these
306 ;; roles in defining a buffer type:
308 ;; NAME - take an instance, return a name for this type buffer for that
310 ;; The remaining function(s) are optional:
312 ;; MODE - called in new new buffer with no arguments, should establish
313 ;; the proper mode for the buffer.
316 (defun gdb-set-instance-buffer-rules (buffer-type &rest rules
)
317 (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc
)))
319 (setcdr binding rules
)
320 (push (cons buffer-type rules
)
321 gdb-instance-buffer-rules-assoc
))))
323 ;; GUD buffers are an exception to the rules
324 (gdb-set-instance-buffer-rules 'gdba
'error
)
327 ;; partial-output buffers
329 ;; These accumulate output from a command executed on
330 ;; behalf of emacs (rather than the user).
333 (gdb-set-instance-buffer-rules 'gdb-partial-output-buffer
334 'gdb-partial-output-name
)
336 (defun gdb-partial-output-name ()
337 (concat "*partial-output-"
338 (gdb-instance-target-string)
342 (gdb-set-instance-buffer-rules 'gdb-inferior-io
343 'gdb-inferior-io-name
344 'gdb-inferior-io-mode
)
346 (defun gdb-inferior-io-name ()
347 (concat "*input/output of "
348 (gdb-instance-target-string)
351 (defvar gdb-inferior-io-mode-map
352 (let ((map (make-sparse-keymap)))
353 (define-key map
"\C-c\C-c" 'gdb-inferior-io-interrupt
)
354 (define-key map
"\C-c\C-z" 'gdb-inferior-io-stop
)
355 (define-key map
"\C-c\C-\\" 'gdb-inferior-io-quit
)
356 (define-key map
"\C-c\C-d" 'gdb-inferior-io-eof
)
359 (define-derived-mode gdb-inferior-io-mode comint-mode
"Debuggee I/O"
360 "Major mode for gdb inferior-io."
361 :syntax-table nil
:abbrev-table nil
362 ;; We want to use comint because it has various nifty and familiar
363 ;; features. We don't need a process, but comint wants one, so create
365 (make-comint-in-buffer
366 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
367 (current-buffer) "/bin/cat")
368 (setq comint-input-sender
'gdb-inferior-io-sender
))
370 (defun gdb-inferior-io-sender (proc string
)
371 ;; PROC is the pseudo-process created to satisfy comint.
372 (with-current-buffer (process-buffer proc
)
373 (setq proc
(get-buffer-process gud-comint-buffer
))
374 (process-send-string proc string
)
375 (process-send-string proc
"\n")))
377 (defun gdb-inferior-io-interrupt ()
378 "Interrupt the program being debugged."
381 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
383 (defun gdb-inferior-io-quit ()
384 "Send quit signal to the program being debugged."
387 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
389 (defun gdb-inferior-io-stop ()
390 "Stop the program being debugged."
393 (get-buffer-process gud-comint-buffer
) comint-ptyp
))
395 (defun gdb-inferior-io-eof ()
396 "Send end-of-file to the program being debugged."
399 (get-buffer-process gud-comint-buffer
)))
403 ;; gdb communications
406 ;; INPUT: things sent to gdb
408 ;; Each instance has a high and low priority
409 ;; input queue. Low priority input is sent only
410 ;; when the high priority queue is idle.
412 ;; The queues are lists. Each element is either
413 ;; a string (indicating user or user-like input)
414 ;; or a list of the form:
416 ;; (INPUT-STRING HANDLER-FN)
419 ;; The handler function will be called from the
420 ;; partial-output buffer when the command completes.
421 ;; This is the way to write commands which
422 ;; invoke gdb commands autonomously.
424 ;; These lists are consumed tail first.
427 (defun gdb-send (proc string
)
428 "A comint send filter for gdb.
429 This filter may simply queue output for a later time."
430 (gdb-instance-enqueue-input (concat string
"\n")))
432 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
433 ;; is a query, or other non-top-level prompt. To guarantee stuff will get
434 ;; sent to the top-level prompt, currently it must be put in the idle queue.
436 ;; [This should encourage gdb extensions that invoke gdb commands to let
437 ;; the user go first; it is not a bug. -t]
440 (defun gdb-instance-enqueue-input (item)
441 (if (gdb-instance-prompting)
444 (set-gdb-instance-prompting nil
))
445 (set-gdb-instance-input-queue
446 (cons item
(gdb-instance-input-queue)))))
448 (defun gdb-instance-dequeue-input ()
449 (let ((queue (gdb-instance-input-queue)))
451 (if (not (cdr queue
))
452 (let ((answer (car queue
)))
453 (set-gdb-instance-input-queue '())
455 (gdb-take-last-elt queue
)))))
457 (defun gdb-instance-enqueue-idle-input (item)
458 (if (and (gdb-instance-prompting)
459 (not (gdb-instance-input-queue)))
462 (set-gdb-instance-prompting nil
))
463 (set-gdb-instance-idle-input-queue
464 (cons item
(gdb-instance-idle-input-queue)))))
466 (defun gdb-instance-dequeue-idle-input ()
467 (let ((queue (gdb-instance-idle-input-queue)))
469 (if (not (cdr queue
))
470 (let ((answer (car queue
)))
471 (set-gdb-instance-idle-input-queue '())
473 (gdb-take-last-elt queue
)))))
475 ;; Don't use this in general.
476 (defun gdb-take-last-elt (l)
478 (gdb-take-last-elt (cdr l
))
479 (let ((answer (car (cdr l
))))
485 ;; output -- things gdb prints to emacs
487 ;; GDB output is a stream interrupted by annotations.
488 ;; Annotations can be recognized by their beginning
489 ;; with \C-j\C-z\C-z<tag><opt>\C-j
491 ;; The tag is a string obeying symbol syntax.
493 ;; The optional part `<opt>' can be either the empty string
494 ;; or a space followed by more data relating to the annotation.
495 ;; For example, the SOURCE annotation is followed by a filename,
496 ;; line number and various useless goo. This data must not include
500 (defcustom gud-gdba-command-name
"gdb -annotate=2"
501 "Default command to execute an executable under the GDB-UI debugger."
505 (defun gdba-marker-filter (string)
506 "A gud marker filter for gdb."
507 (gdb-output-burst string
))
509 (defvar gdb-annotation-rules
510 '(("frames-invalid" gdb-invalidate-frame-and-assembler
)
511 ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler
)
512 ("pre-prompt" gdb-pre-prompt
)
513 ("prompt" gdb-prompt
)
514 ("commands" gdb-subprompt
)
515 ("overload-choice" gdb-subprompt
)
516 ("query" gdb-subprompt
)
517 ("prompt-for-continue" gdb-subprompt
)
518 ("post-prompt" gdb-post-prompt
)
519 ("source" gdb-source
)
520 ("starting" gdb-starting
)
521 ("exited" gdb-stopping
)
522 ("signalled" gdb-stopping
)
523 ("signal" gdb-stopping
)
524 ("breakpoint" gdb-stopping
)
525 ("watchpoint" gdb-stopping
)
526 ("frame-begin" gdb-frame-begin
)
527 ("stopped" gdb-stopped
)
528 ("display-begin" gdb-display-begin
)
529 ("display-end" gdb-display-end
)
530 ("display-number-end" gdb-display-number-end
)
531 ("array-section-begin" gdb-array-section-begin
)
532 ("array-section-end" gdb-array-section-end
)
534 ("field-begin" gdb-field-begin
)
535 ("field-end" gdb-field-end
)
536 ) "An assoc mapping annotation tags to functions which process them.")
538 (defun gdb-ignore-annotation (args)
541 (defconst gdb-source-spec-regexp
542 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
544 ;; Do not use this except as an annotation handler.
545 (defun gdb-source (args)
546 (string-match gdb-source-spec-regexp args
)
547 ;; Extract the frame position from the marker.
550 (match-string 1 args
)
551 (string-to-int (match-string 2 args
))))
552 (setq gdb-current-address
(match-string 3 args
))
553 (setq gdb-main-or-pc gdb-current-address
)
554 ;;update with new frame for machine code if necessary
555 (gdb-invalidate-assembler))
557 (defun gdb-prompt (ignored)
558 "An annotation handler for `prompt'.
559 This sends the next command (if any) to gdb."
560 (let ((sink (gdb-instance-output-sink)))
563 ((eq sink
'post-emacs
)
564 (set-gdb-instance-output-sink 'user
))
566 (set-gdb-instance-output-sink 'user
)
567 (error "Phase error in gdb-prompt (got %s)" sink
))))
568 (let ((highest (gdb-instance-dequeue-input)))
570 (gdb-send-item highest
)
571 (let ((lowest (gdb-instance-dequeue-idle-input)))
573 (gdb-send-item lowest
)
575 (set-gdb-instance-prompting t
)
576 (gud-display-frame)))))))
578 (defun gdb-subprompt (ignored)
579 "An annotation handler for non-top-level prompts."
580 (let ((highest (gdb-instance-dequeue-input)))
582 (gdb-send-item highest
)
583 (set-gdb-instance-prompting t
))))
585 (defun gdb-send-item (item)
586 (set-gdb-instance-current-item item
)
589 (set-gdb-instance-output-sink 'user
)
590 (process-send-string (get-buffer-process gud-comint-buffer
) item
))
592 (gdb-clear-partial-output)
593 (set-gdb-instance-output-sink 'pre-emacs
)
594 (process-send-string (get-buffer-process gud-comint-buffer
)
597 (defun gdb-pre-prompt (ignored)
598 "An annotation handler for `pre-prompt'. This terminates the collection of
599 output from a previous command if that happens to be in effect."
600 (let ((sink (gdb-instance-output-sink)))
604 (set-gdb-instance-output-sink 'post-emacs
)
606 (car (cdr (gdb-instance-current-item)))))
608 (set-buffer (gdb-get-create-instance-buffer
609 'gdb-partial-output-buffer
))
612 (set-gdb-instance-output-sink 'user
)
613 (error "Output sink phase error 1")))))
615 (defun gdb-starting (ignored)
616 "An annotation handler for `starting'. This says that I/O for the
617 subprocess is now the program being debugged, not GDB."
618 (let ((sink (gdb-instance-output-sink)))
623 (set-gdb-instance-output-sink 'inferior
)))
624 (t (error "Unexpected `starting' annotation")))))
626 (defun gdb-stopping (ignored)
627 "An annotation handler for `exited' and other annotations which say that I/O
628 for the subprocess is now GDB, not the program being debugged."
629 (let ((sink (gdb-instance-output-sink)))
632 (set-gdb-instance-output-sink 'user
))
633 (t (error "Unexpected stopping annotation")))))
635 (defun gdb-stopped (ignored)
636 "An annotation handler for `stopped'. It is just like gdb-stopping, except
637 that if we already set the output sink to 'user in gdb-stopping, that is fine."
638 (setq gud-running nil
)
639 (let ((sink (gdb-instance-output-sink)))
642 (set-gdb-instance-output-sink 'user
))
644 (t (error "Unexpected stopped annotation")))))
646 (defun gdb-frame-begin (ignored)
647 (let ((sink (gdb-instance-output-sink)))
650 (set-gdb-instance-output-sink 'user
))
653 (t (error "Unexpected frame-begin annotation (%S)" sink
)))))
655 (defun gdb-post-prompt (ignored)
656 "An annotation handler for `post-prompt'. This begins the collection of
657 output from the current command if that happens to be appropriate."
658 (if (not (gdb-instance-pending-triggers))
660 (gdb-invalidate-registers ignored
)
661 (gdb-invalidate-locals ignored
)
662 (gdb-invalidate-display ignored
)))
663 (let ((sink (gdb-instance-output-sink)))
666 ((eq sink
'pre-emacs
)
667 (set-gdb-instance-output-sink 'emacs
))
669 (set-gdb-instance-output-sink 'user
)
670 (error "Output sink phase error 3")))))
672 ;; If we get an error whilst evaluating one of the expressions
673 ;; we won't get the display-end annotation. Set the sink back to
674 ;; user to make sure that the error message is seen
675 (defun gdb-error-begin (ignored)
676 (set-gdb-instance-output-sink 'user
))
678 (defun gdb-display-begin (ignored)
679 (if (gdb-get-instance-buffer 'gdb-display-buffer
)
681 (set-gdb-instance-output-sink 'emacs
)
682 (gdb-clear-partial-output)
683 (setq gdb-display-in-progress t
))
684 (set-gdb-instance-output-sink 'user
)))
686 (defvar gdb-expression-buffer-name
)
687 (defvar gdb-display-number
)
688 (defvar gdb-dive-display-number
)
690 (defun gdb-display-number-end (ignored)
691 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
692 (setq gdb-display-number
(buffer-string))
693 (setq gdb-expression-buffer-name
694 (concat "*display " gdb-display-number
"*"))
697 (set-buffer (window-buffer))
700 (let ((number gdb-display-number
))
702 (set-buffer (get-buffer-create gdb-expression-buffer-name
)))
703 (gdb-expressions-mode)
704 (setq gdb-dive-display-number number
)))
705 (set-buffer (get-buffer-create gdb-expression-buffer-name
))
706 (if (and (display-graphic-p) (not gdb-dive
))
708 (dolist (frame (frame-list))
709 (if (string-equal (frame-parameter frame
'name
)
710 gdb-expression-buffer-name
)
711 (throw 'frame-exists nil
)))
712 (gdb-expressions-mode)
713 (make-frame '((height .
20) (width .
40)
714 (tool-bar-lines . nil
)
715 (menu-bar-lines . nil
)
716 (minibuffer . nil
)))))))
717 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
720 (defvar gdb-current-frame nil
)
721 (defvar gdb-nesting-level
)
722 (defvar gdb-expression
)
724 (defvar gdb-annotation-arg
)
726 (defun gdb-delete-line ()
727 "Delete the current line."
728 (delete-region (line-beginning-position) (line-beginning-position 2)))
730 (defun gdb-display-end (ignored)
731 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
732 (goto-char (point-min))
733 (search-forward ": ")
734 (looking-at "\\(.*?\\) =")
736 (gdb-temp-value (match-string 1)))
737 ;;move * to front of expression if necessary
738 (if (looking-at ".*\\*")
741 (setq gdb-temp-value
(substring gdb-temp-value
1 nil
))))
743 (set-buffer gdb-expression-buffer-name
)
744 (setq gdb-expression gdb-temp-value
)
745 (if (not (string-match "::" gdb-expression
))
746 (setq gdb-expression
(concat char gdb-current-frame
747 "::" gdb-expression
))
748 ;;else put * back on if necessary
749 (setq gdb-expression
(concat char gdb-expression
)))
750 (setq header-line-format
(concat "-- " gdb-expression
" %-"))))
753 (if (not (re-search-forward "##" nil t
))
756 (set-buffer gdb-expression-buffer-name
)
757 (setq buffer-read-only nil
)
758 (delete-region (point-min) (point-max))
759 (insert-buffer-substring
760 (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
761 (setq buffer-read-only t
)))
762 ;; display expression name...
763 (goto-char (point-min))
764 (let ((start (progn (point)))
765 (end (progn (end-of-line) (point))))
767 (set-buffer gdb-expression-buffer-name
)
768 (setq buffer-read-only nil
)
769 (delete-region (point-min) (point-max))
770 (insert-buffer-substring (gdb-get-instance-buffer
771 'gdb-partial-output-buffer
)
774 (goto-char (point-min))
775 (re-search-forward "##" nil t
)
776 (setq gdb-nesting-level
0)
777 (if (looking-at "array-section-begin")
780 (setq gdb-point
(point))
782 (if (looking-at "field-begin \\(.\\)")
784 (setq gdb-annotation-arg
(match-string 1))
785 (gdb-field-format-begin))))
787 (set-buffer gdb-expression-buffer-name
)
788 (if gdb-dive-display-number
790 (setq buffer-read-only nil
)
791 (goto-char (point-max))
793 (insert-text-button "[back]" 'type
'gdb-display-back
)
794 (setq buffer-read-only t
))))
795 (gdb-clear-partial-output)
796 (set-gdb-instance-output-sink 'user
)
797 (setq gdb-display-in-progress nil
))
799 (define-button-type 'gdb-display-back
800 'help-echo
(purecopy "mouse-2, RET: go back to previous display buffer")
801 'action
(lambda (button) (gdb-display-go-back)))
803 (defun gdb-display-go-back ()
804 ;; delete display so they don't accumulate and delete buffer
805 (let ((number gdb-display-number
))
806 (gdb-instance-enqueue-idle-input
807 (list (concat "server delete display " number
"\n") 'ignore
))
808 (switch-to-buffer (concat "*display " gdb-dive-display-number
"*"))
809 (kill-buffer (get-buffer (concat "*display " number
"*")))))
811 ;; prefix annotations with ## and process whole output in one chunk
812 ;; in gdb-partial-output-buffer (to allow recursion).
814 ;; array-section flags are just removed again but after counting. They
815 ;; might also be useful for arrays of structures and structures with arrays.
816 (defun gdb-array-section-begin (args)
817 (if gdb-display-in-progress
820 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
821 (goto-char (point-max))
822 (insert (concat "\n##array-section-begin " args
"\n"))))))
824 (defun gdb-array-section-end (ignored)
825 (if gdb-display-in-progress
828 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
829 (goto-char (point-max))
830 (insert "\n##array-section-end\n")))))
832 (defun gdb-field-begin (args)
833 (if gdb-display-in-progress
836 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
837 (goto-char (point-max))
838 (insert (concat "\n##field-begin " args
"\n"))))))
840 (defun gdb-field-end (ignored)
841 (if gdb-display-in-progress
844 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
845 (goto-char (point-max))
846 (insert "\n##field-end\n")))))
848 (defun gdb-elt (ignored)
849 (if gdb-display-in-progress
851 (goto-char (point-max))
852 (insert "\n##elt\n"))))
854 (defun gdb-field-format-begin ()
855 ;; get rid of ##field-begin
858 (setq gdb-nesting-level
(+ gdb-nesting-level
1))
859 (while (re-search-forward "##" nil t
)
860 ;; keep making recursive calls...
861 (if (looking-at "field-begin \\(.\\)")
863 (setq gdb-annotation-arg
(match-string 1))
864 (gdb-field-format-begin)))
866 (if (looking-at "field-end") (gdb-field-format-end))))
868 (defun gdb-field-format-end ()
869 ;; get rid of ##field-end and `,' or `}'
872 (setq gdb-nesting-level
(- gdb-nesting-level
1)))
875 (let ((map (make-sparse-keymap)))
876 (define-key map
[mouse-2
] 'gdb-dive
)
877 (define-key map
[S-mouse-2
] 'gdb-dive-new-frame
)
880 (defun gdb-dive (event)
881 "Dive into structure."
884 (gdb-dive-new-frame event
))
886 (defun gdb-dive-new-frame (event)
887 "Dive into structure and display in a new frame."
890 (mouse-set-point event
)
891 (let ((point (point)) (gdb-full-expression gdb-expression
)
892 (end (progn (end-of-line) (point)))
893 (gdb-part-expression "") (gdb-last-field nil
) (gdb-display-char nil
))
895 (if (looking-at "\*") (setq gdb-display-char
"*"))
896 (re-search-forward "\\(\\S-+\\) = " end t
)
897 (setq gdb-last-field
(match-string-no-properties 1))
898 (goto-char (match-beginning 1))
899 (let ((last-column (current-column)))
900 (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t
)
901 (goto-char (match-beginning 1))
902 (if (and (< (current-column) last-column
)
903 (> (count-lines 1 (point)) 1))
905 (setq gdb-part-expression
906 (concat "." (match-string-no-properties 1)
907 gdb-part-expression
))
908 (setq last-column
(current-column))))))
909 ;; * not needed for components of a pointer to a structure in gdb
910 (if (string-equal "*" (substring gdb-full-expression
0 1))
911 (setq gdb-full-expression
(substring gdb-full-expression
1 nil
)))
912 (setq gdb-full-expression
913 (concat gdb-full-expression gdb-part-expression
"." gdb-last-field
))
914 (gdb-instance-enqueue-idle-input
915 (list (concat "server display" gdb-display-char
916 " " gdb-full-expression
"\n")
919 (defun gdb-insert-field ()
920 (let ((start (progn (point)))
921 (end (progn (next-line) (point)))
924 (set-buffer gdb-expression-buffer-name
)
925 (setq buffer-read-only nil
)
926 (if (string-equal gdb-annotation-arg
"\*") (insert "\*"))
927 (while (<= num gdb-nesting-level
)
929 (setq num
(+ num
1)))
930 (insert-buffer-substring (gdb-get-instance-buffer
931 'gdb-partial-output-buffer
)
933 (put-text-property (- (point) (- end start
)) (- (point) 1)
934 'mouse-face
'highlight
)
935 (put-text-property (- (point) (- end start
)) (- (point) 1)
936 'local-map gdb-dive-map
)
937 (setq buffer-read-only t
))
938 (delete-region start end
)))
942 (defun gdb-array-format ()
943 (while (re-search-forward "##" nil t
)
944 ;; keep making recursive calls...
945 (if (looking-at "array-section-begin")
947 ;;get rid of ##array-section-begin
949 (setq gdb-nesting-level
(+ gdb-nesting-level
1))
951 ;;until *matching* array-section-end is found
952 (if (looking-at "array-section-end")
953 (if (eq gdb-nesting-level
0)
955 (let ((values (buffer-substring gdb-point
(- (point) 2))))
957 (set-buffer gdb-expression-buffer-name
)
959 (concat "{" (replace-regexp-in-string "\n" "" values
)
961 (gdb-array-format1))))
962 ;;else get rid of ##array-section-end etc
964 (setq gdb-nesting-level
(- gdb-nesting-level
1))
965 (gdb-array-format)))))
967 (defvar gdb-array-start
)
968 (defvar gdb-array-stop
)
970 (defvar gdb-array-slice-map
971 (let ((map (make-sparse-keymap)))
972 (define-key map
[mouse-2
] 'gdb-array-slice
)
975 (defun gdb-array-slice (event)
976 "Select an array slice to display."
978 (mouse-set-point event
)
980 (let ((n -
1) (stop 0) (start 0) (point (point)))
982 (while (search-forward "[" point t
)
984 (setq start
(string-to-int (read-string "Start index: ")))
985 (aset gdb-array-start n start
)
986 (setq stop
(string-to-int (read-string "Stop index: ")))
987 (aset gdb-array-stop n stop
)))
990 (defvar gdb-display-string
)
991 (defvar gdb-array-size
)
993 (defun gdb-array-format1 ()
994 (setq gdb-display-string
"")
995 (setq buffer-read-only nil
)
996 (delete-region (point-min) (point-max))
997 (let ((gdb-value-list (split-string gdb-values
", ")))
998 (string-match "\\({+\\)" (car gdb-value-list
))
999 (let* ((depth (- (match-end 1) (match-beginning 1)))
1000 (indices (make-vector depth
'0))
1001 (index 0) (num 0) (array-start "")
1002 (array-stop "") (array-slice "") (array-range nil
)
1003 (flag t
) (indices-string ""))
1004 (dolist (gdb-value gdb-value-list
)
1005 (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value
)
1007 (while (< num depth
)
1008 (setq indices-string
1009 (concat indices-string
1010 "[" (int-to-string (aref indices num
)) "]"))
1011 (if (not (= (aref gdb-array-start num
) -
1))
1012 (if (or (< (aref indices num
) (aref gdb-array-start num
))
1013 (> (aref indices num
) (aref gdb-array-stop num
)))
1015 (aset gdb-array-size num
(aref indices num
)))
1016 (setq num
(+ num
1)))
1018 (let ((gdb-display-value (match-string 1 gdb-value
)))
1019 (setq gdb-display-string
(concat gdb-display-string
" "
1022 (concat indices-string
"\t" gdb-display-value
"\n"))))
1023 (setq indices-string
"")
1025 ;; 0<= index < depth, start at right : (- depth 1)
1026 (setq index
(- (- depth
1)
1027 (- (match-end 2) (match-beginning 2))))
1028 ;;don't set for very last brackets
1030 (aset indices index
(+ 1 (aref indices index
)))
1031 (setq num
(+ 1 index
))
1032 (while (< num depth
)
1033 (aset indices num
0)
1034 (setq num
(+ num
1)))))
1036 (while (< num depth
)
1037 (if (= (aref gdb-array-start num
) -
1)
1039 (aset gdb-array-start num
0)
1040 (aset gdb-array-stop num
(aref indices num
))))
1041 (setq array-start
(int-to-string (aref gdb-array-start num
)))
1042 (setq array-stop
(int-to-string (aref gdb-array-stop num
)))
1043 (setq array-range
(concat "[" array-start
1044 ":" array-stop
"]"))
1045 (put-text-property 1 (+ (length array-start
)
1046 (length array-stop
) 2)
1047 'mouse-face
'highlight array-range
)
1048 (put-text-property 1 (+ (length array-start
)
1049 (length array-stop
) 2)
1050 'local-map gdb-array-slice-map array-range
)
1051 (goto-char (point-min))
1052 (setq array-slice
(concat array-slice array-range
))
1053 (setq num
(+ num
1)))
1054 (goto-char (point-min))
1055 (insert "Array Size : ")
1057 (while (< num depth
)
1060 (int-to-string (+ (aref gdb-array-size num
) 1)) "]"))
1061 (setq num
(+ num
1)))
1063 (concat "\n Slice : " array-slice
"\n\nIndex\tValues\n\n"))))
1064 (setq buffer-read-only t
))
1066 ;; Handle a burst of output from a gdb instance.
1067 ;; This function is (indirectly) used as a gud-marker-filter.
1068 ;; It must return output (if any) to be inserted in the gdb
1071 (defun gdb-output-burst (string)
1072 "Handle a burst of output from a gdb instance.
1073 This function is (indirectly) used as a gud-marker-filter.
1074 It must return output (if any) to be insterted in the gdb
1078 ;; Recall the left over burst from last time
1079 (burst (concat (gdb-instance-burst) string
))
1080 ;; Start accumulating output for the GUD buffer
1083 ;; Process all the complete markers in this chunk.
1084 (while (string-match "\n\032\032\\(.*\\)\n" burst
)
1085 (let ((annotation (match-string 1 burst
)))
1087 ;; Stuff prior to the match is just ordinary output.
1088 ;; It is either concatenated to OUTPUT or directed
1093 (substring burst
0 (match-beginning 0))))
1095 ;; Take that stuff off the burst.
1096 (setq burst
(substring burst
(match-end 0)))
1098 ;; Parse the tag from the annotation, and maybe its arguments.
1099 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation
)
1100 (let* ((annotation-type (match-string 1 annotation
))
1101 (annotation-arguments (match-string 2 annotation
))
1102 (annotation-rule (assoc annotation-type
1103 gdb-annotation-rules
)))
1104 ;; Call the handler for this annotation.
1106 (funcall (car (cdr annotation-rule
))
1107 annotation-arguments
)
1108 ;; Else the annotation is not recognized. Ignore it silently,
1109 ;; so that GDB can add new annotations without causing
1113 ;; Does the remaining text end in a partial line?
1114 ;; If it does, then keep part of the burst until we get more.
1115 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1118 ;; Everything before the potential marker start can be output.
1120 (gdb-concat-output output
1121 (substring burst
0 (match-beginning 0))))
1123 ;; Everything after, we save, to combine with later input.
1124 (setq burst
(substring burst
(match-beginning 0))))
1126 ;; In case we know the burst contains no partial annotations:
1128 (setq output
(gdb-concat-output output burst
))
1131 ;; Save the remaining burst for the next call to this function.
1132 (set-gdb-instance-burst burst
)
1135 (defun gdb-concat-output (so-far new
)
1136 (let ((sink (gdb-instance-output-sink )))
1138 ((eq sink
'user
) (concat so-far new
))
1139 ((or (eq sink
'pre-emacs
) (eq sink
'post-emacs
)) so-far
)
1141 (gdb-append-to-partial-output new
)
1143 ((eq sink
'inferior
)
1144 (gdb-append-to-inferior-io new
)
1146 (t (error "Bogon output sink %S" sink
)))))
1148 (defun gdb-append-to-partial-output (string)
1151 (gdb-get-create-instance-buffer 'gdb-partial-output-buffer
))
1152 (goto-char (point-max))
1155 (defun gdb-clear-partial-output ()
1158 (gdb-get-create-instance-buffer 'gdb-partial-output-buffer
))
1159 (delete-region (point-min) (point-max))))
1161 (defun gdb-append-to-inferior-io (string)
1164 (gdb-get-create-instance-buffer 'gdb-inferior-io
))
1165 (goto-char (point-max))
1166 (insert-before-markers string
))
1168 (gdb-get-create-instance-buffer 'gdb-inferior-io
)))
1170 (defun gdb-clear-inferior-io ()
1173 (gdb-get-create-instance-buffer 'gdb-inferior-io
))
1174 (delete-region (point-min) (point-max))))
1177 ;; One trick is to have a command who's output is always available in
1178 ;; a buffer of it's own, and is always up to date. We build several
1179 ;; buffers of this type.
1181 ;; There are two aspects to this: gdb has to tell us when the output
1182 ;; for that command might have changed, and we have to be able to run
1183 ;; the command behind the user's back.
1185 ;; The idle input queue and the output phasing associated with
1186 ;; the instance variable `(gdb-instance-output-sink)' help
1187 ;; us to run commands behind the user's back.
1189 ;; Below is the code for specificly managing buffers of output from one
1193 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1194 ;; It adds an idle input for the command we are tracking. It should be the
1195 ;; annotation rule binding of whatever gdb sends to tell us this command
1196 ;; might have changed it's output.
1198 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1199 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1200 ;; input in the input queue (see comment about ``gdb communications'' above).
1202 (defmacro def-gdb-auto-update-trigger
(name demand-predicate gdb-command
1204 `(defun ,name
(&optional ignored
)
1205 (if (and (,demand-predicate
)
1207 (gdb-instance-pending-triggers))))
1209 (gdb-instance-enqueue-idle-input
1210 (list ,gdb-command
',output-handler
))
1211 (set-gdb-instance-pending-triggers
1213 (gdb-instance-pending-triggers)))))))
1215 (defmacro def-gdb-auto-update-handler
(name trigger buf-key custom-defun
)
1217 (set-gdb-instance-pending-triggers
1219 (gdb-instance-pending-triggers)))
1220 (let ((buf (gdb-get-instance-buffer ',buf-key
)))
1225 (buffer-read-only nil
))
1226 (delete-region (point-min) (point-max))
1227 (insert-buffer-substring (gdb-get-create-instance-buffer
1228 'gdb-partial-output-buffer
))
1230 ;; put customisation here
1233 (defmacro def-gdb-auto-updated-buffer
(buffer-key trigger-name gdb-command
1234 output-handler-name custom-defun
)
1236 (def-gdb-auto-update-trigger ,trigger-name
1237 ;; The demand predicate:
1238 (lambda () (gdb-get-instance-buffer ',buffer-key
))
1240 ,output-handler-name
)
1241 (def-gdb-auto-update-handler ,output-handler-name
1242 ,trigger-name
,buffer-key
,custom-defun
)))
1246 ;; Breakpoint buffers
1248 ;; These display the output of `info breakpoints'.
1251 (gdb-set-instance-buffer-rules 'gdb-breakpoints-buffer
1252 'gdb-breakpoints-buffer-name
1253 'gdb-breakpoints-mode
)
1255 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1256 ;; This defines the auto update rule for buffers of type
1257 ;; `gdb-breakpoints-buffer'.
1259 ;; It defines a function to serve as the annotation handler that
1260 ;; handles the `foo-invalidated' message. That function is called:
1261 gdb-invalidate-breakpoints
1263 ;; To update the buffer, this command is sent to gdb.
1264 "server info breakpoints\n"
1266 ;; This also defines a function to be the handler for the output
1267 ;; from the command above. That function will copy the output into
1268 ;; the appropriately typed buffer. That function will be called:
1269 gdb-info-breakpoints-handler
1270 ;; buffer specific functions
1271 gdb-info-breakpoints-custom
)
1273 (defvar gdb-cdir nil
"Compilation directory.")
1274 (defvar breakpoint-enabled-icon
)
1275 (defvar breakpoint-disabled-icon
)
1277 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1278 (defun gdb-info-breakpoints-custom ()
1279 (let ((flag)(address))
1281 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1282 (let ((buffers (buffer-list)))
1285 (set-buffer (car buffers
))
1286 (if (and (eq gud-minor-mode
'gdba
)
1287 (not (string-match "^\*" (buffer-name))))
1288 (if (display-graphic-p)
1289 (remove-images (point-min) (point-max))
1290 (remove-strings (point-min) (point-max))))
1291 (setq buffers
(cdr buffers
)))))
1294 (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer
))
1296 (goto-char (point-min))
1297 (while (< (point) (- (point-max) 1))
1299 (if (looking-at "[^\t].*breakpoint")
1301 (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1302 (setq flag
(char-after (match-beginning 2)))
1304 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t
)
1306 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1307 (let ((line (match-string 2))
1308 (file (match-string 1)))
1312 (if (file-exists-p file
) file
1313 (expand-file-name file gdb-cdir
))))
1314 (save-current-buffer
1315 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1316 (set (make-local-variable 'tool-bar-map
)
1318 (setq left-margin-width
2)
1319 (if (get-buffer-window (current-buffer))
1320 (set-window-margins (get-buffer-window
1323 right-margin-width
)))
1324 ;; only want one breakpoint icon at each location
1326 (goto-line (string-to-number line
))
1327 (let ((start (progn (beginning-of-line)
1329 (end (progn (end-of-line) (+ (point) 1))))
1330 (if (display-graphic-p)
1332 (remove-images start end
)
1334 (put-image breakpoint-enabled-icon
1336 "breakpoint icon enabled"
1338 (put-image breakpoint-disabled-icon
(point)
1339 "breakpoint icon disabled"
1341 (remove-strings start end
)
1343 (put-string "B" (point) "enabled"
1345 (put-string "b" (point) "disabled"
1346 'left-margin
)))))))))))
1349 (defun gdb-breakpoints-buffer-name ()
1350 (with-current-buffer gud-comint-buffer
1351 (concat "*breakpoints of " (gdb-instance-target-string) "*")))
1353 (defun gdb-display-breakpoints-buffer ()
1356 (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer
)))
1358 (defun gdb-frame-breakpoints-buffer ()
1360 (switch-to-buffer-other-frame
1361 (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer
)))
1363 (defvar gdb-breakpoints-mode-map
1364 (let ((map (make-sparse-keymap))
1365 (menu (make-sparse-keymap "Breakpoints")))
1366 (define-key menu
[toggle] '("Toggle" . gdb-toggle-bp-this-line))
1367 (define-key menu [delete] '("Delete" . gdb-delete-bp-this-line))
1368 (define-key menu [goto] '("Goto" . gdb-goto-bp-this-line))
1370 (suppress-keymap map)
1371 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1372 (define-key map " " 'gdb-toggle-bp-this-line)
1373 (define-key map "d" 'gdb-delete-bp-this-line)
1374 (define-key map "g" 'gdb-goto-bp-this-line)
1377 (defun gdb-breakpoints-mode ()
1378 "Major mode for gdb breakpoints.
1380 \\{gdb-breakpoints-mode-map}"
1381 (setq major-mode 'gdb-breakpoints-mode)
1382 (setq mode-name "Breakpoints")
1383 (use-local-map gdb-breakpoints-mode-map)
1384 (setq buffer-read-only t)
1385 (gdb-invalidate-breakpoints))
1387 (defun gdb-toggle-bp-this-line ()
1388 "Enable/disable the breakpoint of the current line."
1391 (beginning-of-line 1)
1392 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1393 (error "Not recognized as break/watchpoint line")
1394 (gdb-instance-enqueue-idle-input
1397 (if (eq ?y (char-after (match-beginning 2)))
1404 (defun gdb-delete-bp-this-line ()
1405 "Delete the breakpoint of the current line."
1407 (beginning-of-line 1)
1408 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1409 (error "Not recognized as break/watchpoint line")
1410 (gdb-instance-enqueue-idle-input
1418 (defvar gdb-source-window nil)
1420 (defun gdb-goto-bp-this-line ()
1421 "Display the file in the source buffer at the specified breakpoint."
1424 (beginning-of-line 1)
1425 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1426 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1427 (if (match-string 2)
1428 (let ((line (match-string 2))
1429 (file (match-string 1)))
1430 (save-selected-window
1431 (select-window gdb-source-window)
1432 (switch-to-buffer (find-file-noselect
1433 (if (file-exists-p file)
1435 (expand-file-name file gdb-cdir))))
1436 (goto-line (string-to-number line))))))
1439 ;; Frames buffers. These display a perpetually correct bactracktrace
1440 ;; (from the command `where').
1442 ;; Alas, if your stack is deep, they are costly.
1445 (gdb-set-instance-buffer-rules 'gdb-stack-buffer
1446 'gdb-stack-buffer-name
1449 (def-gdb-auto-updated-buffer gdb-stack-buffer
1450 gdb-invalidate-frames
1452 gdb-info-frames-handler
1453 gdb-info-frames-custom)
1455 (defun gdb-info-frames-custom ()
1457 (set-buffer (gdb-get-instance-buffer 'gdb-stack-buffer))
1458 (let ((buffer-read-only nil))
1459 (goto-char (point-min))
1460 (looking-at "\\S-*\\s-*\\(\\S-*\\)")
1461 (setq gdb-current-frame (match-string 1))
1462 (while (< (point) (point-max))
1463 (put-text-property (progn (beginning-of-line) (point))
1464 (progn (end-of-line) (point))
1465 'mouse-face 'highlight)
1466 (forward-line 1)))))
1468 (defun gdb-stack-buffer-name ()
1469 (with-current-buffer gud-comint-buffer
1470 (concat "*stack frames of "
1471 (gdb-instance-target-string) "*")))
1473 (defun gdb-display-stack-buffer ()
1476 (gdb-get-create-instance-buffer 'gdb-stack-buffer)))
1478 (defun gdb-frame-stack-buffer ()
1480 (switch-to-buffer-other-frame
1481 (gdb-get-create-instance-buffer 'gdb-stack-buffer)))
1483 (defvar gdb-frames-mode-map
1484 (let ((map (make-sparse-keymap)))
1485 (suppress-keymap map)
1486 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1489 (defun gdb-frames-mode ()
1490 "Major mode for gdb frames.
1492 \\{gdb-frames-mode-map}"
1493 (setq major-mode 'gdb-frames-mode)
1494 (setq mode-name "Frames")
1495 (setq buffer-read-only t)
1496 (use-local-map gdb-frames-mode-map)
1497 (gdb-invalidate-frames))
1499 (defun gdb-get-frame-number ()
1501 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1502 (n (or (and pos (string-to-int (match-string 1))) 0)))
1505 (defun gdb-frames-mouse-select (e)
1506 "Make the selected frame become the current frame and
1507 display the source in the source buffer."
1511 (set-buffer (window-buffer (posn-window (event-end e))))
1513 (goto-char (posn-point (event-end e)))
1514 (setq selection (gdb-get-frame-number))))
1515 (select-window (posn-window (event-end e)))
1517 (set-buffer gud-comint-buffer)
1518 (gdb-instance-enqueue-idle-input
1519 (list (gud-format-command "server frame %p\n" selection)
1521 (gud-display-frame))))
1525 ;; Registers buffers
1528 (def-gdb-auto-updated-buffer gdb-registers-buffer
1529 gdb-invalidate-registers
1530 "server info registers\n"
1531 gdb-info-registers-handler
1532 gdb-info-registers-custom)
1534 (defun gdb-info-registers-custom ())
1536 (gdb-set-instance-buffer-rules 'gdb-registers-buffer
1537 'gdb-registers-buffer-name
1538 'gdb-registers-mode)
1540 (defvar gdb-registers-mode-map
1541 (let ((map (make-sparse-keymap)))
1542 (suppress-keymap map)
1545 (defun gdb-registers-mode ()
1546 "Major mode for gdb registers.
1548 \\{gdb-registers-mode-map}"
1549 (setq major-mode 'gdb-registers-mode)
1550 (setq mode-name "Registers")
1551 (setq buffer-read-only t)
1552 (use-local-map gdb-registers-mode-map)
1553 (gdb-invalidate-registers))
1555 (defun gdb-registers-buffer-name ()
1556 (with-current-buffer gud-comint-buffer
1557 (concat "*registers of " (gdb-instance-target-string) "*")))
1559 (defun gdb-display-registers-buffer ()
1562 (gdb-get-create-instance-buffer 'gdb-registers-buffer)))
1564 (defun gdb-frame-registers-buffer ()
1566 (switch-to-buffer-other-frame
1567 (gdb-get-create-instance-buffer 'gdb-registers-buffer)))
1573 (def-gdb-auto-updated-buffer gdb-locals-buffer
1574 gdb-invalidate-locals
1575 "server info locals\n"
1576 gdb-info-locals-handler
1577 gdb-info-locals-custom)
1580 ;;Abbreviate for arrays and structures. These can be expanded using gud-display
1581 (defun gdb-info-locals-handler nil
1582 (set-gdb-instance-pending-triggers (delq 'gdb-invalidate-locals
1583 (gdb-instance-pending-triggers)))
1584 (let ((buf (gdb-get-instance-buffer 'gdb-partial-output-buffer)))
1587 (goto-char (point-min))
1588 (while (re-search-forward "^ .*\n" nil t)
1589 (replace-match "" nil nil))
1590 (goto-char (point-min))
1591 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1592 (replace-match "(array);\n" nil nil))
1593 (goto-char (point-min))
1594 (while (re-search-forward "{.*=.*\n" nil t)
1595 (replace-match "(structure);\n" nil nil))))
1596 (let ((buf (gdb-get-instance-buffer 'gdb-locals-buffer)))
1597 (and buf (save-excursion
1600 (buffer-read-only nil))
1601 (delete-region (point-min) (point-max))
1602 (insert-buffer-substring (gdb-get-create-instance-buffer
1603 'gdb-partial-output-buffer))
1605 (run-hooks 'gdb-info-locals-hook))
1607 (defun gdb-info-locals-custom ()
1610 (gdb-set-instance-buffer-rules 'gdb-locals-buffer
1611 'gdb-locals-buffer-name
1614 (defvar gdb-locals-mode-map
1615 (let ((map (make-sparse-keymap)))
1616 (suppress-keymap map)
1619 (defun gdb-locals-mode ()
1620 "Major mode for gdb locals.
1622 \\{gdb-locals-mode-map}"
1623 (setq major-mode 'gdb-locals-mode)
1624 (setq mode-name "Locals")
1625 (setq buffer-read-only t)
1626 (use-local-map gdb-locals-mode-map)
1627 (gdb-invalidate-locals))
1629 (defun gdb-locals-buffer-name ()
1630 (with-current-buffer gud-comint-buffer
1631 (concat "*locals of " (gdb-instance-target-string) "*")))
1633 (defun gdb-display-locals-buffer ()
1636 (gdb-get-create-instance-buffer 'gdb-locals-buffer)))
1638 (defun gdb-frame-locals-buffer ()
1640 (switch-to-buffer-other-frame
1641 (gdb-get-create-instance-buffer 'gdb-locals-buffer)))
1643 ;; Display expression buffers (just allow one to start with)
1645 (gdb-set-instance-buffer-rules 'gdb-display-buffer
1646 'gdb-display-buffer-name
1649 (def-gdb-auto-updated-buffer gdb-display-buffer
1650 ;; `gdb-display-buffer'.
1651 gdb-invalidate-display
1652 "server info display\n"
1653 gdb-info-display-handler
1654 gdb-info-display-custom)
1656 (defun gdb-info-display-custom ()
1657 ;; TODO: ensure frames of expressions that have been deleted are also deleted
1658 ;; these can be missed currently eg through GUD buffer, restarting a
1659 ;; recompiled program.
1662 (defvar gdb-display-mode-map
1663 (let ((map (make-sparse-keymap))
1664 (menu (make-sparse-keymap "Display")))
1665 (define-key menu [toggle] '("Toggle" . gdb-toggle-disp-this-line
))
1666 (define-key menu
[delete] '("Delete" . gdb-delete-disp-this-line))
1668 (suppress-keymap map)
1669 (define-key map [menu-bar display] (cons "Display" menu))
1670 (define-key map " " 'gdb-toggle-disp-this-line)
1671 (define-key map "d" 'gdb-delete-disp-this-line)
1674 (defun gdb-display-mode ()
1675 "Major mode for gdb display.
1677 \\{gdb-display-mode-map}"
1678 (setq major-mode 'gdb-display-mode)
1679 (setq mode-name "Display")
1680 (setq buffer-read-only t)
1681 (use-local-map gdb-display-mode-map)
1682 (gdb-invalidate-display))
1684 (defun gdb-display-buffer-name ()
1685 (with-current-buffer gud-comint-buffer
1686 (concat "*Displayed expressions of " (gdb-instance-target-string) "*")))
1688 (defun gdb-display-display-buffer ()
1691 (gdb-get-create-instance-buffer 'gdb-display-buffer)))
1693 (defun gdb-frame-display-buffer ()
1695 (switch-to-buffer-other-frame
1696 (gdb-get-create-instance-buffer 'gdb-display-buffer)))
1698 (defun gdb-toggle-disp-this-line ()
1699 "Enable/disable the displayed expression of the current line."
1702 (beginning-of-line 1)
1703 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1704 (error "No expression on this line")
1705 (gdb-instance-enqueue-idle-input
1708 (if (eq ?y (char-after (match-beginning 2)))
1709 "server disable display "
1710 "server enable display ")
1715 (defun gdb-delete-disp-this-line ()
1716 "Delete the displayed expression of the current line."
1720 (gdb-get-instance-buffer 'gdb-display-buffer))
1721 (beginning-of-line 1)
1722 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1723 (error "No expression on this line")
1724 (let ((number (match-string 1)))
1725 (gdb-instance-enqueue-idle-input
1726 (list (concat "server delete display " number "\n")
1728 (if (not (display-graphic-p))
1729 (kill-buffer (get-buffer (concat "*display " number "*")))
1731 (let ((frames (frame-list)))
1733 (if (string-equal (frame-parameter (car frames) 'name)
1734 (concat "*display " number "*"))
1736 (get-buffer (concat "*display " number "*")))
1737 (delete-frame (car frames))
1738 (throw 'frame-found nil)))
1739 (setq frames (cdr frames))))))))))
1741 (defvar gdb-expressions-mode-map
1742 (let ((map (make-sparse-keymap)))
1743 (suppress-keymap map)
1744 (define-key map "v" 'gdb-array-visualise)
1745 (define-key map "q" 'gdb-delete-display)
1746 (define-key map [mouse-3] 'gdb-expressions-popup-menu)
1749 (defvar gdb-expressions-mode-menu
1750 '("GDB Expressions Commands"
1752 ["Visualise" gdb-array-visualise t]
1753 ["Delete" gdb-delete-display t])
1754 "Menu for `gdb-expressions-mode'.")
1756 (defun gdb-expressions-popup-menu (event)
1757 "Explicit Popup menu as this buffer doesn't have a menubar."
1759 (mouse-set-point event)
1760 (popup-menu gdb-expressions-mode-menu))
1762 (defun gdb-expressions-mode ()
1763 "Major mode for display expressions.
1765 \\{gdb-expressions-mode-map}"
1766 (setq major-mode 'gdb-expressions-mode)
1767 (setq mode-name "Expressions")
1768 (use-local-map gdb-expressions-mode-map)
1769 (make-local-variable 'gdb-display-number)
1770 (make-local-variable 'gdb-values)
1771 (make-local-variable 'gdb-expression)
1772 (set (make-local-variable 'gdb-display-string) nil)
1773 (set (make-local-variable 'gdb-dive-display-number) nil)
1774 (set (make-local-variable 'gud-minor-mode) 'gdba)
1775 (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1))
1776 (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1))
1777 (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1))
1778 (setq buffer-read-only t))
1781 ;;;; Window management
1783 ;;; FIXME: This should only return true for buffers in the current gdb-proc
1784 (defun gdb-protected-buffer-p (buffer)
1785 "Is BUFFER a buffer which we want to leave displayed?"
1786 (with-current-buffer buffer
1787 (or gdb-buffer-type overlay-arrow-position)))
1789 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1790 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1791 ;;; get at the use_time field of a window, I'm not sure there exists a
1792 ;;; more elegant solution without writing C code.
1794 (defun gdb-display-buffer (buf &optional size)
1795 (let ((must-split nil)
1801 (if (gdb-protected-buffer-p (window-buffer win))
1802 (set-window-dedicated-p win t))))
1803 (setq answer (get-buffer-window buf))
1805 (let ((window (get-lru-window)))
1808 (set-window-buffer window buf)
1809 (setq answer window))
1810 (setq must-split t)))))
1813 (if (gdb-protected-buffer-p (window-buffer win))
1814 (set-window-dedicated-p win nil)))))
1816 (let* ((largest (get-largest-window))
1817 (cur-size (window-height largest))
1818 (new-size (and size (< size cur-size) (- cur-size size))))
1819 (setq answer (split-window largest new-size))
1820 (set-window-buffer answer buf)))
1823 (defun gdb-display-source-buffer (buffer)
1824 (set-window-buffer gdb-source-window buffer))
1827 ;;; Shared keymap initialization:
1829 (defun gdb-display-gdb-buffer ()
1832 (gdb-get-create-instance-buffer 'gdba)))
1834 (let ((menu (make-sparse-keymap "GDB-Windows")))
1835 (define-key gud-menu-map [displays]
1836 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1837 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1838 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1839 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1840 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1841 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1842 (define-key menu [display] '("Display" . gdb-display-display-buffer))
1843 (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer)))
1845 (defun gdb-frame-gdb-buffer ()
1847 (switch-to-buffer-other-frame
1848 (gdb-get-create-instance-buffer 'gdba)))
1850 (let ((menu (make-sparse-keymap "GDB-Frames")))
1851 (define-key gud-menu-map [frames]
1852 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1853 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1854 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1855 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1856 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1857 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1858 (define-key menu [display] '("Display" . gdb-frame-display-buffer))
1859 (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer)))
1861 (defvar gdb-main-file nil "Source file from which program execution begins.")
1863 ;; layout for all the windows
1864 (defun gdb-setup-windows ()
1865 (gdb-display-locals-buffer)
1866 (gdb-display-stack-buffer)
1867 (delete-other-windows)
1868 (gdb-display-breakpoints-buffer)
1869 (gdb-display-display-buffer)
1870 (delete-other-windows)
1871 (split-window nil ( / ( * (window-height) 3) 4))
1872 (split-window nil ( / (window-height) 3))
1873 (split-window-horizontally)
1875 (switch-to-buffer (gdb-locals-buffer-name))
1878 (if gud-last-last-frame
1879 (gud-find-file (car gud-last-last-frame))
1880 (gud-find-file gdb-main-file)))
1881 (setq gdb-source-window (get-buffer-window (current-buffer)))
1882 (split-window-horizontally)
1884 (switch-to-buffer (gdb-inferior-io-name))
1886 (switch-to-buffer (gdb-stack-buffer-name))
1887 (split-window-horizontally)
1889 (switch-to-buffer (gdb-breakpoints-buffer-name))
1892 (define-minor-mode gdb-many-windows
1893 "Toggle the number of windows in the basic arrangement."
1896 (gdb-restore-windows))
1898 (defun gdb-restore-windows ()
1899 "Restore the basic arrangement of windows used by gdba.
1900 This arrangement depends on the value of `gdb-many-windows'."
1902 (if gdb-many-windows
1904 (switch-to-buffer gud-comint-buffer)
1905 (delete-other-windows)
1906 (gdb-setup-windows))
1907 (switch-to-buffer gud-comint-buffer)
1908 (delete-other-windows)
1912 (if gud-last-last-frame
1913 (gud-find-file (car gud-last-last-frame))
1914 (gud-find-file gdb-main-file)))
1917 (defconst breakpoint-xpm-data "/* XPM */
1918 static char *magick[] = {
1919 /* columns rows colors chars-per-pixel */
1937 "XPM file used for breakpoint icon.")
1939 (defvar breakpoint-enabled-icon
1940 (find-image `((:type xpm :data ,breakpoint-xpm-data)))
1941 "Icon for enabled breakpoint in display margin")
1942 (defvar breakpoint-disabled-icon
1943 (find-image `((:type xpm :data ,breakpoint-xpm-data
1944 :conversion laplace)))
1945 "Icon for disabled breakpoint in display margin")
1948 "Kill the GUD and instance buffers and reset variables.
1949 Use this command to exit a debugging session cleanly and reset
1950 things like the toolbar and margin in the source buffers."
1952 (let ((buffers (buffer-list)))
1955 (set-buffer (car buffers))
1956 (if (eq gud-minor-mode 'gdba)
1957 (if (string-match "^\*" (buffer-name))
1959 (if (display-graphic-p)
1960 (remove-images (point-min) (point-max))
1961 (remove-strings (point-min) (point-max)))
1962 (setq left-margin-width 0)
1963 (setq gud-minor-mode nil)
1964 (kill-local-variable 'tool-bar-map)
1965 (setq gud-running nil)
1966 (if (get-buffer-window (current-buffer))
1967 (set-window-margins (get-buffer-window
1970 right-margin-width))))
1971 (setq buffers (cdr buffers)))))
1972 (if (eq (selected-window) (minibuffer-window))
1974 (delete-other-windows))
1976 (defun gdb-source-info ()
1977 "Find the source file where the program starts and displays it with related
1979 (goto-char (point-min))
1980 (when (search-forward "directory is " nil t)
1981 (looking-at "\\S-*")
1982 (setq gdb-cdir (match-string 0))
1983 (search-forward "Located in ")
1984 (looking-at "\\S-*")
1985 (setq gdb-main-file (match-string 0))
1986 ;; Make sure we are not in the minibuffer window when we try to delete
1987 ;; all other windows.
1988 (if (window-minibuffer-p (selected-window))
1990 (delete-other-windows)
1991 (if gdb-many-windows
1993 (gdb-display-breakpoints-buffer)
1994 (gdb-display-display-buffer)
1995 (gdb-display-stack-buffer)
1996 (delete-other-windows)
1999 (switch-to-buffer (gud-find-file gdb-main-file))
2001 (setq gdb-source-window (get-buffer-window (current-buffer))))))
2004 (defun put-string (putstring pos &optional string area)
2005 "Put string PUTSTRING in front of POS in the current buffer.
2006 PUTSTRING is displayed by putting an overlay into the current buffer with a
2007 `before-string' STRING that has a `display' property whose value is
2008 PUTSTRING. STRING is defaulted if you omit it.
2009 POS may be an integer or marker.
2010 AREA is where to display the string. AREA nil or omitted means
2011 display it in the text area, a value of `left-margin' means
2012 display it in the left marginal area, a value of `right-margin'
2013 means display it in the right marginal area."
2014 (unless string (setq string "x"))
2015 (let ((buffer (current-buffer)))
2016 (unless (or (null area) (memq area '(left-margin right-margin)))
2017 (error "Invalid area %s" area))
2018 (setq string (copy-sequence string))
2019 (let ((overlay (make-overlay pos pos buffer))
2020 (prop (if (null area) putstring (list (list 'margin area) putstring))))
2021 (put-text-property 0 (length string) 'display prop string)
2022 (overlay-put overlay 'put-text t)
2023 (overlay-put overlay 'before-string string))))
2025 ;;from remove-images
2026 (defun remove-strings (start end &optional buffer)
2027 "Remove strings between START and END in BUFFER.
2028 Remove only images that were put in BUFFER with calls to `put-string'.
2029 BUFFER nil or omitted means use the current buffer."
2031 (setq buffer (current-buffer)))
2032 (let ((overlays (overlays-in start end)))
2034 (let ((overlay (car overlays)))
2035 (when (overlay-get overlay 'put-text)
2036 (delete-overlay overlay)))
2037 (setq overlays (cdr overlays)))))
2039 (defun put-arrow (putstring pos &optional string area)
2040 "Put arrow string PUTSTRING in front of POS in the current buffer.
2041 PUTSTRING is displayed by putting an overlay into the current buffer with a
2042 `before-string' \"gdb-arrow\" that has a `display' property whose value is
2043 PUTSTRING. STRING is defaulted if you omit it.
2044 POS may be an integer or marker.
2045 AREA is where to display the string. AREA nil or omitted means
2046 display it in the text area, a value of `left-margin' means
2047 display it in the left marginal area, a value of `right-margin'
2048 means display it in the right marginal area."
2049 (setq string "gdb-arrow")
2050 (let ((buffer (current-buffer)))
2051 (unless (or (null area) (memq area '(left-margin right-margin)))
2052 (error "Invalid area %s" area))
2053 (setq string (copy-sequence string))
2054 (let ((overlay (make-overlay pos pos buffer))
2055 (prop (if (null area) putstring (list (list 'margin area) putstring))))
2056 (put-text-property 0 (length string) 'display prop string)
2057 (overlay-put overlay 'put-text t)
2058 (overlay-put overlay 'before-string string))))
2060 (defun remove-arrow (&optional buffer)
2061 "Remove arrow in BUFFER.
2062 Remove only images that were put in BUFFER with calls to `put-arrow'.
2063 BUFFER nil or omitted means use the current buffer."
2065 (setq buffer (current-buffer)))
2066 (let ((overlays (overlays-in (point-min) (point-max))))
2068 (let ((overlay (car overlays)))
2069 (when (string-equal (overlay-get overlay 'before-string) "gdb-arrow")
2070 (delete-overlay overlay)))
2071 (setq overlays (cdr overlays)))))
2073 (defun gdb-array-visualise ()
2074 "Visualise arrays and slices using graph program from plotutils."
2076 (when (and (display-graphic-p) gdb-display-string)
2078 (catch 'multi-dimensional
2079 (while (eq (aref gdb-array-start n) (aref gdb-array-stop n))
2082 (while (< m (length gdb-array-start))
2083 (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m)))
2086 t `(,(concat "Only one dimensional data can be visualised.\n"
2087 "Use an array slice to reduce the number of\n"
2088 "dimensions") ("OK" t)))
2089 (throw 'multi-dimensional nil))
2091 (shell-command (concat "echo" gdb-display-string " | graph -a 1 "
2092 (int-to-string (aref gdb-array-start n))
2094 (int-to-string (aref gdb-array-start n))
2096 (int-to-string (aref gdb-array-stop n))
2099 (defun gdb-delete-display ()
2100 "Delete displayed expression and its frame."
2102 (gdb-instance-enqueue-idle-input
2103 (list (concat "server delete display " gdb-display-number "\n")
2112 (def-gdb-auto-updated-buffer gdb-assembler-buffer
2113 gdb-invalidate-assembler
2114 (concat "server disassemble " gdb-main-or-pc "\n")
2115 gdb-assembler-handler
2116 gdb-assembler-custom)
2118 (defun gdb-assembler-custom ()
2119 (let ((buffer (gdb-get-instance-buffer 'gdb-assembler-buffer))
2120 (gdb-arrow-position) (address) (flag))
2121 (if gdb-current-address
2126 (goto-char (point-min))
2127 (re-search-forward gdb-current-address)
2128 (setq gdb-arrow-position (point))
2129 (put-arrow "=>" gdb-arrow-position nil 'left-margin))))
2131 ;; remove all breakpoint-icons in assembler buffer before updating.
2134 (if (display-graphic-p)
2135 (remove-images (point-min) (point-max))
2136 (remove-strings (point-min) (point-max))))
2138 (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer))
2139 (goto-char (point-min))
2140 (while (< (point) (- (point-max) 1))
2142 (if (looking-at "[^\t].*breakpoint")
2145 "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x0\\(\\S-*\\)")
2146 ;; info break gives '0x0' (8 digit) while dump gives '0x' (7 digit)
2147 (setq address (concat "0x" (match-string 3)))
2148 (setq flag (char-after (match-beginning 2)))
2151 (goto-char (point-min))
2152 (if (re-search-forward address nil t)
2153 (let ((start (progn (beginning-of-line) (- (point) 1)))
2154 (end (progn (end-of-line) (+ (point) 1))))
2155 (if (display-graphic-p)
2157 (remove-images start end)
2159 (put-image breakpoint-enabled-icon (point)
2160 "breakpoint icon enabled"
2162 (put-image breakpoint-disabled-icon (point)
2163 "breakpoint icon disabled"
2165 (remove-strings start end)
2167 (put-string "B" (point) "enabled" 'left-margin)
2168 (put-string "b" (point) "disabled"
2169 'left-margin))))))))))
2170 (if gdb-current-address
2171 (set-window-point (get-buffer-window buffer) gdb-arrow-position))))
2173 (gdb-set-instance-buffer-rules 'gdb-assembler-buffer
2174 'gdb-assembler-buffer-name
2175 'gdb-assembler-mode)
2177 (defvar gdb-assembler-mode-map
2178 (let ((map (make-sparse-keymap)))
2179 (suppress-keymap map)
2182 (defun gdb-assembler-mode ()
2183 "Major mode for viewing code assembler.
2185 \\{gdb-assembler-mode-map}"
2186 (setq major-mode 'gdb-assembler-mode)
2187 (setq mode-name "Assembler")
2188 (setq left-margin-width 2)
2189 (setq buffer-read-only t)
2190 (use-local-map gdb-assembler-mode-map)
2191 (gdb-invalidate-assembler)
2192 (gdb-invalidate-breakpoints))
2194 (defun gdb-assembler-buffer-name ()
2195 (with-current-buffer gud-comint-buffer
2196 (concat "*Machine Code " (gdb-instance-target-string) "*")))
2198 (defun gdb-display-assembler-buffer ()
2201 (gdb-get-create-instance-buffer 'gdb-assembler-buffer)))
2203 (defun gdb-frame-assembler-buffer ()
2205 (switch-to-buffer-other-frame
2206 (gdb-get-create-instance-buffer 'gdb-assembler-buffer)))
2208 (defun gdb-invalidate-frame-and-assembler (&optional ignored)
2209 (gdb-invalidate-frames)
2210 (gdb-invalidate-assembler))
2212 (defun gdb-invalidate-breakpoints-and-assembler (&optional ignored)
2213 (gdb-invalidate-breakpoints)
2214 (gdb-invalidate-assembler))
2216 (defvar gdb-prev-main-or-pc nil)
2218 ;; modified because if gdb-main-or-pc has changed value a new command
2219 ;; must be enqueued to update the buffer with the new output
2220 (defun gdb-invalidate-assembler (&optional ignored)
2221 (if (and (gdb-get-instance-buffer 'gdb-assembler-buffer)
2222 (or (not (member 'gdb-invalidate-assembler
2223 (gdb-instance-pending-triggers)))
2224 (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc))))
2227 ;; take previous disassemble command off the queue
2229 (set-buffer gud-comint-buffer)
2230 (let ((queue gdb-idle-input-queue) (item))
2232 (setq item (car queue))
2233 (if (equal (cdr item) '(gdb-assembler-handler))
2234 (delete item gdb-idle-input-queue))
2235 (setq queue (cdr queue)))))
2237 (gdb-instance-enqueue-idle-input
2238 (list (concat "server disassemble " gdb-main-or-pc "\n")
2239 'gdb-assembler-handler))
2240 (set-gdb-instance-pending-triggers
2241 (cons 'gdb-invalidate-assembler
2242 (gdb-instance-pending-triggers)))
2243 (setq gdb-prev-main-or-pc gdb-main-or-pc))))
2247 ;;; gdb-ui.el ends here