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
)
38 (defvar gdb-first-time nil
)
39 (defvar gdb-proc nil
"The process associated with gdb.")
41 ;; Dynamically-bound vars in gud.el
42 (defvar gud-gdb-complete-string
)
43 (defvar gud-gdb-complete-break
)
44 (defvar gud-gdb-complete-list
)
45 (defvar gud-gdb-complete-in-progress
)
48 (defun gdba (command-line)
49 "Run gdb on program FILE in buffer *gdb-FILE*.
50 The directory containing FILE becomes the initial working directory
51 and source-file directory for your debugger.
53 If `gdb-many-windows' is set to t this works best in X (depending on the size
54 of your monitor) using most of the screen. After a short delay the following
55 layout will appear (keybindings given in relevant buffer) :
57 ---------------------------------------------------------------------
59 ---------------------------------------------------------------------
60 GUD buffer (I/O of gdb) | Locals buffer
64 ---------------------------------------------------------------------
65 Source buffer | Input/Output (of debuggee) buffer
73 ---------------------------------------------------------------------
74 Stack buffer | Breakpoints buffer
75 \[mouse-2\] gdb-frames-select | SPC gdb-toggle-bp-this-line
76 | g gdb-goto-bp-this-line
77 | d gdb-delete-bp-this-line
78 ---------------------------------------------------------------------
80 All the buffers share the toolbar and source should always display in the same
81 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
82 icons are displayed both by setting a break with gud-break and by typing break
85 Displayed expressions appear in separate frames. Arrays may be displayed
86 as slices and visualised using the graph program from plotutils if installed.
88 If `gdb-many-windows' is set to nil then gdb starts with just two windows :
89 the GUD and the source buffer.
91 The following interactive lisp functions help control operation :
93 `gdb-many-windows' - Toggle the number of windows gdb uses.
94 `gdb-restore-windows' - to restore the layout if its lost.
95 `gdb-quit' - to delete (most) of the buffers used by gdb."
97 (interactive (list (gud-query-cmdline 'gdba
)))
99 (gdba-common-init command-line nil
'gdba-marker-filter
)
101 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
103 (gud-def gud-tbreak
"tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
104 (gud-def gud-run
"run" nil
"Run the program.")
105 (gud-def gud-stepi
"stepi %p" "\C-i" "Step one instruction with display.")
106 (gud-def gud-step
"step %p" "\C-s" "Step one source line with display.")
107 (gud-def gud-next
"next %p" "\C-n" "Step one line (skip functions).")
108 (gud-def gud-finish
"finish" "\C-f" "Finish executing current function.")
109 (gud-def gud-cont
"cont" "\C-r" "Continue with display.")
110 (gud-def gud-up
"up %p" "<" "Up N stack frames (numeric arg).")
111 (gud-def gud-down
"down %p" ">" "Down N stack frames (numeric arg).")
112 (gud-def gud-print
"print %e" "\C-p" "Evaluate C expression at point.")
113 (gud-def gud-goto
"until %f:%l" "\C-u" "Continue up to current line.")
115 (define-key gud-mode-map
"\C-c\C-b" 'gud-break
)
116 (define-key global-map
"\C-x\C-a\C-b" 'gud-break
)
118 (define-key gud-mode-map
"\C-c\C-d" 'gud-remove
)
119 (define-key global-map
"\C-x\C-a\C-d" 'gud-remove
)
121 (local-set-key "\C-i" 'gud-gdb-complete-command
)
123 (setq comint-prompt-regexp
"^(.*gdb[+]?) *")
124 (setq comint-input-sender
'gdb-send
)
127 (setq gdb-main-or-pc
"main")
128 (setq gdb-current-address nil
)
129 (setq gdb-display-in-progress nil
)
131 (setq gud-last-last-frame nil
)
132 (setq gud-running nil
)
134 (run-hooks 'gdb-mode-hook
)
135 (setq gdb-proc
(get-buffer-process (current-buffer)))
137 (if gdb-first-time
(gdb-clear-inferior-io))
139 ; find source file and compilation directory here
140 (gdb-instance-enqueue-idle-input (list "server list\n"
142 (gdb-instance-enqueue-idle-input (list "server info source\n"
143 '(lambda () (gdb-source-info)))))
145 (defun gud-break (arg)
146 "Set breakpoint at current line or address."
148 (if (not (string-equal mode-name
"Assembler"))
149 (gud-call "break %f:%l" arg
)
154 (gud-call "break *%a" arg
))))
156 (defun gud-remove (arg)
157 "Remove breakpoint at current line or address."
159 (if (not (string-equal mode-name
"Assembler"))
160 (gud-call "clear %f:%l" arg
)
165 (gud-call "clear *%a" arg
))))
167 (defun gud-display ()
168 "Display (possibly dereferenced) C expression at point."
171 (let ((expr (gud-find-c-expr)))
172 (gdb-instance-enqueue-idle-input
173 (list (concat "server whatis " expr
"\n")
174 `(lambda () (gud-display1 ,expr
)))))))
176 (defun gud-display1 (expr)
177 (goto-char (point-min))
178 (if (re-search-forward "\*" nil t
)
179 (gdb-instance-enqueue-idle-input
180 (list (concat "server display* " expr
"\n")
183 (gdb-instance-enqueue-idle-input
184 (list (concat "server display " expr
"\n")
188 ;; The completion process filter is installed temporarily to slurp the
189 ;; output of GDB up to the next prompt and build the completion list.
190 ;; It must also handle annotations.
191 (defun gdba-complete-filter (string)
192 (gdb-output-burst string
)
193 (while (string-match "\n\032\032\\(.*\\)\n" string
)
194 (setq string
(concat (substring string
0 (match-beginning 0))
195 (substring string
(match-end 0)))))
196 (setq string
(concat gud-gdb-complete-string string
))
197 (while (string-match "\n" string
)
198 (setq gud-gdb-complete-list
199 (cons (substring string gud-gdb-complete-break
(match-beginning 0))
200 gud-gdb-complete-list
))
201 (setq string
(substring string
(match-end 0))))
202 (if (string-match comint-prompt-regexp string
)
204 (setq gud-gdb-complete-in-progress nil
)
207 (setq gud-gdb-complete-string string
)
210 (defvar gdb-target-name
"--unknown--"
211 "The apparent name of the program being debugged in a gud buffer.")
213 (defun gdba-common-init (command-line massage-args marker-filter
&optional find-file
)
215 (let* ((words (split-string command-line
))
216 (program (car words
))
218 ;; Extract the file name from WORDS
219 ;; and put t in its place.
220 ;; Later on we will put the modified file name arg back there.
221 (file-word (let ((w (cdr words
)))
222 (while (and w
(= ?-
(aref (car w
) 0)))
228 (and file-word
(substitute-in-file-name file-word
)))
232 ;; If a directory was specified, expand the file name.
233 ;; Otherwise, don't expand it, so GDB can use the PATH.
234 ;; A file name without directory is literally valid
235 ;; only if the file exists in ., and in that case,
236 ;; omitting the expansion here has no visible effect.
238 (if (file-name-directory file-subst
)
239 (expand-file-name file-subst
)
241 (filepart (and file-word
(file-name-nondirectory file
)))
242 (buffer-name (concat "*gdb-" filepart
"*")))
244 (setq gdb-first-time
(not (get-buffer-process buffer-name
)))
246 (switch-to-buffer buffer-name
)
247 ;; Set default-directory to the file's directory.
250 ;; Don't set default-directory if no directory was specified.
251 ;; In that case, either the file is found in the current directory,
252 ;; in which case this setq is a no-op,
253 ;; or it is found by searching PATH,
254 ;; in which case we don't know what directory it was found in.
255 (file-name-directory file
)
256 (setq default-directory
(file-name-directory file
)))
257 (or (bolp) (newline))
258 (insert "Current directory is " default-directory
"\n")
259 ;; Put the substituted and expanded file name back in its place.
261 (while (and w
(not (eq (car w
) t
)))
265 (apply 'make-comint
(concat "gdb-" filepart
) program nil args
)
267 (setq gdb-target-name filepart
))
268 (make-local-variable 'gud-marker-filter
)
269 (setq gud-marker-filter marker-filter
)
270 (if find-file
(set (make-local-variable 'gud-find-file
) find-file
))
272 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter
)
273 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel
)
277 ;; ======================================================================
279 ;; In this world, there are gdb instance objects (of unspecified
280 ;; representation) and buffers associated with those objects.
284 ;; gdb-instance objects
287 (defvar gdb-instance-variables
'()
288 "A list of variables that are local to the GUD buffer associated
289 with a gdb instance.")
291 ;;; The list of instance variables is built up by the expansions of
295 (defmacro def-gdb-var
(root-symbol &optional default doc
)
296 (let* ((root (symbol-name root-symbol
))
297 (accessor (intern (concat "gdb-instance-" root
)))
298 (setter (intern (concat "set-gdb-instance-" root
)))
299 (name (intern (concat "gdb-" root
))))
301 (defvar ,name
,default
,doc
)
302 (if (not (memq ',name gdb-instance-variables
))
303 (push ',name gdb-instance-variables
))
306 (let ((buffer (gdb-get-instance-buffer 'gdba
)))
307 (and buffer
(buffer-local-value ',name buffer
)))))
309 `(defun ,setter
(val)
310 (let ((buffer (gdb-get-instance-buffer 'gdba
)))
311 (and buffer
(with-current-buffer buffer
312 (setq ,name val
)))))))))
314 (def-gdb-var buffer-type nil
315 "One of the symbols bound in gdb-instance-buffer-rules")
317 (def-gdb-var burst
""
318 "A string of characters from gdb that have not yet been processed.")
320 (def-gdb-var input-queue
()
321 "A list of high priority gdb command objects.")
323 (def-gdb-var idle-input-queue
()
324 "A list of low priority gdb command objects.")
326 (def-gdb-var prompting nil
327 "True when gdb is idle with no pending input.")
329 (def-gdb-var output-sink
'user
330 "The disposition of the output of the current gdb command.
331 Possible values are these symbols:
333 user -- gdb output should be copied to the GUD buffer
336 inferior -- gdb output should be copied to the inferior-io buffer
338 pre-emacs -- output should be ignored util the post-prompt
339 annotation is received. Then the output-sink
341 emacs -- output should be collected in the partial-output-buffer
342 for subsequent processing by a command. This is the
343 disposition of output generated by commands that
344 gdb mode sends to gdb on its own behalf.
345 post-emacs -- ignore input until the prompt annotation is
346 received, then go to USER disposition.
349 (def-gdb-var current-item nil
350 "The most recent command item sent to gdb.")
352 (def-gdb-var pending-triggers
'()
353 "A list of trigger functions that have run later than their output
356 (defun in-gdb-instance-context (form)
357 "Funcall FORM in the GUD buffer."
359 (set-buffer (gdb-get-instance-buffer 'gdba
))
362 ;; end of instance vars
364 (defun gdb-make-instance ()
365 "Create a gdb instance object from a gdb process."
366 (with-current-buffer (process-buffer gdb-proc
)
368 (mapc 'make-local-variable gdb-instance-variables
)
369 (setq gdb-buffer-type
'gdba
))))
371 (defun gdb-instance-target-string ()
372 "The apparent name of the program being debugged by a gdb instance.
373 For sure this the root string used in smashing together the gdb
374 buffer's name, even if that doesn't happen to be the name of a
376 (in-gdb-instance-context
377 (function (lambda () gdb-target-name
))))
384 ;; More than one buffer can be associated with a gdb instance.
386 ;; Each buffer has a TYPE -- a symbol that identifies the function
387 ;; of that particular buffer.
389 ;; The usual gdb interaction buffer is given the type `gdb' and
390 ;; is constructed specially.
392 ;; Others are constructed by gdb-get-create-instance-buffer and
393 ;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc
395 (defvar gdb-instance-buffer-rules-assoc
'())
397 (defun gdb-get-instance-buffer (key)
398 "Return the instance buffer tagged with type KEY.
399 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
401 (gdb-look-for-tagged-buffer key
(buffer-list))))
403 (defun gdb-get-create-instance-buffer (key)
404 "Create a new gdb instance buffer of the type specified by KEY.
405 The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
406 (or (gdb-get-instance-buffer key
)
407 (let* ((rules (assoc key gdb-instance-buffer-rules-assoc
))
408 (name (funcall (gdb-rules-name-maker rules
)))
409 (new (get-buffer-create name
)))
412 (make-variable-buffer-local 'gdb-buffer-type
)
413 (setq gdb-buffer-type key
)
414 (if (cdr (cdr rules
))
415 (funcall (car (cdr (cdr rules
)))))
418 (defun gdb-rules-name-maker (rules) (car (cdr rules
)))
420 (defun gdb-look-for-tagged-buffer (key bufs
)
422 (while (and (not retval
) bufs
)
423 (set-buffer (car bufs
))
424 (if (eq gdb-buffer-type key
)
425 (setq retval
(car bufs
)))
426 (setq bufs
(cdr bufs
)))
430 ;; This assoc maps buffer type symbols to rules. Each rule is a list of
431 ;; at least one and possible more functions. The functions have these
432 ;; roles in defining a buffer type:
434 ;; NAME - take an instance, return a name for this type buffer for that
436 ;; The remaining function(s) are optional:
438 ;; MODE - called in new new buffer with no arguments, should establish
439 ;; the proper mode for the buffer.
442 (defun gdb-set-instance-buffer-rules (buffer-type &rest rules
)
443 (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc
)))
445 (setcdr binding rules
)
446 (setq gdb-instance-buffer-rules-assoc
447 (cons (cons buffer-type rules
)
448 gdb-instance-buffer-rules-assoc
)))))
450 ; GUD buffers are an exception to the rules
451 (gdb-set-instance-buffer-rules 'gdba
'error
)
454 ;; partial-output buffers
456 ;; These accumulate output from a command executed on
457 ;; behalf of emacs (rather than the user).
460 (gdb-set-instance-buffer-rules 'gdb-partial-output-buffer
461 'gdb-partial-output-name
)
463 (defun gdb-partial-output-name ()
464 (concat "*partial-output-"
465 (gdb-instance-target-string)
469 (gdb-set-instance-buffer-rules 'gdb-inferior-io
470 'gdb-inferior-io-name
471 'gdb-inferior-io-mode
)
473 (defun gdb-inferior-io-name ()
474 (concat "*input/output of "
475 (gdb-instance-target-string)
478 (defvar gdb-inferior-io-mode-map
(copy-keymap comint-mode-map
))
479 (define-key comint-mode-map
"\C-c\C-c" 'gdb-inferior-io-interrupt
)
480 (define-key comint-mode-map
"\C-c\C-z" 'gdb-inferior-io-stop
)
481 (define-key comint-mode-map
"\C-c\C-\\" 'gdb-inferior-io-quit
)
482 (define-key comint-mode-map
"\C-c\C-d" 'gdb-inferior-io-eof
)
484 (defun gdb-inferior-io-mode ()
485 "Major mode for gdb inferior-io.
488 ;; We want to use comint because it has various nifty and familiar
489 ;; features. We don't need a process, but comint wants one, so create
491 (make-comint (substring (buffer-name) 1 (- (length (buffer-name)) 1))
493 (setq major-mode
'gdb-inferior-io-mode
)
494 (setq mode-name
"Debuggee I/O")
495 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
496 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
497 (setq comint-input-sender
'gdb-inferior-io-sender
))
499 (defun gdb-inferior-io-sender (proc string
)
501 (set-buffer (process-buffer proc
))
502 (set-buffer (gdb-get-instance-buffer 'gdba
))
503 (process-send-string gdb-proc string
)
504 (process-send-string gdb-proc
"\n")))
506 (defun gdb-inferior-io-interrupt ()
507 "Interrupt the program being debugged."
508 (interactive (list gdb-proc
))
510 (get-buffer-process (gdb-get-instance-buffer 'gdba
)) comint-ptyp
))
512 (defun gdb-inferior-io-quit ()
513 "Send quit signal to the program being debugged."
514 (interactive (list gdb-proc
))
516 (get-buffer-process (gdb-get-instance-buffer 'gdba
)) comint-ptyp
))
518 (defun gdb-inferior-io-stop ()
519 "Stop the program being debugged."
520 (interactive (list gdb-proc
))
522 (get-buffer-process (gdb-get-instance-buffer 'gdba
)) comint-ptyp
))
524 (defun gdb-inferior-io-eof ()
525 "Send end-of-file to the program being debugged."
526 (interactive (list gdb-proc
))
528 (get-buffer-process (gdb-get-instance-buffer 'gdba
))))
532 ;; gdb communications
535 ;; INPUT: things sent to gdb
537 ;; Each instance has a high and low priority
538 ;; input queue. Low priority input is sent only
539 ;; when the high priority queue is idle.
541 ;; The queues are lists. Each element is either
542 ;; a string (indicating user or user-like input)
543 ;; or a list of the form:
545 ;; (INPUT-STRING HANDLER-FN)
548 ;; The handler function will be called from the
549 ;; partial-output buffer when the command completes.
550 ;; This is the way to write commands which
551 ;; invoke gdb commands autonomously.
553 ;; These lists are consumed tail first.
556 (defun gdb-send (proc string
)
557 "A comint send filter for gdb.
558 This filter may simply queue output for a later time."
559 (gdb-instance-enqueue-input (concat string
"\n")))
561 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
562 ;; is a query, or other non-top-level prompt. To guarantee stuff will get
563 ;; sent to the top-level prompt, currently it must be put in the idle queue.
565 ;; [This should encourage gdb extensions that invoke gdb commands to let
566 ;; the user go first; it is not a bug. -t]
569 (defun gdb-instance-enqueue-input (item)
570 (if (gdb-instance-prompting)
573 (set-gdb-instance-prompting nil
))
574 (set-gdb-instance-input-queue
575 (cons item
(gdb-instance-input-queue)))))
577 (defun gdb-instance-dequeue-input ()
578 (let ((queue (gdb-instance-input-queue)))
580 (if (not (cdr queue
))
581 (let ((answer (car queue
)))
582 (set-gdb-instance-input-queue '())
584 (gdb-take-last-elt queue
)))))
586 (defun gdb-instance-enqueue-idle-input (item)
587 (if (and (gdb-instance-prompting)
588 (not (gdb-instance-input-queue)))
591 (set-gdb-instance-prompting nil
))
592 (set-gdb-instance-idle-input-queue
593 (cons item
(gdb-instance-idle-input-queue)))))
595 (defun gdb-instance-dequeue-idle-input ()
596 (let ((queue (gdb-instance-idle-input-queue)))
598 (if (not (cdr queue
))
599 (let ((answer (car queue
)))
600 (set-gdb-instance-idle-input-queue '())
602 (gdb-take-last-elt queue
)))))
604 ; Don't use this in general.
605 (defun gdb-take-last-elt (l)
607 (gdb-take-last-elt (cdr l
))
608 (let ((answer (car (cdr l
))))
614 ;; output -- things gdb prints to emacs
616 ;; GDB output is a stream interrupted by annotations.
617 ;; Annotations can be recognized by their beginning
618 ;; with \C-j\C-z\C-z<tag><opt>\C-j
620 ;; The tag is a string obeying symbol syntax.
622 ;; The optional part `<opt>' can be either the empty string
623 ;; or a space followed by more data relating to the annotation.
624 ;; For example, the SOURCE annotation is followed by a filename,
625 ;; line number and various useless goo. This data must not include
629 (defcustom gud-gdba-command-name
"gdb -annotate=2"
630 "Default command to execute an executable under the GDB debugger (gdb-ui.el)."
634 (defun gdba-marker-filter (string)
635 "A gud marker filter for gdb."
636 ;; Bogons don't tell us the process except through scoping crud.
637 (gdb-output-burst string
))
639 (defvar gdb-annotation-rules
640 '(("frames-invalid" gdb-invalidate-frame-and-assembler
)
641 ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler
)
642 ("pre-prompt" gdb-pre-prompt
)
643 ("prompt" gdb-prompt
)
644 ("commands" gdb-subprompt
)
645 ("overload-choice" gdb-subprompt
)
646 ("query" gdb-subprompt
)
647 ("prompt-for-continue" gdb-subprompt
)
648 ("post-prompt" gdb-post-prompt
)
649 ("source" gdb-source
)
650 ("starting" gdb-starting
)
651 ("exited" gdb-stopping
)
652 ("signalled" gdb-stopping
)
653 ("signal" gdb-stopping
)
654 ("breakpoint" gdb-stopping
)
655 ("watchpoint" gdb-stopping
)
656 ("frame-begin" gdb-frame-begin
)
657 ("stopped" gdb-stopped
)
658 ("display-begin" gdb-display-begin
)
659 ("display-end" gdb-display-end
)
660 ("display-number-end" gdb-display-number-end
)
661 ("array-section-begin" gdb-array-section-begin
)
662 ("array-section-end" gdb-array-section-end
)
664 ("field-begin" gdb-field-begin
)
665 ("field-end" gdb-field-end
)
666 ) "An assoc mapping annotation tags to functions which process them.")
668 (defun gdb-ignore-annotation (args)
671 (defconst gdb-source-spec-regexp
672 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
674 ;; Do not use this except as an annotation handler.
675 (defun gdb-source (args)
676 (string-match gdb-source-spec-regexp args
)
677 ;; Extract the frame position from the marker.
680 (substring args
(match-beginning 1) (match-end 1))
681 (string-to-int (substring args
684 (setq gdb-current-address
(substring args
(match-beginning 3)
686 (setq gdb-main-or-pc gdb-current-address
)
687 ;update with new frame for machine code if necessary
688 (gdb-invalidate-assembler))
690 (defun gdb-prompt (ignored)
691 "An annotation handler for `prompt'.
692 This sends the next command (if any) to gdb."
693 (let ((sink (gdb-instance-output-sink)))
696 ((eq sink
'post-emacs
)
697 (set-gdb-instance-output-sink 'user
))
699 (set-gdb-instance-output-sink 'user
)
700 (error "Phase error in gdb-prompt (got %s)" sink
))))
701 (let ((highest (gdb-instance-dequeue-input)))
703 (gdb-send-item highest
)
704 (let ((lowest (gdb-instance-dequeue-idle-input)))
706 (gdb-send-item lowest
)
708 (set-gdb-instance-prompting t
)
709 (gud-display-frame)))))))
711 (defun gdb-subprompt (ignored)
712 "An annotation handler for non-top-level prompts."
713 (let ((highest (gdb-instance-dequeue-input)))
715 (gdb-send-item highest
)
716 (set-gdb-instance-prompting t
))))
718 (defun gdb-send-item (item)
719 (set-gdb-instance-current-item item
)
722 (set-gdb-instance-output-sink 'user
)
723 (process-send-string gdb-proc item
))
725 (gdb-clear-partial-output)
726 (set-gdb-instance-output-sink 'pre-emacs
)
727 (process-send-string gdb-proc
(car item
)))))
729 (defun gdb-pre-prompt (ignored)
730 "An annotation handler for `pre-prompt'. This terminates the collection of
731 output from a previous command if that happens to be in effect."
732 (let ((sink (gdb-instance-output-sink)))
736 (set-gdb-instance-output-sink 'post-emacs
)
738 (car (cdr (gdb-instance-current-item)))))
740 (set-buffer (gdb-get-create-instance-buffer
741 'gdb-partial-output-buffer
))
744 (set-gdb-instance-output-sink 'user
)
745 (error "Output sink phase error 1")))))
747 (defun gdb-starting (ignored)
748 "An annotation handler for `starting'. This says that I/O for the
749 subprocess is now the program being debugged, not GDB."
750 (let ((sink (gdb-instance-output-sink)))
755 (set-gdb-instance-output-sink 'inferior
)))
756 (t (error "Unexpected `starting' annotation")))))
758 (defun gdb-stopping (ignored)
759 "An annotation handler for `exited' and other annotations which say that I/O
760 for the subprocess is now GDB, not the program being debugged."
761 (let ((sink (gdb-instance-output-sink)))
764 (set-gdb-instance-output-sink 'user
))
765 (t (error "Unexpected stopping annotation")))))
767 (defun gdb-stopped (ignored)
768 "An annotation handler for `stopped'. It is just like gdb-stopping, except
769 that if we already set the output sink to 'user in gdb-stopping, that is fine."
770 (setq gud-running nil
)
771 (let ((sink (gdb-instance-output-sink)))
774 (set-gdb-instance-output-sink 'user
))
776 (t (error "Unexpected stopped annotation")))))
778 (defun gdb-frame-begin (ignored)
779 (let ((sink (gdb-instance-output-sink)))
782 (set-gdb-instance-output-sink 'user
))
785 (t (error "Unexpected frame-begin annotation (%S)" sink
)))))
787 (defun gdb-post-prompt (ignored)
788 "An annotation handler for `post-prompt'. This begins the collection of
789 output from the current command if that happens to be appropriate."
790 (if (not (gdb-instance-pending-triggers))
792 (gdb-invalidate-registers ignored
)
793 (gdb-invalidate-locals ignored
)
794 (gdb-invalidate-display ignored
)))
795 (let ((sink (gdb-instance-output-sink)))
798 ((eq sink
'pre-emacs
)
799 (set-gdb-instance-output-sink 'emacs
))
801 (set-gdb-instance-output-sink 'user
)
802 (error "Output sink phase error 3")))))
804 ;; If we get an error whilst evaluating one of the expressions
805 ;; we won't get the display-end annotation. Set the sink back to
806 ;; user to make sure that the error message is seen
807 (defun gdb-error-begin (ignored)
808 (set-gdb-instance-output-sink 'user
))
810 (defun gdb-display-begin (ignored)
811 (if (gdb-get-instance-buffer 'gdb-display-buffer
)
813 (set-gdb-instance-output-sink 'emacs
)
814 (gdb-clear-partial-output)
815 (setq gdb-display-in-progress t
))
816 (set-gdb-instance-output-sink 'user
)))
818 (defvar gdb-expression-buffer-name
)
819 (defvar gdb-display-number
)
820 (defvar gdb-dive-display-number
)
822 (defun gdb-display-number-end (ignored)
823 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
824 (setq gdb-display-number
(buffer-string))
825 (setq gdb-expression-buffer-name
826 (concat "*display " gdb-display-number
"*"))
829 (set-buffer (window-buffer))
832 (let ((number gdb-display-number
))
834 (set-buffer (get-buffer-create gdb-expression-buffer-name
)))
835 (gdb-expressions-mode)
836 (setq gdb-dive-display-number number
)))
838 (set-buffer (get-buffer-create gdb-expression-buffer-name
))
839 (if (and (display-graphic-p) (not gdb-dive
))
841 (let ((frames (frame-list)))
843 (if (string-equal (frame-parameter (car frames
) 'name
)
844 gdb-expression-buffer-name
)
845 (throw 'frame-exists nil
))
846 (setq frames
(cdr frames
)))
849 (gdb-expressions-mode)
850 (make-frame '((height .
20) (width .
40)
851 (tool-bar-lines . nil
)
852 (menu-bar-lines . nil
)
853 (minibuffer . nil
))))))))))
854 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
857 (defvar gdb-current-frame nil
)
858 (defvar gdb-nesting-level
)
859 (defvar gdb-expression
)
861 (defvar gdb-annotation-arg
)
863 (defun gdb-display-end (ignored)
864 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
865 (goto-char (point-min))
866 (search-forward ": ")
867 (looking-at "\\(.*?\\) =")
869 (gdb-temp-value (buffer-substring (match-beginning 1)
871 ;move * to front of expression if necessary
872 (if (looking-at ".*\\*")
875 (setq gdb-temp-value
(substring gdb-temp-value
1 nil
))))
877 (set-buffer gdb-expression-buffer-name
)
878 (setq gdb-expression gdb-temp-value
)
879 (if (not (string-match "::" gdb-expression
))
880 (setq gdb-expression
(concat char gdb-current-frame
881 "::" gdb-expression
))
882 ;else put * back on if necessary
883 (setq gdb-expression
(concat char gdb-expression
)))
884 (setq header-line-format
(concat "-- " gdb-expression
" %-"))))
887 (if (not (re-search-forward "##" nil t
))
890 (set-buffer gdb-expression-buffer-name
)
891 (setq buffer-read-only nil
)
892 (delete-region (point-min) (point-max))
893 (insert-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
894 (setq buffer-read-only t
)))
896 ; display expression name...
897 (goto-char (point-min))
898 (let ((start (progn (point)))
899 (end (progn (end-of-line) (point))))
901 (set-buffer gdb-expression-buffer-name
)
902 (setq buffer-read-only nil
)
903 (delete-region (point-min) (point-max))
904 (insert-buffer-substring (gdb-get-instance-buffer
905 'gdb-partial-output-buffer
)
908 (goto-char (point-min))
909 (re-search-forward "##" nil t
)
910 (setq gdb-nesting-level
0)
911 (if (looking-at "array-section-begin")
915 (setq gdb-point
(point))
917 (if (looking-at "field-begin \\(.\\)")
919 (setq gdb-annotation-arg
(buffer-substring (match-beginning 1)
921 (gdb-field-format-begin))))
923 (set-buffer gdb-expression-buffer-name
)
924 (if gdb-dive-display-number
926 (setq buffer-read-only nil
)
927 (goto-char (point-max))
929 (insert-text-button "[back]" 'type
'gdb-display-back
)
930 (setq buffer-read-only t
))))
931 (gdb-clear-partial-output)
932 (set-gdb-instance-output-sink 'user
)
933 (setq gdb-display-in-progress nil
))
935 (define-button-type 'gdb-display-back
936 'help-echo
(purecopy "mouse-2, RET: go back to previous display buffer")
937 'action
(lambda (button) (gdb-display-go-back)))
939 (defun gdb-display-go-back ()
940 ; delete display so they don't accumulate and delete buffer
941 (let ((number gdb-display-number
))
942 (gdb-instance-enqueue-idle-input
943 (list (concat "server delete display " number
"\n")
945 (switch-to-buffer (concat "*display " gdb-dive-display-number
"*"))
946 (kill-buffer (get-buffer (concat "*display " number
"*")))))
948 ; prefix annotations with ## and process whole output in one chunk
949 ; in gdb-partial-output-buffer (to allow recursion).
951 ; array-section flags are just removed again but after counting. They
952 ; might also be useful for arrays of structures and structures with arrays.
953 (defun gdb-array-section-begin (args)
954 (if gdb-display-in-progress
957 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
958 (goto-char (point-max))
959 (insert (concat "\n##array-section-begin " args
"\n"))))))
961 (defun gdb-array-section-end (ignored)
962 (if gdb-display-in-progress
965 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
966 (goto-char (point-max))
967 (insert "\n##array-section-end\n")))))
969 (defun gdb-field-begin (args)
970 (if gdb-display-in-progress
973 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
974 (goto-char (point-max))
975 (insert (concat "\n##field-begin " args
"\n"))))))
977 (defun gdb-field-end (ignored)
978 (if gdb-display-in-progress
981 (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer
))
982 (goto-char (point-max))
983 (insert "\n##field-end\n")))))
985 (defun gdb-elt (ignored)
986 (if gdb-display-in-progress
988 (goto-char (point-max))
989 (insert "\n##elt\n"))))
991 (defun gdb-field-format-begin ()
992 ; get rid of ##field-begin
995 (setq gdb-nesting-level
(+ gdb-nesting-level
1))
996 (while (re-search-forward "##" nil t
)
997 ; keep making recursive calls...
998 (if (looking-at "field-begin \\(.\\)")
1000 (setq gdb-annotation-arg
(buffer-substring (match-beginning 1)
1002 (gdb-field-format-begin)))
1004 (if (looking-at "field-end") (gdb-field-format-end))))
1006 (defun gdb-field-format-end ()
1007 ; get rid of ##field-end and `,' or `}'
1010 (setq gdb-nesting-level
(- gdb-nesting-level
1)))
1012 (defvar gdb-dive-map nil
)
1014 (setq gdb-dive-map
(make-keymap))
1015 (define-key gdb-dive-map
[mouse-2
] 'gdb-dive
)
1016 (define-key gdb-dive-map
[S-mouse-2
] 'gdb-dive-new-frame
)
1018 (defun gdb-dive (event)
1019 "Dive into structure."
1022 (gdb-dive-new-frame event
))
1024 (defun gdb-dive-new-frame (event)
1025 "Dive into structure and display in a new frame."
1028 (mouse-set-point event
)
1029 (let ((point (point)) (gdb-full-expression gdb-expression
)
1030 (end (progn (end-of-line) (point)))
1031 (gdb-part-expression "") (gdb-last-field nil
) (gdb-display-char nil
))
1033 (if (looking-at "\*") (setq gdb-display-char
"*"))
1034 (re-search-forward "\\(\\S-+\\) = " end t
)
1035 (setq gdb-last-field
(buffer-substring-no-properties
1038 (goto-char (match-beginning 1))
1039 (let ((last-column (current-column)))
1040 (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t
)
1041 (goto-char (match-beginning 1))
1042 (if (and (< (current-column) last-column
)
1043 (> (count-lines 1 (point)) 1))
1045 (setq gdb-part-expression
1046 (concat "." (buffer-substring-no-properties
1048 (match-end 1)) gdb-part-expression
))
1049 (setq last-column
(current-column))))))
1050 ; * not needed for components of a pointer to a structure in gdb
1051 (if (string-equal "*" (substring gdb-full-expression
0 1))
1052 (setq gdb-full-expression
(substring gdb-full-expression
1 nil
)))
1053 (setq gdb-full-expression
1054 (concat gdb-full-expression gdb-part-expression
"." gdb-last-field
))
1055 (gdb-instance-enqueue-idle-input (list
1056 (concat "server display" gdb-display-char
1057 " " gdb-full-expression
"\n")
1058 '(lambda () nil
))))))
1060 (defun gdb-insert-field ()
1061 (let ((start (progn (point)))
1062 (end (progn (next-line) (point)))
1065 (set-buffer gdb-expression-buffer-name
)
1066 (setq buffer-read-only nil
)
1067 (if (string-equal gdb-annotation-arg
"\*") (insert "\*"))
1068 (while (<= num gdb-nesting-level
)
1070 (setq num
(+ num
1)))
1071 (insert-buffer-substring (gdb-get-instance-buffer
1072 'gdb-partial-output-buffer
)
1074 (put-text-property (- (point) (- end start
)) (- (point) 1)
1075 'mouse-face
'highlight
)
1076 (put-text-property (- (point) (- end start
)) (- (point) 1)
1077 'local-map gdb-dive-map
)
1078 (setq buffer-read-only t
))
1079 (delete-region start end
)))
1083 (defun gdb-array-format ()
1084 (while (re-search-forward "##" nil t
)
1085 ; keep making recursive calls...
1086 (if (looking-at "array-section-begin")
1088 ;get rid of ##array-section-begin
1090 (setq gdb-nesting-level
(+ gdb-nesting-level
1))
1091 (gdb-array-format)))
1092 ;until *matching* array-section-end is found
1093 (if (looking-at "array-section-end")
1094 (if (eq gdb-nesting-level
0)
1096 (let ((values (buffer-substring gdb-point
(- (point) 2))))
1098 (set-buffer gdb-expression-buffer-name
)
1100 (concat "{" (replace-regexp-in-string "\n" "" values
)
1102 (gdb-array-format1))))
1103 ;else get rid of ##array-section-end etc
1105 (setq gdb-nesting-level
(- gdb-nesting-level
1))
1106 (gdb-array-format)))))
1108 (defvar gdb-array-start
)
1109 (defvar gdb-array-stop
)
1111 (defvar gdb-array-slice-map nil
)
1112 (setq gdb-array-slice-map
(make-keymap))
1113 (define-key gdb-array-slice-map
[mouse-2
] 'gdb-array-slice
)
1115 (defun gdb-array-slice (event)
1116 "Select an array slice to display."
1118 (mouse-set-point event
)
1120 (let ((n -
1) (stop 0) (start 0) (point (point)))
1122 (while (search-forward "[" point t
)
1124 (setq start
(string-to-int (read-string "Start index: ")))
1125 (aset gdb-array-start n start
)
1126 (setq stop
(string-to-int (read-string "Stop index: ")))
1127 (aset gdb-array-stop n stop
)))
1128 (gdb-array-format1))
1130 (defvar gdb-display-string
)
1131 (defvar gdb-array-size
)
1133 (defun gdb-array-format1 ()
1134 (setq gdb-display-string
"")
1135 (setq buffer-read-only nil
)
1136 (delete-region (point-min) (point-max))
1137 (let ((gdb-value-list (split-string gdb-values
", ")))
1138 (string-match "\\({+\\)" (car gdb-value-list
))
1139 (let* ((depth (- (match-end 1) (match-beginning 1)))
1140 (indices (make-vector depth
'0))
1141 (index 0) (num 0) (array-start "")
1142 (array-stop "") (array-slice "") (array-range nil
)
1143 (flag t
) (indices-string ""))
1144 (while gdb-value-list
1145 (string-match "{*\\([^}]*\\)\\(}*\\)" (car gdb-value-list
))
1147 (while (< num depth
)
1148 (setq indices-string
1149 (concat indices-string
1150 "[" (int-to-string (aref indices num
)) "]"))
1151 (if (not (= (aref gdb-array-start num
) -
1))
1152 (if (or (< (aref indices num
) (aref gdb-array-start num
))
1153 (> (aref indices num
) (aref gdb-array-stop num
)))
1155 (aset gdb-array-size num
(aref indices num
)))
1156 (setq num
(+ num
1)))
1158 (let ((gdb-display-value (substring (car gdb-value-list
)
1161 (setq gdb-display-string
(concat gdb-display-string
" "
1164 (concat indices-string
"\t" gdb-display-value
"\n"))))
1165 (setq indices-string
"")
1167 ; 0<= index < depth, start at right : (- depth 1)
1168 (setq index
(- (- depth
1)
1169 (- (match-end 2) (match-beginning 2))))
1170 ;don't set for very last brackets
1173 (aset indices index
(+ 1 (aref indices index
)))
1174 (setq num
(+ 1 index
))
1175 (while (< num depth
)
1176 (aset indices num
0)
1177 (setq num
(+ num
1)))))
1178 (setq gdb-value-list
(cdr gdb-value-list
)))
1180 (while (< num depth
)
1181 (if (= (aref gdb-array-start num
) -
1)
1183 (aset gdb-array-start num
0)
1184 (aset gdb-array-stop num
(aref indices num
))))
1185 (setq array-start
(int-to-string (aref gdb-array-start num
)))
1186 (setq array-stop
(int-to-string (aref gdb-array-stop num
)))
1187 (setq array-range
(concat "[" array-start
1188 ":" array-stop
"]"))
1189 (put-text-property 1 (+ (length array-start
)
1190 (length array-stop
) 2)
1191 'mouse-face
'highlight array-range
)
1192 (put-text-property 1 (+ (length array-start
)
1193 (length array-stop
) 2)
1194 'local-map gdb-array-slice-map array-range
)
1195 (goto-char (point-min))
1196 (setq array-slice
(concat array-slice array-range
))
1197 (setq num
(+ num
1)))
1198 (goto-char (point-min))
1199 (insert "Array Size : ")
1201 (while (< num depth
)
1204 (int-to-string (+ (aref gdb-array-size num
) 1)) "]"))
1205 (setq num
(+ num
1)))
1207 (concat "\n Slice : " array-slice
"\n\nIndex\tValues\n\n"))))
1208 (setq buffer-read-only t
))
1210 ;; Handle a burst of output from a gdb instance.
1211 ;; This function is (indirectly) used as a gud-marker-filter.
1212 ;; It must return output (if any) to be inserted in the gdb
1215 (defun gdb-output-burst (string)
1216 "Handle a burst of output from a gdb instance.
1217 This function is (indirectly) used as a gud-marker-filter.
1218 It must return output (if any) to be insterted in the gdb
1222 ;; Recall the left over burst from last time
1223 (burst (concat (gdb-instance-burst) string
))
1224 ;; Start accumulating output for the GUD buffer
1227 ;; Process all the complete markers in this chunk.
1228 (while (string-match "\n\032\032\\(.*\\)\n" burst
)
1229 (let ((annotation (substring burst
1233 ;; Stuff prior to the match is just ordinary output.
1234 ;; It is either concatenated to OUTPUT or directed
1239 (substring burst
0 (match-beginning 0))))
1241 ;; Take that stuff off the burst.
1242 (setq burst
(substring burst
(match-end 0)))
1244 ;; Parse the tag from the annotation, and maybe its arguments.
1245 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation
)
1246 (let* ((annotation-type (substring annotation
1249 (annotation-arguments (substring annotation
1252 (annotation-rule (assoc annotation-type
1253 gdb-annotation-rules
)))
1254 ;; Call the handler for this annotation.
1256 (funcall (car (cdr annotation-rule
))
1257 annotation-arguments
)
1258 ;; Else the annotation is not recognized. Ignore it silently,
1259 ;; so that GDB can add new annotations without causing
1263 ;; Does the remaining text end in a partial line?
1264 ;; If it does, then keep part of the burst until we get more.
1265 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1268 ;; Everything before the potential marker start can be output.
1270 (gdb-concat-output output
1271 (substring burst
0 (match-beginning 0))))
1273 ;; Everything after, we save, to combine with later input.
1274 (setq burst
(substring burst
(match-beginning 0))))
1276 ;; In case we know the burst contains no partial annotations:
1278 (setq output
(gdb-concat-output output burst
))
1281 ;; Save the remaining burst for the next call to this function.
1282 (set-gdb-instance-burst burst
)
1285 (defun gdb-concat-output (so-far new
)
1286 (let ((sink (gdb-instance-output-sink )))
1288 ((eq sink
'user
) (concat so-far new
))
1289 ((or (eq sink
'pre-emacs
) (eq sink
'post-emacs
)) so-far
)
1291 (gdb-append-to-partial-output new
)
1293 ((eq sink
'inferior
)
1294 (gdb-append-to-inferior-io new
)
1296 (t (error "Bogon output sink %S" sink
)))))
1298 (defun gdb-append-to-partial-output (string)
1301 (gdb-get-create-instance-buffer 'gdb-partial-output-buffer
))
1302 (goto-char (point-max))
1305 (defun gdb-clear-partial-output ()
1308 (gdb-get-create-instance-buffer 'gdb-partial-output-buffer
))
1309 (delete-region (point-min) (point-max))))
1311 (defun gdb-append-to-inferior-io (string)
1314 (gdb-get-create-instance-buffer 'gdb-inferior-io
))
1315 (goto-char (point-max))
1316 (insert-before-markers string
))
1318 (gdb-get-create-instance-buffer 'gdb-inferior-io
)))
1320 (defun gdb-clear-inferior-io ()
1323 (gdb-get-create-instance-buffer 'gdb-inferior-io
))
1324 (delete-region (point-min) (point-max))))
1327 ;; One trick is to have a command who's output is always available in
1328 ;; a buffer of it's own, and is always up to date. We build several
1329 ;; buffers of this type.
1331 ;; There are two aspects to this: gdb has to tell us when the output
1332 ;; for that command might have changed, and we have to be able to run
1333 ;; the command behind the user's back.
1335 ;; The idle input queue and the output phasing associated with
1336 ;; the instance variable `(gdb-instance-output-sink)' help
1337 ;; us to run commands behind the user's back.
1339 ;; Below is the code for specificly managing buffers of output from one
1343 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1344 ;; It adds an idle input for the command we are tracking. It should be the
1345 ;; annotation rule binding of whatever gdb sends to tell us this command
1346 ;; might have changed it's output.
1348 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1349 ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1350 ;; input in the input queue (see comment about ``gdb communications'' above).
1352 (defmacro def-gdb-auto-update-trigger
(name demand-predicate gdb-command
1354 `(defun ,name
(&optional ignored
)
1355 (if (and (,demand-predicate
)
1357 (gdb-instance-pending-triggers))))
1359 (gdb-instance-enqueue-idle-input
1360 (list ,gdb-command
',output-handler
))
1361 (set-gdb-instance-pending-triggers
1363 (gdb-instance-pending-triggers)))))))
1365 (defmacro def-gdb-auto-update-handler
(name trigger buf-key custom-defun
)
1367 (set-gdb-instance-pending-triggers
1369 (gdb-instance-pending-triggers)))
1370 (let ((buf (gdb-get-instance-buffer ',buf-key
)))
1375 (buffer-read-only nil
))
1376 (delete-region (point-min) (point-max))
1377 (insert-buffer (gdb-get-create-instance-buffer
1378 'gdb-partial-output-buffer
))
1380 ; put customisation here
1383 (defmacro def-gdb-auto-updated-buffer
1384 (buffer-key trigger-name gdb-command output-handler-name custom-defun
)
1386 (def-gdb-auto-update-trigger ,trigger-name
1387 ;; The demand predicate:
1389 (gdb-get-instance-buffer ',buffer-key
))
1391 ,output-handler-name
)
1392 (def-gdb-auto-update-handler ,output-handler-name
1393 ,trigger-name
,buffer-key
,custom-defun
)))
1397 ;; Breakpoint buffers
1399 ;; These display the output of `info breakpoints'.
1402 (gdb-set-instance-buffer-rules 'gdb-breakpoints-buffer
1403 'gdb-breakpoints-buffer-name
1404 'gdb-breakpoints-mode
)
1406 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1407 ;; This defines the auto update rule for buffers of type
1408 ;; `gdb-breakpoints-buffer'.
1410 ;; It defines a function to serve as the annotation handler that
1411 ;; handles the `foo-invalidated' message. That function is called:
1412 gdb-invalidate-breakpoints
1414 ;; To update the buffer, this command is sent to gdb.
1415 "server info breakpoints\n"
1417 ;; This also defines a function to be the handler for the output
1418 ;; from the command above. That function will copy the output into
1419 ;; the appropriately typed buffer. That function will be called:
1420 gdb-info-breakpoints-handler
1421 ;; buffer specific functions
1422 gdb-info-breakpoints-custom
)
1424 (defvar gdb-cdir nil
"Compilation directory.")
1425 (defvar breakpoint-enabled-icon
1426 "Icon for enabled breakpoint in display margin")
1427 (defvar breakpoint-disabled-icon
1428 "Icon for disabled breakpoint in display margin")
1430 ;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1431 (defun gdb-info-breakpoints-custom ()
1432 (let ((flag)(address))
1434 ; remove all breakpoint-icons in source buffers but not assembler buffer
1435 (let ((buffers (buffer-list)))
1438 (set-buffer (car buffers
))
1439 (if (and (eq gud-minor-mode
'gdba
)
1440 (not (string-match "^\*" (buffer-name))))
1441 (if (display-graphic-p)
1442 (remove-images (point-min) (point-max))
1443 (remove-strings (point-min) (point-max))))
1444 (setq buffers
(cdr buffers
)))))
1447 (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer
))
1449 (goto-char (point-min))
1450 (while (< (point) (- (point-max) 1))
1452 (if (looking-at "[^\t].*breakpoint")
1454 (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1455 (setq flag
(char-after (match-beginning 2)))
1457 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+")
1458 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1459 (let ((line (buffer-substring (match-beginning 2)
1461 (file (buffer-substring (match-beginning 1)
1465 (if (file-exists-p file
)
1466 (find-file-noselect file
)
1468 (find-file-noselect (concat gdb-cdir
"/" file
))))
1469 (with-current-buffer (current-buffer)
1471 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1472 (set (make-local-variable 'tool-bar-map
)
1474 (setq left-margin-width
2)
1475 (if (get-buffer-window (current-buffer))
1476 (set-window-margins (get-buffer-window
1479 right-margin-width
))))
1480 ; only want one breakpoint icon at each location
1482 (goto-line (string-to-number line
))
1483 (let ((start (progn (beginning-of-line) (- (point) 1)))
1484 (end (progn (end-of-line) (+ (point) 1))))
1485 (if (display-graphic-p)
1487 (remove-images start end
)
1489 (put-image breakpoint-enabled-icon
(point)
1490 "breakpoint icon enabled"
1492 (put-image breakpoint-disabled-icon
(point)
1493 "breakpoint icon disabled"
1495 (remove-strings start end
)
1497 (put-string "B" (point) "enabled"
1499 (put-string "b" (point) "disabled"
1500 'left-margin
)))))))))
1503 (defun gdb-breakpoints-buffer-name ()
1505 (set-buffer (process-buffer gdb-proc
))
1506 (concat "*breakpoints of " (gdb-instance-target-string) "*")))
1508 (defun gdb-display-breakpoints-buffer ()
1509 (interactive (list gdb-proc
))
1511 (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer
)))
1513 (defun gdb-frame-breakpoints-buffer ()
1514 (interactive (list gdb-proc
))
1515 (switch-to-buffer-other-frame
1516 (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer
)))
1518 (defvar gdb-breakpoints-mode-map nil
)
1519 (setq gdb-breakpoints-mode-map
(make-keymap))
1520 (suppress-keymap gdb-breakpoints-mode-map
)
1522 (define-key gdb-breakpoints-mode-map
[menu-bar breakpoints
]
1523 (cons "Breakpoints" (make-sparse-keymap "Breakpoints")))
1524 (define-key gdb-breakpoints-mode-map
[menu-bar breakpoints toggle
]
1525 '("Toggle" . gdb-toggle-bp-this-line
))
1526 (define-key gdb-breakpoints-mode-map
[menu-bar breakpoints delete
]
1527 '("Delete" . gdb-delete-bp-this-line
))
1528 (define-key gdb-breakpoints-mode-map
[menu-bar breakpoints goto
]
1529 '("Goto" . gdb-goto-bp-this-line
))
1531 (define-key gdb-breakpoints-mode-map
" " 'gdb-toggle-bp-this-line
)
1532 (define-key gdb-breakpoints-mode-map
"d" 'gdb-delete-bp-this-line
)
1533 (define-key gdb-breakpoints-mode-map
"g" 'gdb-goto-bp-this-line
)
1535 (defun gdb-breakpoints-mode ()
1536 "Major mode for gdb breakpoints.
1538 \\{gdb-breakpoints-mode-map}"
1539 (setq major-mode
'gdb-breakpoints-mode
)
1540 (setq mode-name
"Breakpoints")
1541 (use-local-map gdb-breakpoints-mode-map
)
1542 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1543 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
1544 (setq buffer-read-only t
)
1545 (gdb-invalidate-breakpoints))
1547 (defun gdb-toggle-bp-this-line ()
1548 "Enable/disable the breakpoint on this line."
1551 (beginning-of-line 1)
1552 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1553 (error "Not recognized as break/watchpoint line")
1554 (gdb-instance-enqueue-idle-input
1557 (if (eq ?y
(char-after (match-beginning 2)))
1560 (buffer-substring (match-beginning 0)
1563 '(lambda () nil
))))))
1565 (defun gdb-delete-bp-this-line ()
1566 "Delete the breakpoint on this line."
1568 (beginning-of-line 1)
1569 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1570 (error "Not recognized as break/watchpoint line")
1571 (gdb-instance-enqueue-idle-input
1575 (buffer-substring (match-beginning 0)
1578 '(lambda () nil
)))))
1580 (defvar gdb-source-window nil
)
1582 (defun gdb-goto-bp-this-line ()
1583 "Display the file at the specified breakpoint."
1586 (beginning-of-line 1)
1587 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+")
1588 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1589 (let ((line (buffer-substring (match-beginning 2)
1591 (file (buffer-substring (match-beginning 1)
1593 (if (file-exists-p file
)
1594 (set-window-buffer gdb-source-window
(find-file-noselect file
))
1596 (setq file
(concat gdb-cdir
"/" file
))
1597 (set-window-buffer gdb-source-window
(find-file-noselect file
)))
1598 (goto-line (string-to-number line
))))
1601 ;; Frames buffers. These display a perpetually correct bactracktrace
1602 ;; (from the command `where').
1604 ;; Alas, if your stack is deep, they are costly.
1607 (gdb-set-instance-buffer-rules 'gdb-stack-buffer
1608 'gdb-stack-buffer-name
1611 (def-gdb-auto-updated-buffer gdb-stack-buffer
1612 gdb-invalidate-frames
1614 gdb-info-frames-handler
1615 gdb-info-frames-custom
)
1617 (defun gdb-info-frames-custom ()
1619 (set-buffer (gdb-get-instance-buffer 'gdb-stack-buffer
))
1620 (let ((buffer-read-only nil
))
1621 (goto-char (point-min))
1622 (looking-at "\\S-*\\s-*\\(\\S-*\\)")
1623 (setq gdb-current-frame
(buffer-substring (match-beginning 1) (match-end 1)))
1624 (while (< (point) (point-max))
1625 (put-text-property (progn (beginning-of-line) (point))
1626 (progn (end-of-line) (point))
1627 'mouse-face
'highlight
)
1628 (forward-line 1)))))
1630 (defun gdb-stack-buffer-name ()
1632 (set-buffer (process-buffer gdb-proc
))
1633 (concat "*stack frames of "
1634 (gdb-instance-target-string) "*")))
1636 (defun gdb-display-stack-buffer ()
1637 (interactive (list gdb-proc
))
1639 (gdb-get-create-instance-buffer 'gdb-stack-buffer
)))
1641 (defun gdb-frame-stack-buffer ()
1642 (interactive (list gdb-proc
))
1643 (switch-to-buffer-other-frame
1644 (gdb-get-create-instance-buffer 'gdb-stack-buffer
)))
1646 (defvar gdb-frames-mode-map nil
)
1647 (setq gdb-frames-mode-map
(make-keymap))
1648 (suppress-keymap gdb-frames-mode-map
)
1649 (define-key gdb-frames-mode-map
[mouse-2
]
1650 'gdb-frames-select-by-mouse
)
1652 (defun gdb-frames-mode ()
1653 "Major mode for gdb frames.
1655 \\{gdb-frames-mode-map}"
1656 (setq major-mode
'gdb-frames-mode
)
1657 (setq mode-name
"Frames")
1658 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1659 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
1660 (setq buffer-read-only t
)
1661 (use-local-map gdb-frames-mode-map
)
1662 (gdb-invalidate-frames))
1664 (defun gdb-get-frame-number ()
1666 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t
))
1669 (buffer-substring (match-beginning 1)
1674 (defun gdb-frames-select-by-mouse (e)
1675 "Display the source of the selected frame."
1679 (set-buffer (window-buffer (posn-window (event-end e
))))
1681 (goto-char (posn-point (event-end e
)))
1682 (setq selection
(gdb-get-frame-number))))
1683 (select-window (posn-window (event-end e
)))
1685 (set-buffer (gdb-get-instance-buffer 'gdba
))
1686 (gdb-instance-enqueue-idle-input
1688 (concat (gud-format-command "server frame %p" selection
)
1691 (gud-display-frame))))
1695 ;; Registers buffers
1698 (def-gdb-auto-updated-buffer gdb-registers-buffer
1699 gdb-invalidate-registers
1700 "server info registers\n"
1701 gdb-info-registers-handler
1702 gdb-info-registers-custom
)
1704 (defun gdb-info-registers-custom ())
1706 (gdb-set-instance-buffer-rules 'gdb-registers-buffer
1707 'gdb-registers-buffer-name
1708 'gdb-registers-mode
)
1710 (defvar gdb-registers-mode-map nil
)
1711 (setq gdb-registers-mode-map
(make-keymap))
1712 (suppress-keymap gdb-registers-mode-map
)
1714 (defun gdb-registers-mode ()
1715 "Major mode for gdb registers.
1717 \\{gdb-registers-mode-map}"
1718 (setq major-mode
'gdb-registers-mode
)
1719 (setq mode-name
"Registers")
1720 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1721 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
1722 (setq buffer-read-only t
)
1723 (use-local-map gdb-registers-mode-map
)
1724 (gdb-invalidate-registers))
1726 (defun gdb-registers-buffer-name ()
1728 (set-buffer (process-buffer gdb-proc
))
1729 (concat "*registers of " (gdb-instance-target-string) "*")))
1731 (defun gdb-display-registers-buffer ()
1732 (interactive (list gdb-proc
))
1734 (gdb-get-create-instance-buffer 'gdb-registers-buffer
)))
1736 (defun gdb-frame-registers-buffer ()
1737 (interactive (list gdb-proc
))
1738 (switch-to-buffer-other-frame
1739 (gdb-get-create-instance-buffer 'gdb-registers-buffer
)))
1745 (def-gdb-auto-updated-buffer gdb-locals-buffer
1746 gdb-invalidate-locals
1747 "server info locals\n"
1748 gdb-info-locals-handler
1749 gdb-info-locals-custom
)
1752 ;Abbreviate for arrays and structures. These can be expanded using gud-display
1753 (defun gdb-info-locals-handler nil
1754 (set-gdb-instance-pending-triggers (delq (quote gdb-invalidate-locals
)
1755 (gdb-instance-pending-triggers)))
1756 (let ((buf (gdb-get-instance-buffer (quote gdb-partial-output-buffer
))))
1759 (goto-char (point-min))
1760 (replace-regexp "^ .*\n" "")
1761 (goto-char (point-min))
1762 (replace-regexp "{[-0-9, {}\]*\n" "(array);\n")))
1763 (goto-char (point-min))
1764 (replace-regexp "{.*=.*\n" "(structure);\n")
1765 (let ((buf (gdb-get-instance-buffer (quote gdb-locals-buffer
))))
1766 (and buf
(save-excursion
1769 (buffer-read-only nil
))
1770 (delete-region (point-min) (point-max))
1771 (insert-buffer (gdb-get-create-instance-buffer
1772 (quote gdb-partial-output-buffer
)))
1774 (run-hooks (quote gdb-info-locals-hook
)))
1776 (defun gdb-info-locals-custom ()
1779 (gdb-set-instance-buffer-rules 'gdb-locals-buffer
1780 'gdb-locals-buffer-name
1783 (defvar gdb-locals-mode-map nil
)
1784 (setq gdb-locals-mode-map
(make-keymap))
1785 (suppress-keymap gdb-locals-mode-map
)
1787 (defun gdb-locals-mode ()
1788 "Major mode for gdb locals.
1790 \\{gdb-locals-mode-map}"
1791 (setq major-mode
'gdb-locals-mode
)
1792 (setq mode-name
"Locals")
1793 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1794 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
1795 (setq buffer-read-only t
)
1796 (use-local-map gdb-locals-mode-map
)
1797 (gdb-invalidate-locals))
1799 (defun gdb-locals-buffer-name ()
1801 (set-buffer (process-buffer gdb-proc
))
1802 (concat "*locals of " (gdb-instance-target-string) "*")))
1804 (defun gdb-display-locals-buffer ()
1805 (interactive (list gdb-proc
))
1807 (gdb-get-create-instance-buffer 'gdb-locals-buffer
)))
1809 (defun gdb-frame-locals-buffer ()
1810 (interactive (list gdb-proc
))
1811 (switch-to-buffer-other-frame
1812 (gdb-get-create-instance-buffer 'gdb-locals-buffer
)))
1814 ;; Display expression buffers (just allow one to start with)
1816 (gdb-set-instance-buffer-rules 'gdb-display-buffer
1817 'gdb-display-buffer-name
1820 (def-gdb-auto-updated-buffer gdb-display-buffer
1821 ;; `gdb-display-buffer'.
1822 gdb-invalidate-display
1823 "server info display\n"
1824 gdb-info-display-handler
1825 gdb-info-display-custom
)
1827 (defun gdb-info-display-custom ()
1828 ; TODO: ensure frames of expressions that have been deleted are also deleted
1829 ; these can be missed currently eg through GUD buffer, restarting a
1830 ; recompiled program.
1833 (defvar gdb-display-mode-map nil
)
1834 (setq gdb-display-mode-map
(make-keymap))
1835 (suppress-keymap gdb-display-mode-map
)
1837 (define-key gdb-display-mode-map
[menu-bar display
]
1838 (cons "Display" (make-sparse-keymap "Display")))
1839 (define-key gdb-display-mode-map
[menu-bar display toggle
]
1840 '("Toggle" . gdb-toggle-disp-this-line
))
1841 (define-key gdb-display-mode-map
[menu-bar display delete
]
1842 '("Delete" . gdb-delete-disp-this-line
))
1844 (define-key gdb-display-mode-map
" " 'gdb-toggle-disp-this-line
)
1845 (define-key gdb-display-mode-map
"d" 'gdb-delete-disp-this-line
)
1847 (defun gdb-display-mode ()
1848 "Major mode for gdb display.
1850 \\{gdb-display-mode-map}"
1851 (setq major-mode
'gdb-display-mode
)
1852 (setq mode-name
"Display")
1853 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1854 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
1855 (setq buffer-read-only t
)
1856 (use-local-map gdb-display-mode-map
)
1857 (gdb-invalidate-display))
1859 (defun gdb-display-buffer-name ()
1861 (set-buffer (process-buffer gdb-proc
))
1862 (concat "*Displayed expressions of " (gdb-instance-target-string) "*")))
1864 (defun gdb-display-display-buffer ()
1865 (interactive (list gdb-proc
))
1867 (gdb-get-create-instance-buffer 'gdb-display-buffer
)))
1869 (defun gdb-frame-display-buffer ()
1870 (interactive (list gdb-proc
))
1871 (switch-to-buffer-other-frame
1872 (gdb-get-create-instance-buffer 'gdb-display-buffer
)))
1874 (defun gdb-toggle-disp-this-line ()
1875 "Enable/disable the displayed expression on this line."
1878 (beginning-of-line 1)
1879 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1880 (error "No expression on this line")
1881 (gdb-instance-enqueue-idle-input
1884 (if (eq ?y
(char-after (match-beginning 2)))
1885 "server disable display "
1886 "server enable display ")
1887 (buffer-substring (match-beginning 0)
1890 '(lambda () nil
))))))
1892 (defun gdb-delete-disp-this-line ()
1893 "Delete the displayed expression on this line."
1897 (gdb-get-instance-buffer 'gdb-display-buffer
))
1898 (beginning-of-line 1)
1899 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1900 (error "No expression on this line")
1901 (let ((number (buffer-substring (match-beginning 0)
1903 (gdb-instance-enqueue-idle-input
1904 (list (concat "server delete display " number
"\n")
1906 (if (not (display-graphic-p))
1907 (kill-buffer (get-buffer (concat "*display " number
"*")))
1910 (let ((frames (frame-list)))
1912 (if (string-equal (frame-parameter (car frames
) 'name
)
1913 (concat "*display " number
"*"))
1915 (get-buffer (concat "*display " number
"*")))
1916 (delete-frame (car frames
))
1917 (throw 'frame-found nil
)))
1918 (setq frames
(cdr frames
))))))))))
1920 (defvar gdb-expressions-mode-map nil
)
1921 (setq gdb-expressions-mode-map
(make-keymap))
1922 (suppress-keymap gdb-expressions-mode-map
)
1924 (defvar gdb-expressions-mode-menu
1925 '("GDB Expressions Commands"
1927 ["Visualise" gdb-array-visualise t
]
1928 ["Delete" gdb-delete-display t
])
1929 "Menu for `gdb-expressions-mode'.")
1931 (define-key gdb-expressions-mode-map
"v" 'gdb-array-visualise
)
1932 (define-key gdb-expressions-mode-map
"q" 'gdb-delete-display
)
1933 (define-key gdb-expressions-mode-map
[mouse-3
] 'gdb-expressions-popup-menu
)
1935 (defun gdb-expressions-popup-menu (event)
1936 "Explicit Popup menu as this buffer doesn't have a menubar."
1938 (mouse-set-point event
)
1939 (popup-menu gdb-expressions-mode-menu
))
1941 (defun gdb-expressions-mode ()
1942 "Major mode for display expressions.
1944 \\{gdb-expressions-mode-map}"
1945 (setq major-mode
'gdb-expressions-mode
)
1946 (setq mode-name
"Expressions")
1947 (use-local-map gdb-expressions-mode-map
)
1948 (make-local-variable 'gdb-display-number
)
1949 (make-local-variable 'gdb-values
)
1950 (make-local-variable 'gdb-expression
)
1951 (set (make-local-variable 'gdb-display-string
) nil
)
1952 (set (make-local-variable 'gdb-dive-display-number
) nil
)
1953 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
1954 (set (make-local-variable 'gdb-array-start
) (make-vector 16 '-
1))
1955 (set (make-local-variable 'gdb-array-stop
) (make-vector 16 '-
1))
1956 (set (make-local-variable 'gdb-array-size
) (make-vector 16 '-
1))
1957 (setq buffer-read-only t
))
1960 ;;;; Window management
1962 ;;; FIXME: This should only return true for buffers in the current gdb-proc
1963 (defun gdb-protected-buffer-p (buffer)
1964 "Is BUFFER a buffer which we want to leave displayed?"
1968 overlay-arrow-position
)))
1970 ;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1971 ;;; to do the right thing. Seeing as there is no way for Lisp code to
1972 ;;; get at the use_time field of a window, I'm not sure there exists a
1973 ;;; more elegant solution without writing C code.
1975 (defun gdb-display-buffer (buf &optional size
)
1976 (let ((must-split nil
)
1982 (if (gdb-protected-buffer-p (window-buffer win
))
1983 (set-window-dedicated-p win t
))))
1984 (setq answer
(get-buffer-window buf
))
1986 (let ((window (get-lru-window)))
1989 (set-window-buffer window buf
)
1990 (setq answer window
))
1991 (setq must-split t
)))))
1994 (if (gdb-protected-buffer-p (window-buffer win
))
1995 (set-window-dedicated-p win nil
)))))
1997 (let* ((largest (get-largest-window))
1998 (cur-size (window-height largest
))
1999 (new-size (and size
(< size cur-size
) (- cur-size size
))))
2000 (setq answer
(split-window largest new-size
))
2001 (set-window-buffer answer buf
)))
2004 (defun gdb-display-source-buffer (buffer)
2005 (set-window-buffer gdb-source-window buffer
))
2008 ;;; Shared keymap initialization:
2010 (defun gdb-display-gdb-buffer ()
2011 (interactive (list gdb-proc
))
2013 (gdb-get-create-instance-buffer 'gdba
)))
2015 (defun gdb-make-windows-menu (map)
2016 ;; FIXME: This adds to the DBX, PerlDB, ... menu as well :-(
2017 ;; Probably we should create gdb-many-windows-map and put those menus
2019 (define-key map
[menu-bar displays
]
2020 (cons "GDB-Windows" (make-sparse-keymap "GDB-Windows")))
2021 (define-key map
[menu-bar displays gdb
]
2022 '("Gdb" . gdb-display-gdb-buffer
))
2023 (define-key map
[menu-bar displays locals
]
2024 '("Locals" . gdb-display-locals-buffer
))
2025 (define-key map
[menu-bar displays registers
]
2026 '("Registers" . gdb-display-registers-buffer
))
2027 (define-key map
[menu-bar displays frames
]
2028 '("Stack" . gdb-display-stack-buffer
))
2029 (define-key map
[menu-bar displays breakpoints
]
2030 '("Breakpoints" . gdb-display-breakpoints-buffer
))
2031 (define-key map
[menu-bar displays display
]
2032 '("Display" . gdb-display-display-buffer
))
2033 (define-key map
[menu-bar displays assembler
]
2034 '("Assembler" . gdb-display-assembler-buffer
)))
2036 (define-key gud-minor-mode-map
"\C-c\M-\C-r" 'gdb-display-registers-buffer
)
2037 (define-key gud-minor-mode-map
"\C-c\M-\C-f" 'gdb-display-stack-buffer
)
2038 (define-key gud-minor-mode-map
"\C-c\M-\C-b" 'gdb-display-breakpoints-buffer
)
2040 (gdb-make-windows-menu gud-minor-mode-map
)
2042 (defun gdb-frame-gdb-buffer ()
2043 (interactive (list gdb-proc
))
2044 (switch-to-buffer-other-frame
2045 (gdb-get-create-instance-buffer 'gdba
)))
2047 (defun gdb-make-frames-menu (map)
2048 (define-key map
[menu-bar frames
]
2049 (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames")))
2050 (define-key map
[menu-bar frames gdb
]
2051 '("Gdb" . gdb-frame-gdb-buffer
))
2052 (define-key map
[menu-bar frames locals
]
2053 '("Locals" . gdb-frame-locals-buffer
))
2054 (define-key map
[menu-bar frames registers
]
2055 '("Registers" . gdb-frame-registers-buffer
))
2056 (define-key map
[menu-bar frames frames
]
2057 '("Stack" . gdb-frame-stack-buffer
))
2058 (define-key map
[menu-bar frames breakpoints
]
2059 '("Breakpoints" . gdb-frame-breakpoints-buffer
))
2060 (define-key map
[menu-bar frames display
]
2061 '("Display" . gdb-frame-display-buffer
))
2062 (define-key map
[menu-bar frames assembler
]
2063 '("Assembler" . gdb-frame-assembler-buffer
)))
2065 (if (display-graphic-p)
2066 (gdb-make-frames-menu gud-minor-mode-map
))
2068 (defvar gdb-main-file nil
"Source file from which program execution begins.")
2070 ;; layout for all the windows
2071 (defun gdb-setup-windows ()
2072 (gdb-display-locals-buffer)
2073 (gdb-display-stack-buffer)
2074 (delete-other-windows)
2075 (gdb-display-breakpoints-buffer)
2076 (gdb-display-display-buffer)
2077 (delete-other-windows)
2078 (split-window nil
( / ( * (window-height) 3) 4))
2079 (split-window nil
( / (window-height) 3))
2080 (split-window-horizontally)
2082 (switch-to-buffer (gdb-locals-buffer-name))
2085 (if gud-last-last-frame
2086 (gud-find-file (car gud-last-last-frame
))
2087 (gud-find-file gdb-main-file
)))
2088 (setq gdb-source-window
(get-buffer-window (current-buffer)))
2089 (split-window-horizontally)
2091 (switch-to-buffer (gdb-inferior-io-name))
2093 (switch-to-buffer (gdb-stack-buffer-name))
2094 (split-window-horizontally)
2096 (switch-to-buffer (gdb-breakpoints-buffer-name))
2099 (define-minor-mode gdb-many-windows
2100 "Toggle the number of windows in the basic arrangement."
2103 (gdb-restore-windows))
2105 (defun gdb-restore-windows ()
2106 "Restore the basic arrangement of windows used by gdba.
2107 This arrangement depends on the value of `gdb-many-windows'."
2109 (if gdb-many-windows
2111 (switch-to-buffer gud-comint-buffer
)
2112 (delete-other-windows)
2113 (gdb-setup-windows))
2115 (switch-to-buffer gud-comint-buffer
)
2116 (delete-other-windows)
2120 (if gud-last-last-frame
2121 (gud-find-file (car gud-last-last-frame
))
2122 (gud-find-file gdb-main-file
)))
2125 (defconst breakpoint-xpm-data
"/* XPM */
2126 static char *magick[] = {
2127 /* columns rows colors chars-per-pixel */
2145 "XPM file used for breakpoint icon.")
2147 (setq breakpoint-enabled-icon
(find-image
2148 `((:type xpm
:data
,breakpoint-xpm-data
))))
2149 (setq breakpoint-disabled-icon
(find-image
2150 `((:type xpm
:data
,breakpoint-xpm-data
2151 :conversion laplace
))))
2154 "Kill the GUD and ancillary (including source) buffers.
2155 Just the partial-output buffer is left."
2157 (let ((buffers (buffer-list)))
2160 (set-buffer (car buffers
))
2161 (if (eq gud-minor-mode
'gdba
)
2162 (if (string-match "^\*" (buffer-name))
2164 (if (display-graphic-p)
2165 (remove-images (point-min) (point-max))
2166 (remove-strings (point-min) (point-max)))
2167 (setq left-margin-width
0)
2168 (setq gud-minor-mode nil
)
2169 (kill-local-variable 'tool-bar-map
)
2170 (setq gud-running nil
)
2171 (if (get-buffer-window (current-buffer))
2172 (set-window-margins (get-buffer-window
2175 right-margin-width
))))
2176 (setq buffers
(cdr buffers
)))))
2177 (if (eq (selected-window) (minibuffer-window))
2179 (delete-other-windows))
2181 (defun gdb-source-info ()
2182 "Finds the source file where the program starts and displays it with related
2184 (goto-char (point-min))
2185 (re-search-forward "directory is ")
2186 (looking-at "\\(\\S-*\\)")
2187 (setq gdb-cdir
(buffer-substring (match-beginning 1) (match-end 1)))
2188 (re-search-forward "Located in ")
2189 (looking-at "\\(\\S-*\\)")
2190 (setq gdb-main-file
(buffer-substring (match-beginning 1) (match-end 1)))
2191 ;; Make sure we are not in the minibuffer window when we try to delete
2192 ;; all other windows.
2193 (if (eq (selected-window) (minibuffer-window))
2195 (delete-other-windows)
2196 (if gdb-many-windows
2199 (gdb-display-breakpoints-buffer)
2200 (gdb-display-display-buffer)
2201 (gdb-display-stack-buffer)
2202 (delete-other-windows)
2205 (switch-to-buffer (gud-find-file gdb-main-file
))
2207 (setq gdb-source-window
(get-buffer-window (current-buffer)))))
2210 (defun put-string (putstring pos
&optional string area
)
2211 "Put string PUTSTRING in front of POS in the current buffer.
2212 PUTSTRING is displayed by putting an overlay into the current buffer with a
2213 `before-string' STRING that has a `display' property whose value is
2214 PUTSTRING. STRING is defaulted if you omit it.
2215 POS may be an integer or marker.
2216 AREA is where to display the string. AREA nil or omitted means
2217 display it in the text area, a value of `left-margin' means
2218 display it in the left marginal area, a value of `right-margin'
2219 means display it in the right marginal area."
2220 (unless string
(setq string
"x"))
2221 (let ((buffer (current-buffer)))
2222 (unless (or (null area
) (memq area
'(left-margin right-margin
)))
2223 (error "Invalid area %s" area
))
2224 (setq string
(copy-sequence string
))
2225 (let ((overlay (make-overlay pos pos buffer
))
2226 (prop (if (null area
) putstring
(list (list 'margin area
) putstring
))))
2227 (put-text-property 0 (length string
) 'display prop string
)
2228 (overlay-put overlay
'put-text t
)
2229 (overlay-put overlay
'before-string string
))))
2232 (defun remove-strings (start end
&optional buffer
)
2233 "Remove strings between START and END in BUFFER.
2234 Remove only images that were put in BUFFER with calls to `put-string'.
2235 BUFFER nil or omitted means use the current buffer."
2237 (setq buffer
(current-buffer)))
2238 (let ((overlays (overlays-in start end
)))
2240 (let ((overlay (car overlays
)))
2241 (when (overlay-get overlay
'put-text
)
2242 (delete-overlay overlay
)))
2243 (setq overlays
(cdr overlays
)))))
2245 (defun put-arrow (putstring pos
&optional string area
)
2246 "Put arrow string PUTSTRING in front of POS in the current buffer.
2247 PUTSTRING is displayed by putting an overlay into the current buffer with a
2248 `before-string' \"gdb-arrow\" that has a `display' property whose value is
2249 PUTSTRING. STRING is defaulted if you omit it.
2250 POS may be an integer or marker.
2251 AREA is where to display the string. AREA nil or omitted means
2252 display it in the text area, a value of `left-margin' means
2253 display it in the left marginal area, a value of `right-margin'
2254 means display it in the right marginal area."
2255 (setq string
"gdb-arrow")
2256 (let ((buffer (current-buffer)))
2257 (unless (or (null area
) (memq area
'(left-margin right-margin
)))
2258 (error "Invalid area %s" area
))
2259 (setq string
(copy-sequence string
))
2260 (let ((overlay (make-overlay pos pos buffer
))
2261 (prop (if (null area
) putstring
(list (list 'margin area
) putstring
))))
2262 (put-text-property 0 (length string
) 'display prop string
)
2263 (overlay-put overlay
'put-text t
)
2264 (overlay-put overlay
'before-string string
))))
2266 (defun remove-arrow (&optional buffer
)
2267 "Remove arrow in BUFFER.
2268 Remove only images that were put in BUFFER with calls to `put-arrow'.
2269 BUFFER nil or omitted means use the current buffer."
2271 (setq buffer
(current-buffer)))
2272 (let ((overlays (overlays-in (point-min) (point-max))))
2274 (let ((overlay (car overlays
)))
2275 (when (string-equal (overlay-get overlay
'before-string
) "gdb-arrow")
2276 (delete-overlay overlay
)))
2277 (setq overlays
(cdr overlays
)))))
2279 (defun gdb-array-visualise ()
2280 "Visualise arrays and slices using graph program from plotutils."
2282 (if (and (display-graphic-p) gdb-display-string
)
2284 (catch 'multi-dimensional
2285 (while (eq (aref gdb-array-start n
) (aref gdb-array-stop n
))
2288 (while (< m
(length gdb-array-start
))
2289 (if (not (eq (aref gdb-array-start m
) (aref gdb-array-stop m
)))
2292 t
`(,(concat "Only one dimensional data can be visualised.\n"
2293 "Use an array slice to reduce the number of\n"
2294 "dimensions") ("OK" t
)))
2295 (throw 'multi-dimensional nil
))
2297 (shell-command (concat "echo" gdb-display-string
" | graph -a 1 "
2298 (int-to-string (aref gdb-array-start n
))
2300 (int-to-string (aref gdb-array-start n
))
2302 (int-to-string (aref gdb-array-stop n
))
2305 (defun gdb-delete-display ()
2306 "Delete displayed expression and its frame."
2308 (gdb-instance-enqueue-idle-input
2309 (list (concat "server delete display " gdb-display-number
"\n")
2318 (def-gdb-auto-updated-buffer gdb-assembler-buffer
2319 gdb-invalidate-assembler
2320 (concat "server disassemble " gdb-main-or-pc
"\n")
2321 gdb-assembler-handler
2322 gdb-assembler-custom
)
2324 (defun gdb-assembler-custom ()
2325 (let ((buffer (gdb-get-instance-buffer 'gdb-assembler-buffer
))
2326 (gdb-arrow-position) (address) (flag))
2327 (if gdb-current-address
2332 (goto-char (point-min))
2333 (re-search-forward gdb-current-address
)
2334 (setq gdb-arrow-position
(point))
2335 (put-arrow "=>" gdb-arrow-position nil
'left-margin
))))
2337 ; remove all breakpoint-icons in assembler buffer before updating.
2340 (if (display-graphic-p)
2341 (remove-images (point-min) (point-max))
2342 (remove-strings (point-min) (point-max))))
2344 (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer
))
2345 (goto-char (point-min))
2346 (while (< (point) (- (point-max) 1))
2348 (if (looking-at "[^\t].*breakpoint")
2351 "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x0\\(\\S-*\\)")
2352 ; info break gives '0x0' (8 digit) while dump gives '0x' (7 digit)
2353 (setq address
(concat "0x" (buffer-substring (match-beginning 3)
2355 (setq flag
(char-after (match-beginning 2)))
2358 (goto-char (point-min))
2359 (if (re-search-forward address nil t
)
2360 (let ((start (progn (beginning-of-line) (- (point) 1)))
2361 (end (progn (end-of-line) (+ (point) 1))))
2362 (if (display-graphic-p)
2364 (remove-images start end
)
2366 (put-image breakpoint-enabled-icon
(point)
2367 "breakpoint icon enabled"
2369 (put-image breakpoint-disabled-icon
(point)
2370 "breakpoint icon disabled"
2372 (remove-strings start end
)
2374 (put-string "B" (point) "enabled" 'left-margin
)
2375 (put-string "b" (point) "disabled"
2376 'left-margin
))))))))))
2377 (if gdb-current-address
2378 (set-window-point (get-buffer-window buffer
) gdb-arrow-position
))))
2380 (gdb-set-instance-buffer-rules 'gdb-assembler-buffer
2381 'gdb-assembler-buffer-name
2382 'gdb-assembler-mode
)
2384 (defvar gdb-assembler-mode-map nil
)
2385 (setq gdb-assembler-mode-map
(make-keymap))
2386 (suppress-keymap gdb-assembler-mode-map
)
2388 (defun gdb-assembler-mode ()
2389 "Major mode for viewing code assembler.
2391 \\{gdb-assembler-mode-map}"
2392 (setq major-mode
'gdb-assembler-mode
)
2393 (setq mode-name
"Assembler")
2394 (set (make-local-variable 'gud-minor-mode
) 'gdba
)
2395 (set (make-local-variable 'tool-bar-map
) gud-tool-bar-map
)
2396 (setq left-margin-width
2)
2397 (setq buffer-read-only t
)
2398 (use-local-map gdb-assembler-mode-map
)
2399 (gdb-invalidate-assembler)
2400 (gdb-invalidate-breakpoints))
2402 (defun gdb-assembler-buffer-name ()
2404 (set-buffer (process-buffer gdb-proc
))
2405 (concat "*Machine Code " (gdb-instance-target-string) "*")))
2407 (defun gdb-display-assembler-buffer ()
2408 (interactive (list gdb-proc
))
2410 (gdb-get-create-instance-buffer 'gdb-assembler-buffer
)))
2412 (defun gdb-frame-assembler-buffer ()
2413 (interactive (list gdb-proc
))
2414 (switch-to-buffer-other-frame
2415 (gdb-get-create-instance-buffer 'gdb-assembler-buffer
)))
2417 (defun gdb-invalidate-frame-and-assembler (&optional ignored
)
2418 (gdb-invalidate-frames)
2419 (gdb-invalidate-assembler))
2421 (defun gdb-invalidate-breakpoints-and-assembler (&optional ignored
)
2422 (gdb-invalidate-breakpoints)
2423 (gdb-invalidate-assembler))
2425 (defvar gdb-prev-main-or-pc nil
)
2427 ; modified because if gdb-main-or-pc has changed value a new command
2428 ; must be enqueued to update the buffer with the new output
2429 (defun gdb-invalidate-assembler (&optional ignored
)
2430 (if (and ((lambda ()
2431 (gdb-get-instance-buffer (quote gdb-assembler-buffer
))))
2432 (or (not (member (quote gdb-invalidate-assembler
)
2433 (gdb-instance-pending-triggers)))
2434 (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc
))))
2437 ; take previous disassemble command off the queue
2439 (set-buffer (gdb-get-instance-buffer 'gdba
))
2440 (let ((queue gdb-idle-input-queue
) (item))
2442 (setq item
(car queue
))
2443 (if (equal (cdr item
) '(gdb-assembler-handler))
2444 (delete item gdb-idle-input-queue
))
2445 (setq queue
(cdr queue
)))))
2447 (gdb-instance-enqueue-idle-input
2448 (list (concat "server disassemble " gdb-main-or-pc
"\n")
2449 (quote gdb-assembler-handler
)))
2450 (set-gdb-instance-pending-triggers
2451 (cons (quote gdb-invalidate-assembler
)
2452 (gdb-instance-pending-triggers)))
2453 (setq gdb-prev-main-or-pc gdb-main-or-pc
))))
2455 (defun gdb-delete-line ()
2456 "Delete the current line."
2458 (let ((start (progn (beginning-of-line) (point)))
2459 (end (progn (end-of-line) (+ (point) 1))))
2460 (delete-region start end
)))
2464 ;;; gdb-ui.el ends here