1;;; gdb-ui.el --- User Interface for running GDB 2 3;; Author: Nick Roberts <nickrob@gnu.org> 4;; Maintainer: FSF 5;; Keywords: unix, tools 6 7;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 8;; Free Software Foundation, Inc. 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs 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;; GNU Emacs 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;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; This mode acts as a graphical user interface to GDB. You can interact with 30;; GDB through the GUD buffer in the usual way, but there are also further 31;; buffers which control the execution and describe the state of your program. 32;; It separates the input/output of your program from that of GDB, if 33;; required, and watches expressions in the speedbar. It also uses features of 34;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar 35;; (see the GDB Graphical Interface section in the Emacs info manual). 36 37;; By default, M-x gdb will start the debugger. However, if you have customised 38;; gud-gdb-command-name, then start it with M-x gdba. 39 40;; This file has evolved from gdba.el that was included with GDB 5.0 and 41;; written by Tom Lord and Jim Kingdon. It uses GDB's annotation interface. 42;; You don't need to know about annotations to use this mode as a debugger, 43;; but if you are interested developing the mode itself, see the Annotations 44;; section in the GDB info manual. 45 46;; GDB developers plan to make the annotation interface obsolete. A new 47;; interface called GDB/MI (machine interface) has been designed to replace 48;; it. Some GDB/MI commands are used in this file through the CLI command 49;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included with 50;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB. It is 51;; still under development and is part of a process to migrate Emacs from 52;; annotations to GDB/MI. 53 54;; This mode SHOULD WORK WITH GDB 5.0 or later but you will NEED AT LEAST 55;; GDB 6.0 to use watch expressions. It works best with GDB 6.4 or later 56;; where watch expressions will update more quickly. 57 58;;; Windows Platforms: 59 60;; If you are using Emacs and GDB on Windows you will need to flush the buffer 61;; explicitly in your program if you want timely display of I/O in Emacs. 62;; Alternatively you can make the output stream unbuffered, for example, by 63;; using a macro: 64 65;; #ifdef UNBUFFERED 66;; setvbuf (stdout, (char *) NULL, _IONBF, 0); 67;; #endif 68 69;; and compiling with -DUNBUFFERED while debugging. 70 71;;; Known Bugs: 72 73;; 1) Strings that are watched don't update in the speedbar when their 74;; contents change unless the first character changes. 75;; 2) Cannot handle multiple debug sessions. 76;; 3) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead. 77;; 4) M-x gdb doesn't work if the corefile is specified in the command in the 78;; minibuffer, use M-x gdba instead (or specify the core in the GUD buffer). 79;; 5) If you wish to call procedures from your program in GDB 80;; e.g "call myproc ()", "p mysquare (5)" then use level 2 annotations 81;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed. 82;; 6) After detaching from a process, clicking on the "GO" icon on toolbar 83;; (gud-go) sends "continue" to GDB (should be "run"). 84 85;;; Problems with watch expressions, GDB/MI: 86 87;; 1) They go out of scope when the inferior is re-run. 88;; 2) -stack-list-locals has a type field but also prints type in values field. 89;; 3) VARNUM increments even when variable object is not created 90;; (maybe trivial). 91 92;;; TODO: 93 94;; 1) Use MI command -data-read-memory for memory window. 95;; 2) Use tree-widget.el instead of the speedbar for watch-expressions? 96;; 3) Mark breakpoint locations on scroll-bar of source buffer? 97 98;;; Code: 99 100(require 'gud) 101 102(defvar tool-bar-map) 103(defvar speedbar-initial-expansion-list-name) 104 105(defvar gdb-pc-address nil "Initialization for Assembler buffer. 106Set to \"main\" at start if gdb-show-main is t.") 107(defvar gdb-frame-address nil "Identity of frame for watch expression.") 108(defvar gdb-previous-frame-address nil) 109(defvar gdb-memory-address "main") 110(defvar gdb-previous-frame nil) 111(defvar gdb-selected-frame nil) 112(defvar gdb-frame-number nil) 113(defvar gdb-current-language nil) 114(defvar gdb-var-list nil 115 "List of variables in watch window. 116Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS FP) 117where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame 118address for root variables.") 119(defvar gdb-main-file nil "Source file from which program execution begins.") 120(defvar gud-old-arrow nil) 121(defvar gdb-overlay-arrow-position nil) 122(defvar gdb-stack-position nil) 123(defvar gdb-server-prefix nil) 124(defvar gdb-flush-pending-output nil) 125(defvar gdb-location-alist nil 126 "Alist of breakpoint numbers and full filenames. Only used for files that 127Emacs can't find.") 128(defvar gdb-active-process nil 129 "GUD tooltips display variable values when t, and macro definitions otherwise.") 130(defvar gdb-error "Non-nil when GDB is reporting an error.") 131(defvar gdb-macro-info nil 132 "Non-nil if GDB knows that the inferior includes preprocessor macro info.") 133(defvar gdb-buffer-fringe-width nil) 134(defvar gdb-signalled nil) 135(defvar gdb-source-window nil) 136(defvar gdb-inferior-status nil) 137(defvar gdb-continuation nil) 138(defvar gdb-look-up-stack nil) 139(defvar gdb-frame-begin nil 140 "Non-nil when GDB generates frame-begin annotation.") 141(defvar gdb-printing t) 142 143(defvar gdb-buffer-type nil 144 "One of the symbols bound in `gdb-buffer-rules'.") 145(make-variable-buffer-local 'gdb-buffer-type) 146 147(defvar gdb-input-queue () 148 "A list of gdb command objects.") 149 150(defvar gdb-prompting nil 151 "True when gdb is idle with no pending input.") 152 153(defvar gdb-output-sink 'user 154 "The disposition of the output of the current gdb command. 155Possible values are these symbols: 156 157 `user' -- gdb output should be copied to the GUD buffer 158 for the user to see. 159 160 `inferior' -- gdb output should be copied to the inferior-io buffer. 161 162 `pre-emacs' -- output should be ignored util the post-prompt 163 annotation is received. Then the output-sink 164 becomes:... 165 `emacs' -- output should be collected in the partial-output-buffer 166 for subsequent processing by a command. This is the 167 disposition of output generated by commands that 168 gdb mode sends to gdb on its own behalf. 169 `post-emacs' -- ignore output until the prompt annotation is 170 received, then go to USER disposition. 171 172gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two 173\(`user' and `emacs').") 174 175(defvar gdb-current-item nil 176 "The most recent command item sent to gdb.") 177 178(defvar gdb-pending-triggers '() 179 "A list of trigger functions that have run later than their output 180handlers.") 181 182(defvar gdb-first-post-prompt nil) 183(defvar gdb-version nil) 184(defvar gdb-locals-font-lock-keywords nil) 185(defvar gdb-source-file-list nil 186 "List of source files for the current executable") 187(defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"") 188 189(defvar gdb-locals-font-lock-keywords-1 190 '( 191 ;; var = (struct struct_tag) value 192 ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)" 193 (1 font-lock-variable-name-face) 194 (3 font-lock-keyword-face) 195 (4 font-lock-type-face)) 196 ;; var = (type) value 197 ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)" 198 (1 font-lock-variable-name-face) 199 (3 font-lock-type-face)) 200 ;; var = val 201 ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]" 202 (1 font-lock-variable-name-face)) 203 ) 204 "Font lock keywords used in `gdb-local-mode'.") 205 206(defvar gdb-locals-font-lock-keywords-2 207 '( 208 ;; var = type value 209 ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)" 210 (1 font-lock-variable-name-face) 211 (3 font-lock-type-face)) 212 ) 213 "Font lock keywords used in `gdb-local-mode'.") 214 215;; Variables for GDB 6.4+ 216(defvar gdb-register-names nil "List of register names.") 217(defvar gdb-changed-registers nil 218 "List of changed register numbers (strings).") 219 220;;;###autoload 221(defun gdba (command-line) 222 "Run gdb on program FILE in buffer *gud-FILE*. 223The directory containing FILE becomes the initial working directory 224and source-file directory for your debugger. 225 226If `gdb-many-windows' is nil (the default value) then gdb just 227pops up the GUD buffer unless `gdb-show-main' is t. In this case 228it starts with two windows: one displaying the GUD buffer and the 229other with the source file with the main routine of the inferior. 230 231If `gdb-many-windows' is t, regardless of the value of 232`gdb-show-main', the layout below will appear unless 233`gdb-use-separate-io-buffer' is nil when the source buffer 234occupies the full width of the frame. Keybindings are shown in 235some of the buffers. 236 237Watch expressions appear in the speedbar/slowbar. 238 239The following commands help control operation : 240 241`gdb-many-windows' - Toggle the number of windows gdb uses. 242`gdb-restore-windows' - To restore the window layout. 243 244See Info node `(emacs)GDB Graphical Interface' for a more 245detailed description of this mode. 246 247 248+----------------------------------------------------------------------+ 249| GDB Toolbar | 250+-----------------------------------+----------------------------------+ 251| GUD buffer (I/O of GDB) | Locals buffer | 252| | | 253| | | 254| | | 255+-----------------------------------+----------------------------------+ 256| Source buffer | I/O buffer (of debugged program) | 257| | (comint-mode) | 258| | | 259| | | 260| | | 261| | | 262| | | 263| | | 264+-----------------------------------+----------------------------------+ 265| Stack buffer | Breakpoints buffer | 266| RET gdb-frames-select | SPC gdb-toggle-breakpoint | 267| | RET gdb-goto-breakpoint | 268| | D gdb-delete-breakpoint | 269+-----------------------------------+----------------------------------+" 270 ;; 271 (interactive (list (gud-query-cmdline 'gdba))) 272 ;; 273 ;; Let's start with a basic gud-gdb buffer and then modify it a bit. 274 (gdb command-line) 275 (gdb-init-1)) 276 277(defcustom gdb-debug-log-max 128 278 "Maximum size of `gdb-debug-log'. If nil, size is unlimited." 279 :group 'gud 280 :type '(choice (integer :tag "Number of elements") 281 (const :tag "Unlimited" nil)) 282 :version "22.1") 283 284(defvar gdb-debug-log nil 285 "List of commands sent to and replies received from GDB. Most 286recent commands are listed first. This list stores only the last 287'gdb-debug-log-max' values. This variable is used to debug 288GDB-UI.") 289 290;;;###autoload 291(defcustom gdb-enable-debug nil 292 "Non-nil means record the process input and output in `gdb-debug-log'." 293 :type 'boolean 294 :group 'gud 295 :version "22.1") 296 297(defcustom gdb-cpp-define-alist-program "gcc -E -dM -" 298 "Shell command for generating a list of defined macros in a source file. 299This list is used to display the #define directive associated 300with an identifier as a tooltip. It works in a debug session with 301GDB, when gud-tooltip-mode is t. 302 303Set `gdb-cpp-define-alist-flags' for any include paths or 304predefined macros." 305 :type 'string 306 :group 'gud 307 :version "22.1") 308 309(defcustom gdb-cpp-define-alist-flags "" 310 "Preprocessor flags for `gdb-cpp-define-alist-program'." 311 :type 'string 312 :group 'gud 313 :version "22.1") 314 315(defcustom gdb-show-main nil 316 "Non-nil means display source file containing the main routine at startup. 317Also display the main routine in the disassembly buffer if present." 318 :type 'boolean 319 :group 'gud 320 :version "22.1") 321 322(defcustom gdb-many-windows nil 323 "If nil, just pop up the GUD buffer unless `gdb-show-main' is t. 324In this case start with two windows: one displaying the GUD 325buffer and the other with the source file with the main routine 326of the debugged program. Non-nil means display the layout shown 327for `gdba'." 328 :type 'boolean 329 :group 'gud 330 :version "22.1") 331 332(defcustom gdb-use-separate-io-buffer nil 333 "Non-nil means display output from the debugged program in a separate buffer." 334 :type 'boolean 335 :group 'gud 336 :version "22.1") 337 338(defun gdb-force-mode-line-update (status) 339 (let ((buffer gud-comint-buffer)) 340 (if (and buffer (buffer-name buffer)) 341 (with-current-buffer buffer 342 (setq mode-line-process 343 (format ":%s [%s]" 344 (process-status (get-buffer-process buffer)) status)) 345 ;; Force mode line redisplay soon. 346 (force-mode-line-update))))) 347 348(defun gdb-many-windows (arg) 349 "Toggle the number of windows in the basic arrangement. 350With arg, display additional buffers iff arg is positive." 351 (interactive "P") 352 (setq gdb-many-windows 353 (if (null arg) 354 (not gdb-many-windows) 355 (> (prefix-numeric-value arg) 0))) 356 (message (format "Display of other windows %sabled" 357 (if gdb-many-windows "en" "dis"))) 358 (if (and gud-comint-buffer 359 (buffer-name gud-comint-buffer)) 360 (condition-case nil 361 (gdb-restore-windows) 362 (error nil)))) 363 364(defun gdb-use-separate-io-buffer (arg) 365 "Toggle separate IO for debugged program. 366With arg, use separate IO iff arg is positive." 367 (interactive "P") 368 (setq gdb-use-separate-io-buffer 369 (if (null arg) 370 (not gdb-use-separate-io-buffer) 371 (> (prefix-numeric-value arg) 0))) 372 (message (format "Separate IO %sabled" 373 (if gdb-use-separate-io-buffer "en" "dis"))) 374 (if (and gud-comint-buffer 375 (buffer-name gud-comint-buffer)) 376 (condition-case nil 377 (if gdb-use-separate-io-buffer 378 (if gdb-many-windows (gdb-restore-windows)) 379 (kill-buffer (gdb-inferior-io-name))) 380 (error nil)))) 381 382(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.") 383 384(defun gdb-create-define-alist () 385 "Create an alist of #define directives for GUD tooltips." 386 (let* ((file (buffer-file-name)) 387 (output 388 (with-output-to-string 389 (with-current-buffer standard-output 390 (call-process shell-file-name 391 (if (file-exists-p file) file nil) 392 (list t nil) nil "-c" 393 (concat gdb-cpp-define-alist-program " " 394 gdb-cpp-define-alist-flags))))) 395 (define-list (split-string output "\n" t)) (name)) 396 (setq gdb-define-alist nil) 397 (dolist (define define-list) 398 (setq name (nth 1 (split-string define "[( ]"))) 399 (push (cons name define) gdb-define-alist)))) 400 401(defun gdb-tooltip-print (expr) 402 (tooltip-show 403 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) 404 (goto-char (point-min)) 405 (let ((string 406 (if (search-forward "=" nil t) 407 (concat expr (buffer-substring (- (point) 2) (point-max))) 408 (buffer-string)))) 409 ;; remove newline for gud-tooltip-echo-area 410 (substring string 0 (- (length string) 1)))) 411 (or gud-tooltip-echo-area tooltip-use-echo-area))) 412 413;; If expr is a macro for a function don't print because of possible dangerous 414;; side-effects. Also printing a function within a tooltip generates an 415;; unexpected starting annotation (phase error). 416(defun gdb-tooltip-print-1 (expr) 417 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) 418 (goto-char (point-min)) 419 (if (search-forward "expands to: " nil t) 420 (unless (looking-at "\\S-+.*(.*).*") 421 (gdb-enqueue-input 422 (list (concat gdb-server-prefix "print " expr "\n") 423 `(lambda () (gdb-tooltip-print ,expr)))))))) 424 425(defconst gdb-source-file-regexp "\\(.+?\\), \\|\\([^, \n].*$\\)") 426 427(defun gdb-set-gud-minor-mode-existing-buffers () 428 "Create list of source files for current GDB session." 429 (goto-char (point-min)) 430 (when (search-forward "read in on demand:" nil t) 431 (while (re-search-forward gdb-source-file-regexp nil t) 432 (push (file-name-nondirectory (or (match-string 1) (match-string 2))) 433 gdb-source-file-list)) 434 (dolist (buffer (buffer-list)) 435 (with-current-buffer buffer 436 (when (and buffer-file-name 437 (member (file-name-nondirectory buffer-file-name) 438 gdb-source-file-list)) 439 (set (make-local-variable 'gud-minor-mode) 'gdba) 440 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) 441 (when gud-tooltip-mode 442 (make-local-variable 'gdb-define-alist) 443 (gdb-create-define-alist) 444 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))) 445 (gdb-force-mode-line-update 446 (propertize "ready" 'face font-lock-variable-name-face))) 447 448(defun gdb-find-watch-expression () 449 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) 450 (varnum (car var)) expr array) 451 (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum) 452 (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet 453 (component-list (split-string (match-string 2 varnum) "\\." t))) 454 (setq expr (nth 1 var1)) 455 (setq varnumlet (car var1)) 456 (dolist (component component-list) 457 (setq var2 (assoc varnumlet gdb-var-list)) 458 (setq expr (concat expr 459 (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2)) 460 (concat "[" component "]") 461 (concat "." component)))) 462 (setq varnumlet (concat varnumlet "." component))) 463 expr))) 464 465(defun gdb-init-1 () 466 (set (make-local-variable 'gud-minor-mode) 'gdba) 467 (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) 468 ;; 469 (gud-def gud-break (if (not (string-match "Machine" mode-name)) 470 (gud-call "break %f:%l" arg) 471 (save-excursion 472 (beginning-of-line) 473 (forward-char 2) 474 (gud-call "break *%a" arg))) 475 "\C-b" "Set breakpoint at current line or address.") 476 ;; 477 (gud-def gud-remove (if (not (string-match "Machine" mode-name)) 478 (gud-call "clear %f:%l" arg) 479 (save-excursion 480 (beginning-of-line) 481 (forward-char 2) 482 (gud-call "clear *%a" arg))) 483 "\C-d" "Remove breakpoint at current line or address.") 484 ;; 485 (gud-def gud-until (if (not (string-match "Machine" mode-name)) 486 (gud-call "until %f:%l" arg) 487 (save-excursion 488 (beginning-of-line) 489 (forward-char 2) 490 (gud-call "until *%a" arg))) 491 "\C-u" "Continue to current line or address.") 492 ;; 493 (gud-def gud-go (gud-call (if gdb-active-process "continue" "run") arg) 494 nil "Start or continue execution.") 495 496 ;; For debugging Emacs only. 497 (gud-def gud-pp 498 (gud-call 499 (concat 500 "pp1 " (if (eq (buffer-local-value 501 'major-mode (window-buffer)) 'speedbar-mode) 502 (gdb-find-watch-expression) "%e")) arg) 503 nil "Print the emacs s-expression.") 504 505 (define-key gud-minor-mode-map [left-margin mouse-1] 506 'gdb-mouse-set-clear-breakpoint) 507 (define-key gud-minor-mode-map [left-fringe mouse-1] 508 'gdb-mouse-set-clear-breakpoint) 509 (define-key gud-minor-mode-map [left-margin C-mouse-1] 510 'gdb-mouse-toggle-breakpoint-margin) 511 (define-key gud-minor-mode-map [left-fringe C-mouse-1] 512 'gdb-mouse-toggle-breakpoint-fringe) 513 514 (define-key gud-minor-mode-map [left-margin drag-mouse-1] 515 'gdb-mouse-until) 516 (define-key gud-minor-mode-map [left-fringe drag-mouse-1] 517 'gdb-mouse-until) 518 (define-key gud-minor-mode-map [left-margin mouse-3] 519 'gdb-mouse-until) 520 (define-key gud-minor-mode-map [left-fringe mouse-3] 521 'gdb-mouse-until) 522 523 (define-key gud-minor-mode-map [left-margin C-drag-mouse-1] 524 'gdb-mouse-jump) 525 (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1] 526 'gdb-mouse-jump) 527 (define-key gud-minor-mode-map [left-fringe C-mouse-3] 528 'gdb-mouse-jump) 529 (define-key gud-minor-mode-map [left-margin C-mouse-3] 530 'gdb-mouse-jump) 531 532 (setq comint-input-sender 'gdb-send) 533 534 ;; (re-)initialize 535 (setq gdb-pc-address (if gdb-show-main "main" nil)) 536 (setq gdb-previous-frame-address nil 537 gdb-memory-address "main" 538 gdb-previous-frame nil 539 gdb-selected-frame nil 540 gdb-current-language nil 541 gdb-frame-number nil 542 gdb-var-list nil 543 gdb-main-file nil 544 gdb-first-post-prompt t 545 gdb-prompting nil 546 gdb-input-queue nil 547 gdb-current-item nil 548 gdb-pending-triggers nil 549 gdb-output-sink 'user 550 gdb-server-prefix "server " 551 gdb-flush-pending-output nil 552 gdb-location-alist nil 553 gdb-source-file-list nil 554 gdb-error nil 555 gdb-macro-info nil 556 gdb-buffer-fringe-width (car (window-fringes)) 557 gdb-debug-log nil 558 gdb-signalled nil 559 gdb-source-window nil 560 gdb-inferior-status nil 561 gdb-continuation nil 562 gdb-look-up-stack nil 563 gdb-frame-begin nil 564 gdb-printing t 565 gud-old-arrow nil) 566 567 (setq gdb-buffer-type 'gdba) 568 569 (if gdb-use-separate-io-buffer (gdb-clear-inferior-io)) 570 571 ;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4) 572 (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n" 573 'gdb-get-version))) 574 575(defun gdb-init-2 () 576 (if (eq window-system 'w32) 577 (gdb-enqueue-input (list "set new-console off\n" 'ignore))) 578 (gdb-enqueue-input (list "set height 0\n" 'ignore)) 579 (gdb-enqueue-input (list "set width 0\n" 'ignore)) 580 581 (if (string-equal gdb-version "pre-6.4") 582 (progn 583 (gdb-enqueue-input (list (concat gdb-server-prefix "info sources\n") 584 'gdb-set-gud-minor-mode-existing-buffers)) 585 (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-1)) 586 (gdb-enqueue-input 587 (list "server interpreter mi -data-list-register-names\n" 588 'gdb-get-register-names)) 589 ; Needs GDB 6.2 onwards. 590 (gdb-enqueue-input 591 (list "server interpreter mi \"-file-list-exec-source-files\"\n" 592 'gdb-set-gud-minor-mode-existing-buffers-1)) 593 (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)) 594 595 ;; Find source file and compilation directory here. 596 ;; Works for C, C++, Fortran and Ada but not Java (GDB 6.4) 597 (gdb-enqueue-input (list "server list\n" 'ignore)) 598 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) 599 600 (run-hooks 'gdba-mode-hook)) 601 602(defun gdb-get-version () 603 (goto-char (point-min)) 604 (if (re-search-forward "Undefined\\( mi\\)* command:" nil t) 605 (setq gdb-version "pre-6.4") 606 (setq gdb-version "6.4+")) 607 (gdb-init-2)) 608 609(defmacro gdb-if-arrow (arrow-position &rest body) 610 `(if ,arrow-position 611 (let ((buffer (marker-buffer ,arrow-position)) (line)) 612 (if (equal buffer (window-buffer (posn-window end))) 613 (with-current-buffer buffer 614 (when (or (equal start end) 615 (equal (posn-point start) 616 (marker-position ,arrow-position))) 617 ,@body)))))) 618 619(defun gdb-mouse-until (event) 620 "Continue running until a source line past the current line. 621The destination source line can be selected either by clicking 622with mouse-3 on the fringe/margin or dragging the arrow 623with mouse-1 (default bindings)." 624 (interactive "e") 625 (let ((start (event-start event)) 626 (end (event-end event))) 627 (gdb-if-arrow gud-overlay-arrow-position 628 (setq line (line-number-at-pos (posn-point end))) 629 (gud-call (concat "until " (number-to-string line)))) 630 (gdb-if-arrow gdb-overlay-arrow-position 631 (save-excursion 632 (goto-line (line-number-at-pos (posn-point end))) 633 (forward-char 2) 634 (gud-call (concat "until *%a")))))) 635 636(defun gdb-mouse-jump (event) 637 "Set execution address/line. 638The destination source line can be selected either by clicking with C-mouse-3 639on the fringe/margin or dragging the arrow with C-mouse-1 (default bindings). 640Unlike gdb-mouse-until the destination address can be before the current 641line, and no execution takes place." 642 (interactive "e") 643 (let ((start (event-start event)) 644 (end (event-end event))) 645 (gdb-if-arrow gud-overlay-arrow-position 646 (setq line (line-number-at-pos (posn-point end))) 647 (progn 648 (gud-call (concat "tbreak " (number-to-string line))) 649 (gud-call (concat "jump " (number-to-string line))))) 650 (gdb-if-arrow gdb-overlay-arrow-position 651 (save-excursion 652 (goto-line (line-number-at-pos (posn-point end))) 653 (forward-char 2) 654 (progn 655 (gud-call (concat "tbreak *%a")) 656 (gud-call (concat "jump *%a"))))))) 657 658(defcustom gdb-speedbar-auto-raise nil 659 "If non-nil raise speedbar every time display of watch expressions is\ 660 updated." 661 :type 'boolean 662 :group 'gud 663 :version "22.1") 664 665(defun gdb-speedbar-auto-raise (arg) 666 "Toggle automatic raising of the speedbar for watch expressions. 667With arg, automatically raise speedbar iff arg is positive." 668 (interactive "P") 669 (setq gdb-speedbar-auto-raise 670 (if (null arg) 671 (not gdb-speedbar-auto-raise) 672 (> (prefix-numeric-value arg) 0))) 673 (message (format "Auto raising %sabled" 674 (if gdb-speedbar-auto-raise "en" "dis")))) 675 676(defcustom gdb-use-colon-colon-notation nil 677 "If non-nil use FUN::VAR format to display variables in the speedbar." 678 :type 'boolean 679 :group 'gud 680 :version "22.1") 681 682(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) 683(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch) 684 685(defun gud-watch (&optional arg event) 686 "Watch expression at point. 687With arg, enter name of variable to be watched in the minibuffer." 688 (interactive (list current-prefix-arg last-input-event)) 689 (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer))) 690 (if (memq minor-mode '(gdbmi gdba)) 691 (progn 692 (if event (posn-set-point (event-end event))) 693 (require 'tooltip) 694 (save-selected-window 695 (let ((expr 696 (if arg 697 (completing-read "Name of variable: " 698 'gud-gdb-complete-command) 699 (if (and transient-mark-mode mark-active) 700 (buffer-substring (region-beginning) (region-end)) 701 (tooltip-identifier-from-point (point)))))) 702 (speedbar 1) 703 (set-text-properties 0 (length expr) nil expr) 704 (gdb-enqueue-input 705 (list 706 (if (eq minor-mode 'gdba) 707 (concat 708 "server interpreter mi \"-var-create - * " expr "\"\n") 709 (concat"-var-create - * " expr "\n")) 710 `(lambda () (gdb-var-create-handler ,expr))))))) 711 (message "gud-watch is a no-op in this mode.")))) 712 713(defconst gdb-var-create-regexp 714 "name=\"\\(.*?\\)\",.*numchild=\"\\(.*?\\)\",\\(?:.*value=\\(\".*\"\\),\\)?.*type=\"\\(.*?\\)\"") 715 716(defun gdb-var-create-handler (expr) 717 (goto-char (point-min)) 718 (if (re-search-forward gdb-var-create-regexp nil t) 719 (let ((var (list 720 (match-string 1) 721 (if (and (string-equal gdb-current-language "c") 722 gdb-use-colon-colon-notation gdb-selected-frame) 723 (setq expr (concat gdb-selected-frame "::" expr)) 724 expr) 725 (match-string 2) 726 (match-string 4) 727 (if (match-string 3) (read (match-string 3))) 728 nil gdb-frame-address))) 729 (push var gdb-var-list) 730 (unless (string-equal 731 speedbar-initial-expansion-list-name "GUD") 732 (speedbar-change-initial-expansion-list "GUD")) 733 (unless (nth 4 var) 734 (gdb-enqueue-input 735 (list 736 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 737 'gdba) 738 (concat "server interpreter mi \"0-var-evaluate-expression " 739 (car var) "\"\n") 740 (concat "0-var-evaluate-expression " (car var) "\n")) 741 `(lambda () (gdb-var-evaluate-expression-handler 742 ,(car var) nil)))))) 743 (if (search-forward "Undefined command" nil t) 744 (message-box "Watching expressions requires GDB 6.0 onwards") 745 (message-box "No symbol \"%s\" in current context." expr)))) 746 747(defun gdb-speedbar-update () 748 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) 749 (not (member 'gdb-speedbar-timer gdb-pending-triggers))) 750 ;; Dummy command to update speedbar even when idle. 751 (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn)) 752 ;; Keep gdb-pending-triggers non-nil till end. 753 (push 'gdb-speedbar-timer gdb-pending-triggers))) 754 755(defun gdb-speedbar-timer-fn () 756 (setq gdb-pending-triggers 757 (delq 'gdb-speedbar-timer gdb-pending-triggers)) 758 (speedbar-timer-fn)) 759 760(defun gdb-var-evaluate-expression-handler (varnum changed) 761 (goto-char (point-min)) 762 (re-search-forward "\\(.+\\)\\^done,value=\\(\".*\"\\)" nil t) 763 (setq gdb-pending-triggers 764 (delq (string-to-number (match-string 1)) gdb-pending-triggers)) 765 (let ((var (assoc varnum gdb-var-list))) 766 (when var 767 (if changed (setcar (nthcdr 5 var) 'changed)) 768 (setcar (nthcdr 4 var) (read (match-string 2))))) 769 (gdb-speedbar-update)) 770 771(defun gdb-var-list-children (varnum) 772 (gdb-enqueue-input 773 (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n") 774 `(lambda () (gdb-var-list-children-handler ,varnum))))) 775 776(defconst gdb-var-list-children-regexp 777 "child={.*?name=\"\\(.*?\\)\",.*?exp=\"\\(.*?\\)\",.*?\ 778numchild=\"\\(.*?\\)\"\\(}\\|,.*?\\(type=\"\\(.*?\\)\"\\)?.*?}\\)") 779 780(defun gdb-var-list-children-handler (varnum) 781 (goto-char (point-min)) 782 (let ((var-list nil)) 783 (catch 'child-already-watched 784 (dolist (var gdb-var-list) 785 (if (string-equal varnum (car var)) 786 (progn 787 (push var var-list) 788 (while (re-search-forward gdb-var-list-children-regexp nil t) 789 (let ((varchild (list (match-string 1) 790 (match-string 2) 791 (match-string 3) 792 (match-string 6) 793 nil nil))) 794 (if (assoc (car varchild) gdb-var-list) 795 (throw 'child-already-watched nil)) 796 (push varchild var-list) 797 (gdb-enqueue-input 798 (list 799 (concat 800 "server interpreter mi \"0-var-evaluate-expression " 801 (car varchild) "\"\n") 802 `(lambda () (gdb-var-evaluate-expression-handler 803 ,(car varchild) nil))))))) 804 (push var var-list))) 805 (setq gdb-var-list (nreverse var-list))))) 806 807(defun gdb-var-update () 808 (when (not (member 'gdb-var-update gdb-pending-triggers)) 809 (gdb-enqueue-input 810 (list "server interpreter mi \"-var-update *\"\n" 811 'gdb-var-update-handler)) 812 (push 'gdb-var-update gdb-pending-triggers))) 813 814(defconst gdb-var-update-regexp 815 "{.*?name=\"\\(.*?\\)\",.*?in_scope=\"\\(.*?\\)\",.*?\ 816type_changed=\".*?\".*?}") 817 818(defun gdb-var-update-handler () 819 (dolist (var gdb-var-list) 820 (setcar (nthcdr 5 var) nil)) 821 (goto-char (point-min)) 822 (let ((n 0)) 823 (while (re-search-forward gdb-var-update-regexp nil t) 824 (let ((varnum (match-string 1))) 825 (if (string-equal (match-string 2) "false") 826 (let ((var (assoc varnum gdb-var-list))) 827 (if var (setcar (nthcdr 5 var) 'out-of-scope))) 828 (setq n (1+ n)) 829 (push n gdb-pending-triggers) 830 (gdb-enqueue-input 831 (list 832 (concat "server interpreter mi \"" (number-to-string n) 833 "-var-evaluate-expression " varnum "\"\n") 834 `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))))))) 835 (setq gdb-pending-triggers 836 (delq 'gdb-var-update gdb-pending-triggers))) 837 838(defun gdb-var-delete-1 (varnum) 839 (gdb-enqueue-input 840 (list 841 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 842 'gdba) 843 (concat "server interpreter mi \"-var-delete " varnum "\"\n") 844 (concat "-var-delete " varnum "\n")) 845 'ignore)) 846 (setq gdb-var-list (delq var gdb-var-list)) 847 (dolist (varchild gdb-var-list) 848 (if (string-match (concat (car var) "\\.") (car varchild)) 849 (setq gdb-var-list (delq varchild gdb-var-list))))) 850 851(defun gdb-var-delete () 852 "Delete watch expression at point from the speedbar." 853 (interactive) 854 (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 855 '(gdbmi gdba)) 856 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) 857 (varnum (car var))) 858 (if (string-match "\\." (car var)) 859 (message-box "Can only delete a root expression") 860 (gdb-var-delete-1 varnum))))) 861 862(defun gdb-var-delete-children (varnum) 863 "Delete children of variable object at point from the speedbar." 864 (gdb-enqueue-input 865 (list 866 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 867 (concat "server interpreter mi \"-var-delete -c " varnum "\"\n") 868 (concat "-var-delete -c " varnum "\n")) 'ignore))) 869 870(defun gdb-edit-value (text token indent) 871 "Assign a value to a variable displayed in the speedbar." 872 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) 873 (varnum (car var)) (value)) 874 (setq value (read-string "New value: ")) 875 (gdb-enqueue-input 876 (list 877 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 878 (concat "server interpreter mi \"-var-assign " 879 varnum " " value "\"\n") 880 (concat "-var-assign " varnum " " value "\n")) 881 `(lambda () (gdb-edit-value-handler ,value)))))) 882 883(defun gdb-edit-value-handler (value) 884 (goto-char (point-min)) 885 (if (re-search-forward gdb-error-regexp nil t) 886 (message-box "Invalid number or expression (%s)" value))) 887 888(defcustom gdb-show-changed-values t 889 "If non-nil change the face of out of scope variables and changed values. 890Out of scope variables are suppressed with `shadow' face. 891Changed values are highlighted with the face `font-lock-warning-face'." 892 :type 'boolean 893 :group 'gud 894 :version "22.1") 895 896(defcustom gdb-max-children 40 897 "Maximum number of children before expansion requires confirmation." 898 :type 'integer 899 :group 'gud 900 :version "22.1") 901 902(defun gdb-speedbar-expand-node (text token indent) 903 "Expand the node the user clicked on. 904TEXT is the text of the button we clicked on, a + or - item. 905TOKEN is data related to this node. 906INDENT is the current indentation depth." 907 (if (and gud-comint-buffer (buffer-name gud-comint-buffer)) 908 (progn 909 (cond ((string-match "+" text) ;expand this node 910 (let* ((var (assoc token gdb-var-list)) 911 (expr (nth 1 var)) (children (nth 2 var))) 912 (if (or (<= (string-to-number children) gdb-max-children) 913 (y-or-n-p 914 (format 915 "%s has %s children. Continue? " expr children))) 916 (if (and (eq (buffer-local-value 917 'gud-minor-mode gud-comint-buffer) 'gdba) 918 (string-equal gdb-version "pre-6.4")) 919 (gdb-var-list-children token) 920 (gdb-var-list-children-1 token))))) 921 ((string-match "-" text) ;contract this node 922 (dolist (var gdb-var-list) 923 (if (string-match (concat token "\\.") (car var)) 924 (setq gdb-var-list (delq var gdb-var-list)))) 925 (gdb-var-delete-children token) 926 (speedbar-change-expand-button-char ?+) 927 (speedbar-delete-subblock indent)) 928 (t (error "Ooops... not sure what to do"))) 929 (speedbar-center-buffer-smartly)) 930 (message-box "GUD session has been killed"))) 931 932(defun gdb-get-target-string () 933 (with-current-buffer gud-comint-buffer 934 gud-target-name)) 935 936 937;; 938;; gdb buffers. 939;; 940;; Each buffer has a TYPE -- a symbol that identifies the function 941;; of that particular buffer. 942;; 943;; The usual gdb interaction buffer is given the type `gdba' and 944;; is constructed specially. 945;; 946;; Others are constructed by gdb-get-buffer-create and 947;; named according to the rules set forth in the gdb-buffer-rules-assoc 948 949(defvar gdb-buffer-rules-assoc '()) 950 951(defun gdb-get-buffer (key) 952 "Return the gdb buffer tagged with type KEY. 953The key should be one of the cars in `gdb-buffer-rules-assoc'." 954 (save-excursion 955 (gdb-look-for-tagged-buffer key (buffer-list)))) 956 957(defun gdb-get-buffer-create (key) 958 "Create a new gdb buffer of the type specified by KEY. 959The key should be one of the cars in `gdb-buffer-rules-assoc'." 960 (or (gdb-get-buffer key) 961 (let* ((rules (assoc key gdb-buffer-rules-assoc)) 962 (name (funcall (gdb-rules-name-maker rules))) 963 (new (get-buffer-create name))) 964 (with-current-buffer new 965 (let ((trigger)) 966 (if (cdr (cdr rules)) 967 (setq trigger (funcall (car (cdr (cdr rules)))))) 968 (setq gdb-buffer-type key) 969 (set (make-local-variable 'gud-minor-mode) 970 (buffer-local-value 'gud-minor-mode gud-comint-buffer)) 971 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) 972 (if trigger (funcall trigger))) 973 new)))) 974 975(defun gdb-rules-name-maker (rules) (car (cdr rules))) 976 977(defun gdb-look-for-tagged-buffer (key bufs) 978 (let ((retval nil)) 979 (while (and (not retval) bufs) 980 (set-buffer (car bufs)) 981 (if (eq gdb-buffer-type key) 982 (setq retval (car bufs))) 983 (setq bufs (cdr bufs))) 984 retval)) 985 986;; 987;; This assoc maps buffer type symbols to rules. Each rule is a list of 988;; at least one and possible more functions. The functions have these 989;; roles in defining a buffer type: 990;; 991;; NAME - Return a name for this buffer type. 992;; 993;; The remaining function(s) are optional: 994;; 995;; MODE - called in a new buffer with no arguments, should establish 996;; the proper mode for the buffer. 997;; 998 999(defun gdb-set-buffer-rules (buffer-type &rest rules) 1000 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc))) 1001 (if binding 1002 (setcdr binding rules) 1003 (push (cons buffer-type rules) 1004 gdb-buffer-rules-assoc)))) 1005 1006;; GUD buffers are an exception to the rules 1007(gdb-set-buffer-rules 'gdba 'error) 1008 1009;; Partial-output buffer : This accumulates output from a command executed on 1010;; behalf of emacs (rather than the user). 1011;; 1012(gdb-set-buffer-rules 'gdb-partial-output-buffer 1013 'gdb-partial-output-name) 1014 1015(defun gdb-partial-output-name () 1016 (concat " *partial-output-" 1017 (gdb-get-target-string) 1018 "*")) 1019 1020 1021(gdb-set-buffer-rules 'gdb-inferior-io 1022 'gdb-inferior-io-name 1023 'gdb-inferior-io-mode) 1024 1025(defun gdb-inferior-io-name () 1026 (concat "*input/output of " 1027 (gdb-get-target-string) 1028 "*")) 1029 1030(defun gdb-display-separate-io-buffer () 1031 "Display IO of debugged program in a separate window." 1032 (interactive) 1033 (if gdb-use-separate-io-buffer 1034 (gdb-display-buffer 1035 (gdb-get-buffer-create 'gdb-inferior-io) t))) 1036 1037(defconst gdb-frame-parameters 1038 '((height . 14) (width . 80) 1039 (unsplittable . t) 1040 (tool-bar-lines . nil) 1041 (menu-bar-lines . nil) 1042 (minibuffer . nil))) 1043 1044(defun gdb-frame-separate-io-buffer () 1045 "Display IO of debugged program in a new frame." 1046 (interactive) 1047 (if gdb-use-separate-io-buffer 1048 (let ((special-display-regexps (append special-display-regexps '(".*"))) 1049 (special-display-frame-alist gdb-frame-parameters)) 1050 (display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))) 1051 1052(defvar gdb-inferior-io-mode-map 1053 (let ((map (make-sparse-keymap))) 1054 (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt) 1055 (define-key map "\C-c\C-z" 'gdb-separate-io-stop) 1056 (define-key map "\C-c\C-\\" 'gdb-separate-io-quit) 1057 (define-key map "\C-c\C-d" 'gdb-separate-io-eof) 1058 (define-key map "\C-d" 'gdb-separate-io-eof) 1059 map)) 1060 1061(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O" 1062 "Major mode for gdb inferior-io." 1063 :syntax-table nil :abbrev-table nil 1064 ;; We want to use comint because it has various nifty and familiar 1065 ;; features. We don't need a process, but comint wants one, so create 1066 ;; a dummy one. 1067 (make-comint-in-buffer 1068 (substring (buffer-name) 1 (- (length (buffer-name)) 1)) 1069 (current-buffer) "hexl") 1070 (setq comint-input-sender 'gdb-inferior-io-sender)) 1071 1072(defun gdb-inferior-io-sender (proc string) 1073 ;; PROC is the pseudo-process created to satisfy comint. 1074 (with-current-buffer (process-buffer proc) 1075 (setq proc (get-buffer-process gud-comint-buffer)) 1076 (process-send-string proc string) 1077 (process-send-string proc "\n"))) 1078 1079(defun gdb-separate-io-interrupt () 1080 "Interrupt the program being debugged." 1081 (interactive) 1082 (interrupt-process 1083 (get-buffer-process gud-comint-buffer) comint-ptyp)) 1084 1085(defun gdb-separate-io-quit () 1086 "Send quit signal to the program being debugged." 1087 (interactive) 1088 (quit-process 1089 (get-buffer-process gud-comint-buffer) comint-ptyp)) 1090 1091(defun gdb-separate-io-stop () 1092 "Stop the program being debugged." 1093 (interactive) 1094 (stop-process 1095 (get-buffer-process gud-comint-buffer) comint-ptyp)) 1096 1097(defun gdb-separate-io-eof () 1098 "Send end-of-file to the program being debugged." 1099 (interactive) 1100 (process-send-eof 1101 (get-buffer-process gud-comint-buffer))) 1102 1103 1104;; gdb communications 1105;; 1106 1107;; INPUT: things sent to gdb 1108;; 1109;; The queues are lists. Each element is either a string (indicating user or 1110;; user-like input) or a list of the form: 1111;; 1112;; (INPUT-STRING HANDLER-FN) 1113;; 1114;; The handler function will be called from the partial-output buffer when the 1115;; command completes. This is the way to write commands which invoke gdb 1116;; commands autonomously. 1117;; 1118;; These lists are consumed tail first. 1119;; 1120 1121(defun gdb-send (proc string) 1122 "A comint send filter for gdb. 1123This filter may simply queue input for a later time." 1124 (with-current-buffer gud-comint-buffer 1125 (let ((inhibit-read-only t)) 1126 (remove-text-properties (point-min) (point-max) '(face)))) 1127 (if gud-running 1128 (progn 1129 (let ((item (concat string "\n"))) 1130 (if gdb-enable-debug (push (cons 'send item) gdb-debug-log)) 1131 (process-send-string proc item))) 1132 (if (and (string-match "\\\\$" string) 1133 (not comint-input-sender-no-newline)) ;;Try to catch C-d. 1134 (setq gdb-continuation (concat gdb-continuation string "\n")) 1135 (let ((item (concat gdb-continuation string "\n"))) 1136 (gdb-enqueue-input item) 1137 (setq gdb-continuation nil))))) 1138 1139;; Note: Stuff enqueued here will be sent to the next prompt, even if it 1140;; is a query, or other non-top-level prompt. 1141 1142(defun gdb-enqueue-input (item) 1143 (if (not gud-running) 1144 (if gdb-prompting 1145 (progn 1146 (gdb-send-item item) 1147 (setq gdb-prompting nil)) 1148 (push item gdb-input-queue)))) 1149 1150(defun gdb-dequeue-input () 1151 (let ((queue gdb-input-queue)) 1152 (and queue 1153 (let ((last (car (last queue)))) 1154 (unless (nbutlast queue) (setq gdb-input-queue '())) 1155 last)))) 1156 1157(defun gdb-send-item (item) 1158 (setq gdb-flush-pending-output nil) 1159 (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log)) 1160 (setq gdb-current-item item) 1161 (let ((process (get-buffer-process gud-comint-buffer))) 1162 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 1163 (if (stringp item) 1164 (progn 1165 (setq gdb-output-sink 'user) 1166 (process-send-string process item)) 1167 (progn 1168 (gdb-clear-partial-output) 1169 (setq gdb-output-sink 'pre-emacs) 1170 (process-send-string process 1171 (car item)))) 1172 ;; case: eq gud-minor-mode 'gdbmi 1173 (gdb-clear-partial-output) 1174 (setq gdb-output-sink 'emacs) 1175 (process-send-string process (car item))))) 1176 1177;; 1178;; output -- things gdb prints to emacs 1179;; 1180;; GDB output is a stream interrupted by annotations. 1181;; Annotations can be recognized by their beginning 1182;; with \C-j\C-z\C-z<tag><opt>\C-j 1183;; 1184;; The tag is a string obeying symbol syntax. 1185;; 1186;; The optional part `<opt>' can be either the empty string 1187;; or a space followed by more data relating to the annotation. 1188;; For example, the SOURCE annotation is followed by a filename, 1189;; line number and various useless goo. This data must not include 1190;; any newlines. 1191;; 1192 1193(defcustom gud-gdba-command-name "gdb -annotate=3" 1194 "Default command to execute an executable under the GDB-UI debugger." 1195 :type 'string 1196 :group 'gud 1197 :version "22.1") 1198 1199(defvar gdb-annotation-rules 1200 '(("pre-prompt" gdb-pre-prompt) 1201 ("prompt" gdb-prompt) 1202 ("commands" gdb-subprompt) 1203 ("overload-choice" gdb-subprompt) 1204 ("query" gdb-subprompt) 1205 ;; Need this prompt for GDB 6.1 1206 ("nquery" gdb-subprompt) 1207 ("prompt-for-continue" gdb-subprompt) 1208 ("post-prompt" gdb-post-prompt) 1209 ("source" gdb-source) 1210 ("starting" gdb-starting) 1211 ("exited" gdb-exited) 1212 ("signalled" gdb-signalled) 1213 ("signal" gdb-signal) 1214 ("breakpoint" gdb-stopping) 1215 ("watchpoint" gdb-stopping) 1216 ("frame-begin" gdb-frame-begin) 1217 ("stopped" gdb-stopped) 1218 ("error-begin" gdb-error) 1219 ("error" gdb-error) 1220 ) "An assoc mapping annotation tags to functions which process them.") 1221 1222(defun gdb-resync() 1223 (setq gdb-flush-pending-output t) 1224 (setq gud-running nil) 1225 (gdb-force-mode-line-update 1226 (propertize "stopped"'face font-lock-warning-face)) 1227 (setq gdb-output-sink 'user) 1228 (setq gdb-input-queue nil) 1229 (setq gdb-pending-triggers nil) 1230 (setq gdb-prompting t)) 1231 1232(defconst gdb-source-spec-regexp 1233 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x0*\\([a-f0-9]*\\)") 1234 1235;; Do not use this except as an annotation handler. 1236(defun gdb-source (args) 1237 (string-match gdb-source-spec-regexp args) 1238 ;; Extract the frame position from the marker. 1239 (setq gud-last-frame 1240 (cons 1241 (match-string 1 args) 1242 (string-to-number (match-string 2 args)))) 1243 (setq gdb-pc-address (match-string 3 args)) 1244 ;; cover for auto-display output which comes *before* 1245 ;; stopped annotation 1246 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) 1247 1248(defun gdb-pre-prompt (ignored) 1249 "An annotation handler for `pre-prompt'. 1250This terminates the collection of output from a previous command if that 1251happens to be in effect." 1252 (setq gdb-error nil) 1253 (let ((sink gdb-output-sink)) 1254 (cond 1255 ((eq sink 'user) t) 1256 ((eq sink 'emacs) 1257 (setq gdb-output-sink 'post-emacs)) 1258 (t 1259 (gdb-resync) 1260 (error "Phase error in gdb-pre-prompt (got %s)" sink))))) 1261 1262(defun gdb-prompt (ignored) 1263 "An annotation handler for `prompt'. 1264This sends the next command (if any) to gdb." 1265 (when gdb-first-prompt 1266 (gdb-force-mode-line-update 1267 (propertize "initializing..." 'face font-lock-variable-name-face)) 1268 (gdb-init-1) 1269 (setq gdb-first-prompt nil)) 1270 (let ((sink gdb-output-sink)) 1271 (cond 1272 ((eq sink 'user) t) 1273 ((eq sink 'post-emacs) 1274 (setq gdb-output-sink 'user) 1275 (let ((handler 1276 (car (cdr gdb-current-item)))) 1277 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) 1278 (funcall handler)))) 1279 (t 1280 (gdb-resync) 1281 (error "Phase error in gdb-prompt (got %s)" sink)))) 1282 (let ((input (gdb-dequeue-input))) 1283 (if input 1284 (gdb-send-item input) 1285 (progn 1286 (setq gdb-prompting t) 1287 (gud-display-frame))))) 1288 1289(defun gdb-subprompt (ignored) 1290 "An annotation handler for non-top-level prompts." 1291 (setq gdb-prompting t)) 1292 1293(defun gdb-starting (ignored) 1294 "An annotation handler for `starting'. 1295This says that I/O for the subprocess is now the program being debugged, 1296not GDB." 1297 (setq gdb-active-process t) 1298 (setq gdb-printing t) 1299 (let ((sink gdb-output-sink)) 1300 (cond 1301 ((eq sink 'user) 1302 (progn 1303 (setq gud-running t) 1304 (setq gdb-inferior-status "running") 1305 (setq gdb-signalled nil) 1306 (gdb-force-mode-line-update 1307 (propertize gdb-inferior-status 'face font-lock-type-face)) 1308 (gdb-remove-text-properties) 1309 (setq gud-old-arrow gud-overlay-arrow-position) 1310 (setq gud-overlay-arrow-position nil) 1311 (setq gdb-overlay-arrow-position nil) 1312 (setq gdb-stack-position nil) 1313 (if gdb-use-separate-io-buffer 1314 (setq gdb-output-sink 'inferior)))) 1315 (t 1316 (gdb-resync) 1317 (error "Unexpected `starting' annotation"))))) 1318 1319(defun gdb-signal (ignored) 1320 (setq gdb-inferior-status "signal") 1321 (gdb-force-mode-line-update 1322 (propertize gdb-inferior-status 'face font-lock-warning-face)) 1323 (gdb-stopping ignored)) 1324 1325(defun gdb-stopping (ignored) 1326 "An annotation handler for `breakpoint' and other annotations. 1327They say that I/O for the subprocess is now GDB, not the program 1328being debugged." 1329 (if gdb-use-separate-io-buffer 1330 (let ((sink gdb-output-sink)) 1331 (cond 1332 ((eq sink 'inferior) 1333 (setq gdb-output-sink 'user)) 1334 (t 1335 (gdb-resync) 1336 (error "Unexpected stopping annotation")))))) 1337 1338(defun gdb-exited (ignored) 1339 "An annotation handler for `exited' and `signalled'. 1340They say that I/O for the subprocess is now GDB, not the program 1341being debugged and that the program is no longer running. This 1342function is used to change the focus of GUD tooltips to #define 1343directives." 1344 (setq gdb-active-process nil) 1345 (setq gud-overlay-arrow-position nil) 1346 (setq gdb-overlay-arrow-position nil) 1347 (setq gdb-stack-position nil) 1348 (setq gud-old-arrow nil) 1349 (setq gdb-inferior-status "exited") 1350 (gdb-force-mode-line-update 1351 (propertize gdb-inferior-status 'face font-lock-warning-face)) 1352 (gdb-stopping ignored)) 1353 1354(defun gdb-signalled (ignored) 1355 (setq gdb-signalled t)) 1356 1357(defun gdb-frame-begin (ignored) 1358 (setq gdb-frame-begin t) 1359 (setq gdb-printing nil) 1360 (let ((sink gdb-output-sink)) 1361 (cond 1362 ((eq sink 'inferior) 1363 (setq gdb-output-sink 'user)) 1364 ((eq sink 'user) t) 1365 ((eq sink 'emacs) t) 1366 (t 1367 (gdb-resync) 1368 (error "Unexpected frame-begin annotation (%S)" sink))))) 1369 1370(defcustom gdb-same-frame focus-follows-mouse 1371 "Non-nil means pop up GUD buffer in same frame." 1372 :group 'gud 1373 :type 'boolean 1374 :version "22.1") 1375 1376(defcustom gdb-find-source-frame nil 1377 "Non-nil means try to find a source frame further up stack e.g after signal." 1378 :group 'gud 1379 :type 'boolean 1380 :version "22.1") 1381 1382(defun gdb-find-source-frame (arg) 1383 "Toggle trying to find a source frame further up stack. 1384With arg, look for a source frame further up stack iff arg is positive." 1385 (interactive "P") 1386 (setq gdb-find-source-frame 1387 (if (null arg) 1388 (not gdb-find-source-frame) 1389 (> (prefix-numeric-value arg) 0))) 1390 (message (format "Looking for source frame %sabled" 1391 (if gdb-find-source-frame "en" "dis")))) 1392 1393(defun gdb-stopped (ignored) 1394 "An annotation handler for `stopped'. 1395It is just like `gdb-stopping', except that if we already set the output 1396sink to `user' in `gdb-stopping', that is fine." 1397 (setq gud-running nil) 1398 (unless (or gud-overlay-arrow-position gud-last-frame) 1399 (if (and gdb-frame-begin gdb-printing) 1400 (setq gud-overlay-arrow-position gud-old-arrow) 1401 ;;Pop up GUD buffer to display current frame when it doesn't have source 1402 ;;information i.e if not compiled with -g as with libc routines generally. 1403 (if gdb-same-frame 1404 (gdb-display-gdb-buffer) 1405 (gdb-frame-gdb-buffer)) 1406 (if gdb-find-source-frame 1407 ;;Try to find source further up stack e.g after signal. 1408 (setq gdb-look-up-stack 1409 (if (gdb-get-buffer 'gdb-stack-buffer) 1410 'keep 1411 (progn 1412 (gdb-get-buffer-create 'gdb-stack-buffer) 1413 (gdb-invalidate-frames) 1414 'delete)))))) 1415 (unless (member gdb-inferior-status '("exited" "signal")) 1416 (setq gdb-active-process t) ;Just for attaching case. 1417 (setq gdb-inferior-status "stopped") 1418 (gdb-force-mode-line-update 1419 (propertize gdb-inferior-status 'face font-lock-warning-face))) 1420 (let ((sink gdb-output-sink)) 1421 (cond 1422 ((eq sink 'inferior) 1423 (setq gdb-output-sink 'user)) 1424 ((eq sink 'user) t) 1425 (t 1426 (gdb-resync) 1427 (error "Unexpected stopped annotation")))) 1428 (if gdb-signalled (gdb-exited ignored))) 1429 1430(defun gdb-error (ignored) 1431 (setq gdb-error (not gdb-error))) 1432 1433(defun gdb-post-prompt (ignored) 1434 "An annotation handler for `post-prompt'. 1435This begins the collection of output from the current command if that 1436happens to be appropriate." 1437 ;; Don't add to queue if there outstanding items or gdb-version is not known 1438 ;; yet. 1439 (unless (or gdb-pending-triggers gdb-first-post-prompt) 1440 (gdb-get-selected-frame) 1441 (gdb-invalidate-frames) 1442 ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted. 1443 (gdb-get-buffer-create 'gdb-breakpoints-buffer) 1444 (gdb-invalidate-breakpoints) 1445 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler 1446 ;; so gdb-pc-address is updated. 1447 ;; (gdb-invalidate-assembler) 1448 1449 (if (string-equal gdb-version "pre-6.4") 1450 (gdb-invalidate-registers) 1451 (gdb-get-changed-registers) 1452 (gdb-invalidate-registers-1)) 1453 1454 (gdb-invalidate-memory) 1455 (if (string-equal gdb-version "pre-6.4") 1456 (gdb-invalidate-locals) 1457 (gdb-invalidate-locals-1)) 1458 1459 (gdb-invalidate-threads) 1460 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. 1461 ;; FIXME: with GDB-6 on Darwin, this might very well work. 1462 ;; Only needed/used with speedbar/watch expressions. 1463 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) 1464 (if (string-equal gdb-version "pre-6.4") 1465 (gdb-var-update) 1466 (gdb-var-update-1))))) 1467 (setq gdb-first-post-prompt nil) 1468 (let ((sink gdb-output-sink)) 1469 (cond 1470 ((eq sink 'user) t) 1471 ((eq sink 'pre-emacs) 1472 (setq gdb-output-sink 'emacs)) 1473 (t 1474 (gdb-resync) 1475 (error "Phase error in gdb-post-prompt (got %s)" sink))))) 1476 1477(defconst gdb-buffer-list 1478'(gdb-stack-buffer gdb-locals-buffer gdb-registers-buffer gdb-threads-buffer)) 1479 1480(defun gdb-remove-text-properties () 1481 (dolist (buffertype gdb-buffer-list) 1482 (let ((buffer (gdb-get-buffer buffertype))) 1483 (if buffer 1484 (with-current-buffer buffer 1485 (let ((inhibit-read-only t)) 1486 (remove-text-properties 1487 (point-min) (point-max) '(mouse-face nil help-echo nil)))))))) 1488 1489;; GUD displays the selected GDB frame. This might might not be the current 1490;; GDB frame (after up, down etc). If no GDB frame is visible but the last 1491;; visited breakpoint is, use that window. 1492(defun gdb-display-source-buffer (buffer) 1493 (let* ((last-window (if gud-last-last-frame 1494 (get-buffer-window 1495 (gud-find-file (car gud-last-last-frame))))) 1496 (source-window (or last-window 1497 (if (and gdb-source-window 1498 (window-live-p gdb-source-window)) 1499 gdb-source-window)))) 1500 (when source-window 1501 (setq gdb-source-window source-window) 1502 (set-window-buffer source-window buffer)) 1503 source-window)) 1504 1505(defun gud-gdba-marker-filter (string) 1506 "A gud marker filter for gdb. Handle a burst of output from GDB." 1507 (if gdb-flush-pending-output 1508 nil 1509 (when gdb-enable-debug 1510 (push (cons 'recv string) gdb-debug-log) 1511 (if (and gdb-debug-log-max 1512 (> (length gdb-debug-log) gdb-debug-log-max)) 1513 (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil))) 1514 ;; Recall the left over gud-marker-acc from last time. 1515 (setq gud-marker-acc (concat gud-marker-acc string)) 1516 ;; Start accumulating output for the GUD buffer. 1517 (let ((output "")) 1518 ;; 1519 ;; Process all the complete markers in this chunk. 1520 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) 1521 (let ((annotation (match-string 1 gud-marker-acc))) 1522 ;; 1523 ;; Stuff prior to the match is just ordinary output. 1524 ;; It is either concatenated to OUTPUT or directed 1525 ;; elsewhere. 1526 (setq output 1527 (gdb-concat-output 1528 output 1529 (substring gud-marker-acc 0 (match-beginning 0)))) 1530 ;; 1531 ;; Take that stuff off the gud-marker-acc. 1532 (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) 1533 ;; 1534 ;; Parse the tag from the annotation, and maybe its arguments. 1535 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) 1536 (let* ((annotation-type (match-string 1 annotation)) 1537 (annotation-arguments (match-string 2 annotation)) 1538 (annotation-rule (assoc annotation-type 1539 gdb-annotation-rules))) 1540 ;; Call the handler for this annotation. 1541 (if annotation-rule 1542 (funcall (car (cdr annotation-rule)) 1543 annotation-arguments) 1544 ;; Else the annotation is not recognized. Ignore it silently, 1545 ;; so that GDB can add new annotations without causing 1546 ;; us to blow up. 1547 )))) 1548 ;; 1549 ;; Does the remaining text end in a partial line? 1550 ;; If it does, then keep part of the gud-marker-acc until we get more. 1551 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" 1552 gud-marker-acc) 1553 (progn 1554 ;; Everything before the potential marker start can be output. 1555 (setq output 1556 (gdb-concat-output output 1557 (substring gud-marker-acc 0 1558 (match-beginning 0)))) 1559 ;; 1560 ;; Everything after, we save, to combine with later input. 1561 (setq gud-marker-acc (substring gud-marker-acc 1562 (match-beginning 0)))) 1563 ;; 1564 ;; In case we know the gud-marker-acc contains no partial annotations: 1565 (progn 1566 (setq output (gdb-concat-output output gud-marker-acc)) 1567 (setq gud-marker-acc ""))) 1568 output))) 1569 1570(defun gdb-concat-output (so-far new) 1571 (if gdb-error 1572 (put-text-property 0 (length new) 'face font-lock-warning-face new)) 1573 (let ((sink gdb-output-sink)) 1574 (cond 1575 ((eq sink 'user) (concat so-far new)) 1576 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) 1577 ((eq sink 'emacs) 1578 (gdb-append-to-partial-output new) 1579 so-far) 1580 ((eq sink 'inferior) 1581 (gdb-append-to-inferior-io new) 1582 so-far) 1583 (t 1584 (gdb-resync) 1585 (error "Bogon output sink %S" sink))))) 1586 1587(defun gdb-append-to-partial-output (string) 1588 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) 1589 (goto-char (point-max)) 1590 (insert string))) 1591 1592(defun gdb-clear-partial-output () 1593 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) 1594 (erase-buffer))) 1595 1596(defun gdb-append-to-inferior-io (string) 1597 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) 1598 (goto-char (point-max)) 1599 (insert-before-markers string)) 1600 (if (not (string-equal string "")) 1601 (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t))) 1602 1603(defun gdb-clear-inferior-io () 1604 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) 1605 (erase-buffer))) 1606 1607 1608;; One trick is to have a command who's output is always available in a buffer 1609;; of it's own, and is always up to date. We build several buffers of this 1610;; type. 1611;; 1612;; There are two aspects to this: gdb has to tell us when the output for that 1613;; command might have changed, and we have to be able to run the command 1614;; behind the user's back. 1615;; 1616;; The output phasing associated with the variable gdb-output-sink 1617;; help us to run commands behind the user's back. 1618;; 1619;; Below is the code for specificly managing buffers of output from one 1620;; command. 1621;; 1622 1623;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES 1624;; It adds an input for the command we are tracking. It should be the 1625;; annotation rule binding of whatever gdb sends to tell us this command 1626;; might have changed it's output. 1627;; 1628;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. 1629;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the 1630;; input in the input queue (see comment about ``gdb communications'' above). 1631 1632(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command 1633 output-handler) 1634 `(defun ,name (&optional ignored) 1635 (if (and ,demand-predicate 1636 (not (member ',name 1637 gdb-pending-triggers))) 1638 (progn 1639 (gdb-enqueue-input 1640 (list ,gdb-command ',output-handler)) 1641 (push ',name gdb-pending-triggers))))) 1642 1643(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) 1644 `(defun ,name () 1645 (setq gdb-pending-triggers 1646 (delq ',trigger 1647 gdb-pending-triggers)) 1648 (let ((buf (gdb-get-buffer ',buf-key))) 1649 (and buf 1650 (with-current-buffer buf 1651 (let* ((window (get-buffer-window buf 0)) 1652 (start (window-start window)) 1653 (p (window-point window)) 1654 (buffer-read-only nil)) 1655 (erase-buffer) 1656 (insert-buffer-substring (gdb-get-buffer-create 1657 'gdb-partial-output-buffer)) 1658 (set-window-start window start) 1659 (set-window-point window p))))) 1660 ;; put customisation here 1661 (,custom-defun))) 1662 1663(defmacro def-gdb-auto-updated-buffer (buffer-key 1664 trigger-name gdb-command 1665 output-handler-name custom-defun) 1666 `(progn 1667 (def-gdb-auto-update-trigger ,trigger-name 1668 ;; The demand predicate: 1669 (gdb-get-buffer ',buffer-key) 1670 ,gdb-command 1671 ,output-handler-name) 1672 (def-gdb-auto-update-handler ,output-handler-name 1673 ,trigger-name ,buffer-key ,custom-defun))) 1674 1675 1676;; 1677;; Breakpoint buffer : This displays the output of `info breakpoints'. 1678;; 1679(gdb-set-buffer-rules 'gdb-breakpoints-buffer 1680 'gdb-breakpoints-buffer-name 1681 'gdb-breakpoints-mode) 1682 1683(def-gdb-auto-updated-buffer gdb-breakpoints-buffer 1684 ;; This defines the auto update rule for buffers of type 1685 ;; `gdb-breakpoints-buffer'. 1686 ;; 1687 ;; It defines a function to serve as the annotation handler that 1688 ;; handles the `foo-invalidated' message. That function is called: 1689 gdb-invalidate-breakpoints 1690 ;; 1691 ;; To update the buffer, this command is sent to gdb. 1692 "server info breakpoints\n" 1693 ;; 1694 ;; This also defines a function to be the handler for the output 1695 ;; from the command above. That function will copy the output into 1696 ;; the appropriately typed buffer. That function will be called: 1697 gdb-info-breakpoints-handler 1698 ;; buffer specific functions 1699 gdb-info-breakpoints-custom) 1700 1701(defconst breakpoint-xpm-data 1702 "/* XPM */ 1703static char *magick[] = { 1704/* columns rows colors chars-per-pixel */ 1705\"10 10 2 1\", 1706\" c red\", 1707\"+ c None\", 1708/* pixels */ 1709\"+++ +++\", 1710\"++ ++\", 1711\"+ +\", 1712\" \", 1713\" \", 1714\" \", 1715\" \", 1716\"+ +\", 1717\"++ ++\", 1718\"+++ +++\", 1719};" 1720 "XPM data used for breakpoint icon.") 1721 1722(defconst breakpoint-enabled-pbm-data 1723 "P1 172410 10\", 17250 0 0 0 1 1 1 1 0 0 0 0 17260 0 0 1 1 1 1 1 1 0 0 0 17270 0 1 1 1 1 1 1 1 1 0 0 17280 1 1 1 1 1 1 1 1 1 1 0 17290 1 1 1 1 1 1 1 1 1 1 0 17300 1 1 1 1 1 1 1 1 1 1 0 17310 1 1 1 1 1 1 1 1 1 1 0 17320 0 1 1 1 1 1 1 1 1 0 0 17330 0 0 1 1 1 1 1 1 0 0 0 17340 0 0 0 1 1 1 1 0 0 0 0" 1735 "PBM data used for enabled breakpoint icon.") 1736 1737(defconst breakpoint-disabled-pbm-data 1738 "P1 173910 10\", 17400 0 1 0 1 0 1 0 0 0 17410 1 0 1 0 1 0 1 0 0 17421 0 1 0 1 0 1 0 1 0 17430 1 0 1 0 1 0 1 0 1 17441 0 1 0 1 0 1 0 1 0 17450 1 0 1 0 1 0 1 0 1 17461 0 1 0 1 0 1 0 1 0 17470 1 0 1 0 1 0 1 0 1 17480 0 1 0 1 0 1 0 1 0 17490 0 0 1 0 1 0 1 0 0" 1750 "PBM data used for disabled breakpoint icon.") 1751 1752(defvar breakpoint-enabled-icon nil 1753 "Icon for enabled breakpoint in display margin.") 1754 1755(defvar breakpoint-disabled-icon nil 1756 "Icon for disabled breakpoint in display margin.") 1757 1758(and (display-images-p) 1759 ;; Bitmap for breakpoint in fringe 1760 (define-fringe-bitmap 'breakpoint 1761 "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") 1762 ;; Bitmap for gud-overlay-arrow in fringe 1763 (define-fringe-bitmap 'hollow-right-triangle 1764 "\xe0\x90\x88\x84\x84\x88\x90\xe0")) 1765 1766(defface breakpoint-enabled 1767 '((t 1768 :foreground "red" 1769 :weight bold)) 1770 "Face for enabled breakpoint icon in fringe." 1771 :group 'gud) 1772 1773(defface breakpoint-disabled 1774 '((((class color) (min-colors 88)) :foreground "grey70") 1775 ;; Ensure that on low-color displays that we end up something visible. 1776 (((class color) (min-colors 8) (background light)) 1777 :foreground "black") 1778 (((class color) (min-colors 8) (background dark)) 1779 :foreground "white") 1780 (((type tty) (class mono)) 1781 :inverse-video t) 1782 (t :background "gray")) 1783 "Face for disabled breakpoint icon in fringe." 1784 :group 'gud) 1785 1786(defconst gdb-breakpoint-regexp 1787 "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+") 1788 1789;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). 1790(defun gdb-info-breakpoints-custom () 1791 (let ((flag) (bptno)) 1792 ;; Remove all breakpoint-icons in source buffers but not assembler buffer. 1793 (dolist (buffer (buffer-list)) 1794 (with-current-buffer buffer 1795 (if (and (memq gud-minor-mode '(gdba gdbmi)) 1796 (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) 1797 (gdb-remove-breakpoint-icons (point-min) (point-max))))) 1798 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) 1799 (save-excursion 1800 (let ((buffer-read-only nil)) 1801 (goto-char (point-min)) 1802 (while (< (point) (- (point-max) 1)) 1803 (forward-line 1) 1804 (if (looking-at gdb-breakpoint-regexp) 1805 (progn 1806 (setq bptno (match-string 1)) 1807 (setq flag (char-after (match-beginning 2))) 1808 (add-text-properties 1809 (match-beginning 2) (match-end 2) 1810 (if (eq flag ?y) 1811 '(face font-lock-warning-face) 1812 '(face font-lock-type-face))) 1813 (let ((bl (point)) 1814 (el (line-end-position))) 1815 (if (re-search-forward " in \\(.*\\) at\\s-+" el t) 1816 (progn 1817 (add-text-properties 1818 (match-beginning 1) (match-end 1) 1819 '(face font-lock-function-name-face)) 1820 (looking-at "\\(\\S-+\\):\\([0-9]+\\)") 1821 (let ((line (match-string 2)) 1822 (file (match-string 1))) 1823 (add-text-properties bl el 1824 '(mouse-face highlight 1825 help-echo "mouse-2, RET: visit breakpoint")) 1826 (unless (file-exists-p file) 1827 (setq file (cdr (assoc bptno gdb-location-alist)))) 1828 (if (and file 1829 (not (string-equal file "File not found"))) 1830 (with-current-buffer 1831 (find-file-noselect file 'nowarn) 1832 (set (make-local-variable 'gud-minor-mode) 1833 'gdba) 1834 (set (make-local-variable 'tool-bar-map) 1835 gud-tool-bar-map) 1836 ;; Only want one breakpoint icon at each 1837 ;; location. 1838 (save-excursion 1839 (goto-line (string-to-number line)) 1840 (gdb-put-breakpoint-icon (eq flag ?y) bptno))) 1841 (gdb-enqueue-input 1842 (list 1843 (concat gdb-server-prefix "list " 1844 (match-string-no-properties 1) ":1\n") 1845 'ignore)) 1846 (gdb-enqueue-input 1847 (list (concat gdb-server-prefix "info source\n") 1848 `(lambda () (gdb-get-location 1849 ,bptno ,line ,flag))))))) 1850 (if (re-search-forward 1851 "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" 1852 el t) 1853 (add-text-properties 1854 (match-beginning 1) (match-end 1) 1855 '(face font-lock-function-name-face)) 1856 (end-of-line) 1857 (re-search-backward "\\s-\\(\\S-*\\)" 1858 bl t) 1859 (add-text-properties 1860 (match-beginning 1) (match-end 1) 1861 '(face font-lock-variable-name-face))))))) 1862 (end-of-line)))))) 1863 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) 1864 1865(defun gdb-mouse-set-clear-breakpoint (event) 1866 "Set/clear breakpoint in left fringe/margin with mouse click." 1867 (interactive "e") 1868 (mouse-minibuffer-check event) 1869 (let ((posn (event-end event))) 1870 (if (numberp (posn-point posn)) 1871 (with-selected-window (posn-window posn) 1872 (save-excursion 1873 (goto-char (posn-point posn)) 1874 (if (or (posn-object posn) 1875 (eq (car (fringe-bitmaps-at-pos (posn-point posn))) 1876 'breakpoint)) 1877 (gud-remove nil) 1878 (gud-break nil))))))) 1879 1880(defun gdb-mouse-toggle-breakpoint-margin (event) 1881 "Enable/disable breakpoint in left margin with mouse click." 1882 (interactive "e") 1883 (mouse-minibuffer-check event) 1884 (let ((posn (event-end event))) 1885 (if (numberp (posn-point posn)) 1886 (with-selected-window (posn-window posn) 1887 (save-excursion 1888 (goto-char (posn-point posn)) 1889 (if (posn-object posn) 1890 (gdb-enqueue-input 1891 (list 1892 (let ((bptno (get-text-property 1893 0 'gdb-bptno (car (posn-string posn))))) 1894 (concat gdb-server-prefix 1895 (if (get-text-property 1896 0 'gdb-enabled (car (posn-string posn))) 1897 "disable " 1898 "enable ") 1899 bptno "\n")) 1900 'ignore)))))))) 1901 1902(defun gdb-mouse-toggle-breakpoint-fringe (event) 1903 "Enable/disable breakpoint in left fringe with mouse click." 1904 (interactive "e") 1905 (mouse-minibuffer-check event) 1906 (let* ((posn (event-end event)) 1907 (pos (posn-point posn)) 1908 obj) 1909 (when (numberp pos) 1910 (with-selected-window (posn-window posn) 1911 (save-excursion 1912 (set-buffer (window-buffer (selected-window))) 1913 (goto-char pos) 1914 (dolist (overlay (overlays-in pos pos)) 1915 (when (overlay-get overlay 'put-break) 1916 (setq obj (overlay-get overlay 'before-string)))) 1917 (when (stringp obj) 1918 (gdb-enqueue-input 1919 (list 1920 (concat gdb-server-prefix 1921 (if (get-text-property 0 'gdb-enabled obj) 1922 "disable " 1923 "enable ") 1924 (get-text-property 0 'gdb-bptno obj) "\n") 1925 'ignore)))))))) 1926 1927(defun gdb-breakpoints-buffer-name () 1928 (with-current-buffer gud-comint-buffer 1929 (concat "*breakpoints of " (gdb-get-target-string) "*"))) 1930 1931(defun gdb-display-breakpoints-buffer () 1932 "Display status of user-settable breakpoints." 1933 (interactive) 1934 (gdb-display-buffer 1935 (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)) 1936 1937(defun gdb-frame-breakpoints-buffer () 1938 "Display status of user-settable breakpoints in a new frame." 1939 (interactive) 1940 (let ((special-display-regexps (append special-display-regexps '(".*"))) 1941 (special-display-frame-alist gdb-frame-parameters)) 1942 (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer)))) 1943 1944(defvar gdb-breakpoints-mode-map 1945 (let ((map (make-sparse-keymap)) 1946 (menu (make-sparse-keymap "Breakpoints"))) 1947 (define-key menu [quit] '("Quit" . gdb-delete-frame-or-window)) 1948 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint)) 1949 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint)) 1950 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint)) 1951 (suppress-keymap map) 1952 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu)) 1953 (define-key map " " 'gdb-toggle-breakpoint) 1954 (define-key map "D" 'gdb-delete-breakpoint) 1955 ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons. 1956 (define-key map "q" 'gdb-delete-frame-or-window) 1957 (define-key map "\r" 'gdb-goto-breakpoint) 1958 (define-key map [mouse-2] 'gdb-goto-breakpoint) 1959 (define-key map [follow-link] 'mouse-face) 1960 map)) 1961 1962(defun gdb-delete-frame-or-window () 1963 "Delete frame if there is only one window. Otherwise delete the window." 1964 (interactive) 1965 (if (one-window-p) (delete-frame) 1966 (delete-window))) 1967 1968(defun gdb-breakpoints-mode () 1969 "Major mode for gdb breakpoints. 1970 1971\\{gdb-breakpoints-mode-map}" 1972 (kill-all-local-variables) 1973 (setq major-mode 'gdb-breakpoints-mode) 1974 (setq mode-name "Breakpoints") 1975 (use-local-map gdb-breakpoints-mode-map) 1976 (setq buffer-read-only t) 1977 (run-mode-hooks 'gdb-breakpoints-mode-hook) 1978 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 1979 'gdb-invalidate-breakpoints 1980 'gdbmi-invalidate-breakpoints)) 1981 1982(defun gdb-toggle-breakpoint () 1983 "Enable/disable breakpoint at current line." 1984 (interactive) 1985 (save-excursion 1986 (beginning-of-line 1) 1987 (if (looking-at gdb-breakpoint-regexp) 1988 (gdb-enqueue-input 1989 (list 1990 (concat gdb-server-prefix 1991 (if (eq ?y (char-after (match-beginning 2))) 1992 "disable " 1993 "enable ") 1994 (match-string 1) "\n") 'ignore)) 1995 (error "Not recognized as break/watchpoint line")))) 1996 1997(defun gdb-delete-breakpoint () 1998 "Delete the breakpoint at current line." 1999 (interactive) 2000 (beginning-of-line 1) 2001 (if (looking-at gdb-breakpoint-regexp) 2002 (gdb-enqueue-input 2003 (list 2004 (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore)) 2005 (error "Not recognized as break/watchpoint line"))) 2006 2007(defun gdb-goto-breakpoint (&optional event) 2008 "Display the breakpoint location specified at current line." 2009 (interactive (list last-input-event)) 2010 (if event (posn-set-point (event-end event))) 2011 (save-excursion 2012 (beginning-of-line 1) 2013 (if (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)") 2014 (let ((bptno (match-string 1)) 2015 (file (match-string 2)) 2016 (line (match-string 3))) 2017 (save-selected-window 2018 (let* ((buffer (find-file-noselect 2019 (if (file-exists-p file) file 2020 (cdr (assoc bptno gdb-location-alist))))) 2021 (window (or (gdb-display-source-buffer buffer) 2022 (display-buffer buffer)))) 2023 (setq gdb-source-window window) 2024 (with-current-buffer buffer 2025 (goto-line (string-to-number line)) 2026 (set-window-point window (point)))))) 2027 (error "No location specified.")))) 2028 2029 2030;; Frames buffer. This displays a perpetually correct bactracktrace 2031;; (from the command `where'). 2032;; 2033;; Alas, if your stack is deep, it is costly. 2034;; 2035(defcustom gdb-max-frames 40 2036 "Maximum number of frames displayed in call stack." 2037 :type 'integer 2038 :group 'gud 2039 :version "22.1") 2040 2041(gdb-set-buffer-rules 'gdb-stack-buffer 2042 'gdb-stack-buffer-name 2043 'gdb-frames-mode) 2044 2045(def-gdb-auto-updated-buffer gdb-stack-buffer 2046 gdb-invalidate-frames 2047 (concat "server info stack " (number-to-string gdb-max-frames) "\n") 2048 gdb-info-stack-handler 2049 gdb-info-stack-custom) 2050 2051(defun gdb-info-stack-custom () 2052 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) 2053 (save-excursion 2054 (unless (eq gdb-look-up-stack 'delete) 2055 (let ((buffer-read-only nil) 2056 bl el) 2057 (goto-char (point-min)) 2058 (while (< (point) (point-max)) 2059 (setq bl (line-beginning-position) 2060 el (line-end-position)) 2061 (when (looking-at "#") 2062 (add-text-properties bl el 2063 '(mouse-face highlight 2064 help-echo "mouse-2, RET: Select frame"))) 2065 (goto-char bl) 2066 (when (looking-at "^#\\([0-9]+\\)") 2067 (when (string-equal (match-string 1) gdb-frame-number) 2068 (if (> (car (window-fringes)) 0) 2069 (progn 2070 (or gdb-stack-position 2071 (setq gdb-stack-position (make-marker))) 2072 (set-marker gdb-stack-position (point))) 2073 (put-text-property bl (+ bl 4) 2074 'face '(:inverse-video t)))) 2075 (when (re-search-forward 2076 (concat 2077 (if (string-equal (match-string 1) "0") "" " in ") 2078 "\\([^ ]+\\) (") el t) 2079 (put-text-property (match-beginning 1) (match-end 1) 2080 'face font-lock-function-name-face) 2081 (setq bl (match-end 0)) 2082 (while (re-search-forward "<\\([^>]+\\)>" el t) 2083 (put-text-property (match-beginning 1) (match-end 1) 2084 'face font-lock-function-name-face)) 2085 (goto-char bl) 2086 (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t) 2087 (put-text-property (match-beginning 1) (match-end 1) 2088 'face font-lock-variable-name-face)))) 2089 (forward-line 1)) 2090 (forward-line -1) 2091 (when (looking-at "(More stack frames follow...)") 2092 (add-text-properties (match-beginning 0) (match-end 0) 2093 '(mouse-face highlight 2094 gdb-max-frames t 2095 help-echo 2096 "mouse-2, RET: customize gdb-max-frames to see more frames"))))) 2097 (when gdb-look-up-stack 2098 (goto-char (point-min)) 2099 (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t) 2100 (let ((start (line-beginning-position)) 2101 (file (match-string 1)) 2102 (line (match-string 2))) 2103 (re-search-backward "^#*\\([0-9]+\\)" start t) 2104 (gdb-enqueue-input 2105 (list (concat gdb-server-prefix "frame " 2106 (match-string 1) "\n") 'gdb-set-hollow)) 2107 (gdb-enqueue-input 2108 (list (concat gdb-server-prefix "frame 0\n") 'ignore))))))) 2109 (if (eq gdb-look-up-stack 'delete) 2110 (kill-buffer (gdb-get-buffer 'gdb-stack-buffer))) 2111 (setq gdb-look-up-stack nil)) 2112 2113(defun gdb-set-hollow () 2114 (if gud-last-last-frame 2115 (with-current-buffer (gud-find-file (car gud-last-last-frame)) 2116 (setq fringe-indicator-alist 2117 '((overlay-arrow . hollow-right-triangle)))))) 2118 2119(defun gdb-stack-buffer-name () 2120 (with-current-buffer gud-comint-buffer 2121 (concat "*stack frames of " (gdb-get-target-string) "*"))) 2122 2123(defun gdb-display-stack-buffer () 2124 "Display backtrace of current stack." 2125 (interactive) 2126 (gdb-display-buffer 2127 (gdb-get-buffer-create 'gdb-stack-buffer) t)) 2128 2129(defun gdb-frame-stack-buffer () 2130 "Display backtrace of current stack in a new frame." 2131 (interactive) 2132 (let ((special-display-regexps (append special-display-regexps '(".*"))) 2133 (special-display-frame-alist gdb-frame-parameters)) 2134 (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer)))) 2135 2136(defvar gdb-frames-mode-map 2137 (let ((map (make-sparse-keymap))) 2138 (suppress-keymap map) 2139 (define-key map "q" 'kill-this-buffer) 2140 (define-key map "\r" 'gdb-frames-select) 2141 (define-key map [mouse-2] 'gdb-frames-select) 2142 (define-key map [follow-link] 'mouse-face) 2143 map)) 2144 2145(defun gdb-frames-mode () 2146 "Major mode for gdb call stack. 2147 2148\\{gdb-frames-mode-map}" 2149 (kill-all-local-variables) 2150 (setq major-mode 'gdb-frames-mode) 2151 (setq mode-name "Frames") 2152 (setq gdb-stack-position nil) 2153 (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) 2154 (setq truncate-lines t) ;; Make it easier to see overlay arrow. 2155 (setq buffer-read-only t) 2156 (use-local-map gdb-frames-mode-map) 2157 (run-mode-hooks 'gdb-frames-mode-hook) 2158 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 2159 'gdb-invalidate-frames 2160 'gdbmi-invalidate-frames)) 2161 2162(defun gdb-get-frame-number () 2163 (save-excursion 2164 (end-of-line) 2165 (let* ((start (line-beginning-position)) 2166 (pos (re-search-backward "^#*\\([0-9]+\\)" start t)) 2167 (n (or (and pos (match-string 1)) "0"))) 2168 n))) 2169 2170(defun gdb-frames-select (&optional event) 2171 "Select the frame and display the relevant source." 2172 (interactive (list last-input-event)) 2173 (if event (posn-set-point (event-end event))) 2174 (if (get-text-property (point) 'gdb-max-frames) 2175 (progn 2176 (message-box "After setting gdb-max-frames, you need to enter\n\ 2177another GDB command e.g pwd, to see new frames") 2178 (customize-variable-other-window 'gdb-max-frames)) 2179 (gdb-enqueue-input 2180 (list (concat gdb-server-prefix "frame " 2181 (gdb-get-frame-number) "\n") 'ignore)))) 2182 2183 2184;; Threads buffer. This displays a selectable thread list. 2185;; 2186(gdb-set-buffer-rules 'gdb-threads-buffer 2187 'gdb-threads-buffer-name 2188 'gdb-threads-mode) 2189 2190(def-gdb-auto-updated-buffer gdb-threads-buffer 2191 gdb-invalidate-threads 2192 (concat gdb-server-prefix "info threads\n") 2193 gdb-info-threads-handler 2194 gdb-info-threads-custom) 2195 2196(defun gdb-info-threads-custom () 2197 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer) 2198 (let ((buffer-read-only nil)) 2199 (save-excursion 2200 (goto-char (point-min)) 2201 (while (< (point) (point-max)) 2202 (unless (looking-at "No ") 2203 (add-text-properties (line-beginning-position) (line-end-position) 2204 '(mouse-face highlight 2205 help-echo "mouse-2, RET: select thread"))) 2206 (forward-line 1)))))) 2207 2208(defun gdb-threads-buffer-name () 2209 (with-current-buffer gud-comint-buffer 2210 (concat "*threads of " (gdb-get-target-string) "*"))) 2211 2212(defun gdb-display-threads-buffer () 2213 "Display IDs of currently known threads." 2214 (interactive) 2215 (gdb-display-buffer 2216 (gdb-get-buffer-create 'gdb-threads-buffer) t)) 2217 2218(defun gdb-frame-threads-buffer () 2219 "Display IDs of currently known threads in a new frame." 2220 (interactive) 2221 (let ((special-display-regexps (append special-display-regexps '(".*"))) 2222 (special-display-frame-alist gdb-frame-parameters)) 2223 (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer)))) 2224 2225(defvar gdb-threads-mode-map 2226 (let ((map (make-sparse-keymap))) 2227 (suppress-keymap map) 2228 (define-key map "q" 'kill-this-buffer) 2229 (define-key map "\r" 'gdb-threads-select) 2230 (define-key map [mouse-2] 'gdb-threads-select) 2231 (define-key map [follow-link] 'mouse-face) 2232 map)) 2233 2234(defvar gdb-threads-font-lock-keywords 2235 '((") +\\([^ ]+\\) (" (1 font-lock-function-name-face)) 2236 ("in \\([^ ]+\\) (" (1 font-lock-function-name-face)) 2237 ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face))) 2238 "Font lock keywords used in `gdb-threads-mode'.") 2239 2240(defun gdb-threads-mode () 2241 "Major mode for gdb threads. 2242 2243\\{gdb-threads-mode-map}" 2244 (kill-all-local-variables) 2245 (setq major-mode 'gdb-threads-mode) 2246 (setq mode-name "Threads") 2247 (setq buffer-read-only t) 2248 (use-local-map gdb-threads-mode-map) 2249 (set (make-local-variable 'font-lock-defaults) 2250 '(gdb-threads-font-lock-keywords)) 2251 (run-mode-hooks 'gdb-threads-mode-hook) 2252 'gdb-invalidate-threads) 2253 2254(defun gdb-get-thread-number () 2255 (save-excursion 2256 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t) 2257 (match-string-no-properties 1))) 2258 2259(defun gdb-threads-select (&optional event) 2260 "Select the thread and display the relevant source." 2261 (interactive (list last-input-event)) 2262 (if event (posn-set-point (event-end event))) 2263 (gdb-enqueue-input 2264 (list (concat gdb-server-prefix "thread " 2265 (gdb-get-thread-number) "\n") 'ignore)) 2266 (gud-display-frame)) 2267 2268 2269;; Registers buffer. 2270;; 2271(defcustom gdb-all-registers nil 2272 "Non-nil means include floating-point registers." 2273 :type 'boolean 2274 :group 'gud 2275 :version "22.1") 2276 2277(gdb-set-buffer-rules 'gdb-registers-buffer 2278 'gdb-registers-buffer-name 2279 'gdb-registers-mode) 2280 2281(def-gdb-auto-updated-buffer gdb-registers-buffer 2282 gdb-invalidate-registers 2283 (concat 2284 gdb-server-prefix "info " (if gdb-all-registers "all-") "registers\n") 2285 gdb-info-registers-handler 2286 gdb-info-registers-custom) 2287 2288(defun gdb-info-registers-custom () 2289 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) 2290 (save-excursion 2291 (let ((buffer-read-only nil) 2292 start end) 2293 (goto-char (point-min)) 2294 (while (< (point) (point-max)) 2295 (setq start (line-beginning-position)) 2296 (setq end (line-end-position)) 2297 (when (looking-at "^[^ ]+") 2298 (unless (string-equal (match-string 0) "The") 2299 (put-text-property start (match-end 0) 2300 'face font-lock-variable-name-face) 2301 (add-text-properties start end 2302 '(help-echo "mouse-2: edit value" 2303 mouse-face highlight)))) 2304 (forward-line 1)))))) 2305 2306(defun gdb-edit-register-value (&optional event) 2307 (interactive (list last-input-event)) 2308 (save-excursion 2309 (if event (posn-set-point (event-end event))) 2310 (beginning-of-line) 2311 (let* ((register (current-word)) 2312 (value (read-string (format "New value (%s): " register)))) 2313 (gdb-enqueue-input 2314 (list (concat gdb-server-prefix "set $" register "=" value "\n") 2315 'ignore))))) 2316 2317(defvar gdb-registers-mode-map 2318 (let ((map (make-sparse-keymap))) 2319 (suppress-keymap map) 2320 (define-key map "\r" 'gdb-edit-register-value) 2321 (define-key map [mouse-2] 'gdb-edit-register-value) 2322 (define-key map " " 'gdb-all-registers) 2323 (define-key map "q" 'kill-this-buffer) 2324 map)) 2325 2326(defun gdb-registers-mode () 2327 "Major mode for gdb registers. 2328 2329\\{gdb-registers-mode-map}" 2330 (kill-all-local-variables) 2331 (setq major-mode 'gdb-registers-mode) 2332 (setq mode-name "Registers") 2333 (setq buffer-read-only t) 2334 (use-local-map gdb-registers-mode-map) 2335 (run-mode-hooks 'gdb-registers-mode-hook) 2336 (if (string-equal gdb-version "pre-6.4") 2337 (progn 2338 (if gdb-all-registers (setq mode-name "Registers:All")) 2339 'gdb-invalidate-registers) 2340 'gdb-invalidate-registers-1)) 2341 2342(defun gdb-registers-buffer-name () 2343 (with-current-buffer gud-comint-buffer 2344 (concat "*registers of " (gdb-get-target-string) "*"))) 2345 2346(defun gdb-display-registers-buffer () 2347 "Display integer register contents." 2348 (interactive) 2349 (gdb-display-buffer 2350 (gdb-get-buffer-create 'gdb-registers-buffer) t)) 2351 2352(defun gdb-frame-registers-buffer () 2353 "Display integer register contents in a new frame." 2354 (interactive) 2355 (let ((special-display-regexps (append special-display-regexps '(".*"))) 2356 (special-display-frame-alist gdb-frame-parameters)) 2357 (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer)))) 2358 2359(defun gdb-all-registers () 2360 "Toggle the display of floating-point registers (pre GDB 6.4 only)." 2361 (interactive) 2362 (when (string-equal gdb-version "pre-6.4") 2363 (if gdb-all-registers 2364 (progn 2365 (setq gdb-all-registers nil) 2366 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer) 2367 (setq mode-name "Registers"))) 2368 (setq gdb-all-registers t) 2369 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer) 2370 (setq mode-name "Registers:All"))) 2371 (message (format "Display of floating-point registers %sabled" 2372 (if gdb-all-registers "en" "dis"))) 2373 (gdb-invalidate-registers))) 2374 2375 2376;; Memory buffer. 2377;; 2378(defcustom gdb-memory-repeat-count 32 2379 "Number of data items in memory window." 2380 :type 'integer 2381 :group 'gud 2382 :version "22.1") 2383 2384(defcustom gdb-memory-format "x" 2385 "Display format of data items in memory window." 2386 :type '(choice (const :tag "Hexadecimal" "x") 2387 (const :tag "Signed decimal" "d") 2388 (const :tag "Unsigned decimal" "u") 2389 (const :tag "Octal" "o") 2390 (const :tag "Binary" "t")) 2391 :group 'gud 2392 :version "22.1") 2393 2394(defcustom gdb-memory-unit "w" 2395 "Unit size of data items in memory window." 2396 :type '(choice (const :tag "Byte" "b") 2397 (const :tag "Halfword" "h") 2398 (const :tag "Word" "w") 2399 (const :tag "Giant word" "g")) 2400 :group 'gud 2401 :version "22.1") 2402 2403(gdb-set-buffer-rules 'gdb-memory-buffer 2404 'gdb-memory-buffer-name 2405 'gdb-memory-mode) 2406 2407(def-gdb-auto-updated-buffer gdb-memory-buffer 2408 gdb-invalidate-memory 2409 (concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count) 2410 gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n") 2411 gdb-read-memory-handler 2412 gdb-read-memory-custom) 2413 2414(defun gdb-read-memory-custom () 2415 (save-excursion 2416 (goto-char (point-min)) 2417 (if (looking-at "0x[[:xdigit:]]+") 2418 (setq gdb-memory-address (match-string 0))))) 2419 2420(defvar gdb-memory-mode-map 2421 (let ((map (make-sparse-keymap))) 2422 (suppress-keymap map) 2423 (define-key map "q" 'kill-this-buffer) 2424 map)) 2425 2426(defun gdb-memory-set-address (event) 2427 "Set the start memory address." 2428 (interactive "e") 2429 (save-selected-window 2430 (select-window (posn-window (event-start event))) 2431 (let ((arg (read-from-minibuffer "Memory address: "))) 2432 (setq gdb-memory-address arg)) 2433 (gdb-invalidate-memory))) 2434 2435(defun gdb-memory-set-repeat-count (event) 2436 "Set the number of data items in memory window." 2437 (interactive "e") 2438 (save-selected-window 2439 (select-window (posn-window (event-start event))) 2440 (let* ((arg (read-from-minibuffer "Repeat count: ")) 2441 (count (string-to-number arg))) 2442 (if (<= count 0) 2443 (error "Positive numbers only") 2444 (customize-set-variable 'gdb-memory-repeat-count count) 2445 (gdb-invalidate-memory))))) 2446 2447(defun gdb-memory-format-binary () 2448 "Set the display format to binary." 2449 (interactive) 2450 (customize-set-variable 'gdb-memory-format "t") 2451 (gdb-invalidate-memory)) 2452 2453(defun gdb-memory-format-octal () 2454 "Set the display format to octal." 2455 (interactive) 2456 (customize-set-variable 'gdb-memory-format "o") 2457 (gdb-invalidate-memory)) 2458 2459(defun gdb-memory-format-unsigned () 2460 "Set the display format to unsigned decimal." 2461 (interactive) 2462 (customize-set-variable 'gdb-memory-format "u") 2463 (gdb-invalidate-memory)) 2464 2465(defun gdb-memory-format-signed () 2466 "Set the display format to decimal." 2467 (interactive) 2468 (customize-set-variable 'gdb-memory-format "d") 2469 (gdb-invalidate-memory)) 2470 2471(defun gdb-memory-format-hexadecimal () 2472 "Set the display format to hexadecimal." 2473 (interactive) 2474 (customize-set-variable 'gdb-memory-format "x") 2475 (gdb-invalidate-memory)) 2476 2477(defvar gdb-memory-format-map 2478 (let ((map (make-sparse-keymap))) 2479 (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1) 2480 map) 2481 "Keymap to select format in the header line.") 2482 2483(defvar gdb-memory-format-menu (make-sparse-keymap "Format") 2484 "Menu of display formats in the header line.") 2485 2486(define-key gdb-memory-format-menu [binary] 2487 '(menu-item "Binary" gdb-memory-format-binary 2488 :button (:radio . (equal gdb-memory-format "t")))) 2489(define-key gdb-memory-format-menu [octal] 2490 '(menu-item "Octal" gdb-memory-format-octal 2491 :button (:radio . (equal gdb-memory-format "o")))) 2492(define-key gdb-memory-format-menu [unsigned] 2493 '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned 2494 :button (:radio . (equal gdb-memory-format "u")))) 2495(define-key gdb-memory-format-menu [signed] 2496 '(menu-item "Signed Decimal" gdb-memory-format-signed 2497 :button (:radio . (equal gdb-memory-format "d")))) 2498(define-key gdb-memory-format-menu [hexadecimal] 2499 '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal 2500 :button (:radio . (equal gdb-memory-format "x")))) 2501 2502(defun gdb-memory-format-menu (event) 2503 (interactive "@e") 2504 (x-popup-menu event gdb-memory-format-menu)) 2505 2506(defun gdb-memory-format-menu-1 (event) 2507 (interactive "e") 2508 (save-selected-window 2509 (select-window (posn-window (event-start event))) 2510 (let* ((selection (gdb-memory-format-menu event)) 2511 (binding (and selection (lookup-key gdb-memory-format-menu 2512 (vector (car selection)))))) 2513 (if binding (call-interactively binding))))) 2514 2515(defun gdb-memory-unit-giant () 2516 "Set the unit size to giant words (eight bytes)." 2517 (interactive) 2518 (customize-set-variable 'gdb-memory-unit "g") 2519 (gdb-invalidate-memory)) 2520 2521(defun gdb-memory-unit-word () 2522 "Set the unit size to words (four bytes)." 2523 (interactive) 2524 (customize-set-variable 'gdb-memory-unit "w") 2525 (gdb-invalidate-memory)) 2526 2527(defun gdb-memory-unit-halfword () 2528 "Set the unit size to halfwords (two bytes)." 2529 (interactive) 2530 (customize-set-variable 'gdb-memory-unit "h") 2531 (gdb-invalidate-memory)) 2532 2533(defun gdb-memory-unit-byte () 2534 "Set the unit size to bytes." 2535 (interactive) 2536 (customize-set-variable 'gdb-memory-unit "b") 2537 (gdb-invalidate-memory)) 2538 2539(defvar gdb-memory-unit-map 2540 (let ((map (make-sparse-keymap))) 2541 (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1) 2542 map) 2543 "Keymap to select units in the header line.") 2544 2545(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit") 2546 "Menu of units in the header line.") 2547 2548(define-key gdb-memory-unit-menu [giantwords] 2549 '(menu-item "Giant words" gdb-memory-unit-giant 2550 :button (:radio . (equal gdb-memory-unit "g")))) 2551(define-key gdb-memory-unit-menu [words] 2552 '(menu-item "Words" gdb-memory-unit-word 2553 :button (:radio . (equal gdb-memory-unit "w")))) 2554(define-key gdb-memory-unit-menu [halfwords] 2555 '(menu-item "Halfwords" gdb-memory-unit-halfword 2556 :button (:radio . (equal gdb-memory-unit "h")))) 2557(define-key gdb-memory-unit-menu [bytes] 2558 '(menu-item "Bytes" gdb-memory-unit-byte 2559 :button (:radio . (equal gdb-memory-unit "b")))) 2560 2561(defun gdb-memory-unit-menu (event) 2562 (interactive "@e") 2563 (x-popup-menu event gdb-memory-unit-menu)) 2564 2565(defun gdb-memory-unit-menu-1 (event) 2566 (interactive "e") 2567 (save-selected-window 2568 (select-window (posn-window (event-start event))) 2569 (let* ((selection (gdb-memory-unit-menu event)) 2570 (binding (and selection (lookup-key gdb-memory-unit-menu 2571 (vector (car selection)))))) 2572 (if binding (call-interactively binding))))) 2573 2574;;from make-mode-line-mouse-map 2575(defun gdb-make-header-line-mouse-map (mouse function) "\ 2576Return a keymap with single entry for mouse key MOUSE on the header line. 2577MOUSE is defined to run function FUNCTION with no args in the buffer 2578corresponding to the mode line clicked." 2579 (let ((map (make-sparse-keymap))) 2580 (define-key map (vector 'header-line mouse) function) 2581 (define-key map (vector 'header-line 'down-mouse-1) 'ignore) 2582 map)) 2583 2584(defvar gdb-memory-font-lock-keywords 2585 '(;; <__function.name+n> 2586 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face)) 2587 ) 2588 "Font lock keywords used in `gdb-memory-mode'.") 2589 2590(defun gdb-memory-mode () 2591 "Major mode for examining memory. 2592 2593\\{gdb-memory-mode-map}" 2594 (kill-all-local-variables) 2595 (setq major-mode 'gdb-memory-mode) 2596 (setq mode-name "Memory") 2597 (setq buffer-read-only t) 2598 (use-local-map gdb-memory-mode-map) 2599 (setq header-line-format 2600 '(:eval 2601 (concat 2602 "Read address[" 2603 (propertize 2604 "-" 2605 'face font-lock-warning-face 2606 'help-echo "mouse-1: decrement address" 2607 'mouse-face 'mode-line-highlight 2608 'local-map 2609 (gdb-make-header-line-mouse-map 2610 'mouse-1 2611 (lambda () (interactive) 2612 (let ((gdb-memory-address 2613 ;; Let GDB do the arithmetic. 2614 (concat 2615 gdb-memory-address " - " 2616 (number-to-string 2617 (* gdb-memory-repeat-count 2618 (cond ((string= gdb-memory-unit "b") 1) 2619 ((string= gdb-memory-unit "h") 2) 2620 ((string= gdb-memory-unit "w") 4) 2621 ((string= gdb-memory-unit "g") 8))))))) 2622 (gdb-invalidate-memory))))) 2623 "|" 2624 (propertize "+" 2625 'face font-lock-warning-face 2626 'help-echo "mouse-1: increment address" 2627 'mouse-face 'mode-line-highlight 2628 'local-map (gdb-make-header-line-mouse-map 2629 'mouse-1 2630 (lambda () (interactive) 2631 (let ((gdb-memory-address nil)) 2632 (gdb-invalidate-memory))))) 2633 "]: " 2634 (propertize gdb-memory-address 2635 'face font-lock-warning-face 2636 'help-echo "mouse-1: set memory address" 2637 'mouse-face 'mode-line-highlight 2638 'local-map (gdb-make-header-line-mouse-map 2639 'mouse-1 2640 #'gdb-memory-set-address)) 2641 " Repeat Count: " 2642 (propertize (number-to-string gdb-memory-repeat-count) 2643 'face font-lock-warning-face 2644 'help-echo "mouse-1: set repeat count" 2645 'mouse-face 'mode-line-highlight 2646 'local-map (gdb-make-header-line-mouse-map 2647 'mouse-1 2648 #'gdb-memory-set-repeat-count)) 2649 " Display Format: " 2650 (propertize gdb-memory-format 2651 'face font-lock-warning-face 2652 'help-echo "mouse-3: select display format" 2653 'mouse-face 'mode-line-highlight 2654 'local-map gdb-memory-format-map) 2655 " Unit Size: " 2656 (propertize gdb-memory-unit 2657 'face font-lock-warning-face 2658 'help-echo "mouse-3: select unit size" 2659 'mouse-face 'mode-line-highlight 2660 'local-map gdb-memory-unit-map)))) 2661 (set (make-local-variable 'font-lock-defaults) 2662 '(gdb-memory-font-lock-keywords)) 2663 (run-mode-hooks 'gdb-memory-mode-hook) 2664 'gdb-invalidate-memory) 2665 2666(defun gdb-memory-buffer-name () 2667 (with-current-buffer gud-comint-buffer 2668 (concat "*memory of " (gdb-get-target-string) "*"))) 2669 2670(defun gdb-display-memory-buffer () 2671 "Display memory contents." 2672 (interactive) 2673 (gdb-display-buffer 2674 (gdb-get-buffer-create 'gdb-memory-buffer) t)) 2675 2676(defun gdb-frame-memory-buffer () 2677 "Display memory contents in a new frame." 2678 (interactive) 2679 (let* ((special-display-regexps (append special-display-regexps '(".*"))) 2680 (special-display-frame-alist 2681 (cons '(left-fringe . 0) 2682 (cons '(right-fringe . 0) 2683 (cons '(width . 83) gdb-frame-parameters))))) 2684 (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) 2685 2686 2687;; Locals buffer. 2688;; 2689(gdb-set-buffer-rules 'gdb-locals-buffer 2690 'gdb-locals-buffer-name 2691 'gdb-locals-mode) 2692 2693(def-gdb-auto-update-trigger gdb-invalidate-locals 2694 (gdb-get-buffer 'gdb-locals-buffer) 2695 "server info locals\n" 2696 gdb-info-locals-handler) 2697 2698(defvar gdb-locals-watch-map 2699 (let ((map (make-sparse-keymap))) 2700 (suppress-keymap map) 2701 (define-key map "\r" (lambda () (interactive) 2702 (beginning-of-line) 2703 (gud-watch))) 2704 (define-key map [mouse-2] (lambda (event) (interactive "e") 2705 (mouse-set-point event) 2706 (beginning-of-line) 2707 (gud-watch))) 2708 map) 2709 "Keymap to create watch expression of a complex data type local variable.") 2710 2711(defconst gdb-struct-string 2712 (concat (propertize "[struct/union]" 2713 'mouse-face 'highlight 2714 'help-echo "mouse-2: create watch expression" 2715 'local-map gdb-locals-watch-map) "\n")) 2716 2717(defconst gdb-array-string 2718 (concat " " (propertize "[array]" 2719 'mouse-face 'highlight 2720 'help-echo "mouse-2: create watch expression" 2721 'local-map gdb-locals-watch-map) "\n")) 2722 2723;; Abbreviate for arrays and structures. 2724;; These can be expanded using gud-display. 2725(defun gdb-info-locals-handler () 2726 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals 2727 gdb-pending-triggers)) 2728 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) 2729 (with-current-buffer buf 2730 (goto-char (point-min)) 2731 (while (re-search-forward "^[ }].*\n" nil t) 2732 (replace-match "" nil nil)) 2733 (goto-char (point-min)) 2734 (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t) 2735 (replace-match gdb-struct-string nil nil)) 2736 (goto-char (point-min)) 2737 (while (re-search-forward "\\s-*{.*\n" nil t) 2738 (replace-match gdb-array-string nil nil)))) 2739 (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) 2740 (and buf 2741 (with-current-buffer buf 2742 (let* ((window (get-buffer-window buf 0)) 2743 (start (window-start window)) 2744 (p (window-point window)) 2745 (buffer-read-only nil)) 2746 (erase-buffer) 2747 (insert-buffer-substring (gdb-get-buffer-create 2748 'gdb-partial-output-buffer)) 2749 (set-window-start window start) 2750 (set-window-point window p)) 2751))) 2752 (run-hooks 'gdb-info-locals-hook)) 2753 2754(defvar gdb-locals-mode-map 2755 (let ((map (make-sparse-keymap))) 2756 (suppress-keymap map) 2757 (define-key map "q" 'kill-this-buffer) 2758 map)) 2759 2760(defun gdb-locals-mode () 2761 "Major mode for gdb locals. 2762 2763\\{gdb-locals-mode-map}" 2764 (kill-all-local-variables) 2765 (setq major-mode 'gdb-locals-mode) 2766 (setq mode-name (concat "Locals:" gdb-selected-frame)) 2767 (setq buffer-read-only t) 2768 (use-local-map gdb-locals-mode-map) 2769 (set (make-local-variable 'font-lock-defaults) 2770 '(gdb-locals-font-lock-keywords)) 2771 (run-mode-hooks 'gdb-locals-mode-hook) 2772 (if (and (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 2773 (string-equal gdb-version "pre-6.4")) 2774 'gdb-invalidate-locals 2775 'gdb-invalidate-locals-1)) 2776 2777(defun gdb-locals-buffer-name () 2778 (with-current-buffer gud-comint-buffer 2779 (concat "*locals of " (gdb-get-target-string) "*"))) 2780 2781(defun gdb-display-locals-buffer () 2782 "Display local variables of current stack and their values." 2783 (interactive) 2784 (gdb-display-buffer 2785 (gdb-get-buffer-create 'gdb-locals-buffer) t)) 2786 2787(defun gdb-frame-locals-buffer () 2788 "Display local variables of current stack and their values in a new frame." 2789 (interactive) 2790 (let ((special-display-regexps (append special-display-regexps '(".*"))) 2791 (special-display-frame-alist gdb-frame-parameters)) 2792 (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer)))) 2793 2794 2795;;;; Window management 2796(defun gdb-display-buffer (buf dedicated &optional size) 2797 (let ((answer (get-buffer-window buf 0)) 2798 (must-split nil)) 2799 (if answer 2800 (display-buffer buf nil 0) ;Raise the frame if necessary. 2801 ;; The buffer is not yet displayed. 2802 (pop-to-buffer gud-comint-buffer) ;Select the right frame. 2803 (let ((window (get-lru-window))) 2804 (if (and window 2805 (not (memq window `(,(get-buffer-window gud-comint-buffer) 2806 ,gdb-source-window)))) 2807 (progn 2808 (set-window-buffer window buf) 2809 (setq answer window)) 2810 (setq must-split t))) 2811 (if must-split 2812 (let* ((largest (get-largest-window)) 2813 (cur-size (window-height largest)) 2814 (new-size (and size (< size cur-size) (- cur-size size)))) 2815 (setq answer (split-window largest new-size)) 2816 (set-window-buffer answer buf) 2817 (set-window-dedicated-p answer dedicated))) 2818 answer))) 2819 2820 2821;;; Shared keymap initialization: 2822 2823(let ((menu (make-sparse-keymap "GDB-Windows"))) 2824 (define-key gud-menu-map [displays] 2825 `(menu-item "GDB-Windows" ,menu 2826 :visible (memq gud-minor-mode '(gdbmi gdba)))) 2827 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) 2828 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) 2829 (define-key menu [inferior] 2830 '(menu-item "Separate IO" gdb-display-separate-io-buffer 2831 :enable gdb-use-separate-io-buffer)) 2832 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) 2833 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) 2834 (define-key menu [disassembly] 2835 '("Disassembly" . gdb-display-assembler-buffer)) 2836 (define-key menu [breakpoints] 2837 '("Breakpoints" . gdb-display-breakpoints-buffer)) 2838 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) 2839 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))) 2840 2841(let ((menu (make-sparse-keymap "GDB-Frames"))) 2842 (define-key gud-menu-map [frames] 2843 `(menu-item "GDB-Frames" ,menu 2844 :visible (memq gud-minor-mode '(gdbmi gdba)))) 2845 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) 2846 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) 2847 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) 2848 (define-key menu [inferior] 2849 '(menu-item "Separate IO" gdb-frame-separate-io-buffer 2850 :enable gdb-use-separate-io-buffer)) 2851 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) 2852 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer)) 2853 (define-key menu [breakpoints] 2854 '("Breakpoints" . gdb-frame-breakpoints-buffer)) 2855 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) 2856 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))) 2857 2858(let ((menu (make-sparse-keymap "GDB-UI/MI"))) 2859 (define-key gud-menu-map [ui] 2860 `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI") 2861 ,menu :visible (memq gud-minor-mode '(gdbmi gdba)))) 2862 (define-key menu [gdb-find-source-frame] 2863 '(menu-item "Look For Source Frame" gdb-find-source-frame 2864 :visible (eq gud-minor-mode 'gdba) 2865 :help "Toggle look for source frame." 2866 :button (:toggle . gdb-find-source-frame))) 2867 (define-key menu [gdb-use-separate-io] 2868 '(menu-item "Separate IO" gdb-use-separate-io-buffer 2869 :visible (eq gud-minor-mode 'gdba) 2870 :help "Toggle separate IO for debugged program." 2871 :button (:toggle . gdb-use-separate-io-buffer))) 2872 (define-key menu [gdb-many-windows] 2873 '(menu-item "Display Other Windows" gdb-many-windows 2874 :help "Toggle display of locals, stack and breakpoint information" 2875 :button (:toggle . gdb-many-windows))) 2876 (define-key menu [gdb-restore-windows] 2877 '(menu-item "Restore Window Layout" gdb-restore-windows 2878 :help "Restore standard layout for debug session."))) 2879 2880(defun gdb-frame-gdb-buffer () 2881 "Display GUD buffer in a new frame." 2882 (interactive) 2883 (let ((special-display-regexps (append special-display-regexps '(".*"))) 2884 (special-display-frame-alist 2885 (remove '(menu-bar-lines) (remove '(tool-bar-lines) 2886 gdb-frame-parameters))) 2887 (same-window-regexps nil)) 2888 (display-buffer gud-comint-buffer))) 2889 2890(defun gdb-display-gdb-buffer () 2891 "Display GUD buffer." 2892 (interactive) 2893 (let ((same-window-regexps nil)) 2894 (pop-to-buffer gud-comint-buffer))) 2895 2896(defun gdb-set-window-buffer (name) 2897 (set-window-buffer (selected-window) (get-buffer name)) 2898 (set-window-dedicated-p (selected-window) t)) 2899 2900(defun gdb-setup-windows () 2901 "Layout the window pattern for `gdb-many-windows'." 2902 (gdb-display-locals-buffer) 2903 (gdb-display-stack-buffer) 2904 (delete-other-windows) 2905 (gdb-display-breakpoints-buffer) 2906 (delete-other-windows) 2907 ; Don't dedicate. 2908 (pop-to-buffer gud-comint-buffer) 2909 (split-window nil ( / ( * (window-height) 3) 4)) 2910 (split-window nil ( / (window-height) 3)) 2911 (split-window-horizontally) 2912 (other-window 1) 2913 (gdb-set-window-buffer (gdb-locals-buffer-name)) 2914 (other-window 1) 2915 (switch-to-buffer 2916 (if gud-last-last-frame 2917 (gud-find-file (car gud-last-last-frame)) 2918 (if gdb-main-file 2919 (gud-find-file gdb-main-file) 2920 ;; Put buffer list in window if we 2921 ;; can't find a source file. 2922 (list-buffers-noselect)))) 2923 (setq gdb-source-window (selected-window)) 2924 (when gdb-use-separate-io-buffer 2925 (split-window-horizontally) 2926 (other-window 1) 2927 (gdb-set-window-buffer 2928 (gdb-get-buffer-create 'gdb-inferior-io))) 2929 (other-window 1) 2930 (gdb-set-window-buffer (gdb-stack-buffer-name)) 2931 (split-window-horizontally) 2932 (other-window 1) 2933 (gdb-set-window-buffer (gdb-breakpoints-buffer-name)) 2934 (other-window 1)) 2935 2936(defun gdb-restore-windows () 2937 "Restore the basic arrangement of windows used by gdba. 2938This arrangement depends on the value of `gdb-many-windows'." 2939 (interactive) 2940 (pop-to-buffer gud-comint-buffer) ;Select the right window and frame. 2941 (delete-other-windows) 2942 (if gdb-many-windows 2943 (gdb-setup-windows) 2944 (when (or gud-last-last-frame gdb-show-main) 2945 (split-window) 2946 (other-window 1) 2947 (switch-to-buffer 2948 (if gud-last-last-frame 2949 (gud-find-file (car gud-last-last-frame)) 2950 (gud-find-file gdb-main-file))) 2951 (setq gdb-source-window (selected-window)) 2952 (other-window 1)))) 2953 2954(defun gdb-reset () 2955 "Exit a debugging session cleanly. 2956Kills the gdb buffers, and resets variables and the source buffers." 2957 (dolist (buffer (buffer-list)) 2958 (unless (eq buffer gud-comint-buffer) 2959 (with-current-buffer buffer 2960 (if (memq gud-minor-mode '(gdbmi gdba)) 2961 (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name)) 2962 (kill-buffer nil) 2963 (gdb-remove-breakpoint-icons (point-min) (point-max) t) 2964 (setq gud-minor-mode nil) 2965 (kill-local-variable 'tool-bar-map) 2966 (kill-local-variable 'gdb-define-alist)))))) 2967 (setq gdb-overlay-arrow-position nil) 2968 (setq overlay-arrow-variable-list 2969 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) 2970 (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) 2971 (setq gdb-stack-position nil) 2972 (setq overlay-arrow-variable-list 2973 (delq 'gdb-stack-position overlay-arrow-variable-list)) 2974 (if (boundp 'speedbar-frame) (speedbar-timer-fn)) 2975 (setq gud-running nil) 2976 (setq gdb-active-process nil) 2977 (setq gdb-var-list nil) 2978 (remove-hook 'after-save-hook 'gdb-create-define-alist t)) 2979 2980(defun gdb-source-info () 2981 "Find the source file where the program starts and displays it with related 2982buffers." 2983 (goto-char (point-min)) 2984 (if (and (search-forward "Located in " nil t) 2985 (looking-at "\\S-+")) 2986 (setq gdb-main-file (match-string 0))) 2987 (goto-char (point-min)) 2988 (if (search-forward "Includes preprocessor macro info." nil t) 2989 (setq gdb-macro-info t)) 2990 (if gdb-many-windows 2991 (gdb-setup-windows) 2992 (gdb-get-buffer-create 'gdb-breakpoints-buffer) 2993 (if gdb-show-main 2994 (let ((pop-up-windows t)) 2995 (display-buffer (gud-find-file gdb-main-file)))))) 2996 2997(defun gdb-get-location (bptno line flag) 2998 "Find the directory containing the relevant source file. 2999Put in buffer and place breakpoint icon." 3000 (goto-char (point-min)) 3001 (catch 'file-not-found 3002 (if (search-forward "Located in " nil t) 3003 (when (looking-at "\\S-+") 3004 (delete (cons bptno "File not found") gdb-location-alist) 3005 (push (cons bptno (match-string 0)) gdb-location-alist)) 3006 (gdb-resync) 3007 (unless (assoc bptno gdb-location-alist) 3008 (push (cons bptno "File not found") gdb-location-alist) 3009 (message-box "Cannot find source file for breakpoint location.\n\ 3010Add directory to search path for source files using the GDB command, dir.")) 3011 (throw 'file-not-found nil)) 3012 (with-current-buffer 3013 (find-file-noselect (match-string 0)) 3014 (save-current-buffer 3015 (set (make-local-variable 'gud-minor-mode) 'gdba) 3016 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)) 3017 ;; only want one breakpoint icon at each location 3018 (save-excursion 3019 (goto-line (string-to-number line)) 3020 (gdb-put-breakpoint-icon (eq flag ?y) bptno))))) 3021 3022(add-hook 'find-file-hook 'gdb-find-file-hook) 3023 3024(defun gdb-find-file-hook () 3025 "Set up buffer for debugging if file is part of the source code 3026of the current session." 3027 (if (and (buffer-name gud-comint-buffer) 3028 ;; in case gud or gdb-ui is just loaded 3029 gud-comint-buffer 3030 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 3031 '(gdba gdbmi))) 3032 ;;Pre GDB 6.3 "info sources" doesn't give absolute file name. 3033 (if (member (if (string-equal gdb-version "pre-6.4") 3034 (file-name-nondirectory buffer-file-name) 3035 buffer-file-name) 3036 gdb-source-file-list) 3037 (with-current-buffer (find-buffer-visiting buffer-file-name) 3038 (set (make-local-variable 'gud-minor-mode) 3039 (buffer-local-value 'gud-minor-mode gud-comint-buffer)) 3040 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))))) 3041 3042;;from put-image 3043(defun gdb-put-string (putstring pos &optional dprop &rest sprops) 3044 "Put string PUTSTRING in front of POS in the current buffer. 3045PUTSTRING is displayed by putting an overlay into the current buffer with a 3046`before-string' string that has a `display' property whose value is 3047PUTSTRING." 3048 (let ((string (make-string 1 ?x)) 3049 (buffer (current-buffer))) 3050 (setq putstring (copy-sequence putstring)) 3051 (let ((overlay (make-overlay pos pos buffer)) 3052 (prop (or dprop 3053 (list (list 'margin 'left-margin) putstring)))) 3054 (put-text-property 0 1 'display prop string) 3055 (if sprops 3056 (add-text-properties 0 1 sprops string)) 3057 (overlay-put overlay 'put-break t) 3058 (overlay-put overlay 'before-string string)))) 3059 3060;;from remove-images 3061(defun gdb-remove-strings (start end &optional buffer) 3062 "Remove strings between START and END in BUFFER. 3063Remove only strings that were put in BUFFER with calls to `gdb-put-string'. 3064BUFFER nil or omitted means use the current buffer." 3065 (unless buffer 3066 (setq buffer (current-buffer))) 3067 (dolist (overlay (overlays-in start end)) 3068 (when (overlay-get overlay 'put-break) 3069 (delete-overlay overlay)))) 3070 3071(defun gdb-put-breakpoint-icon (enabled bptno) 3072 (let ((start (- (line-beginning-position) 1)) 3073 (end (+ (line-end-position) 1)) 3074 (putstring (if enabled "B" "b")) 3075 (source-window (get-buffer-window (current-buffer) 0))) 3076 (add-text-properties 3077 0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt") 3078 putstring) 3079 (if enabled 3080 (add-text-properties 3081 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring) 3082 (add-text-properties 3083 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring)) 3084 (gdb-remove-breakpoint-icons start end) 3085 (if (display-images-p) 3086 (if (>= (or left-fringe-width 3087 (if source-window (car (window-fringes source-window))) 3088 gdb-buffer-fringe-width) 8) 3089 (gdb-put-string 3090 nil (1+ start) 3091 `(left-fringe breakpoint 3092 ,(if enabled 3093 'breakpoint-enabled 3094 'breakpoint-disabled)) 3095 'gdb-bptno bptno 3096 'gdb-enabled enabled) 3097 (when (< left-margin-width 2) 3098 (save-current-buffer 3099 (setq left-margin-width 2) 3100 (if source-window 3101 (set-window-margins 3102 source-window 3103 left-margin-width right-margin-width)))) 3104 (put-image 3105 (if enabled 3106 (or breakpoint-enabled-icon 3107 (setq breakpoint-enabled-icon 3108 (find-image `((:type xpm :data 3109 ,breakpoint-xpm-data 3110 :ascent 100 :pointer hand) 3111 (:type pbm :data 3112 ,breakpoint-enabled-pbm-data 3113 :ascent 100 :pointer hand))))) 3114 (or breakpoint-disabled-icon 3115 (setq breakpoint-disabled-icon 3116 (find-image `((:type xpm :data 3117 ,breakpoint-xpm-data 3118 :conversion disabled 3119 :ascent 100 :pointer hand) 3120 (:type pbm :data 3121 ,breakpoint-disabled-pbm-data 3122 :ascent 100 :pointer hand)))))) 3123 (+ start 1) 3124 putstring 3125 'left-margin)) 3126 (when (< left-margin-width 2) 3127 (save-current-buffer 3128 (setq left-margin-width 2) 3129 (let ((window (get-buffer-window (current-buffer) 0))) 3130 (if window 3131 (set-window-margins 3132 window left-margin-width right-margin-width))))) 3133 (gdb-put-string 3134 (propertize putstring 3135 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled)) 3136 (1+ start))))) 3137 3138(defun gdb-remove-breakpoint-icons (start end &optional remove-margin) 3139 (gdb-remove-strings start end) 3140 (if (display-images-p) 3141 (remove-images start end)) 3142 (when remove-margin 3143 (setq left-margin-width 0) 3144 (let ((window (get-buffer-window (current-buffer) 0))) 3145 (if window 3146 (set-window-margins 3147 window left-margin-width right-margin-width))))) 3148 3149 3150;; 3151;; Assembler buffer. 3152;; 3153(gdb-set-buffer-rules 'gdb-assembler-buffer 3154 'gdb-assembler-buffer-name 3155 'gdb-assembler-mode) 3156 3157;; We can't use def-gdb-auto-update-handler because we don't want to use 3158;; window-start but keep the overlay arrow/current line visible. 3159(defun gdb-assembler-handler () 3160 (setq gdb-pending-triggers 3161 (delq 'gdb-invalidate-assembler 3162 gdb-pending-triggers)) 3163 (let ((buf (gdb-get-buffer 'gdb-assembler-buffer))) 3164 (and buf 3165 (with-current-buffer buf 3166 (let* ((window (get-buffer-window buf 0)) 3167 (p (window-point window)) 3168 (buffer-read-only nil)) 3169 (erase-buffer) 3170 (insert-buffer-substring (gdb-get-buffer-create 3171 'gdb-partial-output-buffer)) 3172 (set-window-point window p))))) 3173 ;; put customisation here 3174 (gdb-assembler-custom)) 3175 3176(defun gdb-assembler-custom () 3177 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) 3178 (pos 1) (address) (flag) (bptno)) 3179 (with-current-buffer buffer 3180 (save-excursion 3181 (if (not (equal gdb-pc-address "main")) 3182 (progn 3183 (goto-char (point-min)) 3184 (if (and gdb-pc-address 3185 (search-forward gdb-pc-address nil t)) 3186 (progn 3187 (setq pos (point)) 3188 (beginning-of-line) 3189 (setq fringe-indicator-alist 3190 (if (string-equal gdb-frame-number "0") 3191 nil 3192 '((overlay-arrow . hollow-right-triangle)))) 3193 (or gdb-overlay-arrow-position 3194 (setq gdb-overlay-arrow-position (make-marker))) 3195 (set-marker gdb-overlay-arrow-position (point)))))) 3196 ;; remove all breakpoint-icons in assembler buffer before updating. 3197 (gdb-remove-breakpoint-icons (point-min) (point-max)))) 3198 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) 3199 (goto-char (point-min)) 3200 (while (< (point) (- (point-max) 1)) 3201 (forward-line 1) 3202 (if (looking-at "[^\t].*?breakpoint") 3203 (progn 3204 (looking-at 3205 "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)") 3206 (setq bptno (match-string 1)) 3207 (setq flag (char-after (match-beginning 2))) 3208 (setq address (match-string 3)) 3209 (with-current-buffer buffer 3210 (save-excursion 3211 (goto-char (point-min)) 3212 (if (search-forward address nil t) 3213 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) 3214 (if (not (equal gdb-pc-address "main")) 3215 (with-current-buffer buffer 3216 (set-window-point (get-buffer-window buffer 0) pos))))) 3217 3218(defvar gdb-assembler-mode-map 3219 (let ((map (make-sparse-keymap))) 3220 (suppress-keymap map) 3221 (define-key map "q" 'kill-this-buffer) 3222 map)) 3223 3224(defvar gdb-assembler-font-lock-keywords 3225 '(;; <__function.name+n> 3226 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" 3227 (1 font-lock-function-name-face)) 3228 ;; 0xNNNNNNNN <__function.name+n>: opcode 3229 ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)" 3230 (4 font-lock-keyword-face)) 3231 ;; %register(at least i386) 3232 ("%\\sw+" . font-lock-variable-name-face) 3233 ("^\\(Dump of assembler code for function\\) \\(.+\\):" 3234 (1 font-lock-comment-face) 3235 (2 font-lock-function-name-face)) 3236 ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face)) 3237 "Font lock keywords used in `gdb-assembler-mode'.") 3238 3239(defun gdb-assembler-mode () 3240 "Major mode for viewing code assembler. 3241 3242\\{gdb-assembler-mode-map}" 3243 (kill-all-local-variables) 3244 (setq major-mode 'gdb-assembler-mode) 3245 (setq mode-name (concat "Machine:" gdb-selected-frame)) 3246 (setq gdb-overlay-arrow-position nil) 3247 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) 3248 (setq fringes-outside-margins t) 3249 (setq buffer-read-only t) 3250 (use-local-map gdb-assembler-mode-map) 3251 (gdb-invalidate-assembler) 3252 (set (make-local-variable 'font-lock-defaults) 3253 '(gdb-assembler-font-lock-keywords)) 3254 (run-mode-hooks 'gdb-assembler-mode-hook) 3255 'gdb-invalidate-assembler) 3256 3257(defun gdb-assembler-buffer-name () 3258 (with-current-buffer gud-comint-buffer 3259 (concat "*disassembly of " (gdb-get-target-string) "*"))) 3260 3261(defun gdb-display-assembler-buffer () 3262 "Display disassembly view." 3263 (interactive) 3264 (setq gdb-previous-frame nil) 3265 (gdb-display-buffer 3266 (gdb-get-buffer-create 'gdb-assembler-buffer) t)) 3267 3268(defun gdb-frame-assembler-buffer () 3269 "Display disassembly view in a new frame." 3270 (interactive) 3271 (setq gdb-previous-frame nil) 3272 (let ((special-display-regexps (append special-display-regexps '(".*"))) 3273 (special-display-frame-alist gdb-frame-parameters)) 3274 (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer)))) 3275 3276;; modified because if gdb-pc-address has changed value a new command 3277;; must be enqueued to update the buffer with the new output 3278(defun gdb-invalidate-assembler (&optional ignored) 3279 (if (gdb-get-buffer 'gdb-assembler-buffer) 3280 (progn 3281 (unless (and gdb-selected-frame 3282 (string-equal gdb-selected-frame gdb-previous-frame)) 3283 (if (or (not (member 'gdb-invalidate-assembler 3284 gdb-pending-triggers)) 3285 (not (string-equal gdb-pc-address 3286 gdb-previous-frame-address))) 3287 (progn 3288 ;; take previous disassemble command, if any, off the queue 3289 (with-current-buffer gud-comint-buffer 3290 (let ((queue gdb-input-queue)) 3291 (dolist (item queue) 3292 (if (equal (cdr item) '(gdb-assembler-handler)) 3293 (setq gdb-input-queue 3294 (delete item gdb-input-queue)))))) 3295 (gdb-enqueue-input 3296 (list 3297 (concat gdb-server-prefix "disassemble " 3298 (if (member gdb-pc-address '(nil "main")) nil "0x") 3299 gdb-pc-address "\n") 3300 'gdb-assembler-handler)) 3301 (push 'gdb-invalidate-assembler gdb-pending-triggers) 3302 (setq gdb-previous-frame-address gdb-pc-address) 3303 (setq gdb-previous-frame gdb-selected-frame))))))) 3304 3305(defun gdb-get-selected-frame () 3306 (if (not (member 'gdb-get-selected-frame gdb-pending-triggers)) 3307 (progn 3308 (gdb-enqueue-input 3309 (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler)) 3310 (push 'gdb-get-selected-frame 3311 gdb-pending-triggers)))) 3312 3313(defun gdb-frame-handler () 3314 (setq gdb-pending-triggers 3315 (delq 'gdb-get-selected-frame gdb-pending-triggers)) 3316 (goto-char (point-min)) 3317 (when (re-search-forward 3318 "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t) 3319 (setq gdb-frame-number (match-string 1)) 3320 (setq gdb-frame-address (match-string 2))) 3321 (goto-char (point-min)) 3322 (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\ 3323\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; " 3324 nil t) 3325 (setq gdb-selected-frame (match-string 2)) 3326 (if (gdb-get-buffer 'gdb-locals-buffer) 3327 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) 3328 (setq mode-name (concat "Locals:" gdb-selected-frame)))) 3329 (if (gdb-get-buffer 'gdb-assembler-buffer) 3330 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) 3331 (setq mode-name (concat "Machine:" gdb-selected-frame)))) 3332 (setq gdb-pc-address (match-string 1)) 3333 (if (and (match-string 3) gud-overlay-arrow-position) 3334 (let ((buffer (marker-buffer gud-overlay-arrow-position)) 3335 (position (marker-position gud-overlay-arrow-position))) 3336 (when (and buffer 3337 (string-equal (buffer-name buffer) 3338 (file-name-nondirectory (match-string 3)))) 3339 (with-current-buffer buffer 3340 (setq fringe-indicator-alist 3341 (if (string-equal gdb-frame-number "0") 3342 nil 3343 '((overlay-arrow . hollow-right-triangle)))) 3344 (set-marker gud-overlay-arrow-position position)))))) 3345 (goto-char (point-min)) 3346 (if (re-search-forward " source language \\(\\S-+\\)\." nil t) 3347 (setq gdb-current-language (match-string 1))) 3348 (gdb-invalidate-assembler)) 3349 3350 3351;; Code specific to GDB 6.4 3352(defconst gdb-source-file-regexp-1 "fullname=\"\\(.*?\\)\"") 3353 3354(defun gdb-set-gud-minor-mode-existing-buffers-1 () 3355 "Create list of source files for current GDB session. 3356If buffers already exist for any of these files, gud-minor-mode 3357is set in them." 3358 (goto-char (point-min)) 3359 (while (re-search-forward gdb-source-file-regexp-1 nil t) 3360 (push (match-string 1) gdb-source-file-list)) 3361 (dolist (buffer (buffer-list)) 3362 (with-current-buffer buffer 3363 (when (member buffer-file-name gdb-source-file-list) 3364 (set (make-local-variable 'gud-minor-mode) 3365 (buffer-local-value 'gud-minor-mode gud-comint-buffer)) 3366 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) 3367 (when gud-tooltip-mode 3368 (make-local-variable 'gdb-define-alist) 3369 (gdb-create-define-alist) 3370 (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))) 3371 (gdb-force-mode-line-update 3372 (propertize "ready" 'face font-lock-variable-name-face))) 3373 3374; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. 3375(defun gdb-var-list-children-1 (varnum) 3376 (gdb-enqueue-input 3377 (list 3378 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 3379 (concat "server interpreter mi \"-var-list-children --all-values " 3380 varnum "\"\n") 3381 (concat "-var-list-children --all-values " varnum "\n")) 3382 `(lambda () (gdb-var-list-children-handler-1 ,varnum))))) 3383 3384(defconst gdb-var-list-children-regexp-1 3385 "child={.*?name=\"\\(.+?\\)\",.*?exp=\"\\(.+?\\)\",.*?\ 3386numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\)\ 3387\\(}\\|,.*?\\(type=\"\\(.+?\\)\"\\)?.*?}\\)") 3388 3389(defun gdb-var-list-children-handler-1 (varnum) 3390 (goto-char (point-min)) 3391 (let ((var-list nil)) 3392 (catch 'child-already-watched 3393 (dolist (var gdb-var-list) 3394 (if (string-equal varnum (car var)) 3395 (progn 3396 (push var var-list) 3397 (while (re-search-forward gdb-var-list-children-regexp-1 nil t) 3398 (let ((varchild (list (match-string 1) 3399 (match-string 2) 3400 (match-string 3) 3401 (match-string 7) 3402 (read (match-string 4)) 3403 nil))) 3404 (if (assoc (car varchild) gdb-var-list) 3405 (throw 'child-already-watched nil)) 3406 (push varchild var-list)))) 3407 (push var var-list))) 3408 (setq gdb-var-list (nreverse var-list)))) 3409 (gdb-speedbar-update)) 3410 3411; Uses "-var-update --all-values". Needs GDB 6.4 onwards. 3412(defun gdb-var-update-1 () 3413 (if (not (member 'gdb-var-update gdb-pending-triggers)) 3414 (progn 3415 (gdb-enqueue-input 3416 (list 3417 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 3418 "server interpreter mi \"-var-update --all-values *\"\n" 3419 "-var-update --all-values *\n") 3420 'gdb-var-update-handler-1)) 3421 (push 'gdb-var-update gdb-pending-triggers)))) 3422 3423(defconst gdb-var-update-regexp-1 3424 "{.*?name=\"\\(.*?\\)\",.*?\\(?:value=\\(\".*?\"\\),\\)?.*?\ 3425in_scope=\"\\(.*?\\)\".*?}") 3426 3427(defun gdb-var-update-handler-1 () 3428 (dolist (var gdb-var-list) 3429 (setcar (nthcdr 5 var) nil)) 3430 (goto-char (point-min)) 3431 (while (re-search-forward gdb-var-update-regexp-1 nil t) 3432 (let* ((varnum (match-string 1)) 3433 (var (assoc varnum gdb-var-list))) 3434 (when var 3435 (let ((match (match-string 3))) 3436 (cond ((string-equal match "false") 3437 (setcar (nthcdr 5 var) 'out-of-scope)) 3438 ((string-equal match "true") 3439 (setcar (nthcdr 5 var) 'changed) 3440 (setcar (nthcdr 4 var) 3441 (read (match-string 2)))) 3442 ((string-equal match "invalid") 3443 (gdb-var-delete-1 varnum))))))) 3444 (setq gdb-pending-triggers 3445 (delq 'gdb-var-update gdb-pending-triggers)) 3446 (gdb-speedbar-update)) 3447 3448;; Registers buffer. 3449;; 3450(gdb-set-buffer-rules 'gdb-registers-buffer 3451 'gdb-registers-buffer-name 3452 'gdb-registers-mode) 3453 3454(def-gdb-auto-update-trigger gdb-invalidate-registers-1 3455 (gdb-get-buffer 'gdb-registers-buffer) 3456 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 3457 "server interpreter mi \"-data-list-register-values x\"\n" 3458 "-data-list-register-values x\n") 3459 gdb-data-list-register-values-handler) 3460 3461(defconst gdb-data-list-register-values-regexp 3462 "{.*?number=\"\\(.*?\\)\",.*?value=\"\\(.*?\\)\".*?}") 3463 3464(defun gdb-data-list-register-values-handler () 3465 (setq gdb-pending-triggers (delq 'gdb-invalidate-registers-1 3466 gdb-pending-triggers)) 3467 (goto-char (point-min)) 3468 (if (re-search-forward gdb-error-regexp nil t) 3469 (let ((err (match-string 1))) 3470 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) 3471 (let ((buffer-read-only nil)) 3472 (erase-buffer) 3473 (put-text-property 0 (length err) 'face font-lock-warning-face err) 3474 (insert err) 3475 (goto-char (point-min))))) 3476 (let ((register-list (reverse gdb-register-names)) 3477 (register nil) (register-string nil) (register-values nil)) 3478 (goto-char (point-min)) 3479 (while (re-search-forward gdb-data-list-register-values-regexp nil t) 3480 (setq register (pop register-list)) 3481 (setq register-string (concat register "\t" (match-string 2) "\n")) 3482 (if (member (match-string 1) gdb-changed-registers) 3483 (put-text-property 0 (length register-string) 3484 'face 'font-lock-warning-face 3485 register-string)) 3486 (setq register-values 3487 (concat register-values register-string))) 3488 (let ((buf (gdb-get-buffer 'gdb-registers-buffer))) 3489 (with-current-buffer buf 3490 (let* ((window (get-buffer-window buf 0)) 3491 (start (window-start window)) 3492 (p (window-point window)) 3493 (buffer-read-only nil)) 3494 (erase-buffer) 3495 (insert register-values) 3496 (set-window-start window start) 3497 (set-window-point window p)))))) 3498 (gdb-data-list-register-values-custom)) 3499 3500(defun gdb-data-list-register-values-custom () 3501 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) 3502 (save-excursion 3503 (let ((buffer-read-only nil) 3504 start end) 3505 (goto-char (point-min)) 3506 (while (< (point) (point-max)) 3507 (setq start (line-beginning-position)) 3508 (setq end (line-end-position)) 3509 (when (looking-at "^[^\t]+") 3510 (unless (string-equal (match-string 0) "No registers.") 3511 (put-text-property start (match-end 0) 3512 'face font-lock-variable-name-face) 3513 (add-text-properties start end 3514 '(help-echo "mouse-2: edit value" 3515 mouse-face highlight)))) 3516 (forward-line 1)))))) 3517 3518;; Needs GDB 6.4 onwards (used to fail with no stack). 3519(defun gdb-get-changed-registers () 3520 (if (and (gdb-get-buffer 'gdb-registers-buffer) 3521 (not (member 'gdb-get-changed-registers gdb-pending-triggers))) 3522 (progn 3523 (gdb-enqueue-input 3524 (list 3525 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 3526 "server interpreter mi -data-list-changed-registers\n" 3527 "-data-list-changed-registers\n") 3528 'gdb-get-changed-registers-handler)) 3529 (push 'gdb-get-changed-registers gdb-pending-triggers)))) 3530 3531(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") 3532 3533(defun gdb-get-changed-registers-handler () 3534 (setq gdb-pending-triggers 3535 (delq 'gdb-get-changed-registers gdb-pending-triggers)) 3536 (setq gdb-changed-registers nil) 3537 (goto-char (point-min)) 3538 (while (re-search-forward gdb-data-list-register-names-regexp nil t) 3539 (push (match-string 1) gdb-changed-registers))) 3540 3541 3542;; Locals buffer. 3543;; 3544;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. 3545(gdb-set-buffer-rules 'gdb-locals-buffer 3546 'gdb-locals-buffer-name 3547 'gdb-locals-mode) 3548 3549(def-gdb-auto-update-trigger gdb-invalidate-locals-1 3550 (gdb-get-buffer 'gdb-locals-buffer) 3551 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 3552 "server interpreter mi -\"stack-list-locals --simple-values\"\n" 3553 "-stack-list-locals --simple-values\n") 3554 gdb-stack-list-locals-handler) 3555 3556(defconst gdb-stack-list-locals-regexp 3557 "{.*?name=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\"") 3558 3559(defvar gdb-locals-watch-map-1 3560 (let ((map (make-sparse-keymap))) 3561 (suppress-keymap map) 3562 (define-key map "\r" 'gud-watch) 3563 (define-key map [mouse-2] 'gud-watch) 3564 map) 3565 "Keymap to create watch expression of a complex data type local variable.") 3566 3567(defvar gdb-edit-locals-map-1 3568 (let ((map (make-sparse-keymap))) 3569 (suppress-keymap map) 3570 (define-key map "\r" 'gdb-edit-locals-value) 3571 (define-key map [mouse-2] 'gdb-edit-locals-value) 3572 map) 3573 "Keymap to edit value of a simple data type local variable.") 3574 3575(defun gdb-edit-locals-value (&optional event) 3576 "Assign a value to a variable displayed in the locals buffer." 3577 (interactive (list last-input-event)) 3578 (save-excursion 3579 (if event (posn-set-point (event-end event))) 3580 (beginning-of-line) 3581 (let* ((var (current-word)) 3582 (value (read-string (format "New value (%s): " var)))) 3583 (gdb-enqueue-input 3584 (list (concat gdb-server-prefix"set variable " var " = " value "\n") 3585 'ignore))))) 3586 3587;; Dont display values of arrays or structures. 3588;; These can be expanded using gud-watch. 3589(defun gdb-stack-list-locals-handler () 3590 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1 3591 gdb-pending-triggers)) 3592 (goto-char (point-min)) 3593 (if (re-search-forward gdb-error-regexp nil t) 3594 (let ((err (match-string 1))) 3595 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) 3596 (let ((buffer-read-only nil)) 3597 (erase-buffer) 3598 (insert err) 3599 (goto-char (point-min))))) 3600 (let (local locals-list) 3601 (goto-char (point-min)) 3602 (while (re-search-forward gdb-stack-list-locals-regexp nil t) 3603 (let ((local (list (match-string 1) 3604 (match-string 2) 3605 nil))) 3606 (if (looking-at ",value=\\(\".*\"\\).*?}") 3607 (setcar (nthcdr 2 local) (read (match-string 1)))) 3608 (push local locals-list))) 3609 (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) 3610 (and buf (with-current-buffer buf 3611 (let* ((window (get-buffer-window buf 0)) 3612 (start (window-start window)) 3613 (p (window-point window)) 3614 (buffer-read-only nil) (name) (value)) 3615 (erase-buffer) 3616 (dolist (local locals-list) 3617 (setq name (car local)) 3618 (setq value (nth 2 local)) 3619 (if (or (not value) 3620 (string-match "^\\0x" value)) 3621 (add-text-properties 0 (length name) 3622 `(mouse-face highlight 3623 help-echo "mouse-2: create watch expression" 3624 local-map ,gdb-locals-watch-map-1) 3625 name) 3626 (add-text-properties 0 (length value) 3627 `(mouse-face highlight 3628 help-echo "mouse-2: edit value" 3629 local-map ,gdb-edit-locals-map-1) 3630 value)) 3631 (insert 3632 (concat name "\t" (nth 1 local) 3633 "\t" value "\n"))) 3634 (set-window-start window start) 3635 (set-window-point window p)))))))) 3636 3637(defun gdb-get-register-names () 3638 "Create a list of register names." 3639 (goto-char (point-min)) 3640 (setq gdb-register-names nil) 3641 (while (re-search-forward gdb-data-list-register-names-regexp nil t) 3642 (push (match-string 1) gdb-register-names))) 3643 3644(provide 'gdb-ui) 3645 3646;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 3647;;; gdb-ui.el ends here 3648