Commit | Line | Data |
---|---|---|
aeea8b77 NR |
1 | ;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004) |
2 | ||
3 | ;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command" | |
4 | ;; (could use "-interpreter-exec console cli-command") | |
5 | ||
6 | ;; Author: Nick Roberts <nickrob@gnu.org> | |
7 | ;; Maintainer: Nick Roberts <nickrob@gnu.org> | |
8 | ;; Keywords: unix, tools | |
9 | ||
10 | ;; Copyright (C) 2004 Free Software Foundation, Inc. | |
11 | ||
12 | ;; This file is part of GNU GDB. | |
13 | ||
14 | ;; GNU GDB is free software; you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation; either version 2, or (at your option) | |
17 | ;; any later version. | |
18 | ||
19 | ;; This program is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;;; Commentary: | |
25 | ||
26 | ;; This mode acts as a graphical user interface to GDB and requires GDB 6.1 | |
27 | ;; onwards. You can interact with GDB through the GUD buffer in the usual way, | |
28 | ;; but there are also buffers which control the execution and describe the | |
29 | ;; state of your program. It separates the input/output of your program from | |
30 | ;; that of GDB and displays expressions and their current values in their own | |
31 | ;; buffers. It also uses features of Emacs 21 such as the fringe/display | |
32 | ;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface | |
33 | ;; section in the Emacs info manual). | |
34 | ||
35 | ;; Start the debugger with M-x gdbmi. | |
36 | ||
37 | ;; This file uses GDB/MI as the primary interface to GDB. It is still under | |
38 | ;; development and is part of a process to migrate Emacs from annotations | |
39 | ;; (as used in gdb-ui.el) to GDB/MI. | |
40 | ||
41 | ;; Known Bugs: | |
42 | ;; | |
43 | ||
44 | ;;; Code: | |
45 | ||
46 | (require 'gud) | |
47 | (require 'gdb-ui) | |
48 | \f | |
49 | ||
50 | ;;;###autoload | |
51 | (defun gdbmi (command-line) | |
52 | "Run gdb on program FILE in buffer *gud-FILE*. | |
53 | The directory containing FILE becomes the initial working directory | |
54 | and source-file directory for your debugger. | |
55 | ||
56 | If `gdb-many-windows' is nil (the default value) then gdb just | |
57 | pops up the GUD buffer unless `gdb-show-main' is t. In this case | |
58 | it starts with two windows: one displaying the GUD buffer and the | |
59 | other with the source file with the main routine of the inferior. | |
60 | ||
61 | If `gdb-many-windows' is t, regardless of the value of | |
62 | `gdb-show-main', the layout below will appear. Keybindings are | |
63 | given in relevant buffer. | |
64 | ||
65 | Watch expressions appear in the speedbar/slowbar. | |
66 | ||
67 | The following interactive lisp functions help control operation : | |
68 | ||
69 | `gdb-many-windows' - Toggle the number of windows gdb uses. | |
70 | `gdb-restore-windows' - To restore the window layout. | |
71 | ||
72 | See Info node `(emacs)GDB Graphical Interface' for a more | |
73 | detailed description of this mode. | |
74 | ||
75 | ||
76 | --------------------------------------------------------------------- | |
77 | GDB Toolbar | |
78 | --------------------------------------------------------------------- | |
79 | GUD buffer (I/O of GDB) | Locals buffer | |
80 | | | |
81 | | | |
82 | | | |
83 | --------------------------------------------------------------------- | |
84 | Source buffer | Input/Output (of inferior) buffer | |
85 | | (comint-mode) | |
86 | | | |
87 | | | |
88 | | | |
89 | | | |
90 | | | |
91 | | | |
92 | --------------------------------------------------------------------- | |
93 | Stack buffer | Breakpoints buffer | |
94 | RET gdb-frames-select | SPC gdb-toggle-breakpoint | |
95 | | RET gdb-goto-breakpoint | |
96 | | d gdb-delete-breakpoint | |
97 | --------------------------------------------------------------------- | |
98 | " | |
99 | ;; | |
100 | (interactive (list (gud-query-cmdline 'gdbmi))) | |
101 | ;; | |
102 | ;; Let's start with a basic gud-gdb buffer and then modify it a bit. | |
103 | (gdb command-line) | |
104 | ;; | |
105 | (setq gdb-debug-log nil) | |
106 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) | |
107 | (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter) | |
108 | ;; | |
109 | (gud-def gud-break (if (not (string-equal mode-name "Machine")) | |
110 | (gud-call "-break-insert %f:%l" arg) | |
111 | (save-excursion | |
112 | (beginning-of-line) | |
113 | (forward-char 2) | |
114 | (gud-call "-break-insert *%a" arg))) | |
115 | "\C-b" "Set breakpoint at current line or address.") | |
116 | ;; | |
117 | (gud-def gud-remove (if (not (string-equal mode-name "Machine")) | |
118 | (gud-call "clear %f:%l" arg) | |
119 | (save-excursion | |
120 | (beginning-of-line) | |
121 | (forward-char 2) | |
122 | (gud-call "clear *%a" arg))) | |
123 | "\C-d" "Remove breakpoint at current line or address.") | |
124 | ;; | |
125 | (gud-def gud-until (if (not (string-equal mode-name "Machine")) | |
126 | (gud-call "until %f:%l" arg) | |
127 | (save-excursion | |
128 | (beginning-of-line) | |
129 | (forward-char 2) | |
130 | (gud-call "until *%a" arg))) | |
131 | "\C-u" "Continue to current line or address.") | |
132 | ||
133 | (define-key gud-minor-mode-map [left-margin mouse-1] | |
134 | 'gdb-mouse-toggle-breakpoint) | |
135 | (define-key gud-minor-mode-map [left-fringe mouse-1] | |
136 | 'gdb-mouse-toggle-breakpoint) | |
137 | ||
138 | (setq comint-input-sender 'gdbmi-send) | |
139 | ;; | |
140 | ;; (re-)initialise | |
141 | (setq gdb-main-file nil) | |
142 | (setq gdb-current-address "main") | |
143 | (setq gdb-previous-address nil) | |
144 | (setq gdb-previous-frame nil) | |
145 | (setq gdb-current-frame "main") | |
146 | (setq gdb-view-source t) | |
147 | (setq gdb-selected-view 'source) | |
148 | (setq gdb-var-list nil) | |
149 | (setq gdb-var-changed nil) | |
150 | (setq gdb-prompting nil) | |
151 | (setq gdb-current-item nil) | |
152 | (setq gdb-pending-triggers nil) | |
153 | (setq gdb-output-sink 'user) | |
154 | (setq gdb-server-prefix nil) | |
155 | ;; | |
156 | (setq gdb-buffer-type 'gdbmi) | |
157 | ;; | |
158 | ;; FIXME: use tty command to separate io. | |
159 | ;;(gdb-clear-inferior-io) | |
160 | ;; | |
161 | (if (eq window-system 'w32) | |
162 | (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore))) | |
163 | ;; find source file and compilation directory here | |
164 | (gdb-enqueue-input (list "list main\n" 'ignore)) ; C program | |
165 | (gdb-enqueue-input (list "list MAIN__\n" 'ignore)) ; Fortran program | |
166 | (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info)) | |
167 | ;; | |
168 | (run-hooks 'gdbmi-mode-hook)) | |
169 | ||
170 | ; Force nil till fixed. | |
171 | (defconst gdbmi-use-inferior-io-buffer nil) | |
172 | ||
173 | ; uses --all-values Needs GDB 6.1 onwards. | |
174 | (defun gdbmi-var-list-children (varnum) | |
175 | (gdb-enqueue-input | |
176 | (list (concat "-var-update " varnum "\n") 'ignore)) | |
177 | (gdb-enqueue-input | |
178 | (list (concat "-var-list-children --all-values " | |
179 | varnum "\n") | |
180 | `(lambda () (gdbmi-var-list-children-handler ,varnum))))) | |
181 | ||
182 | (defconst gdbmi-var-list-children-regexp | |
183 | "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\"" | |
184 | ) | |
185 | ||
186 | (defun gdbmi-var-list-children-handler (varnum) | |
187 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
188 | (goto-char (point-min)) | |
189 | (let ((var-list nil)) | |
190 | (catch 'child-already-watched | |
191 | (dolist (var gdb-var-list) | |
192 | (if (string-equal varnum (cadr var)) | |
193 | (progn | |
194 | (push var var-list) | |
195 | (while (re-search-forward gdbmi-var-list-children-regexp nil t) | |
196 | (let ((varchild (list (match-string 2) | |
197 | (match-string 1) | |
198 | (match-string 3) | |
199 | nil | |
200 | (match-string 4) | |
201 | nil))) | |
202 | (if (looking-at ",type=\"\\(.*?\\)\"") | |
203 | (setcar (nthcdr 3 varchild) (match-string 1))) | |
204 | (dolist (var1 gdb-var-list) | |
205 | (if (string-equal (cadr var1) (cadr varchild)) | |
206 | (throw 'child-already-watched nil))) | |
207 | (push varchild var-list)))) | |
208 | (push var var-list))) | |
209 | (setq gdb-var-changed t) | |
210 | (setq gdb-var-list (nreverse var-list)))))) | |
211 | \f | |
212 | ;(defun gdbmi-send (proc string) | |
213 | ; "A comint send filter for gdb." | |
214 | ; (setq gdb-output-sink 'user) | |
215 | ; (setq gdb-prompting nil) | |
216 | ; (process-send-string proc (concat "-interpreter-exec console \"" string "\""))) | |
217 | ||
218 | (defun gdbmi-send (proc string) | |
219 | "A comint send filter for gdb." | |
220 | (setq gdb-output-sink 'user) | |
221 | (setq gdb-prompting nil) | |
222 | (process-send-string proc (concat string "\n"))) | |
223 | ||
224 | (defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi" | |
225 | "Default command to execute an executable under the GDB-UI debugger." | |
226 | :type 'string | |
227 | :group 'gud) | |
228 | ||
229 | (defconst gdb-stopped-regexp | |
230 | "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*") | |
231 | ||
232 | (defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"") | |
233 | ||
234 | (defconst gdb-internals-regexp "&\".*\\n\"\n") | |
235 | ||
236 | (defconst gdb-gdb-regexp "(gdb) \n") | |
237 | ||
238 | (defconst gdb-running-regexp "^\\^running") | |
239 | ||
240 | (defun gdbmi-prompt () | |
241 | "This handler terminates the any collection of output. It also | |
242 | sends the next command (if any) to gdb." | |
243 | (unless gdb-pending-triggers | |
244 | (gdb-get-current-frame) | |
245 | (gdbmi-invalidate-frames) | |
246 | (gdbmi-invalidate-breakpoints) | |
247 | (gdbmi-invalidate-locals) | |
248 | (dolist (frame (frame-list)) | |
249 | (when (string-equal (frame-parameter frame 'name) "Speedbar") | |
250 | (setq gdb-var-changed t) ; force update | |
251 | (dolist (var gdb-var-list) | |
252 | (setcar (nthcdr 5 var) nil)))) | |
253 | (gdb-var-update)) | |
254 | (let ((sink gdb-output-sink)) | |
255 | (when (eq sink 'emacs) | |
256 | (let ((handler | |
257 | (car (cdr gdb-current-item)))) | |
258 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
259 | (funcall handler))))) | |
260 | (let ((input (gdb-dequeue-input))) | |
261 | (if input | |
262 | (gdb-send-item input) | |
263 | (progn | |
264 | (setq gud-running nil) | |
265 | (setq gdb-prompting t) | |
266 | (gud-display-frame))))) | |
267 | ||
268 | (defun gud-gdbmi-marker-filter (string) | |
269 | "Filter GDB/MI output." | |
270 | (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log)) | |
271 | ;; Recall the left over gud-marker-acc from last time | |
272 | (setq gud-marker-acc (concat gud-marker-acc string)) | |
273 | ;; Start accumulating output for the GUD buffer | |
274 | (let ((output "")) | |
275 | ||
276 | (if (string-match gdb-running-regexp gud-marker-acc) | |
277 | (setq gud-marker-acc (substring gud-marker-acc (match-end 0)) | |
278 | gud-running t)) | |
279 | ||
280 | ;; Remove the trimmings from the console stream. | |
281 | (while (string-match gdb-console-regexp gud-marker-acc) | |
282 | (setq | |
283 | gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
284 | (match-string 1 gud-marker-acc) | |
285 | (substring gud-marker-acc (match-end 0))))) | |
286 | ||
287 | ;; Remove log stream containing debugging messages being produced by GDB's | |
288 | ;; internals. | |
289 | (while (string-match gdb-internals-regexp gud-marker-acc) | |
290 | (setq | |
291 | gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
292 | (substring gud-marker-acc (match-end 0))))) | |
293 | ||
294 | (if (string-match gdb-stopped-regexp gud-marker-acc) | |
295 | (setq | |
296 | ||
297 | ;; Extract the frame position from the marker. | |
298 | gud-last-frame (cons (match-string 2 gud-marker-acc) | |
299 | (string-to-int (match-string 3 gud-marker-acc))) | |
300 | ||
301 | ;; Append any text before the marker to the output we're going | |
302 | ;; to return - we don't include the marker in this text. | |
303 | output (gdbmi-concat-output output | |
304 | (substring gud-marker-acc 0 (match-beginning 0))) | |
305 | ||
306 | ;; Set the accumulator to the remaining text. | |
307 | gud-marker-acc (substring gud-marker-acc (match-end 0)))) | |
308 | ||
309 | (while (string-match gdb-gdb-regexp gud-marker-acc) | |
310 | (setq | |
311 | ||
312 | ;; Append any text up to and including prompt less \n to the output. | |
313 | output (gdbmi-concat-output output | |
314 | (substring gud-marker-acc 0 (- (match-end 0) 1))) | |
315 | ||
316 | ;; Set the accumulator to the remaining text. | |
317 | gud-marker-acc (substring gud-marker-acc (match-end 0))) | |
318 | (gdbmi-prompt)) | |
319 | ||
320 | (setq output (gdbmi-concat-output output gud-marker-acc)) | |
321 | (setq gud-marker-acc "") | |
322 | output)) | |
323 | ||
324 | (defun gdbmi-concat-output (so-far new) | |
325 | (let ((sink gdb-output-sink)) | |
326 | (cond | |
327 | ((eq sink 'user) (concat so-far new)) | |
328 | ((eq sink 'emacs) | |
329 | (gdb-append-to-partial-output new) | |
330 | so-far) | |
331 | ((eq sink 'inferior) | |
332 | (gdb-append-to-inferior-io new) | |
333 | so-far)))) | |
334 | \f | |
335 | ||
336 | ;; Breakpoint buffer : This displays the output of `-break-list'. | |
337 | ;; | |
338 | (def-gdb-auto-updated-buffer gdb-breakpoints-buffer | |
339 | ;; This defines the auto update rule for buffers of type | |
340 | ;; `gdb-breakpoints-buffer'. | |
341 | ;; | |
342 | ;; It defines a function that queues the command below. That function is | |
343 | ;; called: | |
344 | gdbmi-invalidate-breakpoints | |
345 | ;; | |
346 | ;; To update the buffer, this command is sent to gdb. | |
347 | "-break-list\n" | |
348 | ;; | |
349 | ;; This also defines a function to be the handler for the output | |
350 | ;; from the command above. That function will copy the output into | |
351 | ;; the appropriately typed buffer. That function will be called: | |
352 | gdb-break-list-handler | |
353 | ;; buffer specific functions | |
354 | gdb-break-list-custom) | |
355 | ||
356 | (defconst gdb-break-list-regexp | |
357 | "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") | |
358 | ||
359 | (defun gdb-break-list-handler () | |
360 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints | |
361 | gdb-pending-triggers)) | |
362 | (let ((breakpoint nil) | |
363 | (breakpoints-list nil)) | |
364 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
365 | (goto-char (point-min)) | |
366 | (while (re-search-forward gdb-break-list-regexp nil t) | |
367 | (let ((breakpoint (list (match-string 1) | |
368 | (match-string 2) | |
369 | (match-string 3) | |
370 | (match-string 4) | |
371 | (match-string 5) | |
372 | (match-string 6) | |
373 | (match-string 7) | |
374 | (match-string 8)))) | |
375 | (push breakpoint breakpoints-list)))) | |
376 | (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer))) | |
377 | (and buf (with-current-buffer buf | |
378 | (let ((p (point)) | |
379 | (buffer-read-only nil)) | |
380 | (erase-buffer) | |
381 | (insert "Num Type Disp Enb Func\tFile:Line\tAddr\n") | |
382 | (dolist (breakpoint breakpoints-list) | |
383 | (insert (concat | |
384 | (nth 0 breakpoint) " " | |
385 | (nth 1 breakpoint) " " | |
386 | (nth 2 breakpoint) " " | |
387 | (nth 3 breakpoint) " " | |
388 | (nth 5 breakpoint) "\t" | |
389 | (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t" | |
390 | (nth 4 breakpoint) "\n"))) | |
391 | (goto-char p)))))) | |
392 | (gdb-break-list-custom)) | |
393 | ||
394 | ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) | |
395 | (defun gdb-break-list-custom () | |
396 | (let ((flag)(address)) | |
397 | ;; | |
398 | ;; remove all breakpoint-icons in source buffers but not assembler buffer | |
399 | (dolist (buffer (buffer-list)) | |
400 | (with-current-buffer buffer | |
401 | (if (and (eq gud-minor-mode 'gdbmi) | |
402 | (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) | |
403 | (gdb-remove-breakpoint-icons (point-min) (point-max))))) | |
404 | (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) | |
405 | (save-excursion | |
406 | (goto-char (point-min)) | |
407 | (while (< (point) (- (point-max) 1)) | |
408 | (forward-line 1) | |
409 | (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)") | |
410 | (progn | |
411 | (setq flag (char-after (match-beginning 1))) | |
412 | (let ((line (match-string 3)) (buffer-read-only nil) | |
413 | (file (match-string 2))) | |
414 | (add-text-properties (point-at-bol) (point-at-eol) | |
415 | '(mouse-face highlight | |
416 | help-echo "mouse-2, RET: visit breakpoint")) | |
417 | (with-current-buffer | |
418 | (find-file-noselect | |
419 | (if (file-exists-p file) file | |
420 | (expand-file-name file gdb-cdir))) | |
421 | (save-current-buffer | |
422 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) | |
423 | (set (make-local-variable 'tool-bar-map) | |
424 | gud-tool-bar-map)) | |
425 | ;; only want one breakpoint icon at each location | |
426 | (save-excursion | |
427 | (goto-line (string-to-number line)) | |
428 | (gdb-put-breakpoint-icon (eq flag ?y))))))))) | |
429 | (end-of-line))) | |
430 | (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) | |
431 | ||
432 | ;; Frames buffer. This displays a perpetually correct bactrack trace. | |
433 | ;; | |
434 | (def-gdb-auto-updated-buffer gdb-stack-buffer | |
435 | gdbmi-invalidate-frames | |
436 | "-stack-list-frames\n" | |
437 | gdb-stack-list-frames-handler | |
438 | gdb-stack-list-frames-custom) | |
439 | ||
440 | (defconst gdb-stack-list-frames-regexp | |
441 | "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") | |
442 | ||
443 | (defun gdb-stack-list-frames-handler () | |
444 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames | |
445 | gdb-pending-triggers)) | |
446 | (let ((frame nil) | |
447 | (call-stack nil)) | |
448 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
449 | (goto-char (point-min)) | |
450 | (while (re-search-forward gdb-stack-list-frames-regexp nil t) | |
451 | (let ((frame (list (match-string 1) | |
452 | (match-string 2) | |
453 | (match-string 3) | |
454 | (match-string 4) | |
455 | (match-string 5)))) | |
456 | (push frame call-stack)))) | |
457 | (let ((buf (gdb-get-buffer 'gdb-stack-buffer))) | |
458 | (and buf (with-current-buffer buf | |
459 | (let ((p (point)) | |
460 | (buffer-read-only nil)) | |
461 | (erase-buffer) | |
462 | (insert "Level\tFunc\tFile:Line\tAddr\n") | |
463 | (dolist (frame (nreverse call-stack)) | |
464 | (insert (concat | |
465 | (nth 0 frame) "\t" | |
466 | (nth 2 frame) "\t" | |
467 | (nth 3 frame) ":" (nth 4 frame) "\t" | |
468 | (nth 1 frame) "\n"))) | |
469 | (goto-char p)))))) | |
470 | (gdb-stack-list-frames-custom)) | |
471 | ||
472 | (defun gdb-stack-list-frames-custom () | |
473 | (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) | |
474 | (save-excursion | |
475 | (let ((buffer-read-only nil)) | |
476 | (goto-char (point-min)) | |
477 | (forward-line 1) | |
478 | (while (< (point) (point-max)) | |
479 | (add-text-properties (point-at-bol) (point-at-eol) | |
480 | '(mouse-face highlight | |
481 | help-echo "mouse-2, RET: Select frame")) | |
482 | (beginning-of-line) | |
483 | (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") | |
484 | (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) | |
485 | (equal (match-string 1) gdb-current-frame)) | |
486 | (put-text-property (point-at-bol) (point-at-eol) | |
487 | 'face '(:inverse-video t))) | |
488 | (forward-line 1)))))) | |
489 | ||
490 | ;; Locals buffer. | |
491 | ;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards. | |
492 | (def-gdb-auto-updated-buffer gdb-locals-buffer | |
493 | gdbmi-invalidate-locals | |
494 | "-stack-list-locals 2\n" | |
495 | gdb-stack-list-locals-handler | |
496 | gdb-stack-list-locals-custom) | |
497 | ||
498 | (defconst gdb-stack-list-locals-regexp | |
499 | (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")) | |
500 | ||
501 | ;; Dont display values of arrays or structures. | |
502 | ;; These can be expanded using gud-watch. | |
503 | (defun gdb-stack-list-locals-handler nil | |
504 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals | |
505 | gdb-pending-triggers)) | |
506 | (let ((local nil) | |
507 | (locals-list nil)) | |
508 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
509 | (goto-char (point-min)) | |
510 | (while (re-search-forward gdb-stack-list-locals-regexp nil t) | |
511 | (let ((local (list (match-string 1) | |
512 | (match-string 2) | |
513 | nil))) | |
514 | (if (looking-at ",value=\"\\(.*?\\)\"") | |
515 | (setcar (nthcdr 2 local) (match-string 1))) | |
516 | (push local locals-list)))) | |
517 | (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) | |
518 | (and buf (with-current-buffer buf | |
519 | (let ((p (point)) | |
520 | (buffer-read-only nil)) | |
521 | (erase-buffer) | |
522 | (dolist (local locals-list) | |
523 | (insert | |
524 | (concat (car local) "\t" (nth 1 local) "\t" | |
525 | (or (nth 2 local) | |
526 | (if (string-match "struct" (nth 1 local)) | |
527 | "(structure)" | |
528 | "(array)")) | |
529 | "\n"))) | |
530 | (goto-char p))))))) | |
531 | ||
532 | (defun gdb-stack-list-locals-custom () | |
533 | nil) | |
534 | ||
535 | (defun gdbmi-source-info () | |
536 | "Find the source file where the program starts and displays it with related | |
537 | buffers." | |
538 | (goto-char (point-min)) | |
539 | (if (search-forward "source file is " nil t) | |
540 | (if (looking-at "\\S-*") | |
541 | (setq gdb-main-file (match-string 0))) | |
542 | (setq gdb-view-source nil)) | |
543 | (if (search-forward "directory is " nil t) | |
544 | (if (looking-at "\\S-*:\\(\\S-*\\)") | |
545 | (setq gdb-cdir (match-string 1)) | |
546 | (looking-at "\\S-*") | |
547 | (setq gdb-cdir (match-string 0)))) | |
548 | ||
549 | ;temporary heuristic | |
550 | (if gdb-main-file | |
551 | (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir))) | |
552 | ||
553 | (if gdb-many-windows | |
554 | (gdb-setup-windows) | |
555 | (gdb-get-create-buffer 'gdb-breakpoints-buffer) | |
556 | (when gdb-show-main | |
557 | (switch-to-buffer gud-comint-buffer) | |
558 | (delete-other-windows) | |
559 | (split-window) | |
560 | (other-window 1) | |
561 | (switch-to-buffer | |
562 | (if gdb-view-source | |
563 | (gud-find-file gdb-main-file) | |
564 | (gdb-get-create-buffer 'gdb-assembler-buffer))) | |
565 | (other-window 1)))) | |
566 | ||
567 | (provide 'gdb-mi) | |
568 | ;;; gdbmi.el ends here |