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