(inferior-emacs-lisp-mode): Bind comint-dynamic-complete-functions locally.
[emacs.git] / lisp / gdb-ui.el
blob72d30d3e226a78f8800bf58f449b163375248355
1 ;;; gdb-ui.el --- User Interface for running GDB
3 ;; Author: Nick Roberts <nick@nick.uklinux.net>
4 ;; Maintainer: FSF
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)
14 ;; any later version.
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.
26 ;;; Commentary:
28 ;; This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim
29 ;; Kingdon and uses GDB's annotation interface. It has been extended to use
30 ;; features of Emacs 21 such as the display margin for breakpoints and the
31 ;; toolbar. It also has new buffers and lots of other new features such as
32 ;; formatted auto-display of arrays and structures (see the GDB-UI section in
33 ;; the Emacs info manual). Start the debugger with M-x gdba.
35 ;; You don't need to know about annotations to use this mode as a graphical
36 ;; user interface to GDB. However, if you are interested developing the mode
37 ;; itself see the Annotations section in the GDB info manual.
39 ;; Known Bugs: Does not auto-display arrays of structures or structures
40 ;; containing arrays.
42 ;;; Code:
44 (require 'gud)
46 (defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.")
47 (defvar gdb-current-address nil)
48 (defvar gdb-display-in-progress nil)
49 (defvar gdb-dive nil)
50 (defvar gdb-buffer-type nil)
51 (defvar gdb-variables '()
52 "A list of variables that are local to the GUD buffer.")
55 ;;;###autoload
56 (defun gdba (command-line)
57 "Run gdb on program FILE in buffer *gud-FILE*.
58 The directory containing FILE becomes the initial working directory
59 and source-file directory for your debugger.
61 If `gdb-many-windows' is nil (the default value) then gdb starts with
62 just two windows : the GUD and the source buffer. If it is t the
63 following layout will appear (keybindings given in relevant buffer) :
65 ---------------------------------------------------------------------
66 GDB Toolbar
67 ---------------------------------------------------------------------
68 GUD buffer (I/O of GDB) | Locals buffer
72 ---------------------------------------------------------------------
73 Source buffer | Input/Output (of debuggee) buffer
74 | (comint-mode)
81 ---------------------------------------------------------------------
82 Stack buffer | Breakpoints buffer
83 RET gdb-frames-select | SPC gdb-toggle-breakpoint
84 | RET gdb-goto-breakpoint
85 | d gdb-delete-breakpoint
86 ---------------------------------------------------------------------
88 All the buffers share the toolbar and source should always display in the same
89 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
90 icons are displayed both by setting a break with gud-break and by typing break
91 in the GUD buffer.
93 This works best (depending on the size of your monitor) using most of the
94 screen.
96 Displayed expressions appear in separate frames. Arrays may be displayed
97 as slices and visualised using the graph program from plotutils if installed.
98 Pointers in structures may be followed in a tree-like fashion.
100 The following interactive lisp functions help control operation :
102 `gdb-many-windows' - Toggle the number of windows gdb uses.
103 `gdb-restore-windows' - To restore the window layout.
104 `gdb-quit' - To delete (most) of the buffers used by GDB-UI and
105 reset variables."
107 (interactive (list (gud-query-cmdline 'gdba)))
109 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
110 (gdb command-line)
112 (set (make-local-variable 'gud-minor-mode) 'gdba)
113 (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)
115 (gud-def gud-break (if (not (string-equal mode-name "Assembler"))
116 (gud-call "break %f:%l" arg)
117 (save-excursion
118 (beginning-of-line)
119 (forward-char 2)
120 (gud-call "break *%a" arg)))
121 "\C-b" "Set breakpoint at current line or address.")
123 (gud-def gud-remove (if (not (string-equal mode-name "Assembler"))
124 (gud-call "clear %f:%l" arg)
125 (save-excursion
126 (beginning-of-line)
127 (forward-char 2)
128 (gud-call "clear *%a" arg)))
129 "\C-d" "Remove breakpoint at current line or address.")
131 (setq comint-input-sender 'gdb-send)
133 ;; (re-)initialise
134 (setq gdb-main-or-pc "main")
135 (setq gdb-current-address nil)
136 (setq gdb-display-in-progress nil)
137 (setq gdb-dive nil)
139 (mapc 'make-local-variable gdb-variables)
140 (setq gdb-buffer-type 'gdba)
142 (gdb-clear-inferior-io)
144 (gdb-enqueue-input (list "set height 0\n" 'ignore))
145 ;; find source file and compilation directory here
146 (gdb-enqueue-input (list "server list\n" 'ignore))
147 (gdb-enqueue-input (list "server info source\n"
148 'gdb-source-info))
150 (run-hooks 'gdba-mode-hook))
152 (defun gud-display ()
153 "Auto-display (possibly dereferenced) C expression at point."
154 (interactive)
155 (save-excursion
156 (let ((expr (gud-find-c-expr)))
157 (gdb-enqueue-input
158 (list (concat "server ptype " expr "\n")
159 `(lambda () (gud-display1 ,expr)))))))
161 (defun gud-display1 (expr)
162 (goto-char (point-min))
163 (if (looking-at "No symbol")
164 (progn
165 (gdb-set-output-sink 'user)
166 (gud-call (concat "server ptype " expr)))
167 (goto-char (- (point-max) 1))
168 (if (equal (char-before) (string-to-char "\*"))
169 (gdb-enqueue-input
170 (list (concat "server display* " expr "\n") 'ignore))
171 (gdb-enqueue-input
172 (list (concat "server display " expr "\n") 'ignore)))))
174 ; this would messy because these bindings don't work with M-x gdb
175 ; (define-key global-map "\C-x\C-a\C-a" 'gud-display)
176 ; (define-key gud-minor-mode-map "\C-c\C-a" 'gud-display)
180 ;; ======================================================================
182 ;; In this world, there are gdb variables (of unspecified
183 ;; representation) and buffers associated with those objects.
184 ;; The list of variables is built up by the expansions of
185 ;; def-gdb-variable
187 (defmacro def-gdb-var (root-symbol &optional default doc)
188 (let* ((root (symbol-name root-symbol))
189 (accessor (intern (concat "gdb-get-" root)))
190 (setter (intern (concat "gdb-set-" root)))
191 (name (intern (concat "gdb-" root))))
192 `(progn
193 (defvar ,name ,default ,doc)
194 (if (not (memq ',name gdb-variables))
195 (push ',name gdb-variables))
196 (defun ,accessor ()
197 (buffer-local-value ',name gud-comint-buffer))
198 (defun ,setter (val)
199 (with-current-buffer gud-comint-buffer
200 (setq ,name val))))))
202 (def-gdb-var buffer-type nil
203 "One of the symbols bound in gdb-buffer-rules")
205 (def-gdb-var burst ""
206 "A string of characters from gdb that have not yet been processed.")
208 (def-gdb-var input-queue ()
209 "A list of high priority gdb command objects.")
211 (def-gdb-var idle-input-queue ()
212 "A list of low priority gdb command objects.")
214 (def-gdb-var prompting nil
215 "True when gdb is idle with no pending input.")
217 (def-gdb-var output-sink 'user
218 "The disposition of the output of the current gdb command.
219 Possible values are these symbols:
221 user -- gdb output should be copied to the GUD buffer
222 for the user to see.
224 inferior -- gdb output should be copied to the inferior-io buffer
226 pre-emacs -- output should be ignored util the post-prompt
227 annotation is received. Then the output-sink
228 becomes:...
229 emacs -- output should be collected in the partial-output-buffer
230 for subsequent processing by a command. This is the
231 disposition of output generated by commands that
232 gdb mode sends to gdb on its own behalf.
233 post-emacs -- ignore input until the prompt annotation is
234 received, then go to USER disposition.
237 (def-gdb-var current-item nil
238 "The most recent command item sent to gdb.")
240 (def-gdb-var pending-triggers '()
241 "A list of trigger functions that have run later than their output
242 handlers.")
244 ;; end of gdb variables
246 (defun gdb-get-target-string ()
247 (with-current-buffer gud-comint-buffer
248 gud-target-name))
252 ;; gdb buffers.
254 ;; Each buffer has a TYPE -- a symbol that identifies the function
255 ;; of that particular buffer.
257 ;; The usual gdb interaction buffer is given the type `gdba' and
258 ;; is constructed specially.
260 ;; Others are constructed by gdb-get-create-buffer and
261 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
263 (defvar gdb-buffer-rules-assoc '())
265 (defun gdb-get-buffer (key)
266 "Return the gdb buffer tagged with type KEY.
267 The key should be one of the cars in `gdb-buffer-rules-assoc'."
268 (save-excursion
269 (gdb-look-for-tagged-buffer key (buffer-list))))
271 (defun gdb-get-create-buffer (key)
272 "Create a new gdb buffer of the type specified by KEY.
273 The key should be one of the cars in `gdb-buffer-rules-assoc'."
274 (or (gdb-get-buffer key)
275 (let* ((rules (assoc key gdb-buffer-rules-assoc))
276 (name (funcall (gdb-rules-name-maker rules)))
277 (new (get-buffer-create name)))
278 (with-current-buffer new
279 ;; FIXME: This should be set after calling the function, since the
280 ;; function should run kill-all-local-variables.
281 (set (make-local-variable 'gdb-buffer-type) key)
282 (if (cdr (cdr rules))
283 (funcall (car (cdr (cdr rules)))))
284 (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer)
285 (set (make-local-variable 'gud-minor-mode) 'gdba)
286 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
287 new))))
289 (defun gdb-rules-name-maker (rules) (car (cdr rules)))
291 (defun gdb-look-for-tagged-buffer (key bufs)
292 (let ((retval nil))
293 (while (and (not retval) bufs)
294 (set-buffer (car bufs))
295 (if (eq gdb-buffer-type key)
296 (setq retval (car bufs)))
297 (setq bufs (cdr bufs)))
298 retval))
301 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
302 ;; at least one and possible more functions. The functions have these
303 ;; roles in defining a buffer type:
305 ;; NAME - Return a name for this buffer type.
307 ;; The remaining function(s) are optional:
309 ;; MODE - called in a new buffer with no arguments, should establish
310 ;; the proper mode for the buffer.
313 (defun gdb-set-buffer-rules (buffer-type &rest rules)
314 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc)))
315 (if binding
316 (setcdr binding rules)
317 (push (cons buffer-type rules)
318 gdb-buffer-rules-assoc))))
320 ;; GUD buffers are an exception to the rules
321 (gdb-set-buffer-rules 'gdba 'error)
324 ;; Partial-output buffer : This accumulates output from a command executed on
325 ;; behalf of emacs (rather than the user).
327 (gdb-set-buffer-rules 'gdb-partial-output-buffer
328 'gdb-partial-output-name)
330 (defun gdb-partial-output-name ()
331 (concat "*partial-output-"
332 (gdb-get-target-string)
333 "*"))
336 (gdb-set-buffer-rules 'gdb-inferior-io
337 'gdb-inferior-io-name
338 'gdb-inferior-io-mode)
340 (defun gdb-inferior-io-name ()
341 (concat "*input/output of "
342 (gdb-get-target-string)
343 "*"))
345 (defvar gdb-inferior-io-mode-map
346 (let ((map (make-sparse-keymap)))
347 (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt)
348 (define-key map "\C-c\C-z" 'gdb-inferior-io-stop)
349 (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit)
350 (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
351 map))
353 (define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O"
354 "Major mode for gdb inferior-io."
355 :syntax-table nil :abbrev-table nil
356 ;; We want to use comint because it has various nifty and familiar
357 ;; features. We don't need a process, but comint wants one, so create
358 ;; a dummy one.
359 (make-comint-in-buffer
360 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
361 (current-buffer) "/bin/cat")
362 (setq comint-input-sender 'gdb-inferior-io-sender))
364 (defun gdb-inferior-io-sender (proc string)
365 ;; PROC is the pseudo-process created to satisfy comint.
366 (with-current-buffer (process-buffer proc)
367 (setq proc (get-buffer-process gud-comint-buffer))
368 (process-send-string proc string)
369 (process-send-string proc "\n")))
371 (defun gdb-inferior-io-interrupt ()
372 "Interrupt the program being debugged."
373 (interactive)
374 (interrupt-process
375 (get-buffer-process gud-comint-buffer) comint-ptyp))
377 (defun gdb-inferior-io-quit ()
378 "Send quit signal to the program being debugged."
379 (interactive)
380 (quit-process
381 (get-buffer-process gud-comint-buffer) comint-ptyp))
383 (defun gdb-inferior-io-stop ()
384 "Stop the program being debugged."
385 (interactive)
386 (stop-process
387 (get-buffer-process gud-comint-buffer) comint-ptyp))
389 (defun gdb-inferior-io-eof ()
390 "Send end-of-file to the program being debugged."
391 (interactive)
392 (process-send-eof
393 (get-buffer-process gud-comint-buffer)))
397 ;; gdb communications
400 ;; INPUT: things sent to gdb
402 ;; There is a high and low priority input queue. Low priority input is sent
403 ;; only when the high priority queue is idle.
405 ;; The queues are lists. Each element is either a string (indicating user or
406 ;; user-like input) or a list of the form:
408 ;; (INPUT-STRING HANDLER-FN)
410 ;; The handler function will be called from the partial-output buffer when the
411 ;; command completes. This is the way to write commands which invoke gdb
412 ;; commands autonomously.
414 ;; These lists are consumed tail first.
417 (defun gdb-send (proc string)
418 "A comint send filter for gdb.
419 This filter may simply queue output for a later time."
420 (gdb-enqueue-input (concat string "\n")))
422 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
423 ;; is a query, or other non-top-level prompt. To guarantee stuff will get
424 ;; sent to the top-level prompt, currently it must be put in the idle queue.
425 ;; ^^^^^^^^^
426 ;; [This should encourage gdb extensions that invoke gdb commands to let
427 ;; the user go first; it is not a bug. -t]
430 (defun gdb-enqueue-input (item)
431 (if (gdb-get-prompting)
432 (progn
433 (gdb-send-item item)
434 (gdb-set-prompting nil))
435 (gdb-set-input-queue
436 (cons item (gdb-get-input-queue)))))
438 (defun gdb-dequeue-input ()
439 (let ((queue (gdb-get-input-queue)))
440 (and queue
441 (if (not (cdr queue))
442 (let ((answer (car queue)))
443 (gdb-set-input-queue '())
444 answer)
445 (gdb-take-last-elt queue)))))
447 (defun gdb-enqueue-idle-input (item)
448 (if (and (gdb-get-prompting)
449 (not (gdb-get-input-queue)))
450 (progn
451 (gdb-send-item item)
452 (gdb-set-prompting nil))
453 (gdb-set-idle-input-queue
454 (cons item (gdb-get-idle-input-queue)))))
456 (defun gdb-dequeue-idle-input ()
457 (let ((queue (gdb-get-idle-input-queue)))
458 (and queue
459 (if (not (cdr queue))
460 (let ((answer (car queue)))
461 (gdb-set-idle-input-queue '())
462 answer)
463 (gdb-take-last-elt queue)))))
465 ;; Don't use this in general.
466 (defun gdb-take-last-elt (l)
467 (if (cdr (cdr l))
468 (gdb-take-last-elt (cdr l))
469 (let ((answer (car (cdr l))))
470 (setcdr l '())
471 answer)))
475 ;; output -- things gdb prints to emacs
477 ;; GDB output is a stream interrupted by annotations.
478 ;; Annotations can be recognized by their beginning
479 ;; with \C-j\C-z\C-z<tag><opt>\C-j
481 ;; The tag is a string obeying symbol syntax.
483 ;; The optional part `<opt>' can be either the empty string
484 ;; or a space followed by more data relating to the annotation.
485 ;; For example, the SOURCE annotation is followed by a filename,
486 ;; line number and various useless goo. This data must not include
487 ;; any newlines.
490 (defcustom gud-gdba-command-name "gdb -annotate=2"
491 "Default command to execute an executable under the GDB-UI debugger."
492 :type 'string
493 :group 'gud)
495 (defvar gdb-annotation-rules
496 '(("frames-invalid" gdb-invalidate-frame-and-assembler)
497 ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler)
498 ("pre-prompt" gdb-pre-prompt)
499 ("prompt" gdb-prompt)
500 ("commands" gdb-subprompt)
501 ("overload-choice" gdb-subprompt)
502 ("query" gdb-subprompt)
503 ("prompt-for-continue" gdb-subprompt)
504 ("post-prompt" gdb-post-prompt)
505 ("source" gdb-source)
506 ("starting" gdb-starting)
507 ("exited" gdb-stopping)
508 ("signalled" gdb-stopping)
509 ("signal" gdb-stopping)
510 ("breakpoint" gdb-stopping)
511 ("watchpoint" gdb-stopping)
512 ("frame-begin" gdb-frame-begin)
513 ("stopped" gdb-stopped)
514 ("display-begin" gdb-display-begin)
515 ("display-end" gdb-display-end)
516 ; GDB commands info stack, info locals and frame generate an error-begin
517 ; annotation at start when there is no stack but this is a quirk/bug in
518 ; annotations.
519 ; ("error-begin" gdb-error-begin)
520 ("display-number-end" gdb-display-number-end)
521 ("array-section-begin" gdb-array-section-begin)
522 ("array-section-end" gdb-array-section-end)
523 ;; ("elt" gdb-elt)
524 ("field-begin" gdb-field-begin)
525 ("field-end" gdb-field-end)
526 ) "An assoc mapping annotation tags to functions which process them.")
528 (defun gdb-ignore-annotation (args)
529 nil)
531 (defconst gdb-source-spec-regexp
532 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
534 ;; Do not use this except as an annotation handler.
535 (defun gdb-source (args)
536 (string-match gdb-source-spec-regexp args)
537 ;; Extract the frame position from the marker.
538 (setq gud-last-frame
539 (cons
540 (match-string 1 args)
541 (string-to-int (match-string 2 args))))
542 (setq gdb-current-address (match-string 3 args))
543 (setq gdb-main-or-pc gdb-current-address)
544 ;;update with new frame for machine code if necessary
545 (gdb-invalidate-assembler))
547 (defun gdb-send-item (item)
548 (gdb-set-current-item item)
549 (if (stringp item)
550 (progn
551 (gdb-set-output-sink 'user)
552 (process-send-string (get-buffer-process gud-comint-buffer) item))
553 (progn
554 (gdb-clear-partial-output)
555 (gdb-set-output-sink 'pre-emacs)
556 (process-send-string (get-buffer-process gud-comint-buffer)
557 (car item)))))
559 (defun gdb-pre-prompt (ignored)
560 "An annotation handler for `pre-prompt'. This terminates the collection of
561 output from a previous command if that happens to be in effect."
562 (let ((sink (gdb-get-output-sink)))
563 (cond
564 ((eq sink 'user) t)
565 ((eq sink 'emacs)
566 (gdb-set-output-sink 'post-emacs)
567 (let ((handler
568 (car (cdr (gdb-get-current-item)))))
569 (save-excursion
570 (set-buffer (gdb-get-create-buffer
571 'gdb-partial-output-buffer))
572 (funcall handler))))
574 (gdb-set-output-sink 'user)
575 (error "Output sink phase error 1")))))
577 (defun gdb-prompt (ignored)
578 "An annotation handler for `prompt'.
579 This sends the next command (if any) to gdb."
580 (let ((sink (gdb-get-output-sink)))
581 (cond
582 ((eq sink 'user) t)
583 ((eq sink 'post-emacs)
584 (gdb-set-output-sink 'user))
586 (gdb-set-output-sink 'user)
587 (error "Phase error in gdb-prompt (got %s)" sink))))
588 (let ((highest (gdb-dequeue-input)))
589 (if highest
590 (gdb-send-item highest)
591 (let ((lowest (gdb-dequeue-idle-input)))
592 (if lowest
593 (gdb-send-item lowest)
594 (progn
595 (gdb-set-prompting t)
596 (gud-display-frame)))))))
598 (defun gdb-subprompt (ignored)
599 "An annotation handler for non-top-level prompts."
600 (let ((highest (gdb-dequeue-input)))
601 (if highest
602 (gdb-send-item highest)
603 (gdb-set-prompting t))))
605 (defun gdb-starting (ignored)
606 "An annotation handler for `starting'. This says that I/O for the
607 subprocess is now the program being debugged, not GDB."
608 (let ((sink (gdb-get-output-sink)))
609 (cond
610 ((eq sink 'user)
611 (progn
612 (setq gud-running t)
613 (gdb-set-output-sink 'inferior)))
614 (t (error "Unexpected `starting' annotation")))))
616 (defun gdb-stopping (ignored)
617 "An annotation handler for `exited' and other annotations which say that I/O
618 for the subprocess is now GDB, not the program being debugged."
619 (let ((sink (gdb-get-output-sink)))
620 (cond
621 ((eq sink 'inferior)
622 (gdb-set-output-sink 'user))
623 (t (error "Unexpected stopping annotation")))))
625 (defun gdb-frame-begin (ignored)
626 (let ((sink (gdb-get-output-sink)))
627 (cond
628 ((eq sink 'inferior)
629 (gdb-set-output-sink 'user))
630 ((eq sink 'user) t)
631 ((eq sink 'emacs) t)
632 (t (error "Unexpected frame-begin annotation (%S)" sink)))))
634 (defun gdb-stopped (ignored)
635 "An annotation handler for `stopped'. It is just like gdb-stopping, except
636 that if we already set the output sink to 'user in gdb-stopping, that is fine."
637 (setq gud-running nil)
638 (let ((sink (gdb-get-output-sink)))
639 (cond
640 ((eq sink 'inferior)
641 (gdb-set-output-sink 'user))
642 ((eq sink 'user) t)
643 (t (error "Unexpected stopped annotation")))))
645 (defun gdb-post-prompt (ignored)
646 "An annotation handler for `post-prompt'. This begins the collection of
647 output from the current command if that happens to be appropriate."
648 (if (not (gdb-get-pending-triggers))
649 (progn
650 (gdb-get-current-frame)
651 (gdb-invalidate-registers ignored)
652 (gdb-invalidate-locals ignored)
653 (gdb-invalidate-display ignored)))
654 (let ((sink (gdb-get-output-sink)))
655 (cond
656 ((eq sink 'user) t)
657 ((eq sink 'pre-emacs)
658 (gdb-set-output-sink 'emacs))
660 (gdb-set-output-sink 'user)
661 (error "Output sink phase error 3")))))
663 ;; If we get an error whilst evaluating one of the expressions
664 ;; we won't get the display-end annotation. Set the sink back to
665 ;; user to make sure that the error message is seen
666 (defun gdb-error-begin (ignored)
667 (gdb-set-output-sink 'user))
669 (defun gdb-display-begin (ignored)
670 (gdb-set-output-sink 'emacs)
671 (gdb-clear-partial-output)
672 (setq gdb-display-in-progress t))
674 (defvar gdb-expression-buffer-name)
675 (defvar gdb-display-number)
676 (defvar gdb-dive-display-number)
678 (defun gdb-display-number-end (ignored)
679 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
680 (setq gdb-display-number (buffer-string))
681 (setq gdb-expression-buffer-name
682 (concat "*display " gdb-display-number "*"))
683 (save-excursion
684 (if (progn
685 (set-buffer (window-buffer))
686 gdb-dive)
687 (progn
688 (let ((number gdb-display-number))
689 (switch-to-buffer
690 (set-buffer (get-buffer-create gdb-expression-buffer-name)))
691 (gdb-expressions-mode)
692 (setq gdb-dive-display-number number)))
693 (set-buffer (get-buffer-create gdb-expression-buffer-name))
694 (gdb-expressions-mode)
695 (if (and (display-graphic-p) (not gdb-dive))
696 (catch 'frame-exists
697 (dolist (frame (frame-list))
698 (if (string-equal (frame-parameter frame 'name)
699 gdb-expression-buffer-name)
700 (throw 'frame-exists nil)))
701 (make-frame '((height . 20) (width . 40)
702 (tool-bar-lines . nil)
703 (menu-bar-lines . nil)
704 (minibuffer . nil))))
705 (gdb-display-buffer (get-buffer gdb-expression-buffer-name)))))
706 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
707 (setq gdb-dive nil))
709 (defvar gdb-current-frame nil)
710 (defvar gdb-nesting-level)
711 (defvar gdb-expression)
712 (defvar gdb-point)
713 (defvar gdb-annotation-arg)
715 (defun gdb-delete-line ()
716 "Delete the current line."
717 (delete-region (line-beginning-position) (line-beginning-position 2)))
719 (defun gdb-display-end (ignored)
720 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
721 (goto-char (point-min))
722 (search-forward ": ")
723 (looking-at "\\(.*?\\) =")
724 (let ((char "")
725 (gdb-temp-value (match-string 1)))
726 ;;move * to front of expression if necessary
727 (if (looking-at ".*\\*")
728 (progn
729 (setq char "*")
730 (setq gdb-temp-value (substring gdb-temp-value 1 nil))))
731 (save-excursion
732 (set-buffer gdb-expression-buffer-name)
733 (setq gdb-expression gdb-temp-value)
734 (if (not (string-match "::" gdb-expression))
735 (setq gdb-expression (concat char gdb-current-frame
736 "::" gdb-expression))
737 ;;else put * back on if necessary
738 (setq gdb-expression (concat char gdb-expression)))
739 (if (not header-line-format)
740 (setq header-line-format (concat "-- " gdb-expression " %-")))))
742 ;;-if scalar/string
743 (if (not (re-search-forward "##" nil t))
744 (progn
745 (save-excursion
746 (set-buffer gdb-expression-buffer-name)
747 (let ((buffer-read-only nil))
748 (delete-region (point-min) (point-max))
749 (insert-buffer-substring
750 (gdb-get-buffer 'gdb-partial-output-buffer)))))
751 ;; display expression name...
752 (goto-char (point-min))
753 (let ((start (progn (point)))
754 (end (progn (end-of-line) (point))))
755 (save-excursion
756 (set-buffer gdb-expression-buffer-name)
757 (setq buffer-read-only nil)
758 (delete-region (point-min) (point-max))
759 (insert-buffer-substring (gdb-get-buffer
760 'gdb-partial-output-buffer)
761 start end)
762 (insert "\n")))
763 (goto-char (point-min))
764 (re-search-forward "##" nil t)
765 (setq gdb-nesting-level 0)
766 (if (looking-at "array-section-begin")
767 (progn
768 (gdb-delete-line)
769 (setq gdb-point (point))
770 (gdb-array-format)))
771 (if (looking-at "field-begin \\(.\\)")
772 (progn
773 (setq gdb-annotation-arg (match-string 1))
774 (gdb-field-format-begin))))
775 (save-excursion
776 (set-buffer gdb-expression-buffer-name)
777 (if gdb-dive-display-number
778 (progn
779 (let ((buffer-read-only nil))
780 (goto-char (point-max))
781 (insert "\n")
782 (insert-text-button "[back]" 'type 'gdb-display-back)))))
783 (gdb-clear-partial-output)
784 (gdb-set-output-sink 'user)
785 (setq gdb-display-in-progress nil))
787 (define-button-type 'gdb-display-back
788 'help-echo (purecopy "mouse-2, RET: go back to previous display buffer")
789 'action (lambda (button) (gdb-display-go-back)))
791 (defun gdb-display-go-back ()
792 ;; delete display so they don't accumulate and delete buffer
793 (let ((number gdb-display-number))
794 (gdb-enqueue-input
795 (list (concat "server delete display " number "\n") 'ignore))
796 (switch-to-buffer (concat "*display " gdb-dive-display-number "*"))
797 (kill-buffer (get-buffer (concat "*display " number "*")))))
799 ;; prefix annotations with ## and process whole output in one chunk
800 ;; in gdb-partial-output-buffer (to allow recursion).
802 ;; array-section flags are just removed again but after counting. They
803 ;; might also be useful for arrays of structures and structures with arrays.
804 (defun gdb-array-section-begin (args)
805 (if gdb-display-in-progress
806 (progn
807 (save-excursion
808 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
809 (goto-char (point-max))
810 (insert (concat "\n##array-section-begin " args "\n"))))))
812 (defun gdb-array-section-end (ignored)
813 (if gdb-display-in-progress
814 (progn
815 (save-excursion
816 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
817 (goto-char (point-max))
818 (insert "\n##array-section-end\n")))))
820 (defun gdb-field-begin (args)
821 (if gdb-display-in-progress
822 (progn
823 (save-excursion
824 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
825 (goto-char (point-max))
826 (insert (concat "\n##field-begin " args "\n"))))))
828 (defun gdb-field-end (ignored)
829 (if gdb-display-in-progress
830 (progn
831 (save-excursion
832 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
833 (goto-char (point-max))
834 (insert "\n##field-end\n")))))
836 (defun gdb-elt (ignored)
837 (if gdb-display-in-progress
838 (progn
839 (goto-char (point-max))
840 (insert "\n##elt\n"))))
842 (defun gdb-field-format-begin ()
843 ;; get rid of ##field-begin
844 (gdb-delete-line)
845 (gdb-insert-field)
846 (setq gdb-nesting-level (+ gdb-nesting-level 1))
847 (while (re-search-forward "##" nil t)
848 ;; keep making recursive calls...
849 (if (looking-at "field-begin \\(.\\)")
850 (progn
851 (setq gdb-annotation-arg (match-string 1))
852 (gdb-field-format-begin)))
853 ;; until field-end.
854 (if (looking-at "field-end") (gdb-field-format-end))))
856 (defun gdb-field-format-end ()
857 ;; get rid of ##field-end and `,' or `}'
858 (gdb-delete-line)
859 (gdb-delete-line)
860 (setq gdb-nesting-level (- gdb-nesting-level 1)))
862 (defvar gdb-dive-map
863 (let ((map (make-sparse-keymap)))
864 (define-key map [mouse-2] 'gdb-dive)
865 (define-key map [S-mouse-2] 'gdb-dive-new-frame)
866 map))
868 (defun gdb-dive (event)
869 "Dive into structure."
870 (interactive "e")
871 (setq gdb-dive t)
872 (gdb-dive-new-frame event))
874 (defun gdb-dive-new-frame (event)
875 "Dive into structure and display in a new frame."
876 (interactive "e")
877 (save-excursion
878 (mouse-set-point event)
879 (let ((point (point)) (gdb-full-expression gdb-expression)
880 (end (progn (end-of-line) (point)))
881 (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil))
882 (beginning-of-line)
883 (if (looking-at "\*") (setq gdb-display-char "*"))
884 (re-search-forward "\\(\\S-+\\) = " end t)
885 (setq gdb-last-field (match-string-no-properties 1))
886 (goto-char (match-beginning 1))
887 (let ((last-column (current-column)))
888 (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t)
889 (goto-char (match-beginning 1))
890 (if (and (< (current-column) last-column)
891 (> (count-lines 1 (point)) 1))
892 (progn
893 (setq gdb-part-expression
894 (concat "." (match-string-no-properties 1)
895 gdb-part-expression))
896 (setq last-column (current-column))))))
897 ;; * not needed for components of a pointer to a structure in gdb
898 (if (string-equal "*" (substring gdb-full-expression 0 1))
899 (setq gdb-full-expression (substring gdb-full-expression 1 nil)))
900 (setq gdb-full-expression
901 (concat gdb-full-expression gdb-part-expression "." gdb-last-field))
902 (gdb-enqueue-input
903 (list (concat "server display" gdb-display-char
904 " " gdb-full-expression "\n")
905 'ignore)))))
907 (defun gdb-insert-field ()
908 (let ((start (progn (point)))
909 (end (progn (next-line) (point)))
910 (num 0))
911 (save-excursion
912 (set-buffer gdb-expression-buffer-name)
913 (let ((buffer-read-only nil))
914 (if (string-equal gdb-annotation-arg "\*") (insert "\*"))
915 (while (<= num gdb-nesting-level)
916 (insert "\t")
917 (setq num (+ num 1)))
918 (insert-buffer-substring (gdb-get-buffer
919 'gdb-partial-output-buffer)
920 start end)
921 (put-text-property (- (point) (- end start)) (- (point) 1)
922 'mouse-face 'highlight)
923 (put-text-property (- (point) (- end start)) (- (point) 1)
924 'local-map gdb-dive-map)))
925 (delete-region start end)))
927 (defvar gdb-values)
929 (defun gdb-array-format ()
930 (while (re-search-forward "##" nil t)
931 ;; keep making recursive calls...
932 (if (looking-at "array-section-begin")
933 (progn
934 ;;get rid of ##array-section-begin
935 (gdb-delete-line)
936 (setq gdb-nesting-level (+ gdb-nesting-level 1))
937 (gdb-array-format)))
938 ;;until *matching* array-section-end is found
939 (if (looking-at "array-section-end")
940 (if (eq gdb-nesting-level 0)
941 (progn
942 (let ((values (buffer-substring gdb-point (- (point) 2))))
943 (save-excursion
944 (set-buffer gdb-expression-buffer-name)
945 (setq gdb-values
946 (concat "{" (replace-regexp-in-string "\n" "" values)
947 "}"))
948 (gdb-array-format1))))
949 ;;else get rid of ##array-section-end etc
950 (gdb-delete-line)
951 (setq gdb-nesting-level (- gdb-nesting-level 1))
952 (gdb-array-format)))))
954 (defvar gdb-array-start)
955 (defvar gdb-array-stop)
957 (defvar gdb-array-slice-map
958 (let ((map (make-sparse-keymap)))
959 (define-key map [mouse-2] 'gdb-array-slice)
960 map))
962 (defun gdb-array-slice (event)
963 "Select an array slice to display."
964 (interactive "e")
965 (mouse-set-point event)
966 (save-excursion
967 (let ((n -1) (stop 0) (start 0) (point (point)))
968 (beginning-of-line)
969 (while (search-forward "[" point t)
970 (setq n (+ n 1)))
971 (setq start (string-to-int (read-string "Start index: ")))
972 (aset gdb-array-start n start)
973 (setq stop (string-to-int (read-string "Stop index: ")))
974 (aset gdb-array-stop n stop)))
975 (gdb-array-format1))
977 (defvar gdb-display-string)
978 (defvar gdb-array-size)
980 (defun gdb-array-format1 ()
981 (setq gdb-display-string "")
982 (let ((buffer-read-only nil))
983 (delete-region (point-min) (point-max))
984 (let ((gdb-value-list (split-string gdb-values ", ")))
985 (string-match "\\({+\\)" (car gdb-value-list))
986 (let* ((depth (- (match-end 1) (match-beginning 1)))
987 (indices (make-vector depth '0))
988 (index 0) (num 0) (array-start "")
989 (array-stop "") (array-slice "") (array-range nil)
990 (flag t) (indices-string ""))
991 (dolist (gdb-value gdb-value-list)
992 (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value)
993 (setq num 0)
994 (while (< num depth)
995 (setq indices-string
996 (concat indices-string
997 "[" (int-to-string (aref indices num)) "]"))
998 (if (not (= (aref gdb-array-start num) -1))
999 (if (or (< (aref indices num) (aref gdb-array-start num))
1000 (> (aref indices num) (aref gdb-array-stop num)))
1001 (setq flag nil))
1002 (aset gdb-array-size num (aref indices num)))
1003 (setq num (+ num 1)))
1004 (if flag
1005 (let ((gdb-display-value (match-string 1 gdb-value)))
1006 (setq gdb-display-string (concat gdb-display-string " "
1007 gdb-display-value))
1008 (insert
1009 (concat indices-string "\t" gdb-display-value "\n"))))
1010 (setq indices-string "")
1011 (setq flag t)
1012 ;; 0<= index < depth, start at right : (- depth 1)
1013 (setq index (- (- depth 1)
1014 (- (match-end 2) (match-beginning 2))))
1015 ;;don't set for very last brackets
1016 (when (>= index 0)
1017 (aset indices index (+ 1 (aref indices index)))
1018 (setq num (+ 1 index))
1019 (while (< num depth)
1020 (aset indices num 0)
1021 (setq num (+ num 1)))))
1022 (setq num 0)
1023 (while (< num depth)
1024 (if (= (aref gdb-array-start num) -1)
1025 (progn
1026 (aset gdb-array-start num 0)
1027 (aset gdb-array-stop num (aref indices num))))
1028 (setq array-start (int-to-string (aref gdb-array-start num)))
1029 (setq array-stop (int-to-string (aref gdb-array-stop num)))
1030 (setq array-range (concat "[" array-start
1031 ":" array-stop "]"))
1032 (put-text-property 1 (+ (length array-start)
1033 (length array-stop) 2)
1034 'mouse-face 'highlight array-range)
1035 (put-text-property 1 (+ (length array-start)
1036 (length array-stop) 2)
1037 'local-map gdb-array-slice-map array-range)
1038 (goto-char (point-min))
1039 (setq array-slice (concat array-slice array-range))
1040 (setq num (+ num 1)))
1041 (goto-char (point-min))
1042 (insert "Array Size : ")
1043 (setq num 0)
1044 (while (< num depth)
1045 (insert
1046 (concat "["
1047 (int-to-string (+ (aref gdb-array-size num) 1)) "]"))
1048 (setq num (+ num 1)))
1049 (insert
1050 (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n"))))))
1052 (defun gud-gdba-marker-filter (string)
1053 "A gud marker filter for gdb. Handle a burst of output from GDB."
1054 (let (
1055 ;; Recall the left over burst from last time
1056 (burst (concat (gdb-get-burst) string))
1057 ;; Start accumulating output for the GUD buffer
1058 (output ""))
1060 ;; Process all the complete markers in this chunk.
1061 (while (string-match "\n\032\032\\(.*\\)\n" burst)
1062 (let ((annotation (match-string 1 burst)))
1064 ;; Stuff prior to the match is just ordinary output.
1065 ;; It is either concatenated to OUTPUT or directed
1066 ;; elsewhere.
1067 (setq output
1068 (gdb-concat-output
1069 output
1070 (substring burst 0 (match-beginning 0))))
1072 ;; Take that stuff off the burst.
1073 (setq burst (substring burst (match-end 0)))
1075 ;; Parse the tag from the annotation, and maybe its arguments.
1076 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
1077 (let* ((annotation-type (match-string 1 annotation))
1078 (annotation-arguments (match-string 2 annotation))
1079 (annotation-rule (assoc annotation-type
1080 gdb-annotation-rules)))
1081 ;; Call the handler for this annotation.
1082 (if annotation-rule
1083 (funcall (car (cdr annotation-rule))
1084 annotation-arguments)
1085 ;; Else the annotation is not recognized. Ignore it silently,
1086 ;; so that GDB can add new annotations without causing
1087 ;; us to blow up.
1088 ))))
1090 ;; Does the remaining text end in a partial line?
1091 ;; If it does, then keep part of the burst until we get more.
1092 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1093 burst)
1094 (progn
1095 ;; Everything before the potential marker start can be output.
1096 (setq output
1097 (gdb-concat-output output
1098 (substring burst 0 (match-beginning 0))))
1100 ;; Everything after, we save, to combine with later input.
1101 (setq burst (substring burst (match-beginning 0))))
1103 ;; In case we know the burst contains no partial annotations:
1104 (progn
1105 (setq output (gdb-concat-output output burst))
1106 (setq burst "")))
1108 ;; Save the remaining burst for the next call to this function.
1109 (gdb-set-burst burst)
1110 output))
1112 (defun gdb-concat-output (so-far new)
1113 (let ((sink (gdb-get-output-sink )))
1114 (cond
1115 ((eq sink 'user) (concat so-far new))
1116 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
1117 ((eq sink 'emacs)
1118 (gdb-append-to-partial-output new)
1119 so-far)
1120 ((eq sink 'inferior)
1121 (gdb-append-to-inferior-io new)
1122 so-far)
1123 (t (error "Bogon output sink %S" sink)))))
1125 (defun gdb-append-to-partial-output (string)
1126 (save-excursion
1127 (set-buffer
1128 (gdb-get-create-buffer 'gdb-partial-output-buffer))
1129 (goto-char (point-max))
1130 (insert string)))
1132 (defun gdb-clear-partial-output ()
1133 (save-excursion
1134 (set-buffer
1135 (gdb-get-create-buffer 'gdb-partial-output-buffer))
1136 (delete-region (point-min) (point-max))))
1138 (defun gdb-append-to-inferior-io (string)
1139 (save-excursion
1140 (set-buffer
1141 (gdb-get-create-buffer 'gdb-inferior-io))
1142 (goto-char (point-max))
1143 (insert-before-markers string))
1144 (if (not (string-equal string ""))
1145 (gdb-display-buffer
1146 (gdb-get-create-buffer 'gdb-inferior-io))))
1148 (defun gdb-clear-inferior-io ()
1149 (save-excursion
1150 (set-buffer
1151 (gdb-get-create-buffer 'gdb-inferior-io))
1152 (delete-region (point-min) (point-max))))
1155 ;; One trick is to have a command who's output is always available in a buffer
1156 ;; of it's own, and is always up to date. We build several buffers of this
1157 ;; type.
1159 ;; There are two aspects to this: gdb has to tell us when the output for that
1160 ;; command might have changed, and we have to be able to run the command
1161 ;; behind the user's back.
1163 ;; The idle input queue and the output phasing associated with the variable
1164 ;; gdb-output-sink help us to run commands behind the user's back.
1166 ;; Below is the code for specificly managing buffers of output from one
1167 ;; command.
1170 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1171 ;; It adds an idle input for the command we are tracking. It should be the
1172 ;; annotation rule binding of whatever gdb sends to tell us this command
1173 ;; might have changed it's output.
1175 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1176 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1177 ;; input in the input queue (see comment about ``gdb communications'' above).
1179 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command
1180 output-handler)
1181 `(defun ,name (&optional ignored)
1182 (if (and (,demand-predicate)
1183 (not (member ',name
1184 (gdb-get-pending-triggers))))
1185 (progn
1186 (gdb-enqueue-idle-input
1187 (list ,gdb-command ',output-handler))
1188 (gdb-set-pending-triggers
1189 (cons ',name
1190 (gdb-get-pending-triggers)))))))
1192 (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
1193 `(defun ,name ()
1194 (gdb-set-pending-triggers
1195 (delq ',trigger
1196 (gdb-get-pending-triggers)))
1197 (let ((buf (gdb-get-buffer ',buf-key)))
1198 (and buf
1199 (save-excursion
1200 (set-buffer buf)
1201 (let ((p (point))
1202 (buffer-read-only nil))
1203 (delete-region (point-min) (point-max))
1204 (insert-buffer-substring (gdb-get-create-buffer
1205 'gdb-partial-output-buffer))
1206 (goto-char p)))))
1207 ;; put customisation here
1208 (,custom-defun)))
1210 (defmacro def-gdb-auto-updated-buffer (buffer-key trigger-name gdb-command
1211 output-handler-name custom-defun)
1212 `(progn
1213 (def-gdb-auto-update-trigger ,trigger-name
1214 ;; The demand predicate:
1215 (lambda () (gdb-get-buffer ',buffer-key))
1216 ,gdb-command
1217 ,output-handler-name)
1218 (def-gdb-auto-update-handler ,output-handler-name
1219 ,trigger-name ,buffer-key ,custom-defun)))
1223 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
1225 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
1226 'gdb-breakpoints-buffer-name
1227 'gdb-breakpoints-mode)
1229 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1230 ;; This defines the auto update rule for buffers of type
1231 ;; `gdb-breakpoints-buffer'.
1233 ;; It defines a function to serve as the annotation handler that
1234 ;; handles the `foo-invalidated' message. That function is called:
1235 gdb-invalidate-breakpoints
1237 ;; To update the buffer, this command is sent to gdb.
1238 "server info breakpoints\n"
1240 ;; This also defines a function to be the handler for the output
1241 ;; from the command above. That function will copy the output into
1242 ;; the appropriately typed buffer. That function will be called:
1243 gdb-info-breakpoints-handler
1244 ;; buffer specific functions
1245 gdb-info-breakpoints-custom)
1247 (defvar gdb-cdir nil "Compilation directory.")
1248 (defvar breakpoint-enabled-icon)
1249 (defvar breakpoint-disabled-icon)
1251 ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1252 (defun gdb-info-breakpoints-custom ()
1253 (let ((flag)(address))
1255 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1256 (dolist (buffer (buffer-list))
1257 (save-excursion
1258 (set-buffer buffer)
1259 (if (and (eq gud-minor-mode 'gdba)
1260 (not (string-match "^\*" (buffer-name))))
1261 (if (display-graphic-p)
1262 (remove-images (point-min) (point-max))
1263 (remove-strings (point-min) (point-max))))))
1264 (save-excursion
1265 (set-buffer (gdb-get-buffer 'gdb-breakpoints-buffer))
1266 (save-excursion
1267 (goto-char (point-min))
1268 (while (< (point) (- (point-max) 1))
1269 (forward-line 1)
1270 (if (looking-at "[^\t].*breakpoint")
1271 (progn
1272 (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1273 (setq flag (char-after (match-beginning 2)))
1274 (beginning-of-line)
1275 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1276 (progn
1277 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1278 (let ((line (match-string 2)) (buffer-read-only nil)
1279 (file (match-string 1)))
1280 (put-text-property (progn (beginning-of-line) (point))
1281 (progn (end-of-line) (point))
1282 'mouse-face 'highlight)
1283 (save-excursion
1284 (set-buffer
1285 (find-file-noselect
1286 (if (file-exists-p file) file
1287 (expand-file-name file gdb-cdir))))
1288 (save-current-buffer
1289 (set (make-local-variable 'gud-minor-mode) 'gdba)
1290 (set (make-local-variable 'tool-bar-map)
1291 gud-tool-bar-map)
1292 (setq left-margin-width 2)
1293 (if (get-buffer-window (current-buffer))
1294 (set-window-margins (get-buffer-window
1295 (current-buffer))
1296 left-margin-width
1297 right-margin-width)))
1298 ;; only want one breakpoint icon at each location
1299 (save-excursion
1300 (goto-line (string-to-number line))
1301 (let ((start (progn (beginning-of-line)
1302 (- (point) 1)))
1303 (end (progn (end-of-line) (+ (point) 1))))
1304 (if (display-graphic-p)
1305 (progn
1306 (remove-images start end)
1307 (if (eq ?y flag)
1308 (put-image breakpoint-enabled-icon
1309 (point)
1310 "breakpoint icon enabled"
1311 'left-margin)
1312 (put-image breakpoint-disabled-icon (point)
1313 "breakpoint icon disabled"
1314 'left-margin)))
1315 (remove-strings start end)
1316 (if (eq ?y flag)
1317 (put-string "B" (point) "enabled"
1318 'left-margin)
1319 (put-string "b" (point) "disabled"
1320 'left-margin)))))))))))
1321 (end-of-line))))))
1323 (defun gdb-breakpoints-buffer-name ()
1324 (with-current-buffer gud-comint-buffer
1325 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1327 (defun gdb-display-breakpoints-buffer ()
1328 (interactive)
1329 (gdb-display-buffer
1330 (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
1332 (defun gdb-frame-breakpoints-buffer ()
1333 (interactive)
1334 (switch-to-buffer-other-frame
1335 (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
1337 (defvar gdb-breakpoints-mode-map
1338 (let ((map (make-sparse-keymap))
1339 (menu (make-sparse-keymap "Breakpoints")))
1340 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
1341 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1342 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1344 (suppress-keymap map)
1345 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1346 (define-key map " " 'gdb-toggle-breakpoint)
1347 (define-key map "d" 'gdb-delete-breakpoint)
1348 (define-key map "\r" 'gdb-goto-breakpoint)
1349 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1350 map))
1352 (defun gdb-breakpoints-mode ()
1353 "Major mode for gdb breakpoints.
1355 \\{gdb-breakpoints-mode-map}"
1356 (setq major-mode 'gdb-breakpoints-mode)
1357 (setq mode-name "Breakpoints")
1358 (use-local-map gdb-breakpoints-mode-map)
1359 (setq buffer-read-only t)
1360 (gdb-invalidate-breakpoints))
1362 (defun gdb-toggle-breakpoint ()
1363 "Enable/disable the breakpoint at current line."
1364 (interactive)
1365 (save-excursion
1366 (beginning-of-line 1)
1367 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1368 (error "Not recognized as break/watchpoint line")
1369 (gdb-enqueue-input
1370 (list
1371 (concat
1372 (if (eq ?y (char-after (match-beginning 2)))
1373 "server disable "
1374 "server enable ")
1375 (match-string 1) "\n")
1376 'ignore)))))
1378 (defun gdb-delete-breakpoint ()
1379 "Delete the breakpoint at current line."
1380 (interactive)
1381 (beginning-of-line 1)
1382 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1383 (error "Not recognized as break/watchpoint line")
1384 (gdb-enqueue-input
1385 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1387 (defvar gdb-source-window nil)
1389 (defun gdb-goto-breakpoint ()
1390 "Display the file in the source buffer at the breakpoint specified on the
1391 current line."
1392 (interactive)
1393 (save-excursion
1394 (beginning-of-line 1)
1395 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1396 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1397 (if (match-string 2)
1398 (let ((line (match-string 2))
1399 (file (match-string 1)))
1400 (save-selected-window
1401 (select-window gdb-source-window)
1402 (switch-to-buffer (find-file-noselect
1403 (if (file-exists-p file)
1404 file
1405 (expand-file-name file gdb-cdir))))
1406 (goto-line (string-to-number line))))))
1408 (defun gdb-mouse-goto-breakpoint (event)
1409 "Display the file in the source buffer at the selected breakpoint."
1410 (interactive "e")
1411 (mouse-set-point event)
1412 (gdb-goto-breakpoint))
1415 ;; Frames buffer. This displays a perpetually correct bactracktrace
1416 ;; (from the command `where').
1418 ;; Alas, if your stack is deep, it is costly.
1420 (gdb-set-buffer-rules 'gdb-stack-buffer
1421 'gdb-stack-buffer-name
1422 'gdb-frames-mode)
1424 (def-gdb-auto-updated-buffer gdb-stack-buffer
1425 gdb-invalidate-frames
1426 "server where\n"
1427 gdb-info-frames-handler
1428 gdb-info-frames-custom)
1430 (defun gdb-info-frames-custom ()
1431 (save-excursion
1432 (set-buffer (gdb-get-buffer 'gdb-stack-buffer))
1433 (let ((buffer-read-only nil))
1434 (goto-char (point-min))
1435 (while (< (point) (point-max))
1436 (put-text-property (progn (beginning-of-line) (point))
1437 (progn (end-of-line) (point))
1438 'mouse-face 'highlight)
1439 (forward-line 1)))))
1441 (defun gdb-stack-buffer-name ()
1442 (with-current-buffer gud-comint-buffer
1443 (concat "*stack frames of " (gdb-get-target-string) "*")))
1445 (defun gdb-display-stack-buffer ()
1446 (interactive)
1447 (gdb-display-buffer
1448 (gdb-get-create-buffer 'gdb-stack-buffer)))
1450 (defun gdb-frame-stack-buffer ()
1451 (interactive)
1452 (switch-to-buffer-other-frame
1453 (gdb-get-create-buffer 'gdb-stack-buffer)))
1455 (defvar gdb-frames-mode-map
1456 (let ((map (make-sparse-keymap)))
1457 (suppress-keymap map)
1458 (define-key map "\r" 'gdb-frames-select)
1459 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1460 map))
1462 (defun gdb-frames-mode ()
1463 "Major mode for gdb frames.
1465 \\{gdb-frames-mode-map}"
1466 (setq major-mode 'gdb-frames-mode)
1467 (setq mode-name "Frames")
1468 (setq buffer-read-only t)
1469 (use-local-map gdb-frames-mode-map)
1470 (gdb-invalidate-frames))
1472 (defun gdb-get-frame-number ()
1473 (save-excursion
1474 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1475 (n (or (and pos (match-string-no-properties 1)) "0")))
1476 n)))
1478 (defun gdb-frames-select ()
1479 "Make the frame on the current line become the current frame and display the
1480 source in the source buffer."
1481 (interactive)
1482 (gdb-enqueue-input
1483 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1484 (gud-display-frame))
1486 (defun gdb-frames-mouse-select (event)
1487 "Make the selected frame become the current frame and display the source in
1488 the source buffer."
1489 (interactive "e")
1490 (mouse-set-point event)
1491 (gdb-frames-select))
1494 ;; Registers buffer.
1496 (gdb-set-buffer-rules 'gdb-registers-buffer
1497 'gdb-registers-buffer-name
1498 'gdb-registers-mode)
1500 (def-gdb-auto-updated-buffer gdb-registers-buffer
1501 gdb-invalidate-registers
1502 "server info registers\n"
1503 gdb-info-registers-handler
1504 gdb-info-registers-custom)
1506 (defun gdb-info-registers-custom ())
1508 (defvar gdb-registers-mode-map
1509 (let ((map (make-sparse-keymap)))
1510 (suppress-keymap map)
1511 map))
1513 (defun gdb-registers-mode ()
1514 "Major mode for gdb registers.
1516 \\{gdb-registers-mode-map}"
1517 (setq major-mode 'gdb-registers-mode)
1518 (setq mode-name "Registers")
1519 (setq buffer-read-only t)
1520 (use-local-map gdb-registers-mode-map)
1521 (gdb-invalidate-registers))
1523 (defun gdb-registers-buffer-name ()
1524 (with-current-buffer gud-comint-buffer
1525 (concat "*registers of " (gdb-get-target-string) "*")))
1527 (defun gdb-display-registers-buffer ()
1528 (interactive)
1529 (gdb-display-buffer
1530 (gdb-get-create-buffer 'gdb-registers-buffer)))
1532 (defun gdb-frame-registers-buffer ()
1533 (interactive)
1534 (switch-to-buffer-other-frame
1535 (gdb-get-create-buffer 'gdb-registers-buffer)))
1538 ;; Locals buffer.
1540 (gdb-set-buffer-rules 'gdb-locals-buffer
1541 'gdb-locals-buffer-name
1542 'gdb-locals-mode)
1544 (def-gdb-auto-updated-buffer gdb-locals-buffer
1545 gdb-invalidate-locals
1546 "server info locals\n"
1547 gdb-info-locals-handler
1548 gdb-info-locals-custom)
1550 ;; Abbreviate for arrays and structures.
1551 ;; These can be expanded using gud-display.
1552 (defun gdb-info-locals-handler nil
1553 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1554 (gdb-get-pending-triggers)))
1555 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1556 (save-excursion
1557 (set-buffer buf)
1558 (goto-char (point-min))
1559 (while (re-search-forward "^ .*\n" nil t)
1560 (replace-match "" nil nil))
1561 (goto-char (point-min))
1562 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1563 (replace-match "(array);\n" nil nil))
1564 (goto-char (point-min))
1565 (while (re-search-forward "{.*=.*\n" nil t)
1566 (replace-match "(structure);\n" nil nil))))
1567 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1568 (and buf (save-excursion
1569 (set-buffer buf)
1570 (let ((p (point))
1571 (buffer-read-only nil))
1572 (delete-region (point-min) (point-max))
1573 (insert-buffer-substring (gdb-get-create-buffer
1574 'gdb-partial-output-buffer))
1575 (goto-char p)))))
1576 (run-hooks 'gdb-info-locals-hook))
1578 (defun gdb-info-locals-custom ()
1579 nil)
1581 (defvar gdb-locals-mode-map
1582 (let ((map (make-sparse-keymap)))
1583 (suppress-keymap map)
1584 map))
1586 (defun gdb-locals-mode ()
1587 "Major mode for gdb locals.
1589 \\{gdb-locals-mode-map}"
1590 (setq major-mode 'gdb-locals-mode)
1591 (setq mode-name "Locals")
1592 (setq buffer-read-only t)
1593 (use-local-map gdb-locals-mode-map)
1594 (gdb-invalidate-locals))
1596 (defun gdb-locals-buffer-name ()
1597 (with-current-buffer gud-comint-buffer
1598 (concat "*locals of " (gdb-get-target-string) "*")))
1600 (defun gdb-display-locals-buffer ()
1601 (interactive)
1602 (gdb-display-buffer
1603 (gdb-get-create-buffer 'gdb-locals-buffer)))
1605 (defun gdb-frame-locals-buffer ()
1606 (interactive)
1607 (switch-to-buffer-other-frame
1608 (gdb-get-create-buffer 'gdb-locals-buffer)))
1611 ;; Display expression buffer.
1613 (gdb-set-buffer-rules 'gdb-display-buffer
1614 'gdb-display-buffer-name
1615 'gdb-display-mode)
1617 (def-gdb-auto-updated-buffer gdb-display-buffer
1618 ;; `gdb-display-buffer'.
1619 gdb-invalidate-display
1620 "server info display\n"
1621 gdb-info-display-handler
1622 gdb-info-display-custom)
1624 (defun gdb-info-display-custom ()
1625 (let ((display-list nil))
1626 (save-excursion
1627 (set-buffer (gdb-get-buffer 'gdb-display-buffer))
1628 (goto-char (point-min))
1629 (while (< (point) (- (point-max) 1))
1630 (forward-line 1)
1631 (if (looking-at "\\([0-9]+\\): \\([ny]\\)")
1632 (setq display-list
1633 (cons (string-to-int (match-string 1)) display-list)))
1634 (end-of-line)))
1635 (if (not (display-graphic-p))
1636 (progn
1637 (dolist (buffer (buffer-list))
1638 (if (string-match "\\*display \\([0-9]+\\)\\*" (buffer-name buffer))
1639 (progn
1640 (let ((number
1641 (match-string 1 (buffer-name buffer))))
1642 (if (not (memq (string-to-int number) display-list))
1643 (kill-buffer
1644 (get-buffer (concat "*display " number "*")))))))))
1645 (gdb-delete-frames display-list))))
1647 (defun gdb-delete-frames (display-list)
1648 (dolist (frame (frame-list))
1649 (let ((frame-name (frame-parameter frame 'name)))
1650 (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name)
1651 (progn
1652 (let ((number (match-string 1 frame-name)))
1653 (if (not (memq (string-to-int number) display-list))
1654 (progn (kill-buffer
1655 (get-buffer (concat "*display " number "*")))
1656 (delete-frame frame)))))))))
1658 (defvar gdb-display-mode-map
1659 (let ((map (make-sparse-keymap))
1660 (menu (make-sparse-keymap "Display")))
1661 (define-key menu [toggle] '("Toggle" . gdb-toggle-display))
1662 (define-key menu [delete] '("Delete" . gdb-delete-display))
1664 (suppress-keymap map)
1665 (define-key map [menu-bar display] (cons "Display" menu))
1666 (define-key map " " 'gdb-toggle-display)
1667 (define-key map "d" 'gdb-delete-display)
1668 map))
1670 (defun gdb-display-mode ()
1671 "Major mode for gdb display.
1673 \\{gdb-display-mode-map}"
1674 (setq major-mode 'gdb-display-mode)
1675 (setq mode-name "Display")
1676 (setq buffer-read-only t)
1677 (use-local-map gdb-display-mode-map)
1678 (gdb-invalidate-display))
1680 (defun gdb-display-buffer-name ()
1681 (with-current-buffer gud-comint-buffer
1682 (concat "*Displayed expressions of " (gdb-get-target-string) "*")))
1684 (defun gdb-display-display-buffer ()
1685 (interactive)
1686 (gdb-display-buffer
1687 (gdb-get-create-buffer 'gdb-display-buffer)))
1689 (defun gdb-frame-display-buffer ()
1690 (interactive)
1691 (switch-to-buffer-other-frame
1692 (gdb-get-create-buffer 'gdb-display-buffer)))
1694 (defun gdb-toggle-display ()
1695 "Enable/disable the displayed expression at current line."
1696 (interactive)
1697 (save-excursion
1698 (beginning-of-line 1)
1699 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1700 (error "No expression on this line")
1701 (gdb-enqueue-input
1702 (list
1703 (concat
1704 (if (eq ?y (char-after (match-beginning 2)))
1705 "server disable display "
1706 "server enable display ")
1707 (match-string 1) "\n")
1708 'ignore)))))
1710 (defun gdb-delete-display ()
1711 "Delete the displayed expression at current line."
1712 (interactive)
1713 (save-excursion
1714 (set-buffer
1715 (gdb-get-buffer 'gdb-display-buffer))
1716 (beginning-of-line 1)
1717 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1718 (error "No expression on this line")
1719 (let ((number (match-string 1)))
1720 (gdb-enqueue-input
1721 (list (concat "server delete display " number "\n") 'ignore))))))
1723 (defvar gdb-expressions-mode-map
1724 (let ((map (make-sparse-keymap)))
1725 (suppress-keymap map)
1726 (define-key map "v" 'gdb-array-visualise)
1727 (define-key map "q" 'gdb-delete-expression)
1728 (define-key map [mouse-3] 'gdb-expressions-popup-menu)
1729 map))
1731 (defvar gdb-expressions-mode-menu
1732 '("GDB Expressions Commands"
1733 "----"
1734 ["Visualise" gdb-array-visualise t]
1735 ["Delete" gdb-delete-expression t])
1736 "Menu for `gdb-expressions-mode'.")
1738 (defun gdb-expressions-popup-menu (event)
1739 "Explicit Popup menu as this buffer doesn't have a menubar."
1740 (interactive "@e")
1741 (mouse-set-point event)
1742 (popup-menu gdb-expressions-mode-menu))
1744 (defun gdb-expressions-mode ()
1745 "Major mode for display expressions.
1747 \\{gdb-expressions-mode-map}"
1748 (setq major-mode 'gdb-expressions-mode)
1749 (setq mode-name "Expressions")
1750 (use-local-map gdb-expressions-mode-map)
1751 (make-local-variable 'gdb-display-number)
1752 (make-local-variable 'gdb-values)
1753 (make-local-variable 'gdb-expression)
1754 (set (make-local-variable 'gdb-display-string) nil)
1755 (set (make-local-variable 'gdb-dive-display-number) nil)
1756 (set (make-local-variable 'gud-minor-mode) 'gdba)
1757 (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1))
1758 (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1))
1759 (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1))
1760 (setq buffer-read-only t))
1763 ;;;; Window management
1765 ;;; FIXME: This should only return true for buffers in the current gdb-proc
1766 (defun gdb-protected-buffer-p (buffer)
1767 "Is BUFFER a buffer which we want to leave displayed?"
1768 (with-current-buffer buffer
1769 (or gdb-buffer-type overlay-arrow-position)))
1771 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1772 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1773 ;;; get at the use_time field of a window, I'm not sure there exists a
1774 ;;; more elegant solution without writing C code.
1776 (defun gdb-display-buffer (buf &optional size)
1777 (let ((must-split nil)
1778 (answer nil))
1779 (unwind-protect
1780 (progn
1781 (walk-windows
1782 '(lambda (win)
1783 (if (or (eq gud-comint-buffer (window-buffer win))
1784 (eq gdb-source-window win))
1785 (set-window-dedicated-p win t))))
1786 (setq answer (get-buffer-window buf))
1787 (if (not answer)
1788 (let ((window (get-lru-window)))
1789 (if window
1790 (progn
1791 (set-window-buffer window buf)
1792 (setq answer window))
1793 (setq must-split t)))))
1794 (walk-windows
1795 '(lambda (win)
1796 (if (or (eq gud-comint-buffer (window-buffer win))
1797 (eq gdb-source-window win))
1798 (set-window-dedicated-p win nil)))))
1799 (if must-split
1800 (let* ((largest (get-largest-window))
1801 (cur-size (window-height largest))
1802 (new-size (and size (< size cur-size) (- cur-size size))))
1803 (setq answer (split-window largest new-size))
1804 (set-window-buffer answer buf)))
1805 answer))
1807 (defun gdb-display-source-buffer (buffer)
1808 (set-window-buffer gdb-source-window buffer)
1809 gdb-source-window)
1812 ;;; Shared keymap initialization:
1814 (defun gdb-display-gdb-buffer ()
1815 (interactive)
1816 (gdb-display-buffer
1817 (gdb-get-create-buffer 'gdba)))
1819 (let ((menu (make-sparse-keymap "GDB-Windows")))
1820 (define-key gud-menu-map [displays]
1821 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1822 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1823 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1824 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1825 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1826 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1827 (define-key menu [display] '("Display" . gdb-display-display-buffer))
1828 (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer)))
1830 (defun gdb-frame-gdb-buffer ()
1831 (interactive)
1832 (switch-to-buffer-other-frame
1833 (gdb-get-create-buffer 'gdba)))
1835 (let ((menu (make-sparse-keymap "GDB-Frames")))
1836 (define-key gud-menu-map [frames]
1837 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1838 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1839 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1840 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1841 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1842 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1843 (define-key menu [display] '("Display" . gdb-frame-display-buffer))
1844 (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer)))
1846 (defvar gdb-main-file nil "Source file from which program execution begins.")
1848 ;; layout for all the windows
1849 (defun gdb-setup-windows ()
1850 (gdb-display-locals-buffer)
1851 (gdb-display-stack-buffer)
1852 (delete-other-windows)
1853 (gdb-display-breakpoints-buffer)
1854 (gdb-display-display-buffer)
1855 (delete-other-windows)
1856 (split-window nil ( / ( * (window-height) 3) 4))
1857 (split-window nil ( / (window-height) 3))
1858 (split-window-horizontally)
1859 (other-window 1)
1860 (switch-to-buffer (gdb-locals-buffer-name))
1861 (other-window 1)
1862 (switch-to-buffer
1863 (if gud-last-last-frame
1864 (gud-find-file (car gud-last-last-frame))
1865 (gud-find-file gdb-main-file)))
1866 (setq gdb-source-window (get-buffer-window (current-buffer)))
1867 (split-window-horizontally)
1868 (other-window 1)
1869 (switch-to-buffer (gdb-inferior-io-name))
1870 (other-window 1)
1871 (switch-to-buffer (gdb-stack-buffer-name))
1872 (split-window-horizontally)
1873 (other-window 1)
1874 (switch-to-buffer (gdb-breakpoints-buffer-name))
1875 (other-window 1))
1877 (define-minor-mode gdb-many-windows
1878 "Toggle the number of windows in the basic arrangement."
1879 :group 'gud
1880 :init-value nil
1881 (gdb-restore-windows))
1883 (defun gdb-restore-windows ()
1884 "Restore the basic arrangement of windows used by gdba.
1885 This arrangement depends on the value of `gdb-many-windows'."
1886 (interactive)
1887 (if gdb-many-windows
1888 (progn
1889 (switch-to-buffer gud-comint-buffer)
1890 (delete-other-windows)
1891 (gdb-setup-windows))
1892 (switch-to-buffer gud-comint-buffer)
1893 (delete-other-windows)
1894 (split-window)
1895 (other-window 1)
1896 (switch-to-buffer
1897 (if gud-last-last-frame
1898 (gud-find-file (car gud-last-last-frame))
1899 (gud-find-file gdb-main-file)))
1900 (other-window 1)))
1902 (defconst breakpoint-xpm-data "/* XPM */
1903 static char *magick[] = {
1904 /* columns rows colors chars-per-pixel */
1905 \"12 12 2 1\",
1906 \" c red\",
1907 \"+ c None\",
1908 /* pixels */
1909 \"+++++ +++++\",
1910 \"+++ +++\",
1911 \"++ ++\",
1912 \"+ +\",
1913 \"+ +\",
1914 \" \",
1915 \" \",
1916 \"+ +\",
1917 \"+ +\",
1918 \"++ ++\",
1919 \"+++ +++\",
1920 \"+++++ +++++\"
1922 "XPM file used for breakpoint icon.")
1924 (defvar breakpoint-enabled-icon
1925 (find-image `((:type xpm :data ,breakpoint-xpm-data)))
1926 "Icon for enabled breakpoint in display margin")
1927 (defvar breakpoint-disabled-icon
1928 (find-image `((:type xpm :data ,breakpoint-xpm-data
1929 :conversion laplace)))
1930 "Icon for disabled breakpoint in display margin")
1932 (defun gdb-reset ()
1933 "Exit a debugging session cleanly by killing the gdb buffers and resetting
1934 the source buffers."
1935 (gdb-delete-frames '())
1936 (dolist (buffer (buffer-list))
1937 (if (not (eq buffer gud-comint-buffer))
1938 (save-excursion
1939 (set-buffer buffer)
1940 (if (eq gud-minor-mode 'gdba)
1941 (if (string-match "^\*.+*$" (buffer-name))
1942 (kill-buffer nil)
1943 (if (display-graphic-p)
1944 (remove-images (point-min) (point-max))
1945 (remove-strings (point-min) (point-max)))
1946 (setq left-margin-width 0)
1947 (setq gud-minor-mode nil)
1948 (kill-local-variable 'tool-bar-map)
1949 (setq gud-running nil)
1950 (if (get-buffer-window (current-buffer))
1951 (set-window-margins (get-buffer-window
1952 (current-buffer))
1953 left-margin-width
1954 right-margin-width))))))))
1956 (defun gdb-source-info ()
1957 "Find the source file where the program starts and displays it with related
1958 buffers."
1959 (goto-char (point-min))
1960 (when (search-forward "directory is " nil t)
1961 (looking-at "\\S-*")
1962 (setq gdb-cdir (match-string 0))
1963 (search-forward "Located in ")
1964 (looking-at "\\S-*")
1965 (setq gdb-main-file (match-string 0))
1966 ;; Make sure we are not in the minibuffer window when we try to delete
1967 ;; all other windows.
1968 (if (window-minibuffer-p (selected-window))
1969 (other-window 1))
1970 (delete-other-windows)
1971 (if gdb-many-windows
1972 (gdb-setup-windows)
1973 (gdb-display-breakpoints-buffer)
1974 (gdb-display-display-buffer)
1975 (delete-other-windows)
1976 (split-window)
1977 (other-window 1)
1978 (switch-to-buffer (gud-find-file gdb-main-file))
1979 (setq gdb-source-window (get-buffer-window (current-buffer)))
1980 (other-window 1))))
1982 ;;from put-image
1983 (defun put-string (putstring pos &optional string area)
1984 "Put string PUTSTRING in front of POS in the current buffer.
1985 PUTSTRING is displayed by putting an overlay into the current buffer with a
1986 `before-string' STRING that has a `display' property whose value is
1987 PUTSTRING. STRING is defaulted if you omit it.
1988 POS may be an integer or marker.
1989 AREA is where to display the string. AREA nil or omitted means
1990 display it in the text area, a value of `left-margin' means
1991 display it in the left marginal area, a value of `right-margin'
1992 means display it in the right marginal area."
1993 (unless string (setq string "x"))
1994 (let ((buffer (current-buffer)))
1995 (unless (or (null area) (memq area '(left-margin right-margin)))
1996 (error "Invalid area %s" area))
1997 (setq string (copy-sequence string))
1998 (let ((overlay (make-overlay pos pos buffer))
1999 (prop (if (null area) putstring (list (list 'margin area) putstring))))
2000 (put-text-property 0 (length string) 'display prop string)
2001 (overlay-put overlay 'put-text t)
2002 (overlay-put overlay 'before-string string))))
2004 ;;from remove-images
2005 (defun remove-strings (start end &optional buffer)
2006 "Remove strings between START and END in BUFFER.
2007 Remove only images that were put in BUFFER with calls to `put-string'.
2008 BUFFER nil or omitted means use the current buffer."
2009 (unless buffer
2010 (setq buffer (current-buffer)))
2011 (let ((overlays (overlays-in start end)))
2012 (while overlays
2013 (let ((overlay (car overlays)))
2014 (when (overlay-get overlay 'put-text)
2015 (delete-overlay overlay)))
2016 (setq overlays (cdr overlays)))))
2018 (defun put-arrow (putstring pos &optional string area)
2019 "Put arrow string PUTSTRING in front of POS in the current buffer.
2020 PUTSTRING is displayed by putting an overlay into the current buffer with a
2021 `before-string' \"gdb-arrow\" that has a `display' property whose value is
2022 PUTSTRING. STRING is defaulted if you omit it.
2023 POS may be an integer or marker.
2024 AREA is where to display the string. AREA nil or omitted means
2025 display it in the text area, a value of `left-margin' means
2026 display it in the left marginal area, a value of `right-margin'
2027 means display it in the right marginal area."
2028 (setq string "gdb-arrow")
2029 (let ((buffer (current-buffer)))
2030 (unless (or (null area) (memq area '(left-margin right-margin)))
2031 (error "Invalid area %s" area))
2032 (setq string (copy-sequence string))
2033 (let ((overlay (make-overlay pos pos buffer))
2034 (prop (if (null area) putstring (list (list 'margin area) putstring))))
2035 (put-text-property 0 (length string) 'display prop string)
2036 (overlay-put overlay 'put-text t)
2037 (overlay-put overlay 'before-string string))))
2039 (defun remove-arrow (&optional buffer)
2040 "Remove arrow in BUFFER.
2041 Remove only images that were put in BUFFER with calls to `put-arrow'.
2042 BUFFER nil or omitted means use the current buffer."
2043 (unless buffer
2044 (setq buffer (current-buffer)))
2045 (let ((overlays (overlays-in (point-min) (point-max))))
2046 (while overlays
2047 (let ((overlay (car overlays)))
2048 (when (string-equal (overlay-get overlay 'before-string) "gdb-arrow")
2049 (delete-overlay overlay)))
2050 (setq overlays (cdr overlays)))))
2052 (defun gdb-array-visualise ()
2053 "Visualise arrays and slices using graph program from plotutils."
2054 (interactive)
2055 (when (and (display-graphic-p) gdb-display-string)
2056 (let ((n 0) m)
2057 (catch 'multi-dimensional
2058 (while (eq (aref gdb-array-start n) (aref gdb-array-stop n))
2059 (setq n (+ n 1)))
2060 (setq m (+ n 1))
2061 (while (< m (length gdb-array-start))
2062 (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m)))
2063 (progn
2064 (x-popup-dialog
2065 t `(,(concat "Only one dimensional data can be visualised.\n"
2066 "Use an array slice to reduce the number of\n"
2067 "dimensions") ("OK" t)))
2068 (throw 'multi-dimensional nil))
2069 (setq m (+ m 1))))
2070 (shell-command (concat "echo" gdb-display-string " | graph -a 1 "
2071 (int-to-string (aref gdb-array-start n))
2072 " -x "
2073 (int-to-string (aref gdb-array-start n))
2075 (int-to-string (aref gdb-array-stop n))
2076 " 1 -T X"))))))
2078 (defun gdb-delete-expression ()
2079 "Delete displayed expression and its frame."
2080 (interactive)
2081 (gdb-enqueue-input
2082 (list (concat "server delete display " gdb-display-number "\n")
2083 'ignore)))
2086 ;; Assembler buffer.
2088 (gdb-set-buffer-rules 'gdb-assembler-buffer
2089 'gdb-assembler-buffer-name
2090 'gdb-assembler-mode)
2092 (def-gdb-auto-updated-buffer gdb-assembler-buffer
2093 gdb-invalidate-assembler
2094 (concat "server disassemble " gdb-main-or-pc "\n")
2095 gdb-assembler-handler
2096 gdb-assembler-custom)
2098 (defun gdb-assembler-custom ()
2099 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
2100 (gdb-arrow-position) (address) (flag))
2101 (if gdb-current-address
2102 (progn
2103 (save-excursion
2104 (set-buffer buffer)
2105 (remove-arrow)
2106 (goto-char (point-min))
2107 (re-search-forward gdb-current-address)
2108 (setq gdb-arrow-position (point))
2109 (put-arrow "=>" gdb-arrow-position nil 'left-margin))))
2110 ;; remove all breakpoint-icons in assembler buffer before updating.
2111 (save-excursion
2112 (set-buffer buffer)
2113 (if (display-graphic-p)
2114 (remove-images (point-min) (point-max))
2115 (remove-strings (point-min) (point-max))))
2116 (save-excursion
2117 (set-buffer (gdb-get-buffer 'gdb-breakpoints-buffer))
2118 (goto-char (point-min))
2119 (while (< (point) (- (point-max) 1))
2120 (forward-line 1)
2121 (if (looking-at "[^\t].*breakpoint")
2122 (progn
2123 (looking-at
2124 "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x0\\(\\S-*\\)")
2125 ;; info break gives '0x0' (8 digit) while dump gives '0x' (7 digit)
2126 (setq address (concat "0x" (match-string 3)))
2127 (setq flag (char-after (match-beginning 2)))
2128 (save-excursion
2129 (set-buffer buffer)
2130 (goto-char (point-min))
2131 (if (re-search-forward address nil t)
2132 (let ((start (progn (beginning-of-line) (- (point) 1)))
2133 (end (progn (end-of-line) (+ (point) 1))))
2134 (if (display-graphic-p)
2135 (progn
2136 (remove-images start end)
2137 (if (eq ?y flag)
2138 (put-image breakpoint-enabled-icon (point)
2139 "breakpoint icon enabled"
2140 'left-margin)
2141 (put-image breakpoint-disabled-icon (point)
2142 "breakpoint icon disabled"
2143 'left-margin)))
2144 (remove-strings start end)
2145 (if (eq ?y flag)
2146 (put-string "B" (point) "enabled" 'left-margin)
2147 (put-string "b" (point) "disabled"
2148 'left-margin))))))))))
2149 (if gdb-current-address
2150 (set-window-point (get-buffer-window buffer) gdb-arrow-position))))
2152 (defvar gdb-assembler-mode-map
2153 (let ((map (make-sparse-keymap)))
2154 (suppress-keymap map)
2155 map))
2157 (defun gdb-assembler-mode ()
2158 "Major mode for viewing code assembler.
2160 \\{gdb-assembler-mode-map}"
2161 (setq major-mode 'gdb-assembler-mode)
2162 (setq mode-name "Assembler")
2163 (setq left-margin-width 2)
2164 (setq buffer-read-only t)
2165 (use-local-map gdb-assembler-mode-map)
2166 (gdb-invalidate-assembler)
2167 (gdb-invalidate-breakpoints))
2169 (defun gdb-assembler-buffer-name ()
2170 (with-current-buffer gud-comint-buffer
2171 (concat "*Machine Code " (gdb-get-target-string) "*")))
2173 (defun gdb-display-assembler-buffer ()
2174 (interactive)
2175 (gdb-display-buffer
2176 (gdb-get-create-buffer 'gdb-assembler-buffer)))
2178 (defun gdb-frame-assembler-buffer ()
2179 (interactive)
2180 (switch-to-buffer-other-frame
2181 (gdb-get-create-buffer 'gdb-assembler-buffer)))
2183 (defun gdb-invalidate-frame-and-assembler (&optional ignored)
2184 (gdb-invalidate-frames)
2185 (gdb-invalidate-assembler))
2187 (defun gdb-invalidate-breakpoints-and-assembler (&optional ignored)
2188 (gdb-invalidate-breakpoints)
2189 (gdb-invalidate-assembler))
2191 (defvar gdb-prev-main-or-pc nil)
2193 ;; modified because if gdb-main-or-pc has changed value a new command
2194 ;; must be enqueued to update the buffer with the new output
2195 (defun gdb-invalidate-assembler (&optional ignored)
2196 (if (and (gdb-get-buffer 'gdb-assembler-buffer)
2197 (or (not (member 'gdb-invalidate-assembler
2198 (gdb-get-pending-triggers)))
2199 (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc))))
2200 (progn
2201 ;; take previous disassemble command off the queue
2202 (save-excursion
2203 (set-buffer gud-comint-buffer)
2204 (let ((queue gdb-idle-input-queue) (item))
2205 (while queue
2206 (setq item (car queue))
2207 (if (equal (cdr item) '(gdb-assembler-handler))
2208 (delete item gdb-idle-input-queue))
2209 (setq queue (cdr queue)))))
2210 (gdb-enqueue-idle-input
2211 (list (concat "server disassemble " gdb-main-or-pc "\n")
2212 'gdb-assembler-handler))
2213 (gdb-set-pending-triggers
2214 (cons 'gdb-invalidate-assembler
2215 (gdb-get-pending-triggers)))
2216 (setq gdb-prev-main-or-pc gdb-main-or-pc))))
2218 (defun gdb-get-current-frame ()
2219 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
2220 (progn
2221 (gdb-enqueue-idle-input
2222 (list (concat "server frame\n") 'gdb-frame-handler))
2223 (gdb-set-pending-triggers
2224 (cons 'gdb-get-current-frame
2225 (gdb-get-pending-triggers))))))
2227 (defun gdb-frame-handler ()
2228 (gdb-set-pending-triggers
2229 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
2230 (save-excursion
2231 (set-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer))
2232 (goto-char (point-min))
2233 (if (looking-at "^#[0-9]*\\s-*0x\\S-* in \\(\\S-*\\)")
2234 (setq gdb-current-frame (match-string 1))
2235 (if (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")
2236 (setq gdb-current-frame (match-string 1))))))
2238 (provide 'gdb-ui)
2240 ;;; gdb-ui.el ends here