]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/mi/gdb-mi.el
Copyright updates for 2007.
[thirdparty/binutils-gdb.git] / gdb / mi / gdb-mi.el
CommitLineData
44236a56 1;;; gdb-mi.el
aeea8b77
NR
2
3;; Author: Nick Roberts <nickrob@gnu.org>
4;; Maintainer: Nick Roberts <nickrob@gnu.org>
5;; Keywords: unix, tools
6
6aba47ca 7;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
aeea8b77
NR
8
9;; This file is part of GNU GDB.
10
11;; GNU GDB 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;; This program 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;;; Commentary:
22
44236a56
NR
23;; This mode acts as a graphical user interface to GDB and works with Emacs
24;; 22.x and the version of GDB with which it is distributed. You can interact
25;; with GDB through the GUD buffer in the usual way, but there are also
26;; buffers which control the execution and describe the state of your program.
27;; It separates the input/output of your program from that of GDB and displays
28;; expressions and their current values in their own buffers. It also uses
29;; features of Emacs 21 such as the fringe/display margin for breakpoints, and
30;; the toolbar (see the GDB Graphical Interface section in the Emacs info
31;; manual).
aeea8b77
NR
32
33;; Start the debugger with M-x gdbmi.
34
35;; This file uses GDB/MI as the primary interface to GDB. It is still under
44236a56
NR
36;; development and is part of a process to migrate Emacs from annotations (as
37;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and
38;; access CLI using "-interpreter-exec console cli-command".
317531b2 39
e93364c8 40;; This mode acts on top of gdb-ui.el. After the release of 22.1,
317531b2
NR
41;; mainline Emacs in the CVS repository will have a file also called gdb-mi.el
42;; which will *replace* gdb-ui.el. If you are interested in developing
43;; this mode you should get this version.
44236a56 44;;
aeea8b77
NR
45;; Known Bugs:
46;;
44236a56
NR
47;; 1) To handle program input, if required, and to avoid extra output in the
48;; GUD buffer you must not use run, step, next or continue etc but their MI
49;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate
50;; icon in the toolbar.
44236a56 51;; 2) Some commands send extra prompts to the GUD buffer.
b6637a13 52;; 3) Doesn't list catchpoints in breakpoints buffer.
44236a56
NR
53;;
54;; TODO:
55;; 1) Prefix MI commands with a token instead of queueing commands.
56;; 2) Use MI command -data-read-memory for memory window.
57;; 3) Use MI command -data-disassemble for disassembly window.
58;; 4) Allow separate buffers for Inferior IO and GDB IO.
59;; 5) Watch windows to work with threads.
60;;
aeea8b77
NR
61;;; Code:
62
63(require 'gud)
64(require 'gdb-ui)
44236a56 65
44236a56
NR
66(defvar gdb-last-command nil)
67(defvar gdb-prompt-name nil)
aeea8b77
NR
68
69;;;###autoload
70(defun gdbmi (command-line)
71 "Run gdb on program FILE in buffer *gud-FILE*.
72The directory containing FILE becomes the initial working directory
73and source-file directory for your debugger.
74
75If `gdb-many-windows' is nil (the default value) then gdb just
76pops up the GUD buffer unless `gdb-show-main' is t. In this case
77it starts with two windows: one displaying the GUD buffer and the
78other with the source file with the main routine of the inferior.
79
80If `gdb-many-windows' is t, regardless of the value of
81`gdb-show-main', the layout below will appear. Keybindings are
82given in relevant buffer.
83
84Watch expressions appear in the speedbar/slowbar.
85
a2140d4d 86The following commands help control operation :
aeea8b77
NR
87
88`gdb-many-windows' - Toggle the number of windows gdb uses.
89`gdb-restore-windows' - To restore the window layout.
90
91See Info node `(emacs)GDB Graphical Interface' for a more
92detailed description of this mode.
93
94
a2140d4d
NR
95+--------------------------------------------------------------+
96| GDB Toolbar |
97+-------------------------------+------------------------------+
98| GUD buffer (I/O of GDB) | Locals buffer |
99| | |
100| | |
101| | |
102+-------------------------------+------------------------------+
103| Source buffer |
104| |
105| |
106| |
107| |
108| |
109| |
110| |
111+-------------------------------+------------------------------+
112| Stack buffer | Breakpoints buffer |
113| RET gdb-frames-select | SPC gdb-toggle-breakpoint |
114| | RET gdb-goto-breakpoint |
115| | d gdb-delete-breakpoint |
116+-------------------------------+------------------------------+"
aeea8b77
NR
117 ;;
118 (interactive (list (gud-query-cmdline 'gdbmi)))
119 ;;
120 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
121 (gdb command-line)
122 ;;
897731a2 123 (setq gdb-debug-ring nil)
aeea8b77
NR
124 (set (make-local-variable 'gud-minor-mode) 'gdbmi)
125 (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
126 ;;
44236a56
NR
127 (gud-def gud-step "-exec-step %p" "\C-s"
128 "Step one source line with display.")
129 (gud-def gud-stepi "-exec-step-instruction %p" "\C-i"
130 "Step one instruction with display.")
131 (gud-def gud-next "-exec-next %p" "\C-n"
132 "Step one line (skip functions).")
133 (gud-def gud-cont "-exec-continue" "\C-r"
134 "Continue with display.")
135 (gud-def gud-finish "-exec-finish" "\C-f"
136 "Finish executing current function.")
137 (gud-def gud-run "-exec-run" nil "Run the program.")
aeea8b77 138 (gud-def gud-break (if (not (string-equal mode-name "Machine"))
44236a56 139 (gud-call "break %f:%l" arg)
aeea8b77
NR
140 (save-excursion
141 (beginning-of-line)
142 (forward-char 2)
44236a56 143 (gud-call "break *%a" arg)))
aeea8b77
NR
144 "\C-b" "Set breakpoint at current line or address.")
145 ;;
146 (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
147 (gud-call "clear %f:%l" arg)
148 (save-excursion
149 (beginning-of-line)
150 (forward-char 2)
151 (gud-call "clear *%a" arg)))
152 "\C-d" "Remove breakpoint at current line or address.")
153 ;;
154 (gud-def gud-until (if (not (string-equal mode-name "Machine"))
44236a56 155 (gud-call "-exec-until %f:%l" arg)
aeea8b77
NR
156 (save-excursion
157 (beginning-of-line)
158 (forward-char 2)
44236a56 159 (gud-call "-exec-until *%a" arg)))
aeea8b77
NR
160 "\C-u" "Continue to current line or address.")
161
162 (define-key gud-minor-mode-map [left-margin mouse-1]
44236a56 163 'gdb-mouse-set-clear-breakpoint)
aeea8b77 164 (define-key gud-minor-mode-map [left-fringe mouse-1]
44236a56 165 'gdb-mouse-set-clear-breakpoint)
a2140d4d
NR
166 (define-key gud-minor-mode-map [left-fringe mouse-2]
167 'gdb-mouse-until)
168 (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
169 'gdb-mouse-until)
44236a56 170 (define-key gud-minor-mode-map [left-margin mouse-3]
a2140d4d
NR
171 'gdb-mouse-toggle-breakpoint-margin)
172 (define-key gud-minor-mode-map [left-fringe mouse-3]
173 'gdb-mouse-toggle-breakpoint-fringe)
aeea8b77
NR
174
175 (setq comint-input-sender 'gdbmi-send)
176 ;;
177 ;; (re-)initialise
2e6d207c 178 (setq gdb-pc-address (if gdb-show-main "main" nil)
44236a56
NR
179 gdb-previous-frame-address nil
180 gdb-memory-address "main"
181 gdb-previous-frame nil
182 gdb-selected-frame nil
183 gdb-frame-number nil
184 gdb-var-list nil
44236a56
NR
185 gdb-prompting nil
186 gdb-input-queue nil
187 gdb-current-item nil
188 gdb-pending-triggers nil
189 gdb-output-sink 'user
190 gdb-server-prefix nil
191 gdb-flush-pending-output nil
192 gdb-location-alist nil
44236a56
NR
193 gdb-source-file-list nil
194 gdb-last-command nil
f0afd306
NR
195 gdb-prompt-name nil
196 gdb-buffer-fringe-width (car (window-fringes)))
317531b2
NR
197 gdb-debug-ring nil
198 gdb-source-window nil
199 gdb-inferior-status nil
200 gdb-continuation nil
aeea8b77
NR
201 ;;
202 (setq gdb-buffer-type 'gdbmi)
203 ;;
204 ;; FIXME: use tty command to separate io.
205 ;;(gdb-clear-inferior-io)
206 ;;
207 (if (eq window-system 'w32)
208 (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
44236a56 209 (gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore))
aeea8b77 210 ;; find source file and compilation directory here
44236a56
NR
211 (gdb-enqueue-input
212 ; Needs GDB 6.2 onwards.
48fc115b
NR
213 (list "-file-list-exec-source-files\n"
214 'gdb-set-gud-minor-mode-existing-buffers-1))
44236a56
NR
215 (gdb-enqueue-input
216 ; Needs GDB 6.0 onwards.
217 (list "-file-list-exec-source-file\n" 'gdb-get-source-file))
218 (gdb-enqueue-input
219 (list "-data-list-register-names\n" 'gdb-get-register-names))
220 (gdb-enqueue-input
221 (list "-gdb-show prompt\n" 'gdb-get-prompt))
aeea8b77 222 ;;
b6637a13 223 (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
aeea8b77
NR
224 (run-hooks 'gdbmi-mode-hook))
225
44236a56 226\f
aeea8b77
NR
227(defun gdbmi-send (proc string)
228 "A comint send filter for gdb."
44236a56
NR
229 (if gud-running
230 (process-send-string proc (concat string "\n"))
231 (with-current-buffer gud-comint-buffer
317531b2
NR
232 (let ((inhibit-read-only t))
233 (remove-text-properties (point-min) (point-max) '(face))))
44236a56
NR
234 (setq gdb-output-sink 'user)
235 (setq gdb-prompting nil)
236 ;; mimic <RET> key to repeat previous command in GDB
2e6d207c 237 (if (not (string-match "^\\s+$" string))
317531b2 238 (setq gdb-last-command string)
44236a56 239 (if gdb-last-command (setq string gdb-last-command)))
897731a2
NR
240 (if gdb-enable-debug
241 (push (cons 'mi-send (concat string "\n")) gdb-debug-ring))
44236a56
NR
242 (if (string-match "^-" string)
243 ;; MI command
897731a2 244 (process-send-string proc (concat string "\n"))
44236a56 245 ;; CLI command
897731a2
NR
246 (if (string-match "\\\\$" string)
247 (setq gdb-continuation (concat gdb-continuation string "\n"))
248 (process-send-string proc
249 (concat "-interpreter-exec console \""
250 gdb-continuation string "\"\n"))
251 (setq gdb-continuation nil)))))
44236a56
NR
252
253(defcustom gud-gdbmi-command-name "gdb -interp=mi"
aeea8b77
NR
254 "Default command to execute an executable under the GDB-UI debugger."
255 :type 'string
256 :group 'gud)
257
44236a56 258(defconst gdb-gdb-regexp "(gdb) \n")
aeea8b77 259
44236a56 260(defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp))
aeea8b77 261
44236a56
NR
262;; fullname added GDB 6.4+.
263;; Probably not needed. -stack-info-frame computes filename and line.
264(defconst gdb-stopped-regexp
265 "\\*stopped,reason=.*?,file=\".*?\"\
266,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n")
aeea8b77 267
44236a56
NR
268(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n")
269
270(defconst gdb-done-regexp "\\^done,*\n*")
aeea8b77 271
44236a56 272(defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n")
aeea8b77 273
44236a56
NR
274(defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n")
275
276(defun gdbmi-prompt1 ()
277 "Queue any GDB commands that the user interface needs."
aeea8b77 278 (unless gdb-pending-triggers
44236a56
NR
279 (gdbmi-get-selected-frame)
280 (gdbmi-invalidate-frames)
281 (gdbmi-invalidate-breakpoints)
282 (gdb-get-changed-registers)
48fc115b 283 (gdb-invalidate-registers-1)
317531b2
NR
284 (gdb-invalidate-locals-1)
285 (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
286 (gdb-var-update-1))))
44236a56
NR
287
288(defun gdbmi-prompt2 ()
289 "Handle any output and send next GDB command."
aeea8b77
NR
290 (let ((sink gdb-output-sink))
291 (when (eq sink 'emacs)
292 (let ((handler
293 (car (cdr gdb-current-item))))
897731a2 294 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
aeea8b77
NR
295 (funcall handler)))))
296 (let ((input (gdb-dequeue-input)))
297 (if input
298 (gdb-send-item input)
299 (progn
300 (setq gud-running nil)
301 (setq gdb-prompting t)
302 (gud-display-frame)))))
303
304(defun gud-gdbmi-marker-filter (string)
305 "Filter GDB/MI output."
44236a56
NR
306 (if gdb-flush-pending-output
307 nil
897731a2
NR
308 (if gdb-enable-debug (push (cons 'recv (list string gdb-output-sink))
309 gdb-debug-ring))
44236a56
NR
310 ;; Recall the left over gud-marker-acc from last time
311 (setq gud-marker-acc (concat gud-marker-acc string))
312 ;; Start accumulating output for the GUD buffer
317531b2 313 (let ((output "") running)
44236a56
NR
314
315 (if (string-match gdb-running-regexp gud-marker-acc)
316 (setq
317 gud-marker-acc
318 (concat (substring gud-marker-acc 0 (match-beginning 0))
319 (substring gud-marker-acc (match-end 0)))
317531b2 320 running t))
44236a56
NR
321
322 (if (string-match gdb-stopped-regexp gud-marker-acc)
323 (setq
324
325 ;; Extract the frame position from the marker.
326 gud-last-frame (cons (match-string 1 gud-marker-acc)
327 (string-to-number
328 (match-string 2 gud-marker-acc)))
329
330 gud-marker-acc
331 (concat (substring gud-marker-acc 0 (match-beginning 0))
332 (substring gud-marker-acc (match-end 0)))))
333
334 ;; Filter error messages going to GUD buffer and
335 ;; display in minibuffer.
317531b2
NR
336 (when (eq gdb-output-sink 'user)
337 (while (string-match gdb-error-regexp gud-marker-acc)
338 (message (read (match-string 1 gud-marker-acc)))
44236a56
NR
339 (setq
340 gud-marker-acc
341 (concat (substring gud-marker-acc 0 (match-beginning 0))
342 (substring gud-marker-acc (match-end 0)))))
343
317531b2
NR
344 (if (string-match gdb-done-regexp gud-marker-acc)
345 (setq
346 gud-marker-acc
347 (concat (substring gud-marker-acc 0 (match-beginning 0))
348 (substring gud-marker-acc (match-end 0))))))
349
44236a56
NR
350 (when (string-match gdb-gdb-regexp gud-marker-acc)
351 (setq
352 gud-marker-acc
353 (concat (substring gud-marker-acc 0 (match-beginning 0))
354 (substring gud-marker-acc (match-end 0))))
355
356 ;; Remove the trimmings from the console stream.
357 (while (string-match gdb-console-regexp gud-marker-acc)
358 (setq
359 gud-marker-acc (concat
360 (substring gud-marker-acc 0 (match-beginning 0))
361 (read (match-string 1 gud-marker-acc))
362 (substring gud-marker-acc (match-end 0)))))
363
364 ;; Remove the trimmings from log stream containing debugging messages
365 ;; being produced by GDB's internals and use warning face.
366 (while (string-match gdb-internals-regexp gud-marker-acc)
367 (setq
368 gud-marker-acc
369 (concat (substring gud-marker-acc 0 (match-beginning 0))
370 (let ((error-message
371 (read (match-string 1 gud-marker-acc))))
372 (put-text-property
373 0 (length error-message)
374 'face font-lock-warning-face
375 error-message)
376 error-message)
377 (substring gud-marker-acc (match-end 0)))))
378
379 (setq output (gdbmi-concat-output output gud-marker-acc))
380 (setq gud-marker-acc "")
381 (gdbmi-prompt1)
382 (unless gdb-input-queue
383 (setq output (concat output gdb-prompt-name)))
317531b2
NR
384 (gdbmi-prompt2)
385 (setq gud-running running))
44236a56
NR
386
387 (when gud-running
388 (setq output (gdbmi-concat-output output gud-marker-acc))
389 (setq gud-marker-acc ""))
390
391 output)))
aeea8b77
NR
392
393(defun gdbmi-concat-output (so-far new)
394 (let ((sink gdb-output-sink))
395 (cond
396 ((eq sink 'user) (concat so-far new))
397 ((eq sink 'emacs)
398 (gdb-append-to-partial-output new)
399 so-far)
400 ((eq sink 'inferior)
401 (gdb-append-to-inferior-io new)
402 so-far))))
403\f
404
405;; Breakpoint buffer : This displays the output of `-break-list'.
406;;
a2140d4d
NR
407(def-gdb-auto-update-trigger gdbmi-invalidate-breakpoints
408 (gdb-get-buffer 'gdb-breakpoints-buffer)
aeea8b77 409 "-break-list\n"
a2140d4d 410 gdb-break-list-handler)
aeea8b77
NR
411
412(defconst gdb-break-list-regexp
897731a2
NR
413"bkpt={.*?number=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\",.*?disp=\"\\(.*?\\)\",.*?\
414enabled=\"\\(.\\)\",.*?addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\",.*?\
415file=\"\\(.*?\\)\",.*?fullname=\".*?\",.*?line=\"\\(.*?\\)\",\
416\\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}")
aeea8b77
NR
417
418(defun gdb-break-list-handler ()
419 (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
420 gdb-pending-triggers))
44236a56 421 (let ((breakpoint) (breakpoints-list))
897731a2 422 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
aeea8b77
NR
423 (goto-char (point-min))
424 (while (re-search-forward gdb-break-list-regexp nil t)
425 (let ((breakpoint (list (match-string 1)
426 (match-string 2)
427 (match-string 3)
428 (match-string 4)
429 (match-string 5)
430 (match-string 6)
431 (match-string 7)
48fc115b
NR
432 (match-string 8)
433 (match-string 9)
434 (match-string 10))))
aeea8b77
NR
435 (push breakpoint breakpoints-list))))
436 (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
437 (and buf (with-current-buffer buf
438 (let ((p (point))
439 (buffer-read-only nil))
440 (erase-buffer)
48fc115b 441 (insert "Num Type Disp Enb Hits Addr What\n")
aeea8b77 442 (dolist (breakpoint breakpoints-list)
48fc115b
NR
443 (insert
444 (concat
445 (nth 0 breakpoint) " "
446 (nth 1 breakpoint) " "
447 (nth 2 breakpoint) " "
448 (nth 3 breakpoint) " "
449 (nth 9 breakpoint) " "
450 (nth 4 breakpoint) " "
451 (if (nth 5 breakpoint)
452 (concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n")
453 (concat (nth 8 breakpoint) "\n")))))
aeea8b77 454 (goto-char p))))))
48fc115b 455 (gdb-info-breakpoints-custom))
a2140d4d 456
44236a56
NR
457(defun gdbmi-get-location (bptno line flag)
458 "Find the directory containing the relevant source file.
459Put in buffer and place breakpoint icon."
460 (goto-char (point-min))
461 (catch 'file-not-found
48fc115b 462 (if (re-search-forward gdb-source-file-regexp-1 nil t)
44236a56
NR
463 (delete (cons bptno "File not found") gdb-location-alist)
464 (push (cons bptno (match-string 1)) gdb-location-alist)
465 (gdb-resync)
466 (unless (assoc bptno gdb-location-alist)
467 (push (cons bptno "File not found") gdb-location-alist)
468 (message-box "Cannot find source file for breakpoint location.
469Add directory to search path for source files using the GDB command, dir."))
470 (throw 'file-not-found nil))
471 (with-current-buffer
472 (find-file-noselect (match-string 1))
473 (save-current-buffer
474 (set (make-local-variable 'gud-minor-mode) 'gdbmi)
475 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))
476 ;; only want one breakpoint icon at each location
477 (save-excursion
478 (goto-line (string-to-number line))
479 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))
480
aeea8b77
NR
481;; Frames buffer. This displays a perpetually correct bactrack trace.
482;;
a2140d4d
NR
483(def-gdb-auto-update-trigger gdbmi-invalidate-frames
484 (gdb-get-buffer 'gdb-stack-buffer)
aeea8b77 485 "-stack-list-frames\n"
a2140d4d
NR
486 gdb-stack-list-frames-handler)
487
aeea8b77 488(defconst gdb-stack-list-frames-regexp
897731a2
NR
489"{.*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\
490\\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\
48fc115b 491from=\"\\(.*?\\)\"\\)")
aeea8b77
NR
492
493(defun gdb-stack-list-frames-handler ()
494 (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
495 gdb-pending-triggers))
496 (let ((frame nil)
497 (call-stack nil))
897731a2 498 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
aeea8b77
NR
499 (goto-char (point-min))
500 (while (re-search-forward gdb-stack-list-frames-regexp nil t)
501 (let ((frame (list (match-string 1)
502 (match-string 2)
503 (match-string 3)
504 (match-string 4)
48fc115b
NR
505 (match-string 5)
506 (match-string 6))))
aeea8b77
NR
507 (push frame call-stack))))
508 (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
509 (and buf (with-current-buffer buf
510 (let ((p (point))
511 (buffer-read-only nil))
512 (erase-buffer)
48fc115b 513 (insert "Level\tAddr\tFunc\tFile:Line\n")
aeea8b77 514 (dolist (frame (nreverse call-stack))
48fc115b
NR
515 (insert
516 (concat
517 (nth 0 frame) "\t"
518 (nth 1 frame) "\t"
317531b2
NR
519 (propertize (nth 2 frame)
520 'face font-lock-function-name-face) "\t"
48fc115b
NR
521 (if (nth 3 frame)
522 (concat "at "(nth 3 frame) ":" (nth 4 frame) "\n")
523 (concat "from " (nth 5 frame) "\n")))))
aeea8b77
NR
524 (goto-char p))))))
525 (gdb-stack-list-frames-custom))
526
527(defun gdb-stack-list-frames-custom ()
528 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
529 (save-excursion
530 (let ((buffer-read-only nil))
531 (goto-char (point-min))
532 (forward-line 1)
533 (while (< (point) (point-max))
534 (add-text-properties (point-at-bol) (point-at-eol)
535 '(mouse-face highlight
536 help-echo "mouse-2, RET: Select frame"))
537 (beginning-of-line)
44236a56
NR
538 (when (and (looking-at "^[0-9]+\\s-+\\(\\S-+\\)")
539 (equal (match-string 1) gdb-selected-frame))
aeea8b77
NR
540 (put-text-property (point-at-bol) (point-at-eol)
541 'face '(:inverse-video t)))
542 (forward-line 1))))))
543
44236a56 544\f
48fc115b 545;; gdb-ui.el uses "info source" to find out if macro information is present.
44236a56
NR
546(defun gdb-get-source-file ()
547 "Find the source file where the program starts and display it with related
548buffers, if required."
aeea8b77 549 (goto-char (point-min))
48fc115b 550 (if (re-search-forward gdb-source-file-regexp-1 nil t)
44236a56
NR
551 (setq gdb-main-file (match-string 1)))
552 (if gdb-many-windows
aeea8b77 553 (gdb-setup-windows)
897731a2 554 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
44236a56
NR
555 (if gdb-show-main
556 (let ((pop-up-windows t))
557 (display-buffer (gud-find-file gdb-main-file))))))
aeea8b77 558
44236a56
NR
559(defun gdbmi-get-selected-frame ()
560 (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers))
561 (progn
562 (gdb-enqueue-input
563 (list "-stack-info-frame\n" 'gdbmi-frame-handler))
564 (push 'gdbmi-get-selected-frame
565 gdb-pending-triggers))))
566
567(defun gdbmi-frame-handler ()
568 (setq gdb-pending-triggers
569 (delq 'gdbmi-get-selected-frame gdb-pending-triggers))
897731a2 570 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
44236a56
NR
571 (goto-char (point-min))
572 (when (re-search-forward gdb-stack-list-frames-regexp nil t)
573 (setq gdb-frame-number (match-string 1))
2e6d207c 574 (setq gdb-pc-address (match-string 2))
44236a56 575 (setq gdb-selected-frame (match-string 3))
2e6d207c
NR
576 (when (match-string 4)
577 (setq gud-last-frame
578 (cons (match-string 4) (string-to-number (match-string 5))))
579 (gud-display-frame)
580 (if gud-overlay-arrow-position
581 (let ((buffer (marker-buffer gud-overlay-arrow-position))
582 (position (marker-position gud-overlay-arrow-position)))
583 (when buffer
584 (with-current-buffer buffer
585 (setq fringe-indicator-alist
586 (if (string-equal gdb-frame-number "0")
587 nil
588 '((overlay-arrow . hollow-right-triangle))))
589 (setq gud-overlay-arrow-position (make-marker))
590 (set-marker gud-overlay-arrow-position position))))))
44236a56
NR
591 (if (gdb-get-buffer 'gdb-locals-buffer)
592 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
593 (setq mode-name (concat "Locals:" gdb-selected-frame))))
594 (if (gdb-get-buffer 'gdb-assembler-buffer)
595 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
596 (setq mode-name (concat "Machine:" gdb-selected-frame)))))))
597
598(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
599
600(defun gdb-get-prompt ()
601 "Find prompt for GDB session."
602 (goto-char (point-min))
603 (setq gdb-prompt-name nil)
604 (re-search-forward gdb-prompt-name-regexp nil t)
605 (setq gdb-prompt-name (match-string 1)))
606
aeea8b77
NR
607(provide 'gdb-mi)
608;;; gdbmi.el ends here