| 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 |