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