48292
|
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.
|
|
36 Use `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*.
|
|
47 The directory containing FILE becomes the initial working directory
|
|
48 and source-file directory for your debugger.
|
|
49
|
|
50 If `gdb-many-windows' is set to t this works best in X (depending on the size
|
|
51 of your monitor) using most of the screen. After a short delay the following
|
|
52 layout will appear (keybindings given in relevant buffer) :
|
|
53
|
|
54 ---------------------------------------------------------------------
|
|
55 GDB Toolbar
|
|
56 ---------------------------------------------------------------------
|
|
57 GUD buffer (I/O of gdb) | Locals buffer
|
|
58 |
|
|
59 |
|
|
60 |
|
|
61 ---------------------------------------------------------------------
|
|
62 Source buffer | Input/Output (of debuggee) buffer
|
|
63 | (comint-mode)
|
|
64 |
|
|
65 |
|
|
66 |
|
|
67 |
|
|
68 |
|
|
69 |
|
|
70 ---------------------------------------------------------------------
|
|
71 Stack 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
|
|
77 All the buffers share the toolbar and source should always display in the same
|
|
78 window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
|
|
79 icons are displayed both by setting a break with gud-break and by typing break
|
|
80 in the GUD buffer.
|
|
81
|
|
82 Displayed expressions appear in separate frames. Arrays may be displayed
|
|
83 as slices and visualised using the graph program from plotutils if installed.
|
|
84
|
|
85 If `gdb-many-windows' is set to nil then gdb starts with just two windows :
|
|
86 the GUD and the source buffer.
|
|
87
|
|
88 The 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
|
|
321 with 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.
|
|
376 Possible 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
|
|
399 handlers.")
|
|
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.
|
|
446 For sure this the root string used in smashing together the gdb
|
|
447 buffer's name, even if that doesn't happen to be the name of a
|
|
448 program."
|
|
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.
|
|
472 The 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.
|
|
478 The 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.
|
|
644 This 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.
|
|
1285 This function is (indirectly) used as a gud-marker-filter.
|
|
1286 It must return output (if any) to be insterted in the gdb
|
|
1287 buffer."
|
|
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.
|
|
2215 This 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 */
|
|
2255 static 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.
|
|
2284 Just 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.
|
|
2336 PUTSTRING is displayed by putting an overlay into the current buffer with a
|
|
2337 `before-string' STRING that has a `display' property whose value is
|
|
2338 PUTSTRING. STRING is defaulted if you omit it.
|
|
2339 POS may be an integer or marker.
|
|
2340 AREA is where to display the string. AREA nil or omitted means
|
|
2341 display it in the text area, a value of `left-margin' means
|
|
2342 display it in the left marginal area, a value of `right-margin'
|
|
2343 means 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.
|
|
2358 Remove only images that were put in BUFFER with calls to `put-string'.
|
|
2359 BUFFER 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.
|
|
2371 PUTSTRING 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
|
|
2373 PUTSTRING. STRING is defaulted if you omit it.
|
|
2374 POS may be an integer or marker.
|
|
2375 AREA is where to display the string. AREA nil or omitted means
|
|
2376 display it in the text area, a value of `left-margin' means
|
|
2377 display it in the left marginal area, a value of `right-margin'
|
|
2378 means 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.
|
|
2392 Remove only images that were put in BUFFER with calls to `put-arrow'.
|
|
2393 BUFFER 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
|