gdb/mi/gdb-mi.el

   1 ;;; gdb-mi.el
   2
   3 ;; Author: Nick Roberts <nickrob@gnu.org>
   4 ;; Maintainer: Nick Roberts <nickrob@gnu.org>
   5 ;; Keywords: unix, tools
   6
   7 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
   8 ;; Free Software Foundation, Inc.
   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
  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).
  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
  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".
  40
  41 ;; This mode acts on top of gdb-ui.el.  After the release of 22.1,
  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.
  45 ;;
  46 ;; Known Bugs:
  47 ;;
  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.
  52 ;; 2) Some commands send extra prompts to the GUD buffer.
  53 ;; 3) Doesn't list catchpoints in breakpoints buffer.
  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 ;;
  62 ;;; Code:
  63
  64 (require 'gud)
  65 (require 'gdb-ui)
  66
  67 (defvar gdb-last-command nil)
  68 (defvar gdb-prompt-name nil)
  69
  70 ;;;###autoload
  71 (defun gdbmi (command-line)
  72   "Run gdb on program FILE in buffer *gud-FILE*.
  73 The directory containing FILE becomes the initial working directory
  74 and source-file directory for your debugger.
  75
  76 If `gdb-many-windows' is nil (the default value) then gdb just
  77 pops up the GUD buffer unless `gdb-show-main' is t. In this case
  78 it starts with two windows: one displaying the GUD buffer and the
  79 other with the source file with the main routine of the inferior.
  80
  81 If `gdb-many-windows' is t, regardless of the value of
  82 `gdb-show-main', the layout below will appear. Keybindings are
  83 given in relevant buffer.
  84
  85 Watch expressions appear in the speedbar/slowbar.
  86
  87 The following commands help control operation :
  88
  89 `gdb-many-windows'    - Toggle the number of windows gdb uses.
  90 `gdb-restore-windows' - To restore the window layout.
  91
  92 See Info node `(emacs)GDB Graphical Interface' for a more
  93 detailed description of this mode.
  94
  95
  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 +-------------------------------+------------------------------+"
 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   ;;
 124   (setq gdb-debug-ring nil)
 125   (set (make-local-variable 'gud-minor-mode) 'gdbmi)
 126   (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
 127   ;;
 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.")
 139   (gud-def gud-break (if (not (string-equal mode-name "Machine"))
 140                          (gud-call "break %f:%l" arg)
 141                        (save-excursion
 142                          (beginning-of-line)
 143                          (forward-char 2)
 144                          (gud-call "break *%a" arg)))
 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"))
 156                           (gud-call "-exec-until %f:%l" arg)
 157                         (save-excursion
 158                           (beginning-of-line)
 159                           (forward-char 2)
 160                           (gud-call "-exec-until *%a" arg)))
 161            "\C-u" "Continue to current line or address.")
 162
 163   (define-key gud-minor-mode-map [left-margin mouse-1]
 164     'gdb-mouse-set-clear-breakpoint)
 165   (define-key gud-minor-mode-map [left-fringe mouse-1]
 166     'gdb-mouse-set-clear-breakpoint)
 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)
 171   (define-key gud-minor-mode-map [left-margin mouse-3]
 172     'gdb-mouse-toggle-breakpoint-margin)
 173   (define-key gud-minor-mode-map [left-fringe mouse-3]
 174     'gdb-mouse-toggle-breakpoint-fringe)
 175
 176   (setq comint-input-sender 'gdbmi-send)
 177   ;;
 178   ;; (re-)initialise
 179   (setq gdb-pc-address (if gdb-show-main "main" nil)
 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
 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
 194         gdb-source-file-list nil
 195         gdb-last-command nil
 196         gdb-prompt-name nil
 197         gdb-buffer-fringe-width (car (window-fringes)))
 198         gdb-debug-ring nil
 199         gdb-source-window nil
 200         gdb-inferior-status nil
 201         gdb-continuation nil
 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)))
 210   (gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore))
 211   ;; find source file and compilation directory here
 212   (gdb-enqueue-input
 213    ; Needs GDB 6.2 onwards.
 214    (list "-file-list-exec-source-files\n"
 215          'gdb-set-gud-minor-mode-existing-buffers-1))
 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))
 223   ;;
 224   (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
 225   (run-hooks 'gdbmi-mode-hook))
 226
 227 \f
 228 (defun gdbmi-send (proc string)
 229   "A comint send filter for gdb."
 230   (if gud-running
 231       (process-send-string proc (concat string "\n"))
 232     (with-current-buffer gud-comint-buffer
 233       (let ((inhibit-read-only t))
 234         (remove-text-properties (point-min) (point-max) '(face))))
 235     (setq gdb-output-sink 'user)
 236     (setq gdb-prompting nil)
 237     ;; mimic <RET> key to repeat previous command in GDB
 238     (if (not (string-match "^\\s+$" string))
 239         (setq gdb-last-command string)
 240       (if gdb-last-command (setq string gdb-last-command)))
 241     (if gdb-enable-debug
 242         (push (cons 'mi-send (concat string "\n")) gdb-debug-ring))
 243      (if (string-match "^-" string)
 244          ;; MI command
 245          (process-send-string proc (concat string "\n"))
 246        ;; CLI command
 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)))))
 253
 254 (defcustom gud-gdbmi-command-name "gdb -interp=mi"
 255   "Default command to execute an executable under the GDB-UI debugger."
 256   :type 'string
 257   :group 'gud)
 258
 259 (defconst gdb-gdb-regexp "(gdb) \n")
 260
 261 (defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp))
 262
 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")
 268
 269 (defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n")
 270
 271 (defconst gdb-done-regexp "\\^done,*\n*")
 272
 273 (defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n")
 274
 275 (defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n")
 276
 277 (defun gdbmi-prompt1 ()
 278   "Queue any GDB commands that the user interface needs."
 279   (unless gdb-pending-triggers
 280     (gdbmi-get-selected-frame)
 281     (gdbmi-invalidate-frames)
 282     (gdbmi-invalidate-breakpoints)
 283     (gdb-get-changed-registers)
 284     (gdb-invalidate-registers-1)
 285     (gdb-invalidate-locals-1)
 286     (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
 287         (gdb-var-update-1))))
 288
 289 (defun gdbmi-prompt2 ()
 290   "Handle any output and send next GDB command."
 291   (let ((sink gdb-output-sink))
 292     (when (eq sink 'emacs)
 293       (let ((handler
 294              (car (cdr gdb-current-item))))
 295         (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
 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."
 307   (if gdb-flush-pending-output
 308       nil
 309     (if gdb-enable-debug (push (cons 'recv (list string gdb-output-sink))
 310                                          gdb-debug-ring))
 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
 314     (let ((output "") running)
 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)))
 321            running t))
 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.
 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)))
 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
 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
 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)))
 385         (gdbmi-prompt2)
 386         (setq gud-running running))
 387
 388       (when gud-running
 389         (setq output (gdbmi-concat-output output gud-marker-acc))
 390         (setq gud-marker-acc ""))
 391
 392        output)))
 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 ;;
 408 (def-gdb-auto-update-trigger gdbmi-invalidate-breakpoints
 409   (gdb-get-buffer 'gdb-breakpoints-buffer)
 410   "-break-list\n"
 411   gdb-break-list-handler)
 412
 413 (defconst gdb-break-list-regexp
 414 "bkpt={.*?number=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\",.*?disp=\"\\(.*?\\)\",.*?\
 415 enabled=\"\\(.\\)\",.*?addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\",.*?\
 416 file=\"\\(.*?\\)\",.*?fullname=\".*?\",.*?line=\"\\(.*?\\)\",\
 417 \\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}")
 418
 419 (defun gdb-break-list-handler ()
 420   (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
 421                                   gdb-pending-triggers))
 422   (let ((breakpoint) (breakpoints-list))
 423     (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
 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)
 433                                 (match-string 8)
 434                                 (match-string 9)
 435                                 (match-string 10))))
 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)
 442                    (insert "Num Type           Disp Enb Hits Addr       What\n")
 443                    (dolist (breakpoint breakpoints-list)
 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")))))
 455                    (goto-char p))))))
 456   (gdb-info-breakpoints-custom))
 457
 458 (defun gdbmi-get-location (bptno line flag)
 459   "Find the directory containing the relevant source file.
 460 Put in buffer and place breakpoint icon."
 461   (goto-char (point-min))
 462   (catch 'file-not-found
 463     (if (re-search-forward gdb-source-file-regexp-1 nil t)
 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.
 470 Add 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
 482 ;; Frames buffer.  This displays a perpetually correct bactrack trace.
 483 ;;
 484 (def-gdb-auto-update-trigger gdbmi-invalidate-frames
 485   (gdb-get-buffer 'gdb-stack-buffer)
 486   "-stack-list-frames\n"
 487   gdb-stack-list-frames-handler)
 488
 489 (defconst gdb-stack-list-frames-regexp
 490 "{.*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\
 491 \\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\
 492 from=\"\\(.*?\\)\"\\)")
 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))
 499     (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
 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)
 506                            (match-string 5)
 507                            (match-string 6))))
 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)
 514                    (insert "Level\tAddr\tFunc\tFile:Line\n")
 515                    (dolist (frame (nreverse call-stack))
 516                      (insert
 517                       (concat
 518                        (nth 0 frame) "\t"
 519                        (nth 1 frame) "\t"
 520                        (propertize (nth 2 frame)
 521                                    'face font-lock-function-name-face) "\t"
 522                        (if (nth 3 frame)
 523                            (concat "at "(nth 3 frame) ":" (nth 4 frame) "\n")
 524                          (concat "from " (nth 5 frame) "\n")))))
 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)
 539           (when (and (looking-at "^[0-9]+\\s-+\\(\\S-+\\)")
 540                      (equal (match-string 1) gdb-selected-frame))
 541             (put-text-property (point-at-bol) (point-at-eol)
 542                                'face '(:inverse-video t)))
 543           (forward-line 1))))))
 544
 545 \f
 546 ;; gdb-ui.el uses "info source" to find out if macro information is present.
 547 (defun gdb-get-source-file ()
 548   "Find the source file where the program starts and display it with related
 549 buffers, if required."
 550   (goto-char (point-min))
 551   (if (re-search-forward gdb-source-file-regexp-1 nil t)
 552       (setq gdb-main-file (match-string 1)))
 553  (if gdb-many-windows
 554       (gdb-setup-windows)
 555    (gdb-get-buffer-create 'gdb-breakpoints-buffer)
 556    (if gdb-show-main
 557        (let ((pop-up-windows t))
 558          (display-buffer (gud-find-file gdb-main-file))))))
 559
 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))
 571   (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
 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))
 575       (setq gdb-pc-address (match-string 2))
 576       (setq gdb-selected-frame (match-string 3))
 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))))))
 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
 608 (provide 'gdb-mi)
 609 ;;; gdbmi.el ends here