aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNick Roberts2002-11-14 01:53:27 +0000
committerNick Roberts2002-11-14 01:53:27 +0000
commit035ca7627f5c1d3afeeb11587cc5a2b681207dd8 (patch)
tree22f0501df8dfffd1d4308c0e5e33ebe2b61f6602
parentd84d173e25ebeb0b36bec1c586b7692ee08b8479 (diff)
downloademacs-035ca7627f5c1d3afeeb11587cc5a2b681207dd8.tar.gz
emacs-035ca7627f5c1d3afeeb11587cc5a2b681207dd8.zip
New file.
Diffstat
-rw-r--r--lisp/gdb-ui.el2610
1 files changed, 2610 insertions, 0 deletions
diff --git a/lisp/gdb-ui.el b/lisp/gdb-ui.el
new file mode 100644
index 00000000000..ee2323099de
--- /dev/null
+++ b/lisp/gdb-ui.el
@@ -0,0 +1,2610 @@
1;;; gdb-ui.el --- User Interface for running GDB
2
3;; Author: Nick Roberts <nick@nick.uklinux.net>
4;; Maintainer: FSF
5;; Keywords: unix, tools
6
7;; Copyright (C) 2002 Free Software Foundation, Inc.
8
9;; This file is part of GNU Emacs.
10
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.
15
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.
20
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.
25
26;;; Commentary:
27
28;; Extension of gdba.el written by Jim Kingdon from gdb 5.0
29
30;;; Code:
31
32(require 'mygud)
33
34(defcustom gdb-many-windows t
35 "If t, using gdba, start gdb with ancillary buffers visible.
36Use `toggle-gdb-windows' to change this value during a gdb session"
37 :type 'boolean
38 :group 'gud)
39
40(defvar gdb-main-file nil "Source file from which program execution begins.")
41(defvar gdb-cdir nil "Compilation directory.")
42(defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.")
43(defvar gdb-prev-main-or-pc nil)
44
45(defun gdba (command-line)
46 "Run gdb on program FILE in buffer *gdb-FILE*.
47The directory containing FILE becomes the initial working directory
48and source-file directory for your debugger.
49
50If `gdb-many-windows' is set to t this works best in X (depending on the size
51of your monitor) using most of the screen. After a short delay the following
52layout will appear (keybindings given in relevant buffer) :
53
54---------------------------------------------------------------------
55 GDB Toolbar
56---------------------------------------------------------------------
57GUD buffer (I/O of gdb) | Locals buffer
58 |
59 |
60 |
61---------------------------------------------------------------------
62Source buffer | Input/Output (of debuggee) buffer
63 | (comint-mode)
64 |
65 |
66 |
67 |
68 |
69 |
70---------------------------------------------------------------------
71Stack buffer | Breakpoints buffer
72\[mouse-2\] gdb-frames-select | SPC gdb-toggle-bp-this-line
73 | g gdb-goto-bp-this-line
74 | d gdb-delete-bp-this-line
75---------------------------------------------------------------------
76
77All the buffers share the toolbar and source should always display in the same
78window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
79icons are displayed both by setting a break with gud-break and by typing break
80in the GUD buffer.
81
82Displayed expressions appear in separate frames. Arrays may be displayed
83as slices and visualised using the graph program from plotutils if installed.
84
85If `gdb-many-windows' is set to nil then gdb starts with just two windows :
86the GUD and the source buffer.
87
88The following interactive lisp functions help control operation :
89
90`toggle-gdb-windows' - Toggle the number of windows gdb uses.
91`gdb-restore-windows' - to restore the layout if its lost.
92`gdb-quit' - to delete (most) of the buffers used by gdb."
93
94 (interactive (list (gud-query-cmdline 'gdba)))
95
96 (gdba-common-init command-line nil
97 'gdba-marker-filter 'gud-gdb-find-file)
98
99 (set (make-local-variable 'gud-minor-mode) 'gdba)
100
101; (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
102 (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
103; (gud-def gud-remove "clear %f:%l" "\C-d" "Remove 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.")
114
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)
117
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)
120
121 (local-set-key "\C-i" 'gud-gdb-complete-command)
122
123 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
124 (setq comint-input-sender 'gdb-send)
125
126; (re-)initialise
127 (setq gdb-main-or-pc "main")
128 (setq gdb-current-address nil)
129 (setq gdb-display-in-progress nil)
130 (setq gdb-dive nil)
131 (setq gud-last-last-frame nil)
132
133 (run-hooks 'gdb-mode-hook)
134 (let ((instance
135 (make-gdb-instance (get-buffer-process (current-buffer)))))
136 (if gdb-first-time (gdb-clear-inferior-io instance))
137
138; find source file and compilation directory here
139 (gdb-instance-enqueue-idle-input instance (list "server list\n"
140 '(lambda () nil)))
141 (gdb-instance-enqueue-idle-input instance (list "server info source\n"
142 '(lambda () (gdb-source-info))))))
143
144(defun gud-break (arg)
145 "Set breakpoint at current line or address."
146 (interactive "p")
147 (if (not (string-equal mode-name "Assembler"))
148 (gud-call "break %f:%l" arg)
149;else
150 (save-excursion
151 (beginning-of-line)
152 (forward-char 2)
153 (gud-call "break *%a" arg))))
154
155(defun gud-remove (arg)
156 "Remove breakpoint at current line or address."
157 (interactive "p")
158 (if (not (string-equal mode-name "Assembler"))
159 (gud-call "clear %f:%l" arg)
160;else
161 (save-excursion
162 (beginning-of-line)
163 (forward-char 2)
164 (gud-call "clear *%a" arg))))
165
166(defun gud-display ()
167 "Display (possibly dereferenced) C expression at point."
168 (interactive)
169 (save-excursion
170 (let ((expr (gud-find-c-expr)))
171 (gdb-instance-enqueue-idle-input
172 gdb-buffer-instance
173 (list (concat "server whatis " expr "\n")
174 `(lambda () (gud-display1 ,expr)))))))
175
176(defun gud-display1 (expr)
177 (goto-char (point-min))
178 (if (re-search-forward "\*" nil t)
179 (gdb-instance-enqueue-idle-input
180 gdb-buffer-instance
181 (list (concat "server display* " expr "\n")
182 '(lambda () nil)))
183;else
184 (gdb-instance-enqueue-idle-input
185 gdb-buffer-instance
186 (list (concat "server display " expr "\n")
187 '(lambda () nil)))))
188
189
190;; The completion process filter is installed temporarily to slurp the
191;; output of GDB up to the next prompt and build the completion list.
192;; It must also handle annotations.
193(defun gdba-complete-filter (string)
194 (gdb-output-burst gdb-buffer-instance string)
195 (while (string-match "\n\032\032\\(.*\\)\n" string)
196 (setq string (concat (substring string 0 (match-beginning 0))
197 (substring string (match-end 0)))))
198 (setq string (concat gud-gdb-complete-string string))
199 (while (string-match "\n" string)
200 (setq gud-gdb-complete-list
201 (cons (substring string gud-gdb-complete-break (match-beginning 0))
202 gud-gdb-complete-list))
203 (setq string (substring string (match-end 0))))
204 (if (string-match comint-prompt-regexp string)
205 (progn
206 (setq gud-gdb-complete-in-progress nil)
207 string)
208 (progn
209 (setq gud-gdb-complete-string string)
210 "")))
211
212
213(defun gdba-common-init (command-line massage-args marker-filter &optional find-file)
214
215 (let* ((words (split-string command-line))
216 (program (car words))
217
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)))
223 (setq w (cdr w)))
224 (and w
225 (prog1 (car w)
226 (setcar w t)))))
227 (file-subst
228 (and file-word (substitute-in-file-name file-word)))
229
230 (args (cdr words))
231
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.
237 (file (and file-word
238 (if (file-name-directory file-subst)
239 (expand-file-name file-subst)
240 file-subst)))
241 (filepart (and file-word (file-name-nondirectory file)))
242 (buffer-name (concat "*gdb-" filepart "*")))
243
244 (setq gdb-first-time (not (get-buffer-process buffer-name)))
245
246 (switch-to-buffer buffer-name)
247 ;; Set default-directory to the file's directory.
248 (and file-word
249 gud-chdir-before-run
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.
260 (let ((w args))
261 (while (and w (not (eq (car w) t)))
262 (setq w (cdr w)))
263 (if w
264 (setcar w file)))
265 (let ((old-instance gdb-buffer-instance))
266 (apply 'make-comint (concat "gdb-" filepart) program nil args)
267 (gud-mode)
268 (make-variable-buffer-local 'old-gdb-buffer-instance)
269 (setq old-gdb-buffer-instance old-instance))
270 (setq gdb-target-name filepart))
271 (make-local-variable 'gud-marker-filter)
272 (setq gud-marker-filter marker-filter)
273 (if find-file (set (make-local-variable 'gud-find-file) find-file))
274
275 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
276 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
277 (gud-set-buffer))
278
279
280;; ======================================================================
281;;
282;; In this world, there are gdb instance objects (of unspecified
283;; representation) and buffers associated with those objects.
284;;
285
286;;
287;; gdb-instance objects
288;;
289
290(defun make-gdb-instance (proc)
291 "Create a gdb instance object from a gdb process."
292 (setq last-proc proc)
293 (let ((instance (cons 'gdb-instance proc)))
294 (save-excursion
295 (set-buffer (process-buffer proc))
296 (setq gdb-buffer-instance instance)
297 (progn
298 (mapcar 'make-variable-buffer-local gdb-instance-variables)
299 (setq gdb-buffer-type 'gdba)
300 ;; If we're taking over the buffer of another process,
301 ;; take over it's ancillery buffers as well.
302 ;;
303 (let ((dead (or old-gdb-buffer-instance)))
304 (mapcar
305 (function
306 (lambda (b)
307 (progn
308 (set-buffer b)
309 (if (eq dead gdb-buffer-instance)
310 (setq gdb-buffer-instance instance)))))
311 (buffer-list)))))
312 instance))
313
314(defun gdb-instance-process (inst) (cdr inst))
315
316;;; The list of instance variables is built up by the expansions of
317;;; DEF-GDB-VARIABLE
318;;;
319(defvar gdb-instance-variables '()
320 "A list of variables that are local to the GUD buffer associated
321with a gdb instance.")
322
323(defmacro def-gdb-variable
324 (name accessor setter &optional default doc)
325 `(progn
326 (defvar ,name ,default ,(or doc "undocumented"))
327 (if (not (memq ',name gdb-instance-variables))
328 (setq gdb-instance-variables
329 (cons ',name gdb-instance-variables)))
330 ,(and accessor
331 `(defun ,accessor (instance)
332 (let
333 ((buffer (gdb-get-instance-buffer instance 'gdba)))
334 (and buffer
335 (save-excursion
336 (set-buffer buffer)
337 ,name)))))
338 ,(and setter
339 `(defun ,setter (instance val)
340 (let
341 ((buffer (gdb-get-instance-buffer instance 'gdba)))
342 (and buffer
343 (save-excursion
344 (set-buffer buffer)
345 (setq ,name val))))))))
346
347(defmacro def-gdb-var (root-symbol &optional default doc)
348 (let* ((root (symbol-name root-symbol))
349 (accessor (intern (concat "gdb-instance-" root)))
350 (setter (intern (concat "set-gdb-instance-" root)))
351 (var-name (intern (concat "gdb-" root))))
352 `(def-gdb-variable
353 ,var-name ,accessor ,setter
354 ,default ,doc)))
355
356(def-gdb-var buffer-instance nil
357 "In an instance buffer, the buffer's instance.")
358
359(def-gdb-var buffer-type nil
360 "One of the symbols bound in gdb-instance-buffer-rules")
361
362(def-gdb-var burst ""
363 "A string of characters from gdb that have not yet been processed.")
364
365(def-gdb-var input-queue ()
366 "A list of high priority gdb command objects.")
367
368(def-gdb-var idle-input-queue ()
369 "A list of low priority gdb command objects.")
370
371(def-gdb-var prompting nil
372 "True when gdb is idle with no pending input.")
373
374(def-gdb-var output-sink 'user
375 "The disposition of the output of the current gdb command.
376Possible values are these symbols:
377
378 user -- gdb output should be copied to the GUD buffer
379 for the user to see.
380
381 inferior -- gdb output should be copied to the inferior-io buffer
382
383 pre-emacs -- output should be ignored util the post-prompt
384 annotation is received. Then the output-sink
385 becomes:...
386 emacs -- output should be collected in the partial-output-buffer
387 for subsequent processing by a command. This is the
388 disposition of output generated by commands that
389 gdb mode sends to gdb on its own behalf.
390 post-emacs -- ignore input until the prompt annotation is
391 received, then go to USER disposition.
392")
393
394(def-gdb-var current-item nil
395 "The most recent command item sent to gdb.")
396
397(def-gdb-var pending-triggers '()
398 "A list of trigger functions that have run later than their output
399handlers.")
400
401(defun in-gdb-instance-context (instance form)
402 "Funcall FORM in the GUD buffer of INSTANCE."
403 (save-excursion
404 (set-buffer (gdb-get-instance-buffer instance 'gdba))
405 (funcall form)))
406
407;; end of instance vars
408
409;;
410;; finding instances
411;;
412
413(defun gdb-proc->instance (proc)
414 (save-excursion
415 (set-buffer (process-buffer proc))
416 gdb-buffer-instance))
417
418(defun gdb-mru-instance-buffer ()
419 "Return the most recently used (non-auxiliary) GUD buffer."
420 (save-excursion
421 (gdb-goto-first-gdb-instance (buffer-list))))
422
423(defun gdb-goto-first-gdb-instance (blist)
424 "Use gdb-mru-instance-buffer -- not this."
425 (and blist
426 (progn
427 (set-buffer (car blist))
428 (or (and gdb-buffer-instance
429 (eq gdb-buffer-type 'gdba)
430 (car blist))
431 (gdb-goto-first-gdb-instance (cdr blist))))))
432
433(defun buffer-gdb-instance (buf)
434 (save-excursion
435 (set-buffer buf)
436 gdb-buffer-instance))
437
438(defun gdb-needed-default-instance ()
439 "Return the most recently used gdb instance or signal an error."
440 (let ((buffer (gdb-mru-instance-buffer)))
441 (or (and buffer (buffer-gdb-instance buffer))
442 (error "No instance of gdb found"))))
443
444(defun gdb-instance-target-string (instance)
445 "The apparent name of the program being debugged by a gdb instance.
446For sure this the root string used in smashing together the gdb
447buffer's name, even if that doesn't happen to be the name of a
448program."
449 (in-gdb-instance-context
450 instance
451 (function (lambda () gdb-target-name))))
452
453
454
455;;
456;; Instance Buffers.
457;;
458
459;; More than one buffer can be associated with a gdb instance.
460;;
461;; Each buffer has a TYPE -- a symbol that identifies the function
462;; of that particular buffer.
463;;
464;; The usual gdb interaction buffer is given the type `gdb' and
465;; is constructed specially.
466;;
467;; Others are constructed by gdb-get-create-instance-buffer and
468;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc
469
470(defun gdb-get-instance-buffer (instance key)
471 "Return the instance buffer for INSTANCE tagged with type KEY.
472The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
473 (save-excursion
474 (gdb-look-for-tagged-buffer instance key (buffer-list))))
475
476(defun gdb-get-create-instance-buffer (instance key)
477 "Create a new gdb instance buffer of the type specified by KEY.
478The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
479 (or (gdb-get-instance-buffer instance key)
480 (let* ((rules (assoc key gdb-instance-buffer-rules-assoc))
481 (name (funcall (gdb-rules-name-maker rules) instance))
482 (new (get-buffer-create name)))
483 (save-excursion
484 (set-buffer new)
485 (make-variable-buffer-local 'gdb-buffer-type)
486 (setq gdb-buffer-type key)
487 (make-variable-buffer-local 'gdb-buffer-instance)
488 (setq gdb-buffer-instance instance)
489 (if (cdr (cdr rules))
490 (funcall (car (cdr (cdr rules)))))
491 new))))
492
493(defun gdb-rules-name-maker (rules) (car (cdr rules)))
494
495(defun gdb-look-for-tagged-buffer (instance key bufs)
496 (let ((retval nil))
497 (while (and (not retval) bufs)
498 (set-buffer (car bufs))
499 (if (and (eq gdb-buffer-instance instance)
500 (eq gdb-buffer-type key))
501 (setq retval (car bufs)))
502 (setq bufs (cdr bufs)))
503 retval))
504
505(defun gdb-instance-buffer-p (buf)
506 (save-excursion
507 (set-buffer buf)
508 (and gdb-buffer-type
509 (not (eq gdb-buffer-type 'gdba)))))
510
511;;
512;; This assoc maps buffer type symbols to rules. Each rule is a list of
513;; at least one and possible more functions. The functions have these
514;; roles in defining a buffer type:
515;;
516;; NAME - take an instance, return a name for this type buffer for that
517;; instance.
518;; The remaining function(s) are optional:
519;;
520;; MODE - called in new new buffer with no arguments, should establish
521;; the proper mode for the buffer.
522;;
523
524(defvar gdb-instance-buffer-rules-assoc '())
525
526(defun gdb-set-instance-buffer-rules (buffer-type &rest rules)
527 (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc)))
528 (if binding
529 (setcdr binding rules)
530 (setq gdb-instance-buffer-rules-assoc
531 (cons (cons buffer-type rules)
532 gdb-instance-buffer-rules-assoc)))))
533
534; GUD buffers are an exception to the rules
535(gdb-set-instance-buffer-rules 'gdba 'error)
536
537;;
538;; partial-output buffers
539;;
540;; These accumulate output from a command executed on
541;; behalf of emacs (rather than the user).
542;;
543
544(gdb-set-instance-buffer-rules 'gdb-partial-output-buffer
545 'gdb-partial-output-name)
546
547(defun gdb-partial-output-name (instance)
548 (concat "*partial-output-"
549 (gdb-instance-target-string instance)
550 "*"))
551
552
553(gdb-set-instance-buffer-rules 'gdb-inferior-io
554 'gdb-inferior-io-name
555 'gdb-inferior-io-mode)
556
557(defun gdb-inferior-io-name (instance)
558 (concat "*input/output of "
559 (gdb-instance-target-string instance)
560 "*"))
561
562(defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map))
563(define-key comint-mode-map "\C-c\C-c" 'gdb-inferior-io-interrupt)
564(define-key comint-mode-map "\C-c\C-z" 'gdb-inferior-io-stop)
565(define-key comint-mode-map "\C-c\C-\\" 'gdb-inferior-io-quit)
566(define-key comint-mode-map "\C-c\C-d" 'gdb-inferior-io-eof)
567
568(defun gdb-inferior-io-mode ()
569 "Major mode for gdb inferior-io.
570
571\\{comint-mode-map}"
572 ;; We want to use comint because it has various nifty and familiar
573 ;; features. We don't need a process, but comint wants one, so create
574 ;; a dummy one.
575 (make-comint (substring (buffer-name) 1 (- (length (buffer-name)) 1))
576 "/bin/cat")
577 (setq major-mode 'gdb-inferior-io-mode)
578 (setq mode-name "Debuggee I/O")
579 (set (make-local-variable 'gud-minor-mode) 'gdba)
580 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
581 (setq comint-input-sender 'gdb-inferior-io-sender))
582
583(defun gdb-inferior-io-sender (proc string)
584 (save-excursion
585 (set-buffer (process-buffer proc))
586 (let ((instance gdb-buffer-instance))
587 (set-buffer (gdb-get-instance-buffer instance 'gdba))
588 (let ((gdb-proc (get-buffer-process (current-buffer))))
589 (process-send-string gdb-proc string)
590 (process-send-string gdb-proc "\n")))))
591
592(defun gdb-inferior-io-interrupt (instance)
593 "Interrupt the program being debugged."
594 (interactive (list (gdb-needed-default-instance)))
595 (interrupt-process
596 (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp))
597
598(defun gdb-inferior-io-quit (instance)
599 "Send quit signal to the program being debugged."
600 (interactive (list (gdb-needed-default-instance)))
601 (quit-process
602 (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp))
603
604(defun gdb-inferior-io-stop (instance)
605 "Stop the program being debugged."
606 (interactive (list (gdb-needed-default-instance)))
607 (stop-process
608 (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp))
609
610(defun gdb-inferior-io-eof (instance)
611 "Send end-of-file to the program being debugged."
612 (interactive (list (gdb-needed-default-instance)))
613 (process-send-eof
614 (get-buffer-process (gdb-get-instance-buffer instance 'gdba))))
615
616
617;;
618;; gdb communications
619;;
620
621;; INPUT: things sent to gdb
622;;
623;; Each instance has a high and low priority
624;; input queue. Low priority input is sent only
625;; when the high priority queue is idle.
626;;
627;; The queues are lists. Each element is either
628;; a string (indicating user or user-like input)
629;; or a list of the form:
630;;
631;; (INPUT-STRING HANDLER-FN)
632;;
633;;
634;; The handler function will be called from the
635;; partial-output buffer when the command completes.
636;; This is the way to write commands which
637;; invoke gdb commands autonomously.
638;;
639;; These lists are consumed tail first.
640;;
641
642(defun gdb-send (proc string)
643 "A comint send filter for gdb.
644This filter may simply queue output for a later time."
645 (let ((instance (gdb-proc->instance proc)))
646 (gdb-instance-enqueue-input instance (concat string "\n"))))
647
648;; Note: Stuff enqueued here will be sent to the next prompt, even if it
649;; is a query, or other non-top-level prompt. To guarantee stuff will get
650;; sent to the top-level prompt, currently it must be put in the idle queue.
651;; ^^^^^^^^^
652;; [This should encourage gdb extensions that invoke gdb commands to let
653;; the user go first; it is not a bug. -t]
654;;
655
656(defun gdb-instance-enqueue-input (instance item)
657 (if (gdb-instance-prompting instance)
658 (progn
659 (gdb-send-item instance item)
660 (set-gdb-instance-prompting instance nil))
661 (set-gdb-instance-input-queue
662 instance
663 (cons item (gdb-instance-input-queue instance)))))
664
665(defun gdb-instance-dequeue-input (instance)
666 (let ((queue (gdb-instance-input-queue instance)))
667 (and queue
668 (if (not (cdr queue))
669 (let ((answer (car queue)))
670 (set-gdb-instance-input-queue instance '())
671 answer)
672 (gdb-take-last-elt queue)))))
673
674(defun gdb-instance-enqueue-idle-input (instance item)
675 (if (and (gdb-instance-prompting instance)
676 (not (gdb-instance-input-queue instance)))
677 (progn
678 (gdb-send-item instance item)
679 (set-gdb-instance-prompting instance nil))
680 (set-gdb-instance-idle-input-queue
681 instance
682 (cons item (gdb-instance-idle-input-queue instance)))))
683
684(defun gdb-instance-dequeue-idle-input (instance)
685 (let ((queue (gdb-instance-idle-input-queue instance)))
686 (and queue
687 (if (not (cdr queue))
688 (let ((answer (car queue)))
689 (set-gdb-instance-idle-input-queue instance '())
690 answer)
691 (gdb-take-last-elt queue)))))
692
693; Don't use this in general.
694(defun gdb-take-last-elt (l)
695 (if (cdr (cdr l))
696 (gdb-take-last-elt (cdr l))
697 (let ((answer (car (cdr l))))
698 (setcdr l '())
699 answer)))
700
701
702;;
703;; output -- things gdb prints to emacs
704;;
705;; GDB output is a stream interrupted by annotations.
706;; Annotations can be recognized by their beginning
707;; with \C-j\C-z\C-z<tag><opt>\C-j
708;;
709;; The tag is a string obeying symbol syntax.
710;;
711;; The optional part `<opt>' can be either the empty string
712;; or a space followed by more data relating to the annotation.
713;; For example, the SOURCE annotation is followed by a filename,
714;; line number and various useless goo. This data must not include
715;; any newlines.
716;;
717
718(defcustom gud-gdba-command-name "gdb -annotate=2"
719 "Default command to execute an executable under the GDB debugger (gdb-ui.el)."
720 :type 'string
721 :group 'gud)
722
723(defun gdba-marker-filter (string)
724 "A gud marker filter for gdb."
725 ;; Bogons don't tell us the process except through scoping crud.
726 (let ((instance (gdb-proc->instance proc)))
727 (gdb-output-burst instance string)))
728
729(defvar gdb-annotation-rules
730 '(("frames-invalid" gdb-invalidate-frame-and-assembler)
731 ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler)
732 ("pre-prompt" gdb-pre-prompt)
733 ("prompt" gdb-prompt)
734 ("commands" gdb-subprompt)
735 ("overload-choice" gdb-subprompt)
736 ("query" gdb-subprompt)
737 ("prompt-for-continue" gdb-subprompt)
738 ("post-prompt" gdb-post-prompt)
739 ("source" gdb-source)
740 ("starting" gdb-starting)
741 ("exited" gdb-stopping)
742 ("signalled" gdb-stopping)
743 ("signal" gdb-stopping)
744 ("breakpoint" gdb-stopping)
745 ("watchpoint" gdb-stopping)
746 ("frame-begin" gdb-frame-begin)
747 ("stopped" gdb-stopped)
748 ("display-begin" gdb-display-begin)
749 ("display-end" gdb-display-end)
750 ("display-number-end" gdb-display-number-end)
751 ("array-section-begin" gdb-array-section-begin)
752 ("array-section-end" gdb-array-section-end)
753; ("elt" gdb-elt)
754 ("field-begin" gdb-field-begin)
755 ("field-end" gdb-field-end)
756 ) "An assoc mapping annotation tags to functions which process them.")
757
758(defun gdb-ignore-annotation (instance args)
759 nil)
760
761(defconst gdb-source-spec-regexp
762 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
763
764;; Do not use this except as an annotation handler."
765(defun gdb-source (instance args)
766 (string-match gdb-source-spec-regexp args)
767 ;; Extract the frame position from the marker.
768 (setq gud-last-frame
769 (cons
770 (substring args (match-beginning 1) (match-end 1))
771 (string-to-int (substring args
772 (match-beginning 2)
773 (match-end 2)))))
774 (setq gdb-current-address (substring args (match-beginning 3)
775 (match-end 3)))
776 (setq gdb-main-or-pc gdb-current-address)
777;update with new frame for machine code if necessary
778 (gdb-invalidate-assembler instance))
779
780;; An annotation handler for `prompt'.
781;; This sends the next command (if any) to gdb.
782(defun gdb-prompt (instance ignored)
783 (let ((sink (gdb-instance-output-sink instance)))
784 (cond
785 ((eq sink 'user) t)
786 ((eq sink 'post-emacs)
787 (set-gdb-instance-output-sink instance 'user))
788 (t
789 (set-gdb-instance-output-sink instance 'user)
790 (error "Phase error in gdb-prompt (got %s)" sink))))
791 (let ((highest (gdb-instance-dequeue-input instance)))
792 (if highest
793 (gdb-send-item instance highest)
794 (let ((lowest (gdb-instance-dequeue-idle-input instance)))
795 (if lowest
796 (gdb-send-item instance lowest)
797 (progn
798 (set-gdb-instance-prompting instance t)
799 (gud-display-frame)))))))
800
801;; An annotation handler for non-top-level prompts.
802(defun gdb-subprompt (instance ignored)
803 (let ((highest (gdb-instance-dequeue-input instance)))
804 (if highest
805 (gdb-send-item instance highest)
806 (set-gdb-instance-prompting instance t))))
807
808(defun gdb-send-item (instance item)
809 (set-gdb-instance-current-item instance item)
810 (if (stringp item)
811 (progn
812 (set-gdb-instance-output-sink instance 'user)
813 (process-send-string (gdb-instance-process instance)
814 item))
815 (progn
816 (gdb-clear-partial-output instance)
817 (set-gdb-instance-output-sink instance 'pre-emacs)
818 (process-send-string (gdb-instance-process instance)
819 (car item)))))
820
821;; An annotation handler for `pre-prompt'.
822;; This terminates the collection of output from a previous
823;; command if that happens to be in effect.
824(defun gdb-pre-prompt (instance ignored)
825 (let ((sink (gdb-instance-output-sink instance)))
826 (cond
827 ((eq sink 'user) t)
828 ((eq sink 'emacs)
829 (set-gdb-instance-output-sink instance 'post-emacs)
830 (let ((handler
831 (car (cdr (gdb-instance-current-item instance)))))
832 (save-excursion
833 (set-buffer (gdb-get-create-instance-buffer
834 instance 'gdb-partial-output-buffer))
835 (funcall handler))))
836 (t
837 (set-gdb-instance-output-sink instance 'user)
838 (error "Output sink phase error 1")))))
839
840;; An annotation handler for `starting'. This says that I/O for the subprocess
841;; is now the program being debugged, not GDB.
842(defun gdb-starting (instance ignored)
843 (let ((sink (gdb-instance-output-sink instance)))
844 (cond
845 ((eq sink 'user)
846 (set-gdb-instance-output-sink instance 'inferior))
847 (t (error "Unexpected `starting' annotation")))))
848
849;; An annotation handler for `exited' and other annotations which say that
850;; I/O for the subprocess is now GDB, not the program being debugged.
851(defun gdb-stopping (instance ignored)
852 (let ((sink (gdb-instance-output-sink instance)))
853 (cond
854 ((eq sink 'inferior)
855 (set-gdb-instance-output-sink instance 'user))
856 (t (error "Unexpected stopping annotation")))))
857
858;; An annotation handler for `stopped'. It is just like gdb-stopping, except
859;; that if we already set the output sink to 'user in gdb-stopping, that is
860;; fine.
861(defun gdb-stopped (instance ignored)
862 (let ((sink (gdb-instance-output-sink instance)))
863 (cond
864 ((eq sink 'inferior)
865 (set-gdb-instance-output-sink instance 'user))
866 ((eq sink 'user) t)
867 (t (error "Unexpected stopped annotation")))))
868
869(defun gdb-frame-begin (instance ignored)
870 (let ((sink (gdb-instance-output-sink instance)))
871 (cond
872 ((eq sink 'inferior)
873 (set-gdb-instance-output-sink instance 'user))
874 ((eq sink 'user) t)
875 ((eq sink 'emacs) t)
876 (t (error "Unexpected frame-begin annotation (%S)" sink)))))
877
878;; An annotation handler for `post-prompt'.
879;; This begins the collection of output from the current
880;; command if that happens to be appropriate."
881(defun gdb-post-prompt (instance ignored)
882 (if (not (gdb-instance-pending-triggers instance))
883 (progn
884 (gdb-invalidate-registers instance ignored)
885 (gdb-invalidate-locals instance ignored)
886 (gdb-invalidate-display instance ignored)))
887 (let ((sink (gdb-instance-output-sink instance)))
888 (cond
889 ((eq sink 'user) t)
890 ((eq sink 'pre-emacs)
891 (set-gdb-instance-output-sink instance 'emacs))
892
893 (t
894 (set-gdb-instance-output-sink instance 'user)
895 (error "Output sink phase error 3")))))
896
897;; If we get an error whilst evaluating one of the expressions
898;; we won't get the display-end annotation. Set the sink back to
899;; user to make sure that the error message is seen
900
901(defun gdb-error-begin (instance ignored)
902 (set-gdb-instance-output-sink instance 'user))
903
904(defun gdb-display-begin (instance ignored)
905 (if (gdb-get-instance-buffer instance 'gdb-display-buffer)
906 (progn
907 (set-gdb-instance-output-sink instance 'emacs)
908 (gdb-clear-partial-output instance)
909 (setq gdb-display-in-progress t))
910 (set-gdb-instance-output-sink instance 'user)))
911
912(defun gdb-display-number-end (instance ignored)
913 (set-buffer (gdb-get-instance-buffer
914 instance 'gdb-partial-output-buffer))
915 (setq gdb-display-number (buffer-string))
916 (setq gdb-expression-buffer-name
917 (concat "*display " gdb-display-number "*"))
918 (save-excursion
919 (if (progn
920 (set-buffer (window-buffer))
921 gdb-dive)
922 (progn
923 (let ((number gdb-display-number))
924 (switch-to-buffer
925 (set-buffer (get-buffer-create gdb-expression-buffer-name)))
926 (gdb-expressions-mode)
927 (setq gdb-dive-display-number number)))
928;else
929 (set-buffer (get-buffer-create gdb-expression-buffer-name))
930 (if (and (display-graphic-p) (not gdb-dive))
931 (catch 'frame-exists
932 (let ((frames (frame-list)))
933 (while frames
934 (if (string-equal (frame-parameter (car frames) 'name)
935 gdb-expression-buffer-name)
936 (throw 'frame-exists nil))
937 (setq frames (cdr frames)))
938 (if (not frames)
939 (progn
940 (gdb-expressions-mode)
941 (make-frame '((height . 20) (width . 40)
942 (tool-bar-lines . nil)
943 (menu-bar-lines . nil)
944 (minibuffer . nil))))))))))
945 (set-buffer (gdb-get-instance-buffer
946 instance 'gdb-partial-output-buffer))
947 (setq gdb-dive nil))
948
949(defun gdb-display-end (instance ignored)
950 (set-buffer (gdb-get-instance-buffer instance 'gdb-partial-output-buffer))
951 (goto-char (point-min))
952 (search-forward ": ")
953 (looking-at "\\(.*?\\) =")
954 (let ((char "")
955 (gdb-temp-value (buffer-substring (match-beginning 1)
956 (match-end 1))))
957;move * to front of expression if necessary
958 (if (looking-at ".*\\*")
959 (progn
960 (setq char "*")
961 (setq gdb-temp-value (substring gdb-temp-value 1 nil))))
962 (save-excursion
963 (set-buffer gdb-expression-buffer-name)
964 (setq gdb-expression gdb-temp-value)
965 (if (not (string-match "::" gdb-expression))
966 (setq gdb-expression (concat char gdb-current-frame
967 "::" gdb-expression))
968;else put * back on if necessary
969 (setq gdb-expression (concat char gdb-expression)))
970 (setq header-line-format (concat "-- " gdb-expression " %-"))))
971
972;-if scalar/string
973 (if (not (re-search-forward "##" nil t))
974 (progn
975 (save-excursion
976 (set-buffer gdb-expression-buffer-name)
977 (setq buffer-read-only nil)
978 (delete-region (point-min) (point-max))
979 (insert-buffer (gdb-get-instance-buffer
980 instance 'gdb-partial-output-buffer))
981 (setq buffer-read-only t)))
982; else
983; display expression name...
984 (goto-char (point-min))
985 (let ((start (progn (point)))
986 (end (progn (end-of-line) (point))))
987 (save-excursion
988 (set-buffer gdb-expression-buffer-name)
989 (setq buffer-read-only nil)
990 (delete-region (point-min) (point-max))
991 (insert-buffer-substring (gdb-get-instance-buffer
992 gdb-buffer-instance
993 'gdb-partial-output-buffer)
994 start end)
995 (insert "\n")))
996
997 (goto-char (point-min))
998 (re-search-forward "##" nil t)
999 (setq gdb-nesting-level 0)
1000 (if (looking-at "array-section-begin")
1001 (progn
1002 (gdb-delete-line)
1003 (beginning-of-line)
1004 (setq gdb-point (point))
1005 (gdb-array-format)))
1006 (if (looking-at "field-begin \\(.\\)")
1007 (progn
1008 (setq gdb-annotation-arg (buffer-substring (match-beginning 1)
1009 (match-end 1)))
1010 (gdb-field-format-begin))))
1011 (save-excursion
1012 (set-buffer gdb-expression-buffer-name)
1013 (if gdb-dive-display-number
1014 (progn
1015 (setq buffer-read-only nil)
1016 (goto-char (point-max))
1017 (insert "\n")
1018 (insert-text-button "[back]" 'type 'gdb-display-back)
1019 (setq buffer-read-only t))))
1020 (gdb-clear-partial-output instance)
1021 (set-gdb-instance-output-sink instance 'user)
1022 (setq gdb-display-in-progress nil))
1023
1024(define-button-type 'gdb-display-back
1025 'help-echo (purecopy "mouse-2, RET: go back to previous display buffer")
1026 'action (lambda (button) (gdb-display-go-back)))
1027
1028(defun gdb-display-go-back ()
1029 ; delete display so they don't accumulate and delete buffer
1030 (let ((number gdb-display-number))
1031 (gdb-instance-enqueue-idle-input
1032 gdb-buffer-instance
1033 (list (concat "server delete display " number "\n")
1034 '(lambda () nil)))
1035 (switch-to-buffer (concat "*display " gdb-dive-display-number "*"))
1036 (kill-buffer (get-buffer (concat "*display " number "*")))))
1037
1038; prefix annotations with ## and process whole output in one chunk
1039; in gdb-partial-output-buffer (to allow recursion).
1040
1041; array-section flags are just removed again but after counting. They
1042; might also be useful for arrays of structures and structures with arrays.
1043(defun gdb-array-section-begin (instance args)
1044 (if gdb-display-in-progress
1045 (progn
1046 (save-excursion
1047 (set-buffer (gdb-get-instance-buffer
1048 instance 'gdb-partial-output-buffer))
1049 (goto-char (point-max))
1050 (insert (concat "\n##array-section-begin " args "\n"))))))
1051
1052(defun gdb-array-section-end (instance ignored)
1053 (if gdb-display-in-progress
1054 (progn
1055 (save-excursion
1056 (set-buffer (gdb-get-instance-buffer
1057 instance 'gdb-partial-output-buffer))
1058 (goto-char (point-max))
1059 (insert "\n##array-section-end\n")))))
1060
1061(defun gdb-field-begin (instance args)
1062 (if gdb-display-in-progress
1063 (progn
1064 (save-excursion
1065 (set-buffer (gdb-get-instance-buffer
1066 instance 'gdb-partial-output-buffer))
1067 (goto-char (point-max))
1068 (insert (concat "\n##field-begin " args "\n"))))))
1069
1070(defun gdb-field-end (instance ignored)
1071 (if gdb-display-in-progress
1072 (progn
1073 (save-excursion
1074 (set-buffer (gdb-get-instance-buffer
1075 instance 'gdb-partial-output-buffer))
1076 (goto-char (point-max))
1077 (insert "\n##field-end\n")))))
1078
1079(defun gdb-elt (instance ignored)
1080 (if gdb-display-in-progress
1081 (progn
1082 (goto-char (point-max))
1083 (insert "\n##elt\n"))))
1084
1085(defun gdb-field-format-begin ()
1086; get rid of ##field-begin
1087 (gdb-delete-line)
1088 (gdb-insert-field)
1089 (setq gdb-nesting-level (+ gdb-nesting-level 1))
1090 (while (re-search-forward "##" nil t)
1091; keep making recursive calls...
1092 (if (looking-at "field-begin \\(.\\)")
1093 (progn
1094 (setq gdb-annotation-arg (buffer-substring (match-beginning 1)
1095 (match-end 1)))
1096 (gdb-field-format-begin)))
1097; until field-end.
1098 (if (looking-at "field-end") (gdb-field-format-end))))
1099
1100(defun gdb-field-format-end ()
1101; get rid of ##field-end and `,' or `}'
1102 (gdb-delete-line)
1103 (gdb-delete-line)
1104 (setq gdb-nesting-level (- gdb-nesting-level 1)))
1105
1106(defun gdb-insert-field ()
1107 (let ((start (progn (point)))
1108 (end (progn (next-line) (point)))
1109 (num 0))
1110 (save-excursion
1111 (set-buffer gdb-expression-buffer-name)
1112 (setq buffer-read-only nil)
1113 (if (string-equal gdb-annotation-arg "\*") (insert "\*"))
1114 (while (<= num gdb-nesting-level)
1115 (insert "\t")
1116 (setq num (+ num 1)))
1117 (insert-buffer-substring (gdb-get-instance-buffer
1118 gdb-buffer-instance
1119 'gdb-partial-output-buffer)
1120 start end)
1121 (put-text-property (- (point) (- end start)) (- (point) 1)
1122 'mouse-face 'highlight)
1123 (put-text-property (- (point) (- end start)) (- (point) 1)
1124 'local-map gdb-dive-map)
1125 (setq buffer-read-only t))
1126 (delete-region start end)))
1127
1128(defun gdb-array-format ()
1129 (while (re-search-forward "##" nil t)
1130; keep making recursive calls...
1131 (if (looking-at "array-section-begin")
1132 (progn
1133;get rid of ##array-section-begin
1134 (gdb-delete-line)
1135 (setq gdb-nesting-level (+ gdb-nesting-level 1))
1136 (gdb-array-format)))
1137;until *matching* array-section-end is found
1138 (if (looking-at "array-section-end")
1139 (if (eq gdb-nesting-level 0)
1140 (progn
1141 (let ((values (buffer-substring gdb-point (- (point) 2))))
1142 (save-excursion
1143 (set-buffer gdb-expression-buffer-name)
1144 (setq gdb-values
1145 (concat "{" (replace-regexp-in-string "\n" "" values)
1146 "}"))
1147 (gdb-array-format1))))
1148;else get rid of ##array-section-end etc
1149 (gdb-delete-line)
1150 (setq gdb-nesting-level (- gdb-nesting-level 1))
1151 (gdb-array-format)))))
1152
1153(defun gdb-array-format1 ()
1154 (setq gdb-display-string "")
1155 (setq buffer-read-only nil)
1156 (delete-region (point-min) (point-max))
1157 (let ((gdb-value-list (split-string gdb-values ", ")))
1158 (string-match "\\({+\\)" (car gdb-value-list))
1159 (let* ((depth (- (match-end 1) (match-beginning 1)))
1160 (indices (make-vector depth '0))
1161 (index 0) (num 0) (array-start "")
1162 (array-stop "") (array-slice "")
1163 (flag t) (indices-string ""))
1164 (while gdb-value-list
1165 (string-match "{*\\([^}]*\\)\\(}*\\)" (car gdb-value-list))
1166 (setq num 0)
1167 (while (< num depth)
1168 (setq indices-string
1169 (concat indices-string
1170 "[" (int-to-string (aref indices num)) "]"))
1171 (if (not (= (aref gdb-array-start num) -1))
1172 (if (or (< (aref indices num) (aref gdb-array-start num))
1173 (> (aref indices num) (aref gdb-array-stop num)))
1174 (setq flag nil))
1175 (aset gdb-array-size num (aref indices num)))
1176 (setq num (+ num 1)))
1177 (if flag
1178 (let ((gdb-display-value (substring (car gdb-value-list)
1179 (match-beginning 1)
1180 (match-end 1))))
1181 (setq gdb-display-string (concat gdb-display-string " "
1182 gdb-display-value))
1183 (insert
1184 (concat indices-string "\t" gdb-display-value "\n"))))
1185 (setq indices-string "")
1186 (setq flag t)
1187 ; 0<= index < depth, start at right : (- depth 1)
1188 (setq index (- (- depth 1)
1189 (- (match-end 2) (match-beginning 2))))
1190 ;don't set for very last brackets
1191 (if (>= index 0)
1192 (progn
1193 (aset indices index (+ 1 (aref indices index)))
1194 (setq num (+ 1 index))
1195 (while (< num depth)
1196 (aset indices num 0)
1197 (setq num (+ num 1)))))
1198 (setq gdb-value-list (cdr gdb-value-list)))
1199 (setq num 0)
1200 (while (< num depth)
1201 (if (= (aref gdb-array-start num) -1)
1202 (progn
1203 (aset gdb-array-start num 0)
1204 (aset gdb-array-stop num (aref indices num))))
1205 (setq array-start (int-to-string (aref gdb-array-start num)))
1206 (setq array-stop (int-to-string (aref gdb-array-stop num)))
1207 (setq array-range (concat "[" array-start
1208 ":" array-stop "]"))
1209 (put-text-property 1 (+ (length array-start)
1210 (length array-stop) 2)
1211 'mouse-face 'highlight array-range)
1212 (put-text-property 1 (+ (length array-start)
1213 (length array-stop) 2)
1214 'local-map gdb-array-slice-map array-range)
1215 (goto-char (point-min))
1216 (setq array-slice (concat array-slice array-range))
1217 (setq num (+ num 1)))
1218 (goto-char (point-min))
1219 (insert "Array Size : ")
1220 (setq num 0)
1221 (while (< num depth)
1222 (insert
1223 (concat "["
1224 (int-to-string (+ (aref gdb-array-size num) 1)) "]"))
1225 (setq num (+ num 1)))
1226 (insert
1227 (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n"))))
1228 (setq buffer-read-only t))
1229
1230(defvar gdb-dive-map nil)
1231(setq gdb-dive-map (make-keymap))
1232(define-key gdb-dive-map [mouse-2] 'gdb-dive)
1233(define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame)
1234
1235(defun gdb-dive (event)
1236 "Dive into structure."
1237 (interactive "e")
1238 (setq gdb-dive t)
1239 (gdb-dive-new-frame event))
1240
1241(defun gdb-dive-new-frame (event)
1242 "Dive into structure and display in a new frame."
1243 (interactive "e")
1244 (save-excursion
1245 (mouse-set-point event)
1246 (let ((point (point)) (gdb-full-expression gdb-expression)
1247 (end (progn (end-of-line) (point)))
1248 (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil))
1249 (beginning-of-line)
1250 (if (looking-at "\*") (setq gdb-display-char "*"))
1251 (re-search-forward "\\(\\S-+\\) = " end t)
1252 (setq gdb-last-field (buffer-substring-no-properties
1253 (match-beginning 1)
1254 (match-end 1)))
1255 (goto-char (match-beginning 1))
1256 (let ((last-column (current-column)))
1257 (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t)
1258 (goto-char (match-beginning 1))
1259 (if (and (< (current-column) last-column)
1260 (> (count-lines 1 (point)) 1))
1261 (progn
1262 (setq gdb-part-expression
1263 (concat "." (buffer-substring-no-properties
1264 (match-beginning 1)
1265 (match-end 1)) gdb-part-expression))
1266 (setq last-column (current-column))))))
1267; * not needed for components of a pointer to a structure in gdb
1268 (if (string-equal "*" (substring gdb-full-expression 0 1))
1269 (setq gdb-full-expression (substring gdb-full-expression 1 nil)))
1270 (setq gdb-full-expression
1271 (concat gdb-full-expression gdb-part-expression "." gdb-last-field))
1272 (gdb-instance-enqueue-idle-input gdb-buffer-instance
1273 (list
1274 (concat "server display" gdb-display-char
1275 " " gdb-full-expression "\n")
1276 '(lambda () nil))))))
1277
1278;; Handle a burst of output from a gdb instance.
1279;; This function is (indirectly) used as a gud-marker-filter.
1280;; It must return output (if any) to be insterted in the gdb
1281;; buffer.
1282
1283(defun gdb-output-burst (instance string)
1284 "Handle a burst of output from a gdb instance.
1285This function is (indirectly) used as a gud-marker-filter.
1286It must return output (if any) to be insterted in the gdb
1287buffer."
1288
1289 (save-match-data
1290 (let (
1291 ;; Recall the left over burst from last time
1292 (burst (concat (gdb-instance-burst instance) string))
1293 ;; Start accumulating output for the GUD buffer
1294 (output ""))
1295
1296 ;; Process all the complete markers in this chunk.
1297
1298 (while (string-match "\n\032\032\\(.*\\)\n" burst)
1299 (let ((annotation (substring burst
1300 (match-beginning 1)
1301 (match-end 1))))
1302
1303 ;; Stuff prior to the match is just ordinary output.
1304 ;; It is either concatenated to OUTPUT or directed
1305 ;; elsewhere.
1306 (setq output
1307 (gdb-concat-output
1308 instance
1309 output
1310 (substring burst 0 (match-beginning 0))))
1311
1312 ;; Take that stuff off the burst.
1313 (setq burst (substring burst (match-end 0)))
1314
1315 ;; Parse the tag from the annotation, and maybe its arguments.
1316 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
1317 (let* ((annotation-type (substring annotation
1318 (match-beginning 1)
1319 (match-end 1)))
1320 (annotation-arguments (substring annotation
1321 (match-beginning 2)
1322 (match-end 2)))
1323 (annotation-rule (assoc annotation-type
1324 gdb-annotation-rules)))
1325 ;; Call the handler for this annotation.
1326 (if annotation-rule
1327 (funcall (car (cdr annotation-rule))
1328 instance
1329 annotation-arguments)
1330 ;; Else the annotation is not recognized. Ignore it silently,
1331 ;; so that GDB can add new annotations without causing
1332 ;; us to blow up.
1333 ))))
1334
1335
1336 ;; Does the remaining text end in a partial line?
1337 ;; If it does, then keep part of the burst until we get more.
1338 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1339 burst)
1340 (progn
1341 ;; Everything before the potential marker start can be output.
1342 (setq output
1343 (gdb-concat-output
1344 instance
1345 output
1346 (substring burst 0 (match-beginning 0))))
1347
1348 ;; Everything after, we save, to combine with later input.
1349 (setq burst (substring burst (match-beginning 0))))
1350
1351 ;; In case we know the burst contains no partial annotations:
1352 (progn
1353 (setq output (gdb-concat-output instance output burst))
1354 (setq burst "")))
1355
1356 ;; Save the remaining burst for the next call to this function.
1357 (set-gdb-instance-burst instance burst)
1358 output)))
1359
1360(defun gdb-concat-output (instance so-far new)
1361 (let ((sink (gdb-instance-output-sink instance)))
1362 (cond
1363 ((eq sink 'user) (concat so-far new))
1364 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
1365 ((eq sink 'emacs)
1366 (gdb-append-to-partial-output instance new)
1367 so-far)
1368 ((eq sink 'inferior)
1369 (gdb-append-to-inferior-io instance new)
1370 so-far)
1371 (t (error "Bogon output sink %S" sink)))))
1372
1373(defun gdb-append-to-partial-output (instance string)
1374 (save-excursion
1375 (set-buffer
1376 (gdb-get-create-instance-buffer
1377 instance 'gdb-partial-output-buffer))
1378 (goto-char (point-max))
1379 (insert string)))
1380
1381(defun gdb-clear-partial-output (instance)
1382 (save-excursion
1383 (set-buffer
1384 (gdb-get-create-instance-buffer
1385 instance 'gdb-partial-output-buffer))
1386 (delete-region (point-min) (point-max))))
1387
1388(defun gdb-append-to-inferior-io (instance string)
1389 (save-excursion
1390 (set-buffer
1391 (gdb-get-create-instance-buffer
1392 instance 'gdb-inferior-io))
1393 (goto-char (point-max))
1394 (insert-before-markers string))
1395 (gdb-display-buffer
1396 (gdb-get-create-instance-buffer instance
1397 'gdb-inferior-io)))
1398
1399(defun gdb-clear-inferior-io (instance)
1400 (save-excursion
1401 (set-buffer
1402 (gdb-get-create-instance-buffer
1403 instance 'gdb-inferior-io))
1404 (delete-region (point-min) (point-max))))
1405
1406
1407
1408;; One trick is to have a command who's output is always available in
1409;; a buffer of it's own, and is always up to date. We build several
1410;; buffers of this type.
1411;;
1412;; There are two aspects to this: gdb has to tell us when the output
1413;; for that command might have changed, and we have to be able to run
1414;; the command behind the user's back.
1415;;
1416;; The idle input queue and the output phasing associated with
1417;; the instance variable `(gdb-instance-output-sink instance)' help
1418;; us to run commands behind the user's back.
1419;;
1420;; Below is the code for specificly managing buffers of output from one
1421;; command.
1422;;
1423
1424
1425;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1426;; It adds an idle input for the command we are tracking. It should be the
1427;; annotation rule binding of whatever gdb sends to tell us this command
1428;; might have changed it's output.
1429;;
1430;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1431;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1432;; input in the input queue (see comment about ``gdb communications'' above).
1433(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler)
1434 `(defun ,name (instance &optional ignored)
1435 (if (and (,demand-predicate instance)
1436 (not (member ',name
1437 (gdb-instance-pending-triggers instance))))
1438 (progn
1439 (gdb-instance-enqueue-idle-input
1440 instance
1441 (list ,gdb-command ',output-handler))
1442 (set-gdb-instance-pending-triggers
1443 instance
1444 (cons ',name
1445 (gdb-instance-pending-triggers instance)))))))
1446
1447(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
1448 `(defun ,name ()
1449 (set-gdb-instance-pending-triggers
1450 instance
1451 (delq ',trigger
1452 (gdb-instance-pending-triggers instance)))
1453 (let ((buf (gdb-get-instance-buffer instance
1454 ',buf-key)))
1455 (and buf
1456 (save-excursion
1457 (set-buffer buf)
1458 (let ((p (point))
1459 (buffer-read-only nil))
1460 (delete-region (point-min) (point-max))
1461 (insert-buffer (gdb-get-create-instance-buffer
1462 instance
1463 'gdb-partial-output-buffer))
1464 (goto-char p)))))
1465; put customisation here
1466 (,custom-defun)))
1467
1468(defmacro def-gdb-auto-updated-buffer
1469 (buffer-key trigger-name gdb-command output-handler-name custom-defun)
1470 `(progn
1471 (def-gdb-auto-update-trigger ,trigger-name
1472 ;; The demand predicate:
1473 (lambda (instance)
1474 (gdb-get-instance-buffer instance ',buffer-key))
1475 ,gdb-command
1476 ,output-handler-name)
1477 (def-gdb-auto-update-handler ,output-handler-name
1478 ,trigger-name ,buffer-key ,custom-defun)))
1479
1480
1481;;
1482;; Breakpoint buffers
1483;;
1484;; These display the output of `info breakpoints'.
1485;;
1486
1487
1488(gdb-set-instance-buffer-rules 'gdb-breakpoints-buffer
1489 'gdb-breakpoints-buffer-name
1490 'gdb-breakpoints-mode)
1491
1492(def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1493 ;; This defines the auto update rule for buffers of type
1494 ;; `gdb-breakpoints-buffer'.
1495 ;;
1496 ;; It defines a function to serve as the annotation handler that
1497 ;; handles the `foo-invalidated' message. That function is called:
1498 gdb-invalidate-breakpoints
1499
1500 ;; To update the buffer, this command is sent to gdb.
1501 "server info breakpoints\n"
1502
1503 ;; This also defines a function to be the handler for the output
1504 ;; from the command above. That function will copy the output into
1505 ;; the appropriately typed buffer. That function will be called:
1506 gdb-info-breakpoints-handler
1507;; buffer specific functions
1508 gdb-info-breakpoints-custom)
1509
1510;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1511(defun gdb-info-breakpoints-custom ()
1512 (let ((flag)(address))
1513
1514; remove all breakpoint-icons in source buffers but not assembler buffer
1515 (let ((buffers (buffer-list)))
1516 (save-excursion
1517 (while buffers
1518 (set-buffer (car buffers))
1519 (if (and (eq gud-minor-mode 'gdba)
1520 (not (string-match "^\*" (buffer-name))))
1521 (if (display-graphic-p)
1522 (remove-images (point-min) (point-max))
1523 (remove-strings (point-min) (point-max))))
1524 (setq buffers (cdr buffers)))))
1525
1526 (save-excursion
1527 (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer))
1528 (save-excursion
1529 (goto-char (point-min))
1530 (while (< (point) (- (point-max) 1))
1531 (forward-line 1)
1532 (if (looking-at "[^\t].*breakpoint")
1533 (progn
1534 (looking-at "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1535 (setq flag (char-after (match-beginning 2)))
1536 (beginning-of-line)
1537 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+")
1538 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1539 (let ((line (buffer-substring (match-beginning 2)
1540 (match-end 2)))
1541 (file (buffer-substring (match-beginning 1)
1542 (match-end 1))))
1543 (save-excursion
1544 (set-buffer
1545 (if (file-exists-p file)
1546 (find-file-noselect file)
1547 ;else
1548 (find-file-noselect (concat gdb-cdir "/" file))))
1549 (with-current-buffer (current-buffer)
1550 (progn
1551 (set (make-local-variable 'gud-minor-mode) 'gdba)
1552 (set (make-local-variable 'tool-bar-map)
1553 gud-tool-bar-map)
1554 (set (make-variable-buffer-local 'left-margin-width) 2)
1555 (if (get-buffer-window (current-buffer))
1556 (set-window-margins (get-buffer-window
1557 (current-buffer))
1558 left-margin-width
1559 right-margin-width))))
1560 ; only want one breakpoint icon at each location
1561 (save-excursion
1562 (goto-line (string-to-number line))
1563 (let ((start (progn (beginning-of-line) (- (point) 1)))
1564 (end (progn (end-of-line) (+ (point) 1))))
1565 (if (display-graphic-p)
1566 (progn
1567 (remove-images start end)
1568 (if (eq ?y flag)
1569 (put-image breakpoint-enabled-icon (point)
1570 "breakpoint icon enabled"
1571 'left-margin)
1572 (put-image breakpoint-disabled-icon (point)
1573 "breakpoint icon disabled"
1574 'left-margin)))
1575 (remove-strings start end)
1576 (if (eq ?y flag)
1577 (put-string "B" (point) "enabled"
1578 'left-margin)
1579 (put-string "b" (point) "disabled"
1580 'left-margin)))))))))
1581 (end-of-line))))))
1582
1583(defun gdb-breakpoints-buffer-name (instance)
1584 (save-excursion
1585 (set-buffer (process-buffer (gdb-instance-process instance)))
1586 (concat "*breakpoints of " (gdb-instance-target-string instance) "*")))
1587
1588(defun gdb-display-breakpoints-buffer (instance)
1589 (interactive (list (gdb-needed-default-instance)))
1590 (gdb-display-buffer
1591 (gdb-get-create-instance-buffer instance
1592 'gdb-breakpoints-buffer)))
1593
1594(defun gdb-frame-breakpoints-buffer (instance)
1595 (interactive (list (gdb-needed-default-instance)))
1596 (switch-to-buffer-other-frame
1597 (gdb-get-create-instance-buffer instance
1598 'gdb-breakpoints-buffer)))
1599
1600(defvar gdb-breakpoints-mode-map nil)
1601(setq gdb-breakpoints-mode-map (make-keymap))
1602(suppress-keymap gdb-breakpoints-mode-map)
1603
1604(define-key gdb-breakpoints-mode-map [menu-bar breakpoints]
1605 (cons "Breakpoints" (make-sparse-keymap "Breakpoints")))
1606(define-key gdb-breakpoints-mode-map [menu-bar breakpoints toggle]
1607 '("Toggle" . gdb-toggle-bp-this-line))
1608(define-key gdb-breakpoints-mode-map [menu-bar breakpoints delete]
1609 '("Delete" . gdb-delete-bp-this-line))
1610(define-key gdb-breakpoints-mode-map [menu-bar breakpoints goto]
1611 '("Goto" . gdb-goto-bp-this-line))
1612
1613(define-key gdb-breakpoints-mode-map " " 'gdb-toggle-bp-this-line)
1614(define-key gdb-breakpoints-mode-map "d" 'gdb-delete-bp-this-line)
1615(define-key gdb-breakpoints-mode-map "g" 'gdb-goto-bp-this-line)
1616
1617(defun gdb-breakpoints-mode ()
1618 "Major mode for gdb breakpoints.
1619
1620\\{gdb-breakpoints-mode-map}"
1621 (setq major-mode 'gdb-breakpoints-mode)
1622 (setq mode-name "Breakpoints")
1623 (use-local-map gdb-breakpoints-mode-map)
1624 (set (make-local-variable 'gud-minor-mode) 'gdba)
1625 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1626 (setq buffer-read-only t)
1627 (gdb-invalidate-breakpoints gdb-buffer-instance))
1628
1629(defun gdb-toggle-bp-this-line ()
1630 (interactive)
1631 (save-excursion
1632 (beginning-of-line 1)
1633 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1634 (error "Not recognized as break/watchpoint line")
1635 (Gdb-instance-enqueue-idle-input
1636 gdb-buffer-instance
1637 (list
1638 (concat
1639 (if (eq ?y (char-after (match-beginning 2)))
1640 "server disable "
1641 "server enable ")
1642 (buffer-substring (match-beginning 0)
1643 (match-end 1))
1644 "\n")
1645 '(lambda () nil))))))
1646
1647(defun gdb-delete-bp-this-line ()
1648 (interactive)
1649 (beginning-of-line 1)
1650 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1651 (error "Not recognized as break/watchpoint line")
1652 (gdb-instance-enqueue-idle-input
1653 gdb-buffer-instance
1654 (list
1655 (concat
1656 "server delete "
1657 (buffer-substring (match-beginning 0)
1658 (match-end 1))
1659 "\n")
1660 '(lambda () nil)))))
1661
1662(defun gdb-goto-bp-this-line ()
1663"Display the file at the breakpoint specified."
1664 (interactive)
1665 (save-excursion
1666 (beginning-of-line 1)
1667 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+")
1668 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1669 (let ((line (buffer-substring (match-beginning 2)
1670 (match-end 2)))
1671 (file (buffer-substring (match-beginning 1)
1672 (match-end 1))))
1673 (if (file-exists-p file)
1674 (set-window-buffer gdb-source-window (find-file-noselect file))
1675 ;else
1676 (setq file (concat gdb-cdir "/" file))
1677 (set-window-buffer gdb-source-window (find-file-noselect file)))
1678 (goto-line (string-to-number line))))
1679
1680;;
1681;; Frames buffers. These display a perpetually correct bactracktrace
1682;; (from the command `where').
1683;;
1684;; Alas, if your stack is deep, they are costly.
1685;;
1686
1687(gdb-set-instance-buffer-rules 'gdb-stack-buffer
1688 'gdb-stack-buffer-name
1689 'gdb-frames-mode)
1690
1691(def-gdb-auto-updated-buffer gdb-stack-buffer
1692 gdb-invalidate-frames
1693 "server where\n"
1694 gdb-info-frames-handler
1695 gdb-info-frames-custom)
1696
1697(defun gdb-info-frames-custom ()
1698 (save-excursion
1699 (set-buffer (gdb-get-instance-buffer instance 'gdb-stack-buffer))
1700 (let ((buffer-read-only nil))
1701 (goto-char (point-min))
1702 (looking-at "\\S-*\\s-*\\(\\S-*\\)")
1703 (setq gdb-current-frame (buffer-substring (match-beginning 1) (match-end 1)))
1704 (while (< (point) (point-max))
1705 (put-text-property (progn (beginning-of-line) (point))
1706 (progn (end-of-line) (point))
1707 'mouse-face 'highlight)
1708 (forward-line 1)))))
1709
1710(defun gdb-stack-buffer-name (instance)
1711 (save-excursion
1712 (set-buffer (process-buffer (gdb-instance-process instance)))
1713 (concat "*stack frames of "
1714 (gdb-instance-target-string instance) "*")))
1715
1716(defun gdb-display-stack-buffer (instance)
1717 (interactive (list (gdb-needed-default-instance)))
1718 (gdb-display-buffer
1719 (gdb-get-create-instance-buffer instance
1720 'gdb-stack-buffer)))
1721
1722(defun gdb-frame-stack-buffer (instance)
1723 (interactive (list (gdb-needed-default-instance)))
1724 (switch-to-buffer-other-frame
1725 (gdb-get-create-instance-buffer instance
1726 'gdb-stack-buffer)))
1727
1728(defvar gdb-frames-mode-map nil)
1729(setq gdb-frames-mode-map (make-keymap))
1730(suppress-keymap gdb-frames-mode-map)
1731(define-key gdb-frames-mode-map [mouse-2]
1732 'gdb-frames-select-by-mouse)
1733
1734(defun gdb-frames-mode ()
1735 "Major mode for gdb frames.
1736
1737\\{gdb-frames-mode-map}"
1738 (setq major-mode 'gdb-frames-mode)
1739 (setq mode-name "Frames")
1740 (set (make-local-variable 'gud-minor-mode) 'gdba)
1741 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1742 (setq buffer-read-only t)
1743 (use-local-map gdb-frames-mode-map)
1744 (gdb-invalidate-frames gdb-buffer-instance))
1745
1746(defun gdb-get-frame-number ()
1747 (save-excursion
1748 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1749 (n (or (and pos
1750 (string-to-int
1751 (buffer-substring (match-beginning 1)
1752 (match-end 1))))
1753 0)))
1754 n)))
1755
1756(defun gdb-frames-select-by-mouse (e)
1757"Display the source of the selected frame."
1758 (interactive "e")
1759 (let (selection)
1760 (save-excursion
1761 (set-buffer (window-buffer (posn-window (event-end e))))
1762 (save-excursion
1763 (goto-char (posn-point (event-end e)))
1764 (setq selection (gdb-get-frame-number))))
1765 (select-window (posn-window (event-end e)))
1766 (save-excursion
1767 (set-buffer (gdb-get-instance-buffer (gdb-needed-default-instance) 'gdba))
1768 (gdb-instance-enqueue-idle-input
1769 gdb-buffer-instance
1770 (list
1771 (concat (gud-format-command "server frame %p" selection)
1772 "\n")
1773 '(lambda () nil)))
1774 (gud-display-frame))))
1775
1776
1777;;
1778;; Registers buffers
1779;;
1780
1781(def-gdb-auto-updated-buffer gdb-registers-buffer
1782 gdb-invalidate-registers
1783 "server info registers\n"
1784 gdb-info-registers-handler
1785 gdb-info-registers-custom)
1786
1787(defun gdb-info-registers-custom ())
1788
1789(gdb-set-instance-buffer-rules 'gdb-registers-buffer
1790 'gdb-registers-buffer-name
1791 'gdb-registers-mode)
1792
1793(defvar gdb-registers-mode-map nil)
1794(setq gdb-registers-mode-map (make-keymap))
1795(suppress-keymap gdb-registers-mode-map)
1796
1797(defun gdb-registers-mode ()
1798 "Major mode for gdb registers.
1799
1800\\{gdb-registers-mode-map}"
1801 (setq major-mode 'gdb-registers-mode)
1802 (setq mode-name "Registers")
1803 (set (make-local-variable 'gud-minor-mode) 'gdba)
1804 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1805 (setq buffer-read-only t)
1806 (use-local-map gdb-registers-mode-map)
1807 (gdb-invalidate-registers gdb-buffer-instance))
1808
1809(defun gdb-registers-buffer-name (instance)
1810 (save-excursion
1811 (set-buffer (process-buffer (gdb-instance-process instance)))
1812 (concat "*registers of " (gdb-instance-target-string instance) "*")))
1813
1814(defun gdb-display-registers-buffer (instance)
1815 (interactive (list (gdb-needed-default-instance)))
1816 (gdb-display-buffer
1817 (gdb-get-create-instance-buffer instance
1818 'gdb-registers-buffer)))
1819
1820(defun gdb-frame-registers-buffer (instance)
1821 (interactive (list (gdb-needed-default-instance)))
1822 (switch-to-buffer-other-frame
1823 (gdb-get-create-instance-buffer instance
1824 'gdb-registers-buffer)))
1825
1826;;
1827;; Locals buffers
1828;;
1829
1830(def-gdb-auto-updated-buffer gdb-locals-buffer
1831 gdb-invalidate-locals
1832 "server info locals\n"
1833 gdb-info-locals-handler
1834 gdb-info-locals-custom)
1835
1836
1837;Abbreviate for arrays and structures. These can be expanded using gud-display
1838(defun gdb-info-locals-handler nil
1839 (set-gdb-instance-pending-triggers
1840 instance (delq (quote gdb-invalidate-locals)
1841 (gdb-instance-pending-triggers instance)))
1842 (let ((buf (gdb-get-instance-buffer instance
1843 (quote gdb-partial-output-buffer))))
1844 (save-excursion
1845 (set-buffer buf)
1846 (goto-char (point-min))
1847 (replace-regexp "^ .*\n" "")
1848 (goto-char (point-min))
1849 (replace-regexp "{[-0-9, {}\]*\n" "(array);\n")))
1850 (goto-char (point-min))
1851 (replace-regexp "{.*=.*\n" "(structure);\n")
1852 (let ((buf (gdb-get-instance-buffer instance (quote gdb-locals-buffer))))
1853 (and buf (save-excursion
1854 (set-buffer buf)
1855 (let ((p (point))
1856 (buffer-read-only nil))
1857 (delete-region (point-min) (point-max))
1858 (insert-buffer (gdb-get-create-instance-buffer
1859 instance
1860 (quote gdb-partial-output-buffer)))
1861 (goto-char p)))))
1862 (run-hooks (quote gdb-info-locals-hook)))
1863
1864(defun gdb-info-locals-custom ()
1865 nil)
1866
1867(gdb-set-instance-buffer-rules 'gdb-locals-buffer
1868 'gdb-locals-buffer-name
1869 'gdb-locals-mode)
1870
1871(defvar gdb-locals-mode-map nil)
1872(setq gdb-locals-mode-map (make-keymap))
1873(suppress-keymap gdb-locals-mode-map)
1874
1875(defun gdb-locals-mode ()
1876 "Major mode for gdb locals.
1877
1878\\{gdb-locals-mode-map}"
1879 (setq major-mode 'gdb-locals-mode)
1880 (setq mode-name "Locals")
1881 (set (make-local-variable 'gud-minor-mode) 'gdba)
1882 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1883 (setq buffer-read-only t)
1884 (use-local-map gdb-locals-mode-map)
1885 (gdb-invalidate-locals gdb-buffer-instance))
1886
1887(defun gdb-locals-buffer-name (instance)
1888 (save-excursion
1889 (set-buffer (process-buffer (gdb-instance-process instance)))
1890 (concat "*locals of " (gdb-instance-target-string instance) "*")))
1891
1892(defun gdb-display-locals-buffer (instance)
1893 (interactive (list (gdb-needed-default-instance)))
1894 (gdb-display-buffer
1895 (gdb-get-create-instance-buffer instance
1896 'gdb-locals-buffer)))
1897
1898(defun gdb-frame-locals-buffer (instance)
1899 (interactive (list (gdb-needed-default-instance)))
1900 (switch-to-buffer-other-frame
1901 (gdb-get-create-instance-buffer instance
1902 'gdb-locals-buffer)))
1903;;
1904;; Display expression buffers (just allow one to start with)
1905;;
1906(gdb-set-instance-buffer-rules 'gdb-display-buffer
1907 'gdb-display-buffer-name
1908 'gdb-display-mode)
1909
1910(def-gdb-auto-updated-buffer gdb-display-buffer
1911 ;; This defines the auto update rule for buffers of type
1912 ;; `gdb-display-buffer'.
1913 ;;
1914 ;; It defines a function to serve as the annotation handler that
1915 ;; handles the `foo-invalidated' message. That function is called:
1916 gdb-invalidate-display
1917
1918 ;; To update the buffer, this command is sent to gdb.
1919 "server info display\n"
1920
1921 ;; This also defines a function to be the handler for the output
1922 ;; from the command above. That function will copy the output into
1923 ;; the appropriately typed buffer. That function will be called:
1924 gdb-info-display-handler
1925; buffer specific functions
1926 gdb-info-display-custom)
1927
1928(defun gdb-info-display-custom ()
1929; TODO: ensure frames of expressions that have been deleted are also deleted
1930; these can be missed currently eg through GUD buffer, restarting a
1931; recompiled program.
1932)
1933
1934(defvar gdb-display-mode-map nil)
1935(setq gdb-display-mode-map (make-keymap))
1936(suppress-keymap gdb-display-mode-map)
1937
1938(define-key gdb-display-mode-map [menu-bar display]
1939 (cons "Display" (make-sparse-keymap "Display")))
1940(define-key gdb-display-mode-map [menu-bar display toggle]
1941 '("Toggle" . gdb-toggle-disp-this-line))
1942(define-key gdb-display-mode-map [menu-bar display delete]
1943 '("Delete" . gdb-delete-disp-this-line))
1944
1945(define-key gdb-display-mode-map " " 'gdb-toggle-disp-this-line)
1946(define-key gdb-display-mode-map "d" 'gdb-delete-disp-this-line)
1947
1948(defun gdb-display-mode ()
1949 "Major mode for gdb display.
1950
1951\\{gdb-display-mode-map}"
1952 (setq major-mode 'gdb-display-mode)
1953 (setq mode-name "Display")
1954 (set (make-local-variable 'gud-minor-mode) 'gdba)
1955 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1956 (setq buffer-read-only t)
1957 (use-local-map gdb-display-mode-map)
1958 (gdb-invalidate-display gdb-buffer-instance))
1959
1960(defun gdb-display-buffer-name (instance)
1961 (save-excursion
1962 (set-buffer (process-buffer (gdb-instance-process instance)))
1963 (concat "*Displayed expressions of " (gdb-instance-target-string instance) "*")))
1964
1965(defun gdb-display-display-buffer (instance)
1966 (interactive (list (gdb-needed-default-instance)))
1967 (gdb-display-buffer
1968 (gdb-get-create-instance-buffer instance
1969 'gdb-display-buffer)))
1970
1971(defun gdb-frame-display-buffer (instance)
1972 (interactive (list (gdb-needed-default-instance)))
1973 (switch-to-buffer-other-frame
1974 (gdb-get-create-instance-buffer instance
1975 'gdb-display-buffer)))
1976
1977(defun gdb-toggle-disp-this-line ()
1978 (interactive)
1979 (save-excursion
1980 (beginning-of-line 1)
1981 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1982 (error "No expression on this line")
1983 (gdb-instance-enqueue-idle-input
1984 gdb-buffer-instance
1985 (list
1986 (concat
1987 (if (eq ?y (char-after (match-beginning 2)))
1988 "server disable display "
1989 "server enable display ")
1990 (buffer-substring (match-beginning 0)
1991 (match-end 1))
1992 "\n")
1993 '(lambda () nil))))))
1994
1995(defun gdb-delete-disp-this-line ()
1996 (interactive)
1997 (save-excursion
1998 (set-buffer
1999 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-display-buffer))
2000 (beginning-of-line 1)
2001 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
2002 (error "No expression on this line")
2003 (let ((number (buffer-substring (match-beginning 0)
2004 (match-end 1))))
2005 (gdb-instance-enqueue-idle-input
2006 gdb-buffer-instance
2007 (list (concat "server delete display " number "\n")
2008 '(lambda () nil)))
2009 (if (not (display-graphic-p))
2010 (kill-buffer (get-buffer (concat "*display " number "*")))
2011 ;else
2012 (catch 'frame-found
2013 (let ((frames (frame-list)))
2014 (while frames
2015 (if (string-equal (frame-parameter (car frames) 'name)
2016 (concat "*display " number "*"))
2017 (progn (kill-buffer
2018 (get-buffer (concat "*display " number "*")))
2019 (delete-frame (car frames))
2020 (throw 'frame-found nil)))
2021 (setq frames (cdr frames))))))))))
2022
2023(defvar gdb-expressions-mode-map nil)
2024(setq gdb-expressions-mode-map (make-keymap))
2025(suppress-keymap gdb-expressions-mode-map)
2026
2027(defvar gdb-expressions-mode-menu
2028 '("GDB Expressions Commands"
2029 "----"
2030 ["Visualise" gdb-array-visualise t]
2031 ["Delete" gdb-delete-display t])
2032 "Menu for `gdb-expressions-mode'.")
2033
2034(define-key gdb-expressions-mode-map "v" 'gdb-array-visualise)
2035(define-key gdb-expressions-mode-map "q" 'gdb-delete-display)
2036(define-key gdb-expressions-mode-map [mouse-3] 'gdb-expressions-popup-menu)
2037
2038(defun gdb-expressions-popup-menu (event)
2039 "Explicit Popup menu as this buffer doesn't have a menubar."
2040 (interactive "@e")
2041 (mouse-set-point event)
2042 (popup-menu gdb-expressions-mode-menu))
2043
2044(defun gdb-expressions-mode ()
2045 "Major mode for display expressions.
2046
2047\\{gdb-expressions-mode-map}"
2048 (setq major-mode 'gdb-expressions-mode)
2049 (setq mode-name "Expressions")
2050 (use-local-map gdb-expressions-mode-map)
2051 (make-local-variable 'gdb-display-number)
2052 (make-local-variable 'gdb-values)
2053 (make-local-variable 'gdb-expression)
2054 (set (make-local-variable 'gdb-display-string) nil)
2055 (set (make-local-variable 'gdb-dive-display-number) nil)
2056 (set (make-local-variable 'gud-minor-mode) 'gdba)
2057 (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1))
2058 (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1))
2059 (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1))
2060 (setq buffer-read-only t))
2061
2062
2063;;;; Window management
2064
2065;;; FIXME: This should only return true for buffers in the current instance
2066(defun gdb-protected-buffer-p (buffer)
2067 "Is BUFFER a buffer which we want to leave displayed?"
2068 (save-excursion
2069 (set-buffer buffer)
2070 (or gdb-buffer-type
2071 overlay-arrow-position)))
2072
2073;;; The way we abuse the dedicated-p flag is pretty gross, but seems
2074;;; to do the right thing. Seeing as there is no way for Lisp code to
2075;;; get at the use_time field of a window, I'm not sure there exists a
2076;;; more elegant solution without writing C code.
2077
2078(defun gdb-display-buffer (buf &optional size)
2079 (let ((must-split nil)
2080 (answer nil))
2081 (unwind-protect
2082 (progn
2083 (walk-windows
2084 '(lambda (win)
2085 (if (gdb-protected-buffer-p (window-buffer win))
2086 (set-window-dedicated-p win t))))
2087 (setq answer (get-buffer-window buf))
2088 (if (not answer)
2089 (let ((window (get-lru-window)))
2090 (if window
2091 (progn
2092 (set-window-buffer window buf)
2093 (setq answer window))
2094 (setq must-split t)))))
2095 (walk-windows
2096 '(lambda (win)
2097 (if (gdb-protected-buffer-p (window-buffer win))
2098 (set-window-dedicated-p win nil)))))
2099 (if must-split
2100 (let* ((largest (get-largest-window))
2101 (cur-size (window-height largest))
2102 (new-size (and size (< size cur-size) (- cur-size size))))
2103 (setq answer (split-window largest new-size))
2104 (set-window-buffer answer buf)))
2105 answer))
2106
2107(defun gdb-display-source-buffer (buffer)
2108 (set-window-buffer gdb-source-window buffer))
2109
2110
2111;;; Shared keymap initialization:
2112
2113(defun gdb-display-gdb-buffer (instance)
2114 (interactive (list (gdb-needed-default-instance)))
2115 (gdb-display-buffer
2116 (gdb-get-create-instance-buffer instance 'gdba)))
2117
2118(defun make-windows-menu (map)
2119 (define-key map [menu-bar displays]
2120 (cons "GDB-Windows" (make-sparse-keymap "GDB-Windows")))
2121 (define-key map [menu-bar displays gdb]
2122 '("Gdb" . gdb-display-gdb-buffer))
2123 (define-key map [menu-bar displays locals]
2124 '("Locals" . gdb-display-locals-buffer))
2125 (define-key map [menu-bar displays registers]
2126 '("Registers" . gdb-display-registers-buffer))
2127 (define-key map [menu-bar displays frames]
2128 '("Stack" . gdb-display-stack-buffer))
2129 (define-key map [menu-bar displays breakpoints]
2130 '("Breakpoints" . gdb-display-breakpoints-buffer))
2131 (define-key map [menu-bar displays display]
2132 '("Display" . gdb-display-display-buffer))
2133 (define-key map [menu-bar displays assembler]
2134 '("Assembler" . gdb-display-assembler-buffer)))
2135
2136(define-key gud-minor-mode-map "\C-c\M-\C-r" 'gdb-display-registers-buffer)
2137(define-key gud-minor-mode-map "\C-c\M-\C-f" 'gdb-display-stack-buffer)
2138(define-key gud-minor-mode-map "\C-c\M-\C-b" 'gdb-display-breakpoints-buffer)
2139
2140(make-windows-menu gud-minor-mode-map)
2141
2142(defun gdb-frame-gdb-buffer (instance)
2143 (interactive (list (gdb-needed-default-instance)))
2144 (switch-to-buffer-other-frame
2145 (gdb-get-create-instance-buffer instance 'gdba)))
2146
2147(defun make-frames-menu (map)
2148 (define-key map [menu-bar frames]
2149 (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames")))
2150 (define-key map [menu-bar frames gdb]
2151 '("Gdb" . gdb-frame-gdb-buffer))
2152 (define-key map [menu-bar frames locals]
2153 '("Locals" . gdb-frame-locals-buffer))
2154 (define-key map [menu-bar frames registers]
2155 '("Registers" . gdb-frame-registers-buffer))
2156 (define-key map [menu-bar frames frames]
2157 '("Stack" . gdb-frame-stack-buffer))
2158 (define-key map [menu-bar frames breakpoints]
2159 '("Breakpoints" . gdb-frame-breakpoints-buffer))
2160 (define-key map [menu-bar frames display]
2161 '("Display" . gdb-frame-display-buffer))
2162 (define-key map [menu-bar frames assembler]
2163 '("Assembler" . gdb-frame-assembler-buffer)))
2164
2165(if (display-graphic-p)
2166 (make-frames-menu gud-minor-mode-map))
2167
2168(defvar gdb-target-name "--unknown--"
2169 "The apparent name of the program being debugged in a gud buffer.")
2170
2171(defun gdb-proc-died (proc)
2172 ;; Stop displaying an arrow in a source file.
2173 (setq overlay-arrow-position nil)
2174
2175 ;; Kill the dummy process, so that C-x C-c won't worry about it.
2176 (save-excursion
2177 (set-buffer (process-buffer proc))
2178 (kill-process
2179 (get-buffer-process
2180 (gdb-get-instance-buffer gdb-buffer-instance 'gdb-inferior-io)))))
2181;; end of functions from gdba.el
2182
2183;; new functions for gdb-ui.el
2184;; layout for all the windows
2185(defun gdb-setup-windows (instance)
2186 (gdb-display-locals-buffer instance)
2187 (gdb-display-stack-buffer instance)
2188 (delete-other-windows)
2189 (gdb-display-breakpoints-buffer instance)
2190 (gdb-display-display-buffer instance)
2191 (delete-other-windows)
2192 (split-window nil ( / ( * (window-height) 3) 4))
2193 (split-window nil ( / (window-height) 3))
2194 (split-window-horizontally)
2195 (other-window 1)
2196 (switch-to-buffer (gdb-locals-buffer-name instance))
2197 (other-window 1)
2198 (switch-to-buffer
2199 (if gud-last-last-frame
2200 (gud-find-file (car gud-last-last-frame))
2201 (gud-find-file gdb-main-file)))
2202 (setq gdb-source-window (get-buffer-window (current-buffer)))
2203 (split-window-horizontally)
2204 (other-window 1)
2205 (switch-to-buffer (gdb-inferior-io-name instance))
2206 (other-window 1)
2207 (switch-to-buffer (gdb-stack-buffer-name instance))
2208 (split-window-horizontally)
2209 (other-window 1)
2210 (switch-to-buffer (gdb-breakpoints-buffer-name instance))
2211 (other-window 1))
2212
2213(defun gdb-restore-windows ()
2214 "Restore the basic arrangement of windows used by gdba.
2215This arrangement depends on the value of `gdb-many-windows'"
2216 (interactive)
2217 (if gdb-many-windows
2218 (progn
2219 (switch-to-buffer gud-comint-buffer)
2220 (delete-other-windows)
2221 (gdb-setup-windows gdb-buffer-instance))
2222;else
2223 (switch-to-buffer gud-comint-buffer)
2224 (delete-other-windows)
2225 (split-window)
2226 (other-window 1)
2227 (switch-to-buffer
2228 (if gud-last-last-frame
2229 (gud-find-file (car gud-last-last-frame))
2230 (gud-find-file gdb-main-file)))
2231 (other-window 1)))
2232
2233(defun toggle-gdb-windows ()
2234 "Toggle the number of windows in the basic arrangement."
2235 (interactive)
2236 (if gdb-many-windows
2237 (progn
2238 (switch-to-buffer gud-comint-buffer)
2239 (delete-other-windows)
2240 (split-window)
2241 (other-window 1)
2242 (switch-to-buffer
2243 (if gud-last-last-frame
2244 (gud-find-file (car gud-last-last-frame))
2245 (gud-find-file gdb-main-file)))
2246 (other-window 1)
2247 (setq gdb-many-windows nil))
2248;else
2249 (switch-to-buffer gud-comint-buffer)
2250 (delete-other-windows)
2251 (gdb-setup-windows gdb-buffer-instance)
2252 (setq gdb-many-windows t)))
2253
2254(defconst breakpoint-xpm-data "/* XPM */
2255static char *magick[] = {
2256/* columns rows colors chars-per-pixel */
2257\"12 12 2 1\",
2258\" c red\",
2259\"+ c None\",
2260/* pixels */
2261\"+++++ +++++\",
2262\"+++ +++\",
2263\"++ ++\",
2264\"+ +\",
2265\"+ +\",
2266\" \",
2267\" \",
2268\"+ +\",
2269\"+ +\",
2270\"++ ++\",
2271\"+++ +++\",
2272\"+++++ +++++\"
2273};"
2274"XPM file used for breakpoint icon.")
2275
2276(setq breakpoint-enabled-icon (find-image
2277 `((:type xpm :data ,breakpoint-xpm-data))))
2278(setq breakpoint-disabled-icon (find-image
2279 `((:type xpm :data ,breakpoint-xpm-data
2280 :conversion laplace))))
2281
2282(defun gdb-quit ()
2283 "Kill the GUD and ancillary (including source) buffers.
2284Just the partial-output buffer is left."
2285 (interactive)
2286 (let ((buffers (buffer-list)))
2287 (save-excursion
2288 (while buffers
2289 (set-buffer (car buffers))
2290 (if (eq gud-minor-mode 'gdba)
2291 (if (string-match "^\*" (buffer-name))
2292 (kill-buffer nil)
2293 (if (display-graphic-p)
2294 (remove-images (point-min) (point-max))
2295 (remove-strings (point-min) (point-max)))
2296 (setq left-margin-width 0)
2297 (if (get-buffer-window (current-buffer))
2298 (set-window-margins (get-buffer-window
2299 (current-buffer))
2300 left-margin-width
2301 right-margin-width))))
2302 (setq buffers (cdr buffers)))))
2303 (if (eq (selected-window) (minibuffer-window))
2304 (other-window 1))
2305 (delete-other-windows))
2306
2307(defun gdb-source-info ()
2308 (goto-char (point-min))
2309 (re-search-forward "directory is ")
2310 (looking-at "\\(\\S-*\\)")
2311 (setq gdb-cdir (buffer-substring (match-beginning 1) (match-end 1)))
2312 (re-search-forward "Located in ")
2313 (looking-at "\\(\\S-*\\)")
2314 (setq gdb-main-file (buffer-substring (match-beginning 1) (match-end 1)))
2315 ;; Make sure we are not in the minibuffer window when we try to delete
2316 ;; all other windows.
2317 (if (eq (selected-window) (minibuffer-window))
2318 (other-window 1))
2319 (delete-other-windows)
2320 (if gdb-many-windows
2321 (gdb-setup-windows gdb-buffer-instance)
2322;else
2323 (gdb-display-breakpoints-buffer gdb-buffer-instance)
2324 (gdb-display-display-buffer instance)
2325 (gdb-display-stack-buffer instance)
2326 (delete-other-windows)
2327 (split-window)
2328 (other-window 1)
2329 (switch-to-buffer (gud-find-file gdb-main-file))
2330 (other-window 1)
2331 (setq gdb-source-window (get-buffer-window (current-buffer)))))
2332
2333;from put-image
2334(defun put-string (putstring pos &optional string area)
2335 "Put string PUTSTRING in front of POS in the current buffer.
2336PUTSTRING is displayed by putting an overlay into the current buffer with a
2337`before-string' STRING that has a `display' property whose value is
2338PUTSTRING. STRING is defaulted if you omit it.
2339POS may be an integer or marker.
2340AREA is where to display the string. AREA nil or omitted means
2341display it in the text area, a value of `left-margin' means
2342display it in the left marginal area, a value of `right-margin'
2343means display it in the right marginal area."
2344 (unless string (setq string "x"))
2345 (let ((buffer (current-buffer)))
2346 (unless (or (null area) (memq area '(left-margin right-margin)))
2347 (error "Invalid area %s" area))
2348 (setq string (copy-sequence string))
2349 (let ((overlay (make-overlay pos pos buffer))
2350 (prop (if (null area) putstring (list (list 'margin area) putstring))))
2351 (put-text-property 0 (length string) 'display prop string)
2352 (overlay-put overlay 'put-text t)
2353 (overlay-put overlay 'before-string string))))
2354
2355;from remove-images
2356(defun remove-strings (start end &optional buffer)
2357 "Remove strings between START and END in BUFFER.
2358Remove only images that were put in BUFFER with calls to `put-string'.
2359BUFFER nil or omitted means use the current buffer."
2360 (unless buffer
2361 (setq buffer (current-buffer)))
2362 (let ((overlays (overlays-in start end)))
2363 (while overlays
2364 (let ((overlay (car overlays)))
2365 (when (overlay-get overlay 'put-text)
2366 (delete-overlay overlay)))
2367 (setq overlays (cdr overlays)))))
2368
2369(defun put-arrow (putstring pos &optional string area)
2370 "Put arrow string PUTSTRING in front of POS in the current buffer.
2371PUTSTRING is displayed by putting an overlay into the current buffer with a
2372`before-string' \"gdb-arrow\" that has a `display' property whose value is
2373PUTSTRING. STRING is defaulted if you omit it.
2374POS may be an integer or marker.
2375AREA is where to display the string. AREA nil or omitted means
2376display it in the text area, a value of `left-margin' means
2377display it in the left marginal area, a value of `right-margin'
2378means display it in the right marginal area."
2379 (setq string "gdb-arrow")
2380 (let ((buffer (current-buffer)))
2381 (unless (or (null area) (memq area '(left-margin right-margin)))
2382 (error "Invalid area %s" area))
2383 (setq string (copy-sequence string))
2384 (let ((overlay (make-overlay pos pos buffer))
2385 (prop (if (null area) putstring (list (list 'margin area) putstring))))
2386 (put-text-property 0 (length string) 'display prop string)
2387 (overlay-put overlay 'put-text t)
2388 (overlay-put overlay 'before-string string))))
2389
2390(defun remove-arrow (&optional buffer)
2391 "Remove arrow in BUFFER.
2392Remove only images that were put in BUFFER with calls to `put-arrow'.
2393BUFFER nil or omitted means use the current buffer."
2394 (unless buffer
2395 (setq buffer (current-buffer)))
2396 (let ((overlays (overlays-in (point-min) (point-max))))
2397 (while overlays
2398 (let ((overlay (car overlays)))
2399 (when (string-equal (overlay-get overlay 'before-string) "gdb-arrow")
2400 (delete-overlay overlay)))
2401 (setq overlays (cdr overlays)))))
2402
2403(defvar gdb-array-slice-map nil)
2404(setq gdb-array-slice-map (make-keymap))
2405(define-key gdb-array-slice-map [mouse-2] 'gdb-array-slice)
2406
2407(defun gdb-array-slice (event)
2408 "Select an array slice to display."
2409 (interactive "e")
2410 (mouse-set-point event)
2411 (save-excursion
2412 (let ((n -1) (stop 0) (start 0) (point (point)))
2413 (beginning-of-line)
2414 (while (search-forward "[" point t)
2415 (setq n (+ n 1)))
2416 (setq start (string-to-int (read-string "Start index: ")))
2417 (aset gdb-array-start n start)
2418 (setq stop (string-to-int (read-string "Stop index: ")))
2419 (aset gdb-array-stop n stop)))
2420 (gdb-array-format1))
2421
2422(defun gdb-array-visualise ()
2423 "Visualise arrays and slices using graph program from plotutils."
2424 (Interactive)
2425 (if (and (display-graphic-p) gdb-display-string)
2426 (let ((n 0) m)
2427 (catch 'multi-dimensional
2428 (while (eq (aref gdb-array-start n) (aref gdb-array-stop n))
2429 (setq n (+ n 1)))
2430 (setq m (+ n 1))
2431 (while (< m (length gdb-array-start))
2432 (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m)))
2433 (progn
2434 (x-popup-dialog
2435 t `(,(concat "Only one dimensional data can be visualised.\n"
2436 "Use an array slice to reduce the number of\n"
2437 "dimensions") ("OK" t)))
2438 (throw 'multi-dimensional))
2439 (setq m (+ m 1))))
2440 (shell-command (concat "echo" gdb-display-string " | graph -a 1 "
2441 (int-to-string (aref gdb-array-start n))
2442 " -x "
2443 (int-to-string (aref gdb-array-start n))
2444 " "
2445 (int-to-string (aref gdb-array-stop n))
2446 " 1 -T X"))))))
2447
2448(defun gdb-delete-display ()
2449 "Delete displayed expression and its frame."
2450 (interactive)
2451 (gdb-instance-enqueue-idle-input
2452 gdb-buffer-instance
2453 (list (concat "server delete display " gdb-display-number "\n")
2454 '(lambda () nil)))
2455 (kill-buffer nil)
2456 (delete-frame))
2457
2458;;
2459;; Assembler buffer
2460;;
2461
2462(def-gdb-auto-updated-buffer gdb-assembler-buffer
2463 gdb-invalidate-assembler
2464 (concat "server disassemble " gdb-main-or-pc "\n")
2465 gdb-assembler-handler
2466 gdb-assembler-custom)
2467
2468(defun gdb-assembler-custom ()
2469 (let ((buffer (gdb-get-instance-buffer gdb-buffer-instance
2470 'gdb-assembler-buffer))
2471 (gdb-arrow-position))
2472 (if gdb-current-address
2473 (progn
2474 (save-excursion
2475 (set-buffer buffer)
2476 (remove-arrow)
2477 (goto-char (point-min))
2478 (re-search-forward gdb-current-address)
2479 (setq gdb-arrow-position (point))
2480 (put-arrow "=>" gdb-arrow-position nil 'left-margin))))
2481
2482; remove all breakpoint-icons in assembler buffer before updating.
2483 (save-excursion
2484 (set-buffer buffer)
2485 (if (display-graphic-p)
2486 (remove-images (point-min) (point-max))
2487 (remove-strings (point-min) (point-max))))
2488 (save-excursion
2489 (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer))
2490 (goto-char (point-min))
2491 (while (< (point) (- (point-max) 1))
2492 (forward-line 1)
2493 (if (looking-at "[^\t].*breakpoint")
2494 (progn
2495 (looking-at
2496 "\\([0-9]*\\)\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x0\\(\\S-*\\)")
2497 ; info break gives '0x0' (8 digit) while dump gives '0x' (7 digit)
2498 (setq address (concat "0x" (buffer-substring (match-beginning 3)
2499 (match-end 3))))
2500 (setq flag (char-after (match-beginning 2)))
2501 (save-excursion
2502 (set-buffer buffer)
2503 (goto-char (point-min))
2504 (if (re-search-forward address nil t)
2505 (let ((start (progn (beginning-of-line) (- (point) 1)))
2506 (end (progn (end-of-line) (+ (point) 1))))
2507 (if (display-graphic-p)
2508 (progn
2509 (remove-images start end)
2510 (if (eq ?y flag)
2511 (put-image breakpoint-enabled-icon (point)
2512 "breakpoint icon enabled"
2513 'left-margin)
2514 (put-image breakpoint-disabled-icon (point)
2515 "breakpoint icon disabled"
2516 'left-margin)))
2517 (remove-strings start end)
2518 (if (eq ?y flag)
2519 (put-string "B" (point) "enabled" 'left-margin)
2520 (put-string "b" (point) "disabled"
2521 'left-margin))))))))))
2522 (if gdb-current-address
2523 (set-window-point (get-buffer-window buffer) gdb-arrow-position))))
2524
2525(gdb-set-instance-buffer-rules 'gdb-assembler-buffer
2526 'gdb-assembler-buffer-name
2527 'gdb-assembler-mode)
2528
2529(defvar gdb-assembler-mode-map nil)
2530(setq gdb-assembler-mode-map (make-keymap))
2531(suppress-keymap gdb-assembler-mode-map)
2532
2533(defun gdb-assembler-mode ()
2534 "Major mode for viewing code assembler.
2535
2536\\{gdb-assembler-mode-map}"
2537 (setq major-mode 'gdb-assembler-mode)
2538 (setq mode-name "Assembler")
2539 (set (make-local-variable 'gud-minor-mode) 'gdba)
2540 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
2541 (set (make-variable-buffer-local 'left-margin-width) 2)
2542 (setq buffer-read-only t)
2543 (use-local-map gdb-assembler-mode-map)
2544 (gdb-invalidate-assembler gdb-buffer-instance)
2545 (gdb-invalidate-breakpoints gdb-buffer-instance))
2546
2547(defun gdb-assembler-buffer-name (instance)
2548 (save-excursion
2549 (set-buffer (process-buffer (gdb-instance-process instance)))
2550 (concat "*Machine Code " (gdb-instance-target-string instance) "*")))
2551
2552(defun gdb-display-assembler-buffer (instance)
2553 (interactive (list (gdb-needed-default-instance)))
2554 (gdb-display-buffer
2555 (gdb-get-create-instance-buffer instance
2556 'gdb-assembler-buffer)))
2557
2558(defun gdb-frame-assembler-buffer (instance)
2559 (interactive (list (gdb-needed-default-instance)))
2560 (switch-to-buffer-other-frame
2561 (gdb-get-create-instance-buffer instance
2562 'gdb-assembler-buffer)))
2563
2564(defun gdb-invalidate-frame-and-assembler (instance &optional ignored)
2565 (gdb-invalidate-frames instance)
2566 (gdb-invalidate-assembler instance))
2567
2568(defun gdb-invalidate-breakpoints-and-assembler (instance &optional ignored)
2569 (gdb-invalidate-breakpoints instance)
2570 (gdb-invalidate-assembler instance))
2571
2572; modified because if gdb-main-or-pc has changed value a new command
2573; must be enqueued to update the buffer with the new output
2574(defun gdb-invalidate-assembler (instance &optional ignored)
2575 (if (and ((lambda (instance)
2576 (gdb-get-instance-buffer instance
2577 (quote gdb-assembler-buffer))) instance)
2578 (or (not (member (quote gdb-invalidate-assembler)
2579 (gdb-instance-pending-triggers instance)))
2580 (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc))))
2581 (progn
2582
2583 ; take previous disassemble command off the queue
2584 (save-excursion
2585 (set-buffer (gdb-get-instance-buffer instance 'gdba))
2586 (let ((queue gdb-idle-input-queue) (item))
2587 (while queue
2588 (setq item (car queue))
2589 (if (equal (cdr item) '(gdb-assembler-handler))
2590 (delete item gdb-idle-input-queue))
2591 (setq queue (cdr queue)))))
2592
2593 (gdb-instance-enqueue-idle-input
2594 instance (list (concat "server disassemble " gdb-main-or-pc "\n")
2595 (quote gdb-assembler-handler)))
2596 (set-gdb-instance-pending-triggers
2597 instance (cons (quote gdb-invalidate-assembler)
2598 (gdb-instance-pending-triggers instance)))
2599 (setq gdb-prev-main-or-pc gdb-main-or-pc))))
2600
2601(defun gdb-delete-line ()
2602"Delete current line."
2603(interactive)
2604 (let ((start (progn (beginning-of-line) (point)))
2605 (end (progn (end-of-line) (+ (point) 1))))
2606 (delete-region start end)))
2607
2608(provide 'gdb-ui)
2609
2610;;; gdb-ui.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-23 00:39:27 +0000