code.delx.au - gnu-emacs/blob - lisp/progmodes/gdb-ui.el

   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  Free Software Foundation, Inc.
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This mode acts as a graphical user interface to GDB.  You can interact with
  29 ;; GDB through the GUD buffer in the usual way, but there are also further
  30 ;; buffers which control the execution and describe the state of your program.
  31 ;; It separates the input/output of your program from that of GDB, if
  32 ;; required, and watches expressions in the speedbar.  It also uses features of
  33 ;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar
  34 ;; (see the GDB Graphical Interface section in the Emacs info manual).
  35
  36 ;; By default, M-x gdb will start the debugger. However, if you have customised
  37 ;; gud-gdb-command-name, then start it with M-x gdba.
  38
  39 ;; This file has evolved from gdba.el that was included with GDB 5.0 and
  40 ;; written by Tom Lord and Jim Kingdon.  It uses GDB's annotation interface.
  41 ;; You don't need to know about annotations to use this mode as a debugger,
  42 ;; but if you are interested developing the mode itself, then see the
  43 ;; Annotations section in the GDB info manual.
  44 ;;
  45 ;; GDB developers plan to make the annotation interface obsolete.  A new
  46 ;; interface called GDB/MI (machine interface) has been designed to replace
  47 ;; it.  Some GDB/MI commands are used in this file through the CLI command
  48 ;; 'interpreter mi <mi-command>'.  A file called gdb-mi.el is included with
  49 ;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB.  It is
  50 ;; still under development and is part of a process to migrate Emacs from
  51 ;; annotations to GDB/MI.
  52 ;;
  53 ;; Windows Platforms:
  54 ;;
  55 ;; If you are using Emacs and GDB on Windows you will need to flush the buffer
  56 ;; explicitly in your program if you want timely display of I/O in Emacs.
  57 ;; Alternatively you can make the output stream unbuffered, for example, by
  58 ;; using a macro:
  59 ;;
  60 ;;           #ifdef UNBUFFERED
  61 ;;           setvbuf (stdout, (char *) NULL, _IONBF, 0);
  62 ;;           #endif
  63 ;;
  64 ;; and compiling with -DUNBUFFERED while debugging.
  65 ;;
  66 ;; Known Bugs:
  67 ;;
  68 ;; TODO:
  69 ;; 1) Use MI command -data-read-memory for memory window.
  70 ;; 2) Highlight changed register values (use MI commands
  71 ;;    -data-list-register-values and -data-list-changed-registers instead
  72 ;;    of 'info registers'.
  73 ;; 3) Use tree-widget.el instead of the speedbar for watch-expressions?
  74 ;; 4) Mark breakpoint locations on scroll-bar of source buffer?
  75 ;; 5) After release of 22.1 use '-var-list-children --all-values'
  76 ;;    and '-stack-list-locals 2' which need GDB 6.1 onwards.
  77
  78 ;;; Code:
  79
  80 (require 'gud)
  81
  82 (defvar tool-bar-map)
  83
  84 (defvar gdb-frame-address "main" "Initialization for Assembler buffer.")
  85 (defvar gdb-previous-frame-address nil)
  86 (defvar gdb-memory-address "main")
  87 (defvar gdb-previous-frame nil)
  88 (defvar gdb-selected-frame nil)
  89 (defvar gdb-frame-number nil)
  90 (defvar gdb-current-language nil)
  91 (defvar gdb-var-list nil "List of variables in watch window.")
  92 (defvar gdb-var-changed nil "Non-nil means that `gdb-var-list' has changed.")
  93 (defvar gdb-main-file nil "Source file from which program execution begins.")
  94 (defvar gdb-buffer-type nil)
  95 (defvar gdb-overlay-arrow-position nil)
  96 (defvar gdb-server-prefix nil)
  97 (defvar gdb-flush-pending-output nil)
  98 (defvar gdb-location-alist nil
  99   "Alist of breakpoint numbers and full filenames.")
 100 (defvar gdb-find-file-unhook nil)
 101 (defvar gdb-active-process nil "GUD tooltips display variable values when t, \
 102 and #define directives otherwise.")
 103 (defvar gdb-error "Non-nil when GDB is reporting an error.")
 104 (defvar gdb-macro-info nil
 105   "Non-nil if GDB knows that the inferior includes preprocessor macro info.")
 106 (defvar gdb-buffer-fringe-width nil)
 107
 108 (defvar gdb-buffer-type nil
 109   "One of the symbols bound in `gdb-buffer-rules'.")
 110
 111 (defvar gdb-input-queue ()
 112   "A list of gdb command objects.")
 113
 114 (defvar gdb-prompting nil
 115   "True when gdb is idle with no pending input.")
 116
 117 (defvar gdb-output-sink 'user
 118   "The disposition of the output of the current gdb command.
 119 Possible values are these symbols:
 120
 121     `user' -- gdb output should be copied to the GUD buffer
 122               for the user to see.
 123
 124     `inferior' -- gdb output should be copied to the inferior-io buffer.
 125
 126     `pre-emacs' -- output should be ignored util the post-prompt
 127                    annotation is received.  Then the output-sink
 128                    becomes:...
 129     `emacs' -- output should be collected in the partial-output-buffer
 130                for subsequent processing by a command.  This is the
 131                disposition of output generated by commands that
 132                gdb mode sends to gdb on its own behalf.
 133     `post-emacs' -- ignore output until the prompt annotation is
 134                     received, then go to USER disposition.
 135
 136 gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two
 137 \(`user' and `emacs').")
 138
 139 (defvar gdb-current-item nil
 140   "The most recent command item sent to gdb.")
 141
 142 (defvar gdb-pending-triggers '()
 143   "A list of trigger functions that have run later than their output
 144 handlers.")
 145
 146 ;; end of gdb variables
 147
 148 ;;;###autoload
 149 (defun gdba (command-line)
 150   "Run gdb on program FILE in buffer *gud-FILE*.
 151 The directory containing FILE becomes the initial working directory
 152 and source-file directory for your debugger.
 153
 154 If `gdb-many-windows' is nil (the default value) then gdb just
 155 pops up the GUD buffer unless `gdb-show-main' is t.  In this case
 156 it starts with two windows: one displaying the GUD buffer and the
 157 other with the source file with the main routine of the inferior.
 158
 159 If `gdb-many-windows' is t, regardless of the value of
 160 `gdb-show-main', the layout below will appear unless
 161 `gdb-use-inferior-io-buffer' is nil when the source buffer
 162 occupies the full width of the frame.  Keybindings are given in
 163 relevant buffer.
 164
 165 Watch expressions appear in the speedbar/slowbar.
 166
 167 The following commands help control operation :
 168
 169 `gdb-many-windows'    - Toggle the number of windows gdb uses.
 170 `gdb-restore-windows' - To restore the window layout.
 171
 172 See Info node `(emacs)GDB Graphical Interface' for a more
 173 detailed description of this mode.
 174
 175
 176 +--------------------------------------------------------------+
 177 |                           GDB Toolbar                        |
 178 +-------------------------------+------------------------------+
 179 | GUD buffer (I/O of GDB)       | Locals buffer                |
 180 |                               |                              |
 181 |                               |                              |
 182 |                               |                              |
 183 +-------------------------------+------------------------------+
 184 | Source buffer                 | I/O buffer (of inferior)     |
 185 |                               | (comint-mode)                |
 186 |                               |                              |
 187 |                               |                              |
 188 |                               |                              |
 189 |                               |                              |
 190 |                               |                              |
 191 |                               |                              |
 192 +-------------------------------+------------------------------+
 193 | Stack buffer                  | Breakpoints buffer           |
 194 | RET      gdb-frames-select    | SPC    gdb-toggle-breakpoint |
 195 |                               | RET    gdb-goto-breakpoint   |
 196 |                               | d      gdb-delete-breakpoint |
 197 +-------------------------------+------------------------------+"
 198   ;;
 199   (interactive (list (gud-query-cmdline 'gdba)))
 200   ;;
 201   ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
 202   (gdb command-line)
 203   (gdb-ann3))
 204
 205 (defvar gdb-debug-log nil)
 206
 207 ;;;###autoload
 208 (defcustom gdb-enable-debug-log nil
 209   "Non-nil means record the process input and output in `gdb-debug-log'."
 210   :type 'boolean
 211   :group 'gud
 212   :version "22.1")
 213
 214 (defcustom gdb-use-inferior-io-buffer nil
 215   "Non-nil means display output from the inferior in a separate buffer."
 216   :type 'boolean
 217   :group 'gud
 218   :version "22.1")
 219
 220 (defcustom gdb-cpp-define-alist-program "gcc -E -dM -"
 221   "Shell command for generating a list of defined macros in a source file.
 222 This list is used to display the #define directive associated
 223 with an identifier as a tooltip.  It works in a debug session with
 224 GDB, when gud-tooltip-mode is t.
 225
 226 Set `gdb-cpp-define-alist-flags' for any include paths or
 227 predefined macros."
 228   :type 'string
 229   :group 'gud
 230   :version "22.1")
 231
 232 (defcustom gdb-cpp-define-alist-flags ""
 233   "Preprocessor flags for `gdb-cpp-define-alist-program'."
 234   :type 'string
 235   :group 'gud
 236   :version "22.1")
 237
 238 (defcustom gdb-show-main nil
 239   "Non-nil means display source file containing the main routine at startup.
 240 Also display the main routine in the disassembly buffer if present."
 241   :type 'boolean
 242   :group 'gud
 243   :version "22.1")
 244
 245 (defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
 246
 247 (defun gdb-create-define-alist ()
 248   "Create an alist of #define directives for GUD tooltips."
 249   (let* ((file (buffer-file-name))
 250          (output
 251           (with-output-to-string
 252             (with-current-buffer standard-output
 253               (call-process shell-file-name
 254                             (if (file-exists-p file) file nil)
 255                             (list t nil) nil "-c"
 256                             (concat gdb-cpp-define-alist-program " "
 257                                     gdb-cpp-define-alist-flags)))))
 258         (define-list (split-string output "\n" t))
 259         (name))
 260     (setq gdb-define-alist nil)
 261     (dolist (define define-list)
 262       (setq name (nth 1 (split-string define "[( ]")))
 263       (push (cons name define) gdb-define-alist))))
 264
 265 (defun gdb-tooltip-print ()
 266   (tooltip-show
 267    (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
 268      (let ((string (buffer-string)))
 269        ;; remove newline for gud-tooltip-echo-area
 270        (substring string 0 (- (length string) 1))))
 271    (or gud-tooltip-echo-area tooltip-use-echo-area)))
 272
 273 ;; If expr is a macro for a function don't print because of possible dangerous
 274 ;; side-effects. Also printing a function within a tooltip generates an
 275 ;; unexpected starting annotation (phase error).
 276 (defun gdb-tooltip-print-1 (expr)
 277   (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
 278     (goto-char (point-min))
 279     (if (search-forward "expands to: " nil t)
 280         (unless (looking-at "\\S+.*(.*).*")
 281           (gdb-enqueue-input
 282            (list  (concat gdb-server-prefix "print " expr "\n")
 283                   'gdb-tooltip-print))))))
 284
 285 (defun gdb-set-gud-minor-mode (buffer)
 286   "Set `gud-minor-mode' from find-file if appropriate."
 287   (goto-char (point-min))
 288   (unless (search-forward "No source file named " nil t)
 289     (condition-case nil
 290         (gdb-enqueue-input
 291          (list (concat gdb-server-prefix "info source\n")
 292                `(lambda () (gdb-set-gud-minor-mode-1 ,buffer))))
 293       (error (setq gdb-find-file-unhook t)))))
 294
 295 (defun gdb-set-gud-minor-mode-1 (buffer)
 296   (goto-char (point-min))
 297   (when (and (search-forward "Located in " nil t)
 298              (looking-at "\\S-+")
 299              (string-equal (buffer-file-name buffer)
 300                            (match-string 0)))
 301     (with-current-buffer buffer
 302       (set (make-local-variable 'gud-minor-mode) 'gdba)
 303       (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
 304       (when gud-tooltip-mode
 305         (make-local-variable 'gdb-define-alist)
 306         (gdb-create-define-alist)
 307         (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))
 308
 309 (defun gdb-set-gud-minor-mode-existing-buffers ()
 310   (dolist (buffer (buffer-list))
 311     (let ((file (buffer-file-name buffer)))
 312       (if file
 313         (progn
 314           (gdb-enqueue-input
 315            (list (concat gdb-server-prefix "list "
 316                          (file-name-nondirectory file) ":1\n")
 317                  `(lambda () (gdb-set-gud-minor-mode ,buffer)))))))))
 318
 319 (defun gdb-ann3 ()
 320   (setq gdb-debug-log nil)
 321   (set (make-local-variable 'gud-minor-mode) 'gdba)
 322   (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)
 323   ;;
 324   (gud-def gud-break (if (not (string-match "Machine" mode-name))
 325                          (gud-call "break %f:%l" arg)
 326                        (save-excursion
 327                          (beginning-of-line)
 328                          (forward-char 2)
 329                          (gud-call "break *%a" arg)))
 330            "\C-b" "Set breakpoint at current line or address.")
 331   ;;
 332   (gud-def gud-remove (if (not (string-match "Machine" mode-name))
 333                           (gud-call "clear %f:%l" arg)
 334                         (save-excursion
 335                           (beginning-of-line)
 336                           (forward-char 2)
 337                           (gud-call "clear *%a" arg)))
 338            "\C-d" "Remove breakpoint at current line or address.")
 339   ;;
 340   (gud-def gud-until  (if (not (string-match "Machine" mode-name))
 341                           (gud-call "until %f:%l" arg)
 342                         (save-excursion
 343                           (beginning-of-line)
 344                           (forward-char 2)
 345                           (gud-call "until *%a" arg)))
 346            "\C-u" "Continue to current line or address.")
 347
 348   (define-key gud-minor-mode-map [left-margin mouse-1]
 349     'gdb-mouse-set-clear-breakpoint)
 350   (define-key gud-minor-mode-map [left-fringe mouse-1]
 351     'gdb-mouse-set-clear-breakpoint)
 352   (define-key gud-minor-mode-map [left-fringe mouse-2]
 353     'gdb-mouse-until)
 354   (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
 355     'gdb-mouse-until)
 356   (define-key gud-minor-mode-map [left-margin mouse-3]
 357     'gdb-mouse-toggle-breakpoint-margin)
 358   (define-key gud-minor-mode-map [left-fringe mouse-3]
 359     'gdb-mouse-toggle-breakpoint-fringe)
 360
 361   (setq comint-input-sender 'gdb-send)
 362   ;;
 363   ;; (re-)initialize
 364   (setq gdb-frame-address (if gdb-show-main "main" nil))
 365   (setq gdb-previous-frame-address nil
 366         gdb-memory-address "main"
 367         gdb-previous-frame nil
 368         gdb-selected-frame nil
 369         gdb-current-language nil
 370         gdb-frame-number nil
 371         gdb-var-list nil
 372         gdb-var-changed nil
 373         gdb-first-prompt nil
 374         gdb-prompting nil
 375         gdb-input-queue nil
 376         gdb-current-item nil
 377         gdb-pending-triggers nil
 378         gdb-output-sink 'user
 379         gdb-server-prefix "server "
 380         gdb-flush-pending-output nil
 381         gdb-location-alist nil
 382         gdb-find-file-unhook nil
 383         gdb-error nil
 384         gdb-macro-info nil
 385         gdb-buffer-fringe-width (car (window-fringes)))
 386   ;;
 387   (setq gdb-buffer-type 'gdba)
 388   ;;
 389   (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io))
 390   ;;
 391   (if (eq window-system 'w32)
 392       (gdb-enqueue-input (list "set new-console off\n" 'ignore)))
 393   (gdb-enqueue-input (list "set height 0\n" 'ignore))
 394   (gdb-enqueue-input (list "set width 0\n" 'ignore))
 395   ;; find source file and compilation directory here
 396   (gdb-enqueue-input (list "server list main\n"   'ignore))   ; C program
 397   (gdb-enqueue-input (list "server list MAIN__\n" 'ignore))   ; Fortran program
 398   (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))
 399   ;;
 400   (gdb-set-gud-minor-mode-existing-buffers)
 401   (run-hooks 'gdba-mode-hook))
 402
 403 (defun gdb-mouse-until (event)
 404   "Execute source lines by dragging the overlay arrow (fringe) with the mouse."
 405   (interactive "e")
 406   (if gud-overlay-arrow-position
 407         (let ((start (event-start event))
 408               (end  (event-end event))
 409               (buffer (marker-buffer gud-overlay-arrow-position)) (line))
 410           (if (equal buffer (window-buffer (posn-window end)))
 411               (with-current-buffer buffer
 412                 (when (or (equal start end)
 413                           (equal (posn-point start)
 414                                  (marker-position gud-overlay-arrow-position)))
 415                   (setq line (line-number-at-pos (posn-point end)))
 416                   (gud-call (concat "until " (number-to-string line)))))))))
 417
 418 (defcustom gdb-use-colon-colon-notation nil
 419   "If non-nil use FUN::VAR format to display variables in the speedbar."
 420   :type 'boolean
 421   :group 'gud
 422   :version "22.1")
 423
 424 (defun gud-watch ()
 425   "Watch expression at point."
 426   (interactive)
 427   (require 'tooltip)
 428   (let ((expr (tooltip-identifier-from-point (point))))
 429     (if (and (string-equal gdb-current-language "c")
 430              gdb-use-colon-colon-notation gdb-selected-frame)
 431         (setq expr (concat gdb-selected-frame "::" expr)))
 432     (catch 'already-watched
 433       (dolist (var gdb-var-list)
 434         (if (string-equal expr (car var)) (throw 'already-watched nil)))
 435       (set-text-properties 0 (length expr) nil expr)
 436       (gdb-enqueue-input
 437        (list
 438         (if (eq gud-minor-mode 'gdba)
 439             (concat "server interpreter mi \"-var-create - * "  expr "\"\n")
 440           (concat"-var-create - * "  expr "\n"))
 441              `(lambda () (gdb-var-create-handler ,expr))))))
 442   (select-window (get-buffer-window gud-comint-buffer 0)))
 443
 444 (defconst gdb-var-create-regexp
 445   "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
 446
 447 (defun gdb-var-create-handler (expr)
 448   (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
 449     (goto-char (point-min))
 450     (if (re-search-forward gdb-var-create-regexp nil t)
 451         (let ((var (list expr
 452                          (match-string 1)
 453                          (match-string 2)
 454                          (match-string 3)
 455                          nil nil)))
 456           (push var gdb-var-list)
 457           (speedbar 1)
 458           (unless (string-equal
 459                    speedbar-initial-expansion-list-name "GUD")
 460             (speedbar-change-initial-expansion-list "GUD"))
 461           (if (equal (nth 2 var) "0")
 462               (gdb-enqueue-input
 463                (list
 464                 (if (with-current-buffer
 465                         gud-comint-buffer (eq gud-minor-mode 'gdba))
 466                     (concat "server interpreter mi \"-var-evaluate-expression "
 467                             (nth 1 var) "\"\n")
 468                   (concat "-var-evaluate-expression " (nth 1 var) "\n"))
 469                      `(lambda () (gdb-var-evaluate-expression-handler
 470                                   ,(nth 1 var) nil))))
 471             (setq gdb-var-changed t)))
 472       (if (re-search-forward "Undefined command" nil t)
 473           (message-box "Watching expressions requires gdb 6.0 onwards")
 474         (message "No symbol \"%s\" in current context." expr)))))
 475
 476 (defun gdb-var-evaluate-expression-handler (varnum changed)
 477   (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
 478     (goto-char (point-min))
 479     (re-search-forward ".*value=\"\\(.*?\\)\"" nil t)
 480     (catch 'var-found
 481       (let ((num 0))
 482         (dolist (var gdb-var-list)
 483           (if (string-equal varnum (cadr var))
 484               (progn
 485                 (if changed (setcar (nthcdr 5 var) t))
 486                 (setcar (nthcdr 4 var) (match-string 1))
 487                 (setcar (nthcdr num gdb-var-list) var)
 488                 (throw 'var-found nil)))
 489           (setq num (+ num 1))))))
 490   (setq gdb-var-changed t))
 491
 492 (defun gdb-var-list-children (varnum)
 493   (gdb-enqueue-input
 494    (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n")
 495          `(lambda () (gdb-var-list-children-handler ,varnum)))))
 496
 497 (defconst gdb-var-list-children-regexp
 498   "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"")
 499
 500 (defun gdb-var-list-children-handler (varnum)
 501   (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
 502     (goto-char (point-min))
 503     (let ((var-list nil))
 504      (catch 'child-already-watched
 505        (dolist (var gdb-var-list)
 506          (if (string-equal varnum (cadr var))
 507              (progn
 508                (push var var-list)
 509                (while (re-search-forward gdb-var-list-children-regexp nil t)
 510                  (let ((varchild (list (match-string 2)
 511                                        (match-string 1)
 512                                        (match-string 3)
 513                                        nil nil nil)))
 514                    (if (looking-at ",type=\"\\(.*?\\)\"")
 515                        (setcar (nthcdr 3 varchild) (match-string 1)))
 516                    (dolist (var1 gdb-var-list)
 517                      (if (string-equal (cadr var1) (cadr varchild))
 518                          (throw 'child-already-watched nil)))
 519                    (push varchild var-list)
 520                    (if (equal (nth 2 varchild) "0")
 521                        (gdb-enqueue-input
 522                         (list
 523                          (concat
 524                           "server interpreter mi \"-var-evaluate-expression "
 525                                  (nth 1 varchild) "\"\n")
 526                          `(lambda () (gdb-var-evaluate-expression-handler
 527                                       ,(nth 1 varchild) nil))))))))
 528            (push var var-list)))
 529        (setq gdb-var-list (nreverse var-list))))))
 530
 531 (defun gdb-var-update ()
 532   (when (not (member 'gdb-var-update gdb-pending-triggers))
 533     (gdb-enqueue-input
 534      (list "server interpreter mi \"-var-update *\"\n"
 535            'gdb-var-update-handler))
 536     (push 'gdb-var-update gdb-pending-triggers)))
 537
 538 (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")
 539
 540 (defun gdb-var-update-handler ()
 541   (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
 542     (goto-char (point-min))
 543     (while (re-search-forward gdb-var-update-regexp nil t)
 544         (let ((varnum (match-string 1)))
 545           (gdb-enqueue-input
 546            (list
 547             (concat "server interpreter mi \"-var-evaluate-expression "
 548                     varnum "\"\n")
 549             `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))))))
 550   (setq gdb-pending-triggers
 551    (delq 'gdb-var-update gdb-pending-triggers))
 552   (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
 553     ;; Dummy command to update speedbar at right time.
 554     (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))
 555     ;; Keep gdb-pending-triggers non-nil till end.
 556     (push 'gdb-speedbar-timer gdb-pending-triggers)))
 557
 558 (defun gdb-speedbar-timer-fn ()
 559   (setq gdb-pending-triggers
 560         (delq 'gdb-speedbar-timer gdb-pending-triggers))
 561   (with-current-buffer gud-comint-buffer
 562     (speedbar-timer-fn)))
 563
 564 (defun gdb-var-delete ()
 565   "Delete watch expression at point from the speedbar."
 566   (interactive)
 567   (if (with-current-buffer
 568           gud-comint-buffer (memq gud-minor-mode '(gdbmi gdba)))
 569       (let ((text (speedbar-line-text)))
 570         (string-match "\\(\\S-+\\)" text)
 571         (let* ((expr (match-string 1 text))
 572                (var (assoc expr gdb-var-list))
 573                (varnum (cadr var)))
 574           (unless (string-match "\\." varnum)
 575             (gdb-enqueue-input
 576              (list
 577               (if (with-current-buffer gud-comint-buffer
 578                     (eq gud-minor-mode 'gdba))
 579                   (concat "server interpreter mi \"-var-delete " varnum "\"\n")
 580                 (concat "-var-delete " varnum "\n"))
 581                    'ignore))
 582             (setq gdb-var-list (delq var gdb-var-list))
 583             (dolist (varchild gdb-var-list)
 584               (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild))
 585                   (setq gdb-var-list (delq varchild gdb-var-list))))
 586             (setq gdb-var-changed t))))))
 587
 588 (defun gdb-edit-value (text token indent)
 589   "Assign a value to a variable displayed in the speedbar."
 590   (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
 591          (varnum (cadr var)) (value))
 592     (setq value (read-string "New value: "))
 593     (gdb-enqueue-input
 594      (list
 595       (if (with-current-buffer gud-comint-buffer
 596             (eq gud-minor-mode 'gdba))
 597           (concat "server interpreter mi \"-var-assign "
 598                   varnum " " value "\"\n")
 599         (concat "-var-assign " varnum " " value "\n"))
 600            'ignore))))
 601
 602 (defcustom gdb-show-changed-values t
 603   "If non-nil highlight values that have recently changed in the speedbar.
 604 The highlighting is done with `font-lock-warning-face'."
 605   :type 'boolean
 606   :group 'gud
 607   :version "22.1")
 608
 609 (defun gdb-speedbar-expand-node (text token indent)
 610   "Expand the node the user clicked on.
 611 TEXT is the text of the button we clicked on, a + or - item.
 612 TOKEN is data related to this node.
 613 INDENT is the current indentation depth."
 614   (cond ((string-match "+" text)        ;expand this node
 615          (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
 616              (gdb-var-list-children token)
 617            (progn
 618              (gdbmi-var-update)
 619              (gdbmi-var-list-children token))))
 620         ((string-match "-" text)        ;contract this node
 621          (dolist (var gdb-var-list)
 622            (if (string-match (concat token "\\.") (nth 1 var))
 623                (setq gdb-var-list (delq var gdb-var-list))))
 624          (setq gdb-var-changed t)
 625          (with-current-buffer gud-comint-buffer
 626            (speedbar-timer-fn)))))
 627
 628 (defun gdb-get-target-string ()
 629   (with-current-buffer gud-comint-buffer
 630     gud-target-name))
 631 \f
 632
 633 ;;
 634 ;; gdb buffers.
 635 ;;
 636 ;; Each buffer has a TYPE -- a symbol that identifies the function
 637 ;; of that particular buffer.
 638 ;;
 639 ;; The usual gdb interaction buffer is given the type `gdba' and
 640 ;; is constructed specially.
 641 ;;
 642 ;; Others are constructed by gdb-get-create-buffer and
 643 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
 644
 645 (defvar gdb-buffer-rules-assoc '())
 646
 647 (defun gdb-get-buffer (key)
 648   "Return the gdb buffer tagged with type KEY.
 649 The key should be one of the cars in `gdb-buffer-rules-assoc'."
 650   (save-excursion
 651     (gdb-look-for-tagged-buffer key (buffer-list))))
 652
 653 (defun gdb-get-create-buffer (key)
 654   "Create a new gdb  buffer of the type specified by KEY.
 655 The key should be one of the cars in `gdb-buffer-rules-assoc'."
 656   (or (gdb-get-buffer key)
 657       (let* ((rules (assoc key gdb-buffer-rules-assoc))
 658              (name (funcall (gdb-rules-name-maker rules)))
 659              (new (get-buffer-create name)))
 660         (with-current-buffer new
 661           (let ((trigger))
 662             (if (cdr (cdr rules))
 663                 (setq trigger (funcall (car (cdr (cdr rules))))))
 664             (set (make-local-variable 'gdb-buffer-type) key)
 665             (set (make-local-variable 'gud-minor-mode)
 666                  (with-current-buffer gud-comint-buffer gud-minor-mode))
 667             (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
 668             (if trigger (funcall trigger)))
 669           new))))
 670
 671 (defun gdb-rules-name-maker (rules) (car (cdr rules)))
 672
 673 (defun gdb-look-for-tagged-buffer (key bufs)
 674   (let ((retval nil))
 675     (while (and (not retval) bufs)
 676       (set-buffer (car bufs))
 677       (if (eq gdb-buffer-type key)
 678           (setq retval (car bufs)))
 679       (setq bufs (cdr bufs)))
 680     retval))
 681
 682 ;;
 683 ;; This assoc maps buffer type symbols to rules.  Each rule is a list of
 684 ;; at least one and possible more functions.  The functions have these
 685 ;; roles in defining a buffer type:
 686 ;;
 687 ;;     NAME - Return a name for this  buffer type.
 688 ;;
 689 ;; The remaining function(s) are optional:
 690 ;;
 691 ;;     MODE - called in a new buffer with no arguments, should establish
 692 ;;            the proper mode for the buffer.
 693 ;;
 694
 695 (defun gdb-set-buffer-rules (buffer-type &rest rules)
 696   (let ((binding (assoc buffer-type gdb-buffer-rules-assoc)))
 697     (if binding
 698         (setcdr binding rules)
 699       (push (cons buffer-type rules)
 700             gdb-buffer-rules-assoc))))
 701
 702 ;; GUD buffers are an exception to the rules
 703 (gdb-set-buffer-rules 'gdba 'error)
 704
 705 ;;
 706 ;; Partial-output buffer : This accumulates output from a command executed on
 707 ;; behalf of emacs (rather than the user).
 708 ;;
 709 (gdb-set-buffer-rules 'gdb-partial-output-buffer
 710                       'gdb-partial-output-name)
 711
 712 (defun gdb-partial-output-name ()
 713   (concat "*partial-output-"
 714           (gdb-get-target-string)
 715           "*"))
 716
 717 \f
 718 (gdb-set-buffer-rules 'gdb-inferior-io
 719                       'gdb-inferior-io-name
 720                       'gdb-inferior-io-mode)
 721
 722 (defun gdb-inferior-io-name ()
 723   (concat "*input/output of "
 724           (gdb-get-target-string)
 725           "*"))
 726
 727 (defun gdb-display-inferior-io-buffer ()
 728   "Display IO of inferior in a separate window."
 729   (interactive)
 730   (if gdb-use-inferior-io-buffer
 731       (gdb-display-buffer
 732        (gdb-get-create-buffer 'gdb-inferior-io))))
 733
 734 (defconst gdb-frame-parameters
 735   '((height . 14) (width . 80)
 736     (unsplittable . t)
 737     (tool-bar-lines . nil)
 738     (menu-bar-lines . nil)
 739     (minibuffer . nil)))
 740
 741 (defun gdb-frame-inferior-io-buffer ()
 742   "Display IO of inferior in a new frame."
 743   (interactive)
 744   (if gdb-use-inferior-io-buffer
 745       (let ((special-display-regexps (append special-display-regexps '(".*")))
 746             (special-display-frame-alist gdb-frame-parameters))
 747         (display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))))
 748
 749 (defvar gdb-inferior-io-mode-map
 750   (let ((map (make-sparse-keymap)))
 751     (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt)
 752     (define-key map "\C-c\C-z" 'gdb-inferior-io-stop)
 753     (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit)
 754     (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
 755     (define-key map "\C-d" 'gdb-inferior-io-eof)
 756     map))
 757
 758 (define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
 759   "Major mode for gdb inferior-io."
 760   :syntax-table nil :abbrev-table nil
 761   ;; We want to use comint because it has various nifty and familiar
 762   ;; features.  We don't need a process, but comint wants one, so create
 763   ;; a dummy one.
 764   (make-comint-in-buffer
 765    (substring (buffer-name) 1 (- (length (buffer-name)) 1))
 766    (current-buffer) "hexl")
 767   (setq comint-input-sender 'gdb-inferior-io-sender))
 768
 769 (defun gdb-inferior-io-sender (proc string)
 770   ;; PROC is the pseudo-process created to satisfy comint.
 771   (with-current-buffer (process-buffer proc)
 772     (setq proc (get-buffer-process gud-comint-buffer))
 773     (process-send-string proc string)
 774     (process-send-string proc "\n")))
 775
 776 (defun gdb-inferior-io-interrupt ()
 777   "Interrupt the program being debugged."
 778   (interactive)
 779   (interrupt-process
 780    (get-buffer-process gud-comint-buffer) comint-ptyp))
 781
 782 (defun gdb-inferior-io-quit ()
 783   "Send quit signal to the program being debugged."
 784   (interactive)
 785   (quit-process
 786    (get-buffer-process gud-comint-buffer) comint-ptyp))
 787
 788 (defun gdb-inferior-io-stop ()
 789   "Stop the program being debugged."
 790   (interactive)
 791   (stop-process
 792    (get-buffer-process gud-comint-buffer) comint-ptyp))
 793
 794 (defun gdb-inferior-io-eof ()
 795   "Send end-of-file to the program being debugged."
 796   (interactive)
 797   (process-send-eof
 798    (get-buffer-process gud-comint-buffer)))
 799 \f
 800
 801 ;;
 802 ;; gdb communications
 803 ;;
 804
 805 ;; INPUT: things sent to gdb
 806 ;;
 807 ;; The queues are lists.  Each element is either a string (indicating user or
 808 ;; user-like input) or a list of the form:
 809 ;;
 810 ;;    (INPUT-STRING  HANDLER-FN)
 811 ;;
 812 ;; The handler function will be called from the partial-output buffer when the
 813 ;; command completes.  This is the way to write commands which invoke gdb
 814 ;; commands autonomously.
 815 ;;
 816 ;; These lists are consumed tail first.
 817 ;;
 818
 819 (defun gdb-send (proc string)
 820   "A comint send filter for gdb.
 821 This filter may simply queue input for a later time."
 822   (with-current-buffer gud-comint-buffer
 823     (let ((inhibit-read-only t))
 824       (remove-text-properties (point-min) (point-max) '(face))))
 825   (let ((item (concat string "\n")))
 826     (if gud-running
 827       (progn
 828         (if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log))
 829         (process-send-string proc item))
 830       (gdb-enqueue-input item))))
 831
 832 ;; Note: Stuff enqueued here will be sent to the next prompt, even if it
 833 ;; is a query, or other non-top-level prompt.
 834
 835 (defun gdb-enqueue-input (item)
 836   (if gdb-prompting
 837       (progn
 838         (gdb-send-item item)
 839         (setq gdb-prompting nil))
 840     (push item gdb-input-queue)))
 841
 842 (defun gdb-dequeue-input ()
 843   (let ((queue gdb-input-queue))
 844     (and queue
 845          (let ((last (car (last queue))))
 846            (unless (nbutlast queue) (setq gdb-input-queue '()))
 847            last))))
 848
 849 (defun gdb-send-item (item)
 850   (setq gdb-flush-pending-output nil)
 851   (if gdb-enable-debug-log (push (cons 'send-item item) gdb-debug-log))
 852   (setq gdb-current-item item)
 853   (with-current-buffer gud-comint-buffer
 854     (if (eq gud-minor-mode 'gdba)
 855         (if (stringp item)
 856             (progn
 857               (setq gdb-output-sink 'user)
 858               (process-send-string (get-buffer-process gud-comint-buffer) item))
 859           (progn
 860             (gdb-clear-partial-output)
 861             (setq gdb-output-sink 'pre-emacs)
 862             (process-send-string (get-buffer-process gud-comint-buffer)
 863                                  (car item))))
 864       ;; case: eq gud-minor-mode 'gdbmi
 865       (gdb-clear-partial-output)
 866       (setq gdb-output-sink 'emacs)
 867       (process-send-string (get-buffer-process gud-comint-buffer)
 868                            (car item)))))
 869 \f
 870 ;;
 871 ;; output -- things gdb prints to emacs
 872 ;;
 873 ;; GDB output is a stream interrupted by annotations.
 874 ;; Annotations can be recognized by their beginning
 875 ;; with \C-j\C-z\C-z<tag><opt>\C-j
 876 ;;
 877 ;; The tag is a string obeying symbol syntax.
 878 ;;
 879 ;; The optional part `<opt>' can be either the empty string
 880 ;; or a space followed by more data relating to the annotation.
 881 ;; For example, the SOURCE annotation is followed by a filename,
 882 ;; line number and various useless goo.  This data must not include
 883 ;; any newlines.
 884 ;;
 885
 886 (defcustom gud-gdba-command-name "gdb -annotate=3"
 887   "Default command to execute an executable under the GDB-UI debugger."
 888   :type 'string
 889   :group 'gud
 890   :version "22.1")
 891
 892 (defvar gdb-annotation-rules
 893   '(("pre-prompt" gdb-pre-prompt)
 894     ("prompt" gdb-prompt)
 895     ("commands" gdb-subprompt)
 896     ("overload-choice" gdb-subprompt)
 897     ("query" gdb-subprompt)
 898     ;; Need this prompt for GDB 6.1
 899     ("nquery" gdb-subprompt)
 900     ("prompt-for-continue" gdb-subprompt)
 901     ("post-prompt" gdb-post-prompt)
 902     ("source" gdb-source)
 903     ("starting" gdb-starting)
 904     ("exited" gdb-exited)
 905     ("signalled" gdb-exited)
 906     ("signal" gdb-stopping)
 907     ("breakpoint" gdb-stopping)
 908     ("watchpoint" gdb-stopping)
 909     ("frame-begin" gdb-frame-begin)
 910     ("stopped" gdb-stopped)
 911     ("error-begin" gdb-error)
 912     ("error" gdb-error)
 913     ) "An assoc mapping annotation tags to functions which process them.")
 914
 915 (defun gdb-resync()
 916   (setq gdb-flush-pending-output t)
 917   (setq gud-running nil)
 918   (setq gdb-output-sink 'user)
 919   (setq gdb-input-queue nil)
 920   (setq gdb-pending-triggers nil)
 921   (setq gdb-prompting t))
 922
 923 (defconst gdb-source-spec-regexp
 924   "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x0*\\([a-f0-9]*\\)")
 925
 926 ;; Do not use this except as an annotation handler.
 927 (defun gdb-source (args)
 928   (string-match gdb-source-spec-regexp args)
 929   ;; Extract the frame position from the marker.
 930   (setq gud-last-frame
 931         (cons
 932          (match-string 1 args)
 933          (string-to-number (match-string 2 args))))
 934   (setq gdb-frame-address (match-string 3 args))
 935   ;; cover for auto-display output which comes *before*
 936   ;; stopped annotation
 937   (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
 938
 939 (defun gdb-pre-prompt (ignored)
 940   "An annotation handler for `pre-prompt'.
 941 This terminates the collection of output from a previous command if that
 942 happens to be in effect."
 943   (let ((sink gdb-output-sink))
 944     (cond
 945      ((eq sink 'user) t)
 946      ((eq sink 'emacs)
 947       (setq gdb-output-sink 'post-emacs))
 948      (t
 949       (gdb-resync)
 950       (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
 951
 952 (defun gdb-prompt (ignored)
 953   "An annotation handler for `prompt'.
 954 This sends the next command (if any) to gdb."
 955   (when gdb-first-prompt (gdb-ann3))
 956   (let ((sink gdb-output-sink))
 957     (cond
 958      ((eq sink 'user) t)
 959      ((eq sink 'post-emacs)
 960       (setq gdb-output-sink 'user)
 961       (let ((handler
 962              (car (cdr gdb-current-item))))
 963         (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
 964           (funcall handler))))
 965      (t
 966       (gdb-resync)
 967       (error "Phase error in gdb-prompt (got %s)" sink))))
 968   (let ((input (gdb-dequeue-input)))
 969     (if input
 970         (gdb-send-item input)
 971       (progn
 972         (setq gdb-prompting t)
 973         (gud-display-frame)))))
 974
 975 (defun gdb-subprompt (ignored)
 976   "An annotation handler for non-top-level prompts."
 977   (setq gdb-prompting t))
 978
 979 (defun gdb-starting (ignored)
 980   "An annotation handler for `starting'.
 981 This says that I/O for the subprocess is now the program being debugged,
 982 not GDB."
 983   (setq gdb-active-process t)
 984   (let ((sink gdb-output-sink))
 985     (cond
 986      ((eq sink 'user)
 987       (progn
 988         (setq gud-running t)
 989         (if gdb-use-inferior-io-buffer
 990             (setq gdb-output-sink 'inferior))))
 991      (t
 992       (gdb-resync)
 993       (error "Unexpected `starting' annotation")))))
 994
 995 (defun gdb-stopping (ignored)
 996   "An annotation handler for `breakpoint' and other annotations.
 997 They say that I/O for the subprocess is now GDB, not the program
 998 being debugged."
 999   (if gdb-use-inferior-io-buffer
1000       (let ((sink gdb-output-sink))
1001         (cond
1002          ((eq sink 'inferior)
1003           (setq gdb-output-sink 'user))
1004          (t
1005           (gdb-resync)
1006           (error "Unexpected stopping annotation"))))))
1007
1008 (defun gdb-exited (ignored)
1009   "An annotation handler for `exited' and `signalled'.
1010 They say that I/O for the subprocess is now GDB, not the program
1011 being debugged and that the program is no longer running.  This
1012 function is used to change the focus of GUD tooltips to #define
1013 directives."
1014   (setq gdb-active-process nil)
1015   (gdb-stopping ignored))
1016
1017 (defun gdb-frame-begin (ignored)
1018   (let ((sink gdb-output-sink))
1019     (cond
1020      ((eq sink 'inferior)
1021       (setq gdb-output-sink 'user))
1022      ((eq sink 'user) t)
1023      ((eq sink 'emacs) t)
1024      (t
1025       (gdb-resync)
1026       (error "Unexpected frame-begin annotation (%S)" sink)))))
1027
1028 (defun gdb-stopped (ignored)
1029   "An annotation handler for `stopped'.
1030 It is just like `gdb-stopping', except that if we already set the output
1031 sink to `user' in `gdb-stopping', that is fine."
1032   (setq gud-running nil)
1033   (let ((sink gdb-output-sink))
1034     (cond
1035      ((eq sink 'inferior)
1036       (setq gdb-output-sink 'user))
1037      ((eq sink 'user) t)
1038      (t
1039       (gdb-resync)
1040       (error "Unexpected stopped annotation")))))
1041
1042 (defun gdb-error (ignored)
1043   (setq gdb-error (not gdb-error)))
1044
1045 (defun gdb-post-prompt (ignored)
1046   "An annotation handler for `post-prompt'.
1047 This begins the collection of output from the current command if that
1048 happens to be appropriate."
1049   (unless gdb-pending-triggers
1050     (gdb-get-selected-frame)
1051     (gdb-invalidate-frames)
1052     (gdb-invalidate-breakpoints)
1053     ;; Do this through gdb-get-selected-frame -> gdb-frame-handler
1054     ;; so gdb-frame-address is updated.
1055     ;; (gdb-invalidate-assembler)
1056     (gdb-invalidate-registers)
1057     (gdb-invalidate-memory)
1058     (gdb-invalidate-locals)
1059     (gdb-invalidate-threads)
1060     (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
1061       ;; FIXME: with GDB-6 on Darwin, this might very well work.
1062       ;; Only needed/used with speedbar/watch expressions.
1063       (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
1064         (setq gdb-var-changed t)    ; force update
1065         (dolist (var gdb-var-list)
1066           (setcar (nthcdr 5 var) nil))
1067         (gdb-var-update))))
1068   (let ((sink gdb-output-sink))
1069     (cond
1070      ((eq sink 'user) t)
1071      ((eq sink 'pre-emacs)
1072       (setq gdb-output-sink 'emacs))
1073      (t
1074       (gdb-resync)
1075       (error "Phase error in gdb-post-prompt (got %s)" sink)))))
1076
1077 (defun gud-gdba-marker-filter (string)
1078   "A gud marker filter for gdb.  Handle a burst of output from GDB."
1079   (if gdb-flush-pending-output
1080       nil
1081     (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
1082     ;; Recall the left over gud-marker-acc from last time.
1083     (setq gud-marker-acc (concat gud-marker-acc string))
1084     ;; Start accumulating output for the GUD buffer.
1085     (let ((output ""))
1086       ;;
1087       ;; Process all the complete markers in this chunk.
1088       (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
1089         (let ((annotation (match-string 1 gud-marker-acc)))
1090           ;;
1091           ;; Stuff prior to the match is just ordinary output.
1092           ;; It is either concatenated to OUTPUT or directed
1093           ;; elsewhere.
1094           (setq output
1095                 (gdb-concat-output
1096                  output
1097                  (substring gud-marker-acc 0 (match-beginning 0))))
1098           ;;
1099           ;; Take that stuff off the gud-marker-acc.
1100           (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
1101           ;;
1102           ;; Parse the tag from the annotation, and maybe its arguments.
1103           (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
1104           (let* ((annotation-type (match-string 1 annotation))
1105                  (annotation-arguments (match-string 2 annotation))
1106                  (annotation-rule (assoc annotation-type
1107                                          gdb-annotation-rules)))
1108             ;; Call the handler for this annotation.
1109             (if annotation-rule
1110                 (funcall (car (cdr annotation-rule))
1111                          annotation-arguments)
1112               ;; Else the annotation is not recognized.  Ignore it silently,
1113               ;; so that GDB can add new annotations without causing
1114               ;; us to blow up.
1115               ))))
1116       ;;
1117       ;; Does the remaining text end in a partial line?
1118       ;; If it does, then keep part of the gud-marker-acc until we get more.
1119       (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1120                         gud-marker-acc)
1121           (progn
1122             ;; Everything before the potential marker start can be output.
1123             (setq output
1124                   (gdb-concat-output output
1125                                      (substring gud-marker-acc 0
1126                                                 (match-beginning 0))))
1127             ;;
1128             ;; Everything after, we save, to combine with later input.
1129             (setq gud-marker-acc (substring gud-marker-acc
1130                                             (match-beginning 0))))
1131         ;;
1132         ;; In case we know the gud-marker-acc contains no partial annotations:
1133         (progn
1134           (setq output (gdb-concat-output output gud-marker-acc))
1135           (setq gud-marker-acc "")))
1136       output)))
1137
1138 (defun gdb-concat-output (so-far new)
1139   (if gdb-error
1140       (put-text-property 0 (length new) 'face font-lock-warning-face new))
1141   (let ((sink gdb-output-sink))
1142     (cond
1143      ((eq sink 'user) (concat so-far new))
1144      ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
1145      ((eq sink 'emacs)
1146       (gdb-append-to-partial-output new)
1147       so-far)
1148      ((eq sink 'inferior)
1149       (gdb-append-to-inferior-io new)
1150       so-far)
1151      (t
1152       (gdb-resync)
1153       (error "Bogon output sink %S" sink)))))
1154
1155 (defun gdb-append-to-partial-output (string)
1156   (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1157     (goto-char (point-max))
1158     (insert string)))
1159
1160 (defun gdb-clear-partial-output ()
1161   (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1162     (erase-buffer)))
1163
1164 (defun gdb-append-to-inferior-io (string)
1165   (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
1166     (goto-char (point-max))
1167     (insert-before-markers string))
1168   (if (not (string-equal string ""))
1169       (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io))))
1170
1171 (defun gdb-clear-inferior-io ()
1172   (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
1173     (erase-buffer)))
1174 \f
1175
1176 ;; One trick is to have a command who's output is always available in a buffer
1177 ;; of it's own, and is always up to date.  We build several buffers of this
1178 ;; type.
1179 ;;
1180 ;; There are two aspects to this: gdb has to tell us when the output for that
1181 ;; command might have changed, and we have to be able to run the command
1182 ;; behind the user's back.
1183 ;;
1184 ;; The output phasing associated with the variable gdb-output-sink
1185 ;; help us to run commands behind the user's back.
1186 ;;
1187 ;; Below is the code for specificly managing buffers of output from one
1188 ;; command.
1189 ;;
1190
1191 ;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1192 ;; It adds an input for the command we are tracking.  It should be the
1193 ;; annotation rule binding of whatever gdb sends to tell us this command
1194 ;; might have changed it's output.
1195 ;;
1196 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1197 ;; GDB-COMMAND is a string of such.  OUTPUT-HANDLER is the function bound to the
1198 ;; input in the input queue (see comment about ``gdb communications'' above).
1199
1200 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command
1201                                             output-handler)
1202   `(defun ,name (&optional ignored)
1203      (if (and ,demand-predicate
1204               (not (member ',name
1205                            gdb-pending-triggers)))
1206          (progn
1207            (gdb-enqueue-input
1208             (list ,gdb-command ',output-handler))
1209            (push ',name gdb-pending-triggers)))))
1210
1211 (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
1212   `(defun ,name ()
1213      (setq gdb-pending-triggers
1214       (delq ',trigger
1215             gdb-pending-triggers))
1216      (let ((buf (gdb-get-buffer ',buf-key)))
1217        (and buf
1218             (with-current-buffer buf
1219               (let* ((window (get-buffer-window buf 0))
1220                      (p (window-point window))
1221                     (buffer-read-only nil))
1222                 (erase-buffer)
1223                 (insert-buffer-substring (gdb-get-create-buffer
1224                                           'gdb-partial-output-buffer))
1225                 (set-window-point window p)))))
1226      ;; put customisation here
1227      (,custom-defun)))
1228
1229 (defmacro def-gdb-auto-updated-buffer (buffer-key
1230                                        trigger-name gdb-command
1231                                        output-handler-name custom-defun)
1232   `(progn
1233      (def-gdb-auto-update-trigger ,trigger-name
1234        ;; The demand predicate:
1235        (gdb-get-buffer ',buffer-key)
1236        ,gdb-command
1237        ,output-handler-name)
1238      (def-gdb-auto-update-handler ,output-handler-name
1239        ,trigger-name ,buffer-key ,custom-defun)))
1240
1241 \f
1242 ;;
1243 ;; Breakpoint buffer : This displays the output of `info breakpoints'.
1244 ;;
1245 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
1246                       'gdb-breakpoints-buffer-name
1247                       'gdb-breakpoints-mode)
1248
1249 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1250   ;; This defines the auto update rule for buffers of type
1251   ;; `gdb-breakpoints-buffer'.
1252   ;;
1253   ;; It defines a function to serve as the annotation handler that
1254   ;; handles the `foo-invalidated' message.  That function is called:
1255   gdb-invalidate-breakpoints
1256   ;;
1257   ;; To update the buffer, this command is sent to gdb.
1258   "server info breakpoints\n"
1259   ;;
1260   ;; This also defines a function to be the handler for the output
1261   ;; from the command above.  That function will copy the output into
1262   ;; the appropriately typed buffer.  That function will be called:
1263   gdb-info-breakpoints-handler
1264   ;; buffer specific functions
1265   gdb-info-breakpoints-custom)
1266
1267 (defconst breakpoint-xpm-data
1268   "/* XPM */
1269 static char *magick[] = {
1270 /* columns rows colors chars-per-pixel */
1271 \"10 10 2 1\",
1272 \"  c red\",
1273 \"+ c None\",
1274 /* pixels */
1275 \"+++    +++\",
1276 \"++      ++\",
1277 \"+        +\",
1278 \"          \",
1279 \"          \",
1280 \"          \",
1281 \"          \",
1282 \"+        +\",
1283 \"++      ++\",
1284 \"+++    +++\",
1285 };"
1286   "XPM data used for breakpoint icon.")
1287
1288 (defconst breakpoint-enabled-pbm-data
1289   "P1
1290 10 10\",
1291 0 0 0 0 1 1 1 1 0 0 0 0
1292 0 0 0 1 1 1 1 1 1 0 0 0
1293 0 0 1 1 1 1 1 1 1 1 0 0
1294 0 1 1 1 1 1 1 1 1 1 1 0
1295 0 1 1 1 1 1 1 1 1 1 1 0
1296 0 1 1 1 1 1 1 1 1 1 1 0
1297 0 1 1 1 1 1 1 1 1 1 1 0
1298 0 0 1 1 1 1 1 1 1 1 0 0
1299 0 0 0 1 1 1 1 1 1 0 0 0
1300 0 0 0 0 1 1 1 1 0 0 0 0"
1301   "PBM data used for enabled breakpoint icon.")
1302
1303 (defconst breakpoint-disabled-pbm-data
1304   "P1
1305 10 10\",
1306 0 0 1 0 1 0 1 0 0 0
1307 0 1 0 1 0 1 0 1 0 0
1308 1 0 1 0 1 0 1 0 1 0
1309 0 1 0 1 0 1 0 1 0 1
1310 1 0 1 0 1 0 1 0 1 0
1311 0 1 0 1 0 1 0 1 0 1
1312 1 0 1 0 1 0 1 0 1 0
1313 0 1 0 1 0 1 0 1 0 1
1314 0 0 1 0 1 0 1 0 1 0
1315 0 0 0 1 0 1 0 1 0 0"
1316   "PBM data used for disabled breakpoint icon.")
1317
1318 (defvar breakpoint-enabled-icon nil
1319   "Icon for enabled breakpoint in display margin.")
1320
1321 (defvar breakpoint-disabled-icon nil
1322   "Icon for disabled breakpoint in display margin.")
1323
1324 ;; Bitmap for breakpoint in fringe
1325 (and (display-images-p)
1326      (define-fringe-bitmap 'breakpoint
1327        "\x3c\x7e\xff\xff\xff\xff\x7e\x3c"))
1328
1329 (defface breakpoint-enabled
1330   '((t
1331      :foreground "red"
1332      :weight bold))
1333   "Face for enabled breakpoint icon in fringe."
1334   :group 'gud)
1335 ;; Compatibility alias for old name.
1336 (put 'breakpoint-enabled-bitmap-face 'face-alias 'breakpoint-enabled)
1337
1338 (defface breakpoint-disabled
1339   ;; We use different values of grey for different background types,
1340   ;; so that on low-color displays it will end up as something visible
1341   ;; if it has to be approximated.
1342   '((((background dark))  :foreground "grey60")
1343     (((background light)) :foreground "grey40"))
1344   "Face for disabled breakpoint icon in fringe."
1345   :group 'gud)
1346
1347 ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
1348 (defun gdb-info-breakpoints-custom ()
1349   (let ((flag) (bptno))
1350     ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
1351     (dolist (buffer (buffer-list))
1352       (with-current-buffer buffer
1353         (if (and (eq gud-minor-mode 'gdba)
1354                  (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
1355             (gdb-remove-breakpoint-icons (point-min) (point-max)))))
1356     (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1357       (save-excursion
1358         (goto-char (point-min))
1359         (while (< (point) (- (point-max) 1))
1360           (forward-line 1)
1361           (if (looking-at "[^\t].*?breakpoint")
1362               (progn
1363                 (looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)")
1364                 (setq bptno (match-string 1))
1365                 (setq flag (char-after (match-beginning 2)))
1366                 (beginning-of-line)
1367                 (if (re-search-forward " in \\(.*\\) at\\s-+" nil t)
1368                     (progn
1369                       (let ((buffer-read-only nil))
1370                         (add-text-properties (match-beginning 1) (match-end 1)
1371                                              '(face font-lock-function-name-face)))
1372                       (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
1373                       (let ((line (match-string 2)) (buffer-read-only nil)
1374                             (file (match-string 1)))
1375                         (add-text-properties (line-beginning-position)
1376                                              (line-end-position)
1377                          '(mouse-face highlight
1378                            help-echo "mouse-2, RET: visit breakpoint"))
1379                         (unless (file-exists-p file)
1380                            (setq file (cdr (assoc bptno gdb-location-alist))))
1381                         (if (and file
1382                                  (not (string-equal file "File not found")))
1383                             (with-current-buffer
1384                                 (find-file-noselect file 'nowarn)
1385                               (set (make-local-variable 'gud-minor-mode)
1386                                    'gdba)
1387                               (set (make-local-variable 'tool-bar-map)
1388                                    gud-tool-bar-map)
1389                               ;; Only want one breakpoint icon at each
1390                               ;; location.
1391                               (save-excursion
1392                                 (goto-line (string-to-number line))
1393                                 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
1394                           (gdb-enqueue-input
1395                            (list
1396                             (concat "list "
1397                                     (match-string-no-properties 1) ":1\n")
1398                             'ignore))
1399                           (gdb-enqueue-input
1400                            (list "info source\n"
1401                                  `(lambda () (gdb-get-location
1402                                               ,bptno ,line ,flag))))))))))
1403           (end-of-line)))))
1404   (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
1405
1406 (defun gdb-mouse-set-clear-breakpoint (event)
1407   "Set/clear breakpoint in left fringe/margin with mouse click."
1408   (interactive "e")
1409   (mouse-minibuffer-check event)
1410   (let ((posn (event-end event)))
1411     (if (numberp (posn-point posn))
1412         (with-selected-window (posn-window posn)
1413           (save-excursion
1414             (goto-char (posn-point posn))
1415             (if (or (posn-object posn)
1416                     (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
1417                         'breakpoint))
1418                 (gud-remove nil)
1419               (gud-break nil)))))))
1420
1421 (defun gdb-mouse-toggle-breakpoint-margin (event)
1422   "Enable/disable breakpoint in left margin with mouse click."
1423   (interactive "e")
1424   (mouse-minibuffer-check event)
1425   (let ((posn (event-end event)))
1426     (if (numberp (posn-point posn))
1427         (with-selected-window (posn-window posn)
1428           (save-excursion
1429             (goto-char (posn-point posn))
1430             (if (posn-object posn)
1431                 (gdb-enqueue-input
1432                  (list
1433                   (let ((bptno (get-text-property
1434                                 0 'gdb-bptno (car (posn-string posn)))))
1435                     (concat
1436                             (if (get-text-property
1437                                  0 'gdb-enabled (car (posn-string posn)))
1438                                 "disable "
1439                               "enable ")
1440                             bptno "\n"))
1441                   'ignore))))))))
1442
1443 (defun gdb-mouse-toggle-breakpoint-fringe (event)
1444   "Enable/disable breakpoint in left fringe with mouse click."
1445   (interactive "e")
1446   (mouse-minibuffer-check event)
1447   (let* ((posn (event-end event))
1448          (pos (posn-point posn))
1449          obj)
1450     (when (numberp pos)
1451       (with-selected-window (posn-window posn)
1452         (save-excursion
1453           (set-buffer (window-buffer (selected-window)))
1454           (goto-char pos)
1455           (dolist (overlay (overlays-in pos pos))
1456             (when (overlay-get overlay 'put-break)
1457               (setq obj (overlay-get overlay 'before-string))))
1458           (when (stringp obj)
1459             (gdb-enqueue-input
1460              (list
1461               (concat
1462                (if (get-text-property 0 'gdb-enabled obj)
1463                    "disable "
1464                  "enable ")
1465                (get-text-property 0 'gdb-bptno obj) "\n")
1466               'ignore))))))))
1467
1468 (defun gdb-breakpoints-buffer-name ()
1469   (with-current-buffer gud-comint-buffer
1470     (concat "*breakpoints of " (gdb-get-target-string) "*")))
1471
1472 (defun gdb-display-breakpoints-buffer ()
1473   "Display status of user-settable breakpoints."
1474   (interactive)
1475   (gdb-display-buffer
1476    (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
1477
1478 (defun gdb-frame-breakpoints-buffer ()
1479   "Display status of user-settable breakpoints in a new frame."
1480   (interactive)
1481   (let ((special-display-regexps (append special-display-regexps '(".*")))
1482         (special-display-frame-alist gdb-frame-parameters))
1483     (display-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer))))
1484
1485 (defvar gdb-breakpoints-mode-map
1486   (let ((map (make-sparse-keymap))
1487         (menu (make-sparse-keymap "Breakpoints")))
1488     (define-key menu [quit] '("Quit"   . kill-this-buffer))
1489     (define-key menu [goto] '("Goto"   . gdb-goto-breakpoint))
1490     (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1491     (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
1492     (suppress-keymap map)
1493     (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1494     (define-key map " " 'gdb-toggle-breakpoint)
1495     (define-key map "d" 'gdb-delete-breakpoint)
1496     (define-key map "q" 'kill-this-buffer)
1497     (define-key map "\r" 'gdb-goto-breakpoint)
1498     (define-key map [mouse-2] 'gdb-goto-breakpoint)
1499     (define-key map [follow-link] 'mouse-face)
1500     map))
1501
1502 (defun gdb-breakpoints-mode ()
1503   "Major mode for gdb breakpoints.
1504
1505 \\{gdb-breakpoints-mode-map}"
1506   (kill-all-local-variables)
1507   (setq major-mode 'gdb-breakpoints-mode)
1508   (setq mode-name "Breakpoints")
1509   (use-local-map gdb-breakpoints-mode-map)
1510   (setq buffer-read-only t)
1511   (run-mode-hooks 'gdb-breakpoints-mode-hook)
1512   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1513       'gdb-invalidate-breakpoints
1514     'gdbmi-invalidate-breakpoints))
1515
1516 (defun gdb-toggle-breakpoint ()
1517   "Enable/disable breakpoint at current line."
1518   (interactive)
1519   (save-excursion
1520     (beginning-of-line 1)
1521     (if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1522             (looking-at "\\([0-9]+\\).*?point\\s-+\\S-+\\s-+\\(.\\)\\s-+")
1523           (looking-at
1524      "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+\\S-+\\s-+\\S-+:[0-9]+"))
1525         (gdb-enqueue-input
1526          (list
1527           (concat gdb-server-prefix
1528                   (if (eq ?y (char-after (match-beginning 2)))
1529                       "disable "
1530                     "enable ")
1531                   (match-string 1) "\n") 'ignore))
1532       (error "Not recognized as break/watchpoint line"))))
1533
1534 (defun gdb-delete-breakpoint ()
1535   "Delete the breakpoint at current line."
1536   (interactive)
1537   (beginning-of-line 1)
1538   (if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1539           (looking-at "\\([0-9]+\\).*?point\\s-+\\S-+\\s-+\\(.\\)")
1540         (looking-at
1541          "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\s-+\\S-+\\s-+\\S-+:[0-9]+"))
1542       (gdb-enqueue-input
1543        (list
1544         (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore))
1545     (error "Not recognized as break/watchpoint line")))
1546
1547 (defun gdb-goto-breakpoint (&optional event)
1548   "Display the breakpoint location specified at current line."
1549   (interactive (list last-input-event))
1550   (if event (mouse-set-point event))
1551   (save-excursion
1552     (beginning-of-line 1)
1553     (if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1554             (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)")
1555           (looking-at
1556            "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+.\\s-+\\S-+\\s-+\
1557 \\(\\S-+\\):\\([0-9]+\\)"))
1558         (let ((bptno (match-string 1))
1559               (file  (match-string 2))
1560               (line  (match-string 3)))
1561           (save-selected-window
1562             (let* ((buf (find-file-noselect
1563                          (if (file-exists-p file) file
1564                            (cdr (assoc bptno gdb-location-alist)))))
1565                    (window (display-buffer buf)))
1566               (with-current-buffer buf
1567                 (goto-line (string-to-number line))
1568                 (set-window-point window (point))))))
1569       (error "Not recognized as break/watchpoint line"))))
1570 \f
1571
1572 ;; Frames buffer.  This displays a perpetually correct bactracktrace
1573 ;; (from the command `where').
1574 ;;
1575 ;; Alas, if your stack is deep, it is costly.
1576 ;;
1577 (gdb-set-buffer-rules 'gdb-stack-buffer
1578                       'gdb-stack-buffer-name
1579                       'gdb-frames-mode)
1580
1581 (def-gdb-auto-updated-buffer gdb-stack-buffer
1582   gdb-invalidate-frames
1583   "server where\n"
1584   gdb-info-frames-handler
1585   gdb-info-frames-custom)
1586
1587 (defun gdb-info-frames-custom ()
1588   (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1589     (save-excursion
1590       (let ((buffer-read-only nil)
1591             bl el)
1592         (goto-char (point-min))
1593         (while (< (point) (point-max))
1594           (setq bl (line-beginning-position)
1595                 el (line-end-position))
1596           (add-text-properties bl el
1597                              '(mouse-face highlight
1598                                help-echo "mouse-2, RET: Select frame"))
1599           (goto-char bl)
1600           (when (looking-at "^#\\([0-9]+\\)")
1601             (when (string-equal (match-string 1) gdb-frame-number)
1602                 (put-text-property bl (+ bl 4)
1603                                    'face '(:inverse-video t)))
1604             (when (re-search-forward
1605                    (concat
1606                     (if (string-equal (match-string 1) "0") "" " in ")
1607                     "\\([^ ]+\\) (") el t)
1608               (put-text-property (match-beginning 1) (match-end 1)
1609                                  'face font-lock-function-name-face)
1610               (setq bl (match-end 0))
1611               (while (re-search-forward "<\\([^>]+\\)>" el t)
1612                 (put-text-property (match-beginning 1) (match-end 1)
1613                                      'face font-lock-function-name-face))
1614               (goto-char bl)
1615               (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t)
1616                 (put-text-property (match-beginning 1) (match-end 1)
1617                                    'face font-lock-variable-name-face))))
1618           (forward-line 1))))))
1619
1620 (defun gdb-stack-buffer-name ()
1621   (with-current-buffer gud-comint-buffer
1622     (concat "*stack frames of " (gdb-get-target-string) "*")))
1623
1624 (defun gdb-display-stack-buffer ()
1625   "Display backtrace of current stack."
1626   (interactive)
1627   (gdb-display-buffer
1628    (gdb-get-create-buffer 'gdb-stack-buffer)))
1629
1630 (defun gdb-frame-stack-buffer ()
1631   "Display backtrace of current stack in a new frame."
1632   (interactive)
1633   (let ((special-display-regexps (append special-display-regexps '(".*")))
1634         (special-display-frame-alist gdb-frame-parameters))
1635     (display-buffer (gdb-get-create-buffer 'gdb-stack-buffer))))
1636
1637 (defvar gdb-frames-mode-map
1638   (let ((map (make-sparse-keymap)))
1639     (suppress-keymap map)
1640     (define-key map "q" 'kill-this-buffer)
1641     (define-key map "\r" 'gdb-frames-select)
1642     (define-key map [mouse-2] 'gdb-frames-select)
1643     (define-key map [follow-link] 'mouse-face)
1644     map))
1645
1646 (defun gdb-frames-mode ()
1647   "Major mode for gdb frames.
1648
1649 \\{gdb-frames-mode-map}"
1650   (kill-all-local-variables)
1651   (setq major-mode 'gdb-frames-mode)
1652   (setq mode-name "Frames")
1653   (setq buffer-read-only t)
1654   (use-local-map gdb-frames-mode-map)
1655   (font-lock-mode -1)
1656   (run-mode-hooks 'gdb-frames-mode-hook)
1657   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1658       'gdb-invalidate-frames
1659     'gdbmi-invalidate-frames))
1660
1661 (defun gdb-get-frame-number ()
1662   (save-excursion
1663     (end-of-line)
1664     (let* ((pos (re-search-backward "^#*\\([0-9]*\\)" nil t))
1665            (n (or (and pos (match-string-no-properties 1)) "0")))
1666       n)))
1667
1668 (defun gdb-frames-select (&optional event)
1669   "Select the frame and display the relevant source."
1670   (interactive (list last-input-event))
1671   (if event (mouse-set-point event))
1672   (gdb-enqueue-input
1673    (list (concat gdb-server-prefix "frame "
1674                  (gdb-get-frame-number) "\n") 'ignore))
1675   (gud-display-frame))
1676 \f
1677
1678 ;; Threads buffer.  This displays a selectable thread list.
1679 ;;
1680 (gdb-set-buffer-rules 'gdb-threads-buffer
1681                       'gdb-threads-buffer-name
1682                       'gdb-threads-mode)
1683
1684 (def-gdb-auto-updated-buffer gdb-threads-buffer
1685   gdb-invalidate-threads
1686   (concat gdb-server-prefix "info threads\n")
1687   gdb-info-threads-handler
1688   gdb-info-threads-custom)
1689
1690 (defun gdb-info-threads-custom ()
1691   (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1692     (let ((buffer-read-only nil))
1693       (goto-char (point-min))
1694       (while (< (point) (point-max))
1695         (add-text-properties (line-beginning-position) (line-end-position)
1696                              '(mouse-face highlight
1697                                help-echo "mouse-2, RET: select thread"))
1698         (forward-line 1)))))
1699
1700 (defun gdb-threads-buffer-name ()
1701   (with-current-buffer gud-comint-buffer
1702     (concat "*threads of " (gdb-get-target-string) "*")))
1703
1704 (defun gdb-display-threads-buffer ()
1705   "Display IDs of currently known threads."
1706   (interactive)
1707   (gdb-display-buffer
1708    (gdb-get-create-buffer 'gdb-threads-buffer)))
1709
1710 (defun gdb-frame-threads-buffer ()
1711   "Display IDs of currently known threads in a new frame."
1712   (interactive)
1713   (let ((special-display-regexps (append special-display-regexps '(".*")))
1714         (special-display-frame-alist gdb-frame-parameters))
1715     (display-buffer (gdb-get-create-buffer 'gdb-threads-buffer))))
1716
1717 (defvar gdb-threads-mode-map
1718   (let ((map (make-sparse-keymap)))
1719     (suppress-keymap map)
1720     (define-key map "q" 'kill-this-buffer)
1721     (define-key map "\r" 'gdb-threads-select)
1722     (define-key map [mouse-2] 'gdb-threads-select)
1723     map))
1724
1725 (defvar gdb-threads-font-lock-keywords
1726   '(
1727     (") +\\([^ ]+\\) ("  (1 font-lock-function-name-face))
1728     ("in \\([^ ]+\\) ("  (1 font-lock-function-name-face))
1729     ("\\(\\(\\sw\\|[_.]\\)+\\)="  (1 font-lock-variable-name-face))
1730     )
1731   "Font lock keywords used in `gdb-threads-mode'.")
1732
1733 (defun gdb-threads-mode ()
1734   "Major mode for gdb frames.
1735
1736 \\{gdb-threads-mode-map}"
1737   (kill-all-local-variables)
1738   (setq major-mode 'gdb-threads-mode)
1739   (setq mode-name "Threads")
1740   (setq buffer-read-only t)
1741   (use-local-map gdb-threads-mode-map)
1742   (set (make-local-variable 'font-lock-defaults)
1743        '(gdb-threads-font-lock-keywords))
1744   (run-mode-hooks 'gdb-threads-mode-hook)
1745   'gdb-invalidate-threads)
1746
1747 (defun gdb-get-thread-number ()
1748   (save-excursion
1749     (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1750     (match-string-no-properties 1)))
1751
1752 (defun gdb-threads-select (&optional event)
1753   "Select the thread and display the relevant source."
1754   (interactive (list last-input-event))
1755   (if event (mouse-set-point event))
1756   (gdb-enqueue-input
1757    (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1758   (gud-display-frame))
1759 \f
1760
1761 ;; Registers buffer.
1762 ;;
1763 (defcustom gdb-all-registers nil
1764   "Non-nil means include floating-point registers."
1765   :type 'boolean
1766   :group 'gud
1767   :version "22.1")
1768
1769 (gdb-set-buffer-rules 'gdb-registers-buffer
1770                       'gdb-registers-buffer-name
1771                       'gdb-registers-mode)
1772
1773 (def-gdb-auto-updated-buffer gdb-registers-buffer
1774   gdb-invalidate-registers
1775   (concat
1776    gdb-server-prefix "info " (if gdb-all-registers "all-") "registers\n")
1777   gdb-info-registers-handler
1778   gdb-info-registers-custom)
1779
1780 (defun gdb-info-registers-custom ())
1781
1782 (defvar gdb-registers-mode-map
1783   (let ((map (make-sparse-keymap)))
1784     (suppress-keymap map)
1785     (define-key map " " 'toggle-gdb-all-registers)
1786     (define-key map "q" 'kill-this-buffer)
1787      map))
1788
1789 (defvar gdb-registers-font-lock-keywords
1790   '(
1791     ("^[^ ]+" . font-lock-variable-name-face)
1792     )
1793   "Font lock keywords used in `gdb-registers-mode'.")
1794
1795 (defun gdb-registers-mode ()
1796   "Major mode for gdb registers.
1797
1798 \\{gdb-registers-mode-map}"
1799   (kill-all-local-variables)
1800   (setq major-mode 'gdb-registers-mode)
1801   (setq mode-name "Registers:")
1802   (setq buffer-read-only t)
1803   (use-local-map gdb-registers-mode-map)
1804   (set (make-local-variable 'font-lock-defaults)
1805        '(gdb-registers-font-lock-keywords))
1806   (run-mode-hooks 'gdb-registers-mode-hook)
1807   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1808       'gdb-invalidate-registers
1809     'gdbmi-invalidate-registers))
1810
1811 (defun gdb-registers-buffer-name ()
1812   (with-current-buffer gud-comint-buffer
1813     (concat "*registers of " (gdb-get-target-string) "*")))
1814
1815 (defun gdb-display-registers-buffer ()
1816   "Display integer register contents."
1817   (interactive)
1818   (gdb-display-buffer
1819    (gdb-get-create-buffer 'gdb-registers-buffer)))
1820
1821 (defun gdb-frame-registers-buffer ()
1822   "Display integer register contents in a new frame."
1823   (interactive)
1824   (let ((special-display-regexps (append special-display-regexps '(".*")))
1825         (special-display-frame-alist gdb-frame-parameters))
1826     (display-buffer (gdb-get-create-buffer 'gdb-registers-buffer))))
1827
1828 (defun toggle-gdb-all-registers ()
1829   "Toggle the display of floating-point registers."
1830   (interactive)
1831   (if gdb-all-registers
1832       (progn
1833         (setq gdb-all-registers nil)
1834         (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
1835           (setq mode-name "Registers:")))
1836         (setq gdb-all-registers t)
1837         (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
1838           (setq mode-name "Registers:All")))
1839   (gdb-invalidate-registers))
1840 \f
1841
1842 ;; Memory buffer.
1843 ;;
1844 (defcustom gdb-memory-repeat-count 32
1845   "Number of data items in memory window."
1846   :type 'integer
1847   :group 'gud
1848   :version "22.1")
1849
1850 (defcustom gdb-memory-format "x"
1851   "Display format of data items in memory window."
1852   :type '(choice (const :tag "Hexadecimal" "x")
1853                  (const :tag "Signed decimal" "d")
1854                  (const :tag "Unsigned decimal" "u")
1855                  (const :tag "Octal" "o")
1856                  (const :tag "Binary" "t"))
1857   :group 'gud
1858   :version "22.1")
1859
1860 (defcustom gdb-memory-unit "w"
1861   "Unit size of data items in memory window."
1862   :type '(choice (const :tag "Byte" "b")
1863                  (const :tag "Halfword" "h")
1864                  (const :tag "Word" "w")
1865                  (const :tag "Giant word" "g"))
1866   :group 'gud
1867   :version "22.1")
1868
1869 (gdb-set-buffer-rules 'gdb-memory-buffer
1870                       'gdb-memory-buffer-name
1871                       'gdb-memory-mode)
1872
1873 (def-gdb-auto-updated-buffer gdb-memory-buffer
1874   gdb-invalidate-memory
1875   (concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count)
1876           gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n")
1877   gdb-read-memory-handler
1878   gdb-read-memory-custom)
1879
1880 (defun gdb-read-memory-custom ()
1881   (save-excursion
1882     (goto-char (point-min))
1883     (if (looking-at "0x[[:xdigit:]]+")
1884         (setq gdb-memory-address (match-string 0)))))
1885
1886 (defvar gdb-memory-mode-map
1887   (let ((map (make-sparse-keymap)))
1888     (suppress-keymap map)
1889     (define-key map "q" 'kill-this-buffer)
1890      map))
1891
1892 (defun gdb-memory-set-address (event)
1893   "Set the start memory address."
1894   (interactive "e")
1895   (save-selected-window
1896     (select-window (posn-window (event-start event)))
1897     (let ((arg (read-from-minibuffer "Memory address: ")))
1898       (setq gdb-memory-address arg))
1899     (gdb-invalidate-memory)))
1900
1901 (defun gdb-memory-set-repeat-count (event)
1902   "Set the number of data items in memory window."
1903   (interactive "e")
1904   (save-selected-window
1905     (select-window (posn-window (event-start event)))
1906     (let* ((arg (read-from-minibuffer "Repeat count: "))
1907           (count (string-to-number arg)))
1908       (if (<= count 0)
1909           (error "Positive numbers only")
1910         (customize-set-variable 'gdb-memory-repeat-count count)
1911         (gdb-invalidate-memory)))))
1912
1913 (defun gdb-memory-format-binary ()
1914   "Set the display format to binary."
1915   (interactive)
1916   (customize-set-variable 'gdb-memory-format "t")
1917   (gdb-invalidate-memory))
1918
1919 (defun gdb-memory-format-octal ()
1920   "Set the display format to octal."
1921   (interactive)
1922   (customize-set-variable 'gdb-memory-format "o")
1923   (gdb-invalidate-memory))
1924
1925 (defun gdb-memory-format-unsigned ()
1926   "Set the display format to unsigned decimal."
1927   (interactive)
1928   (customize-set-variable 'gdb-memory-format "u")
1929   (gdb-invalidate-memory))
1930
1931 (defun gdb-memory-format-signed ()
1932   "Set the display format to decimal."
1933   (interactive)
1934   (customize-set-variable 'gdb-memory-format "d")
1935   (gdb-invalidate-memory))
1936
1937 (defun gdb-memory-format-hexadecimal ()
1938   "Set the display format to hexadecimal."
1939   (interactive)
1940   (customize-set-variable 'gdb-memory-format "x")
1941   (gdb-invalidate-memory))
1942
1943 (defvar gdb-memory-format-keymap
1944   (let ((map (make-sparse-keymap)))
1945     (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
1946     map)
1947  "Keymap to select format in the header line.")
1948
1949 (defvar gdb-memory-format-menu (make-sparse-keymap "Format")
1950  "Menu of display formats in the header line.")
1951
1952 (define-key gdb-memory-format-menu [binary]
1953   '(menu-item "Binary" gdb-memory-format-binary
1954               :button (:radio . (equal gdb-memory-format "t"))))
1955 (define-key gdb-memory-format-menu [octal]
1956   '(menu-item "Octal" gdb-memory-format-octal
1957               :button (:radio . (equal gdb-memory-format "o"))))
1958 (define-key gdb-memory-format-menu [unsigned]
1959   '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
1960               :button (:radio . (equal gdb-memory-format "u"))))
1961 (define-key gdb-memory-format-menu [signed]
1962   '(menu-item "Signed Decimal" gdb-memory-format-signed
1963               :button (:radio . (equal gdb-memory-format "d"))))
1964 (define-key gdb-memory-format-menu [hexadecimal]
1965   '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
1966               :button (:radio . (equal gdb-memory-format "x"))))
1967
1968 (defun gdb-memory-format-menu (event)
1969   (interactive "@e")
1970   (x-popup-menu event gdb-memory-format-menu))
1971
1972 (defun gdb-memory-format-menu-1 (event)
1973   (interactive "e")
1974   (save-selected-window
1975     (select-window (posn-window (event-start event)))
1976     (let* ((selection (gdb-memory-format-menu event))
1977            (binding (and selection (lookup-key gdb-memory-format-menu
1978                                                (vector (car selection))))))
1979       (if binding (call-interactively binding)))))
1980
1981 (defun gdb-memory-unit-giant ()
1982   "Set the unit size to giant words (eight bytes)."
1983   (interactive)
1984   (customize-set-variable 'gdb-memory-unit "g")
1985   (gdb-invalidate-memory))
1986
1987 (defun gdb-memory-unit-word ()
1988   "Set the unit size to words (four bytes)."
1989   (interactive)
1990   (customize-set-variable 'gdb-memory-unit "w")
1991   (gdb-invalidate-memory))
1992
1993 (defun gdb-memory-unit-halfword ()
1994   "Set the unit size to halfwords (two bytes)."
1995   (interactive)
1996   (customize-set-variable 'gdb-memory-unit "h")
1997   (gdb-invalidate-memory))
1998
1999 (defun gdb-memory-unit-byte ()
2000   "Set the unit size to bytes."
2001   (interactive)
2002   (customize-set-variable 'gdb-memory-unit "b")
2003   (gdb-invalidate-memory))
2004
2005 (defvar gdb-memory-unit-keymap
2006   (let ((map (make-sparse-keymap)))
2007     (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
2008     map)
2009  "Keymap to select units in the header line.")
2010
2011 (defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
2012  "Menu of units in the header line.")
2013
2014 (define-key gdb-memory-unit-menu [giantwords]
2015   '(menu-item "Giant words" gdb-memory-unit-giant
2016               :button (:radio . (equal gdb-memory-unit "g"))))
2017 (define-key gdb-memory-unit-menu [words]
2018   '(menu-item "Words" gdb-memory-unit-word
2019               :button (:radio . (equal gdb-memory-unit "w"))))
2020 (define-key gdb-memory-unit-menu [halfwords]
2021   '(menu-item "Halfwords" gdb-memory-unit-halfword
2022               :button (:radio . (equal gdb-memory-unit "h"))))
2023 (define-key gdb-memory-unit-menu [bytes]
2024   '(menu-item "Bytes" gdb-memory-unit-byte
2025               :button (:radio . (equal gdb-memory-unit "b"))))
2026
2027 (defun gdb-memory-unit-menu (event)
2028   (interactive "@e")
2029   (x-popup-menu event gdb-memory-unit-menu))
2030
2031 (defun gdb-memory-unit-menu-1 (event)
2032   (interactive "e")
2033   (save-selected-window
2034     (select-window (posn-window (event-start event)))
2035     (let* ((selection (gdb-memory-unit-menu event))
2036            (binding (and selection (lookup-key gdb-memory-unit-menu
2037                                                (vector (car selection))))))
2038       (if binding (call-interactively binding)))))
2039
2040 ;;from make-mode-line-mouse-map
2041 (defun gdb-make-header-line-mouse-map (mouse function) "\
2042 Return a keymap with single entry for mouse key MOUSE on the header line.
2043 MOUSE is defined to run function FUNCTION with no args in the buffer
2044 corresponding to the mode line clicked."
2045   (let ((map (make-sparse-keymap)))
2046     (define-key map (vector 'header-line mouse) function)
2047     (define-key map (vector 'header-line 'down-mouse-1) 'ignore)
2048     map))
2049
2050 (defvar gdb-memory-font-lock-keywords
2051   '(;; <__function.name+n>
2052     ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face))
2053     )
2054   "Font lock keywords used in `gdb-memory-mode'.")
2055
2056 (defun gdb-memory-mode ()
2057   "Major mode for examining memory.
2058
2059 \\{gdb-memory-mode-map}"
2060   (kill-all-local-variables)
2061   (setq major-mode 'gdb-memory-mode)
2062   (setq mode-name "Memory")
2063   (setq buffer-read-only t)
2064   (use-local-map gdb-memory-mode-map)
2065   (setq header-line-format
2066         '(:eval
2067           (concat
2068            "Read address["
2069            (propertize
2070             "-"
2071             'face font-lock-warning-face
2072             'help-echo "mouse-1: Decrement address"
2073             'mouse-face 'mode-line-highlight
2074             'local-map
2075             (gdb-make-header-line-mouse-map
2076              'mouse-1
2077              #'(lambda () (interactive)
2078                  (let ((gdb-memory-address
2079                         ;; Let GDB do the arithmetic.
2080                         (concat
2081                          gdb-memory-address " - "
2082                          (number-to-string
2083                           (* gdb-memory-repeat-count
2084                              (cond ((string= gdb-memory-unit "b") 1)
2085                                    ((string= gdb-memory-unit "h") 2)
2086                                    ((string= gdb-memory-unit "w") 4)
2087                                    ((string= gdb-memory-unit "g") 8)))))))
2088                        (gdb-invalidate-memory)))))
2089            "|"
2090            (propertize "+"
2091                        'face font-lock-warning-face
2092                        'help-echo "mouse-1: Increment address"
2093                        'mouse-face 'mode-line-highlight
2094                        'local-map (gdb-make-header-line-mouse-map
2095                                    'mouse-1
2096                                    #'(lambda () (interactive)
2097                                        (let ((gdb-memory-address nil))
2098                                          (gdb-invalidate-memory)))))
2099            "]: "
2100            (propertize gdb-memory-address
2101                        'face font-lock-warning-face
2102                        'help-echo "mouse-1: Set memory address"
2103                        'mouse-face 'mode-line-highlight
2104                        'local-map (gdb-make-header-line-mouse-map
2105                                    'mouse-1
2106                                    #'gdb-memory-set-address))
2107            "  Repeat Count: "
2108            (propertize (number-to-string gdb-memory-repeat-count)
2109                        'face font-lock-warning-face
2110                        'help-echo "mouse-1: Set repeat count"
2111                        'mouse-face 'mode-line-highlight
2112                        'local-map (gdb-make-header-line-mouse-map
2113                                    'mouse-1
2114                                    #'gdb-memory-set-repeat-count))
2115            "  Display Format: "
2116            (propertize gdb-memory-format
2117                        'face font-lock-warning-face
2118                        'help-echo "mouse-3: Select display format"
2119                        'mouse-face 'mode-line-highlight
2120                        'local-map gdb-memory-format-keymap)
2121            "  Unit Size: "
2122            (propertize gdb-memory-unit
2123                        'face font-lock-warning-face
2124                        'help-echo "mouse-3: Select unit size"
2125                        'mouse-face 'mode-line-highlight
2126                        'local-map gdb-memory-unit-keymap))))
2127   (set (make-local-variable 'font-lock-defaults)
2128        '(gdb-memory-font-lock-keywords))
2129   (run-mode-hooks 'gdb-memory-mode-hook)
2130   'gdb-invalidate-memory)
2131
2132 (defun gdb-memory-buffer-name ()
2133   (with-current-buffer gud-comint-buffer
2134     (concat "*memory of " (gdb-get-target-string) "*")))
2135
2136 (defun gdb-display-memory-buffer ()
2137   "Display memory contents."
2138   (interactive)
2139   (gdb-display-buffer
2140    (gdb-get-create-buffer 'gdb-memory-buffer)))
2141
2142 (defun gdb-frame-memory-buffer ()
2143   "Display memory contents in a new frame."
2144   (interactive)
2145   (let ((special-display-regexps (append special-display-regexps '(".*")))
2146         (special-display-frame-alist gdb-frame-parameters))
2147     (display-buffer (gdb-get-create-buffer 'gdb-memory-buffer))))
2148 \f
2149
2150 ;; Locals buffer.
2151 ;;
2152 (gdb-set-buffer-rules 'gdb-locals-buffer
2153                       'gdb-locals-buffer-name
2154                       'gdb-locals-mode)
2155
2156 (def-gdb-auto-update-trigger gdb-invalidate-locals
2157   (gdb-get-buffer 'gdb-locals-buffer)
2158   "server info locals\n"
2159   gdb-info-locals-handler)
2160
2161 ;; Abbreviate for arrays and structures.
2162 ;; These can be expanded using gud-display.
2163 (defun gdb-info-locals-handler nil
2164   (setq gdb-pending-triggers (delq 'gdb-invalidate-locals
2165                                   gdb-pending-triggers))
2166   (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
2167     (with-current-buffer buf
2168       (goto-char (point-min))
2169       (while (re-search-forward "^[ }].*\n" nil t)
2170         (replace-match "" nil nil))
2171       (goto-char (point-min))
2172       (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t)
2173         (replace-match "(structure);\n" nil nil))
2174       (goto-char (point-min))
2175       (while (re-search-forward "\\s-*{.*\n" nil t)
2176         (replace-match " (array);\n" nil nil))))
2177   (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
2178     (and buf
2179          (with-current-buffer buf
2180               (let* ((window (get-buffer-window buf 0))
2181                      (p (window-point window))
2182                      (buffer-read-only nil))
2183                  (erase-buffer)
2184                  (insert-buffer-substring (gdb-get-create-buffer
2185                                            'gdb-partial-output-buffer))
2186                 (set-window-point window p)))))
2187   (run-hooks 'gdb-info-locals-hook))
2188
2189 (defvar gdb-locals-mode-map
2190   (let ((map (make-sparse-keymap)))
2191     (suppress-keymap map)
2192     (define-key map "q" 'kill-this-buffer)
2193      map))
2194
2195 (defvar gdb-local-font-lock-keywords
2196   '(
2197     ;; var = (struct struct_tag) value
2198     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)"
2199       (1 font-lock-variable-name-face)
2200       (3 font-lock-keyword-face)
2201       (4 font-lock-type-face))
2202     ;; var = (type) value
2203     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)"
2204       (1 font-lock-variable-name-face)
2205       (3 font-lock-type-face))
2206     ;; var = val
2207     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]"
2208       (1 font-lock-variable-name-face))
2209     )
2210   "Font lock keywords used in `gdb-local-mode'.")
2211
2212 (defun gdb-locals-mode ()
2213   "Major mode for gdb locals.
2214
2215 \\{gdb-locals-mode-map}"
2216   (kill-all-local-variables)
2217   (setq major-mode 'gdb-locals-mode)
2218   (setq mode-name (concat "Locals:" gdb-selected-frame))
2219   (setq buffer-read-only t)
2220   (use-local-map gdb-locals-mode-map)
2221   (set (make-local-variable 'font-lock-defaults)
2222        '(gdb-local-font-lock-keywords))
2223   (run-mode-hooks 'gdb-locals-mode-hook)
2224   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
2225       'gdb-invalidate-locals
2226     'gdbmi-invalidate-locals))
2227
2228 (defun gdb-locals-buffer-name ()
2229   (with-current-buffer gud-comint-buffer
2230     (concat "*locals of " (gdb-get-target-string) "*")))
2231
2232 (defun gdb-display-locals-buffer ()
2233   "Display local variables of current stack and their values."
2234   (interactive)
2235   (gdb-display-buffer
2236    (gdb-get-create-buffer 'gdb-locals-buffer)))
2237
2238 (defun gdb-frame-locals-buffer ()
2239   "Display local variables of current stack and their values in a new frame."
2240   (interactive)
2241   (let ((special-display-regexps (append special-display-regexps '(".*")))
2242         (special-display-frame-alist gdb-frame-parameters))
2243     (display-buffer (gdb-get-create-buffer 'gdb-locals-buffer))))
2244 \f
2245
2246 ;;;; Window management
2247 (defun gdb-display-buffer (buf &optional size)
2248   (let ((answer (get-buffer-window buf 0))
2249         (must-split nil))
2250     (if answer
2251         (display-buffer buf nil 0)      ;Raise the frame if necessary.
2252       ;; The buffer is not yet displayed.
2253       (pop-to-buffer gud-comint-buffer) ;Select the right frame.
2254       (let ((window (get-lru-window)))
2255         (if (and window
2256             (not (eq window (get-buffer-window gud-comint-buffer))))
2257             (progn
2258               (set-window-buffer window buf)
2259               (setq answer window))
2260           (setq must-split t)))
2261       (if must-split
2262           (let* ((largest (get-largest-window))
2263                  (cur-size (window-height largest))
2264                  (new-size (and size (< size cur-size) (- cur-size size))))
2265             (setq answer (split-window largest new-size))
2266             (set-window-buffer answer buf)
2267             (set-window-dedicated-p answer t)))
2268       answer)))
2269
2270 \f
2271 ;;; Shared keymap initialization:
2272
2273 (let ((menu (make-sparse-keymap "GDB-Windows")))
2274   (define-key gud-menu-map [displays]
2275     `(menu-item "GDB-Windows" ,menu
2276                 :visible (memq gud-minor-mode '(gdbmi gdba))))
2277   (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
2278   (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
2279   (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
2280   (define-key menu [disassembly]
2281     '("Disassembly" . gdb-display-assembler-buffer))
2282   (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
2283   (define-key menu [inferior]
2284     '(menu-item "Inferior IO" gdb-display-inferior-io-buffer
2285                 :enable gdb-use-inferior-io-buffer))
2286   (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
2287   (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
2288   (define-key menu [breakpoints]
2289     '("Breakpoints" . gdb-display-breakpoints-buffer)))
2290
2291 (let ((menu (make-sparse-keymap "GDB-Frames")))
2292   (define-key gud-menu-map [frames]
2293     `(menu-item "GDB-Frames" ,menu
2294                 :visible (memq gud-minor-mode '(gdbmi gdba))))
2295   (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
2296   (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
2297   (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
2298   (define-key menu [disassembly] '("Disassembiy" . gdb-frame-assembler-buffer))
2299   (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
2300   (define-key menu [inferior]
2301     '(menu-item "Inferior IO" gdb-frame-inferior-io-buffer
2302                 :enable gdb-use-inferior-io-buffer))
2303   (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
2304   (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
2305   (define-key menu [breakpoints]
2306     '("Breakpoints" . gdb-frame-breakpoints-buffer)))
2307
2308 (let ((menu (make-sparse-keymap "GDB-UI")))
2309   (define-key gud-menu-map [ui]
2310     `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
2311   (define-key menu [gdb-use-inferior-io]
2312     ;; See defadvice below.
2313     (menu-bar-make-toggle toggle-gdb-use-inferior-io-buffer
2314                           gdb-use-inferior-io-buffer
2315      "Separate inferior IO" "Use separate IO %s"
2316      "Toggle separate IO for inferior."))
2317   (define-key menu [gdb-many-windows]
2318   '(menu-item "Display Other Windows" gdb-many-windows
2319               :help "Toggle display of locals, stack and breakpoint information"
2320               :button (:toggle . gdb-many-windows)))
2321   (define-key menu [gdb-restore-windows]
2322   '(menu-item "Restore Window Layout" gdb-restore-windows
2323               :help "Restore standard layout for debug session.")))
2324
2325 ;; This function is defined above through a macro.
2326 (defadvice toggle-gdb-use-inferior-io-buffer (after gdb-kill-io-buffer activate)
2327   (unless gdb-use-inferior-io-buffer
2328     (kill-buffer (gdb-inferior-io-name))))
2329
2330 (defun gdb-frame-gdb-buffer ()
2331   "Display GUD buffer in a new frame."
2332   (interactive)
2333   (select-frame (make-frame gdb-frame-parameters))
2334   (switch-to-buffer (gdb-get-create-buffer 'gdba))
2335   (set-window-dedicated-p (selected-window) t))
2336
2337 (defun gdb-display-gdb-buffer ()
2338   "Display GUD buffer."
2339   (interactive)
2340   (gdb-display-buffer
2341    (gdb-get-create-buffer 'gdba)))
2342
2343 (defun gdb-set-window-buffer (name)
2344   (set-window-buffer (selected-window) (get-buffer name))
2345   (set-window-dedicated-p (selected-window) t))
2346
2347 (defun gdb-setup-windows ()
2348   "Layout the window pattern for `gdb-many-windows'."
2349   (gdb-display-locals-buffer)
2350   (gdb-display-stack-buffer)
2351   (delete-other-windows)
2352   (gdb-display-breakpoints-buffer)
2353   (delete-other-windows)
2354   ; Don't dedicate.
2355   (pop-to-buffer gud-comint-buffer)
2356   (split-window nil ( / ( * (window-height) 3) 4))
2357   (split-window nil ( / (window-height) 3))
2358   (split-window-horizontally)
2359   (other-window 1)
2360   (gdb-set-window-buffer (gdb-locals-buffer-name))
2361   (other-window 1)
2362   (switch-to-buffer
2363        (if gud-last-last-frame
2364            (gud-find-file (car gud-last-last-frame))
2365          (gud-find-file gdb-main-file)))
2366   (when gdb-use-inferior-io-buffer
2367     (split-window-horizontally)
2368     (other-window 1)
2369     (gdb-set-window-buffer
2370      (gdb-get-create-buffer 'gdb-inferior-io)))
2371   (other-window 1)
2372   (gdb-set-window-buffer (gdb-stack-buffer-name))
2373   (split-window-horizontally)
2374   (other-window 1)
2375   (gdb-set-window-buffer (gdb-breakpoints-buffer-name))
2376   (other-window 1))
2377
2378 (defcustom gdb-many-windows nil
2379   "Nil means just pop up the GUD buffer unless `gdb-show-main' is t.
2380 In this case it starts with two windows: one displaying the GUD
2381 buffer and the other with the source file with the main routine
2382 of the inferior.  Non-nil means display the layout shown for
2383 `gdba'."
2384   :type 'boolean
2385   :group 'gud
2386   :version "22.1")
2387
2388 (defun gdb-many-windows (arg)
2389   "Toggle the number of windows in the basic arrangement."
2390   (interactive "P")
2391   (setq gdb-many-windows
2392         (if (null arg)
2393             (not gdb-many-windows)
2394           (> (prefix-numeric-value arg) 0)))
2395   (condition-case nil
2396       (gdb-restore-windows)
2397     (error nil)))
2398
2399 (defun gdb-restore-windows ()
2400   "Restore the basic arrangement of windows used by gdba.
2401 This arrangement depends on the value of `gdb-many-windows'."
2402   (interactive)
2403   (pop-to-buffer gud-comint-buffer)     ;Select the right window and frame.
2404     (delete-other-windows)
2405   (if gdb-many-windows
2406       (gdb-setup-windows)
2407     (split-window)
2408     (other-window 1)
2409     (switch-to-buffer
2410          (if gud-last-last-frame
2411              (gud-find-file (car gud-last-last-frame))
2412            (gud-find-file gdb-main-file)))
2413     (other-window 1)))
2414
2415 (defun gdb-reset ()
2416   "Exit a debugging session cleanly.
2417 Kills the gdb buffers and resets the source buffers."
2418   (dolist (buffer (buffer-list))
2419     (unless (eq buffer gud-comint-buffer)
2420       (with-current-buffer buffer
2421         (if (memq gud-minor-mode '(gdbmi gdba))
2422             (if (string-match "\\`\\*.+\\*\\'" (buffer-name))
2423                 (kill-buffer nil)
2424               (gdb-remove-breakpoint-icons (point-min) (point-max) t)
2425               (setq gud-minor-mode nil)
2426               (kill-local-variable 'tool-bar-map)
2427               (kill-local-variable 'gdb-define-alist))))))
2428   (when (markerp gdb-overlay-arrow-position)
2429     (move-marker gdb-overlay-arrow-position nil)
2430     (setq gdb-overlay-arrow-position nil))
2431   (setq overlay-arrow-variable-list
2432         (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
2433   (setq gud-running nil)
2434   (setq gdb-active-process nil)
2435   (remove-hook 'after-save-hook 'gdb-create-define-alist t))
2436
2437 (defun gdb-source-info ()
2438   "Find the source file where the program starts and displays it with related
2439 buffers."
2440   (goto-char (point-min))
2441   (if (and (search-forward "Located in " nil t)
2442            (looking-at "\\S-+"))
2443       (setq gdb-main-file (match-string 0)))
2444   (goto-char (point-min))
2445   (if (search-forward "Includes preprocessor macro info." nil t)
2446       (setq gdb-macro-info t))
2447  (if gdb-many-windows
2448       (gdb-setup-windows)
2449    (gdb-get-create-buffer 'gdb-breakpoints-buffer)
2450    (if gdb-show-main
2451        (let ((pop-up-windows t))
2452          (display-buffer (gud-find-file gdb-main-file))))))
2453
2454 (defun gdb-get-location (bptno line flag)
2455   "Find the directory containing the relevant source file.
2456 Put in buffer and place breakpoint icon."
2457   (goto-char (point-min))
2458   (catch 'file-not-found
2459     (if (search-forward "Located in " nil t)
2460         (when (looking-at "\\S-+")
2461           (delete (cons bptno "File not found") gdb-location-alist)
2462           (push (cons bptno (match-string 0)) gdb-location-alist))
2463       (gdb-resync)
2464       (unless (assoc bptno gdb-location-alist)
2465         (push (cons bptno "File not found") gdb-location-alist)
2466         (message-box "Cannot find source file for breakpoint location.\n\
2467 Add directory to search path for source files using the GDB command, dir."))
2468       (throw 'file-not-found nil))
2469     (with-current-buffer
2470         (find-file-noselect (match-string 0))
2471       (save-current-buffer
2472         (set (make-local-variable 'gud-minor-mode) 'gdba)
2473         (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))
2474       ;; only want one breakpoint icon at each location
2475       (save-excursion
2476         (goto-line (string-to-number line))
2477         (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))
2478
2479 (add-hook 'find-file-hook 'gdb-find-file-hook)
2480
2481 (defun gdb-find-file-hook ()
2482 "Set up buffer for debugging if file is part of the source code
2483 of the current session."
2484   (if (and (not gdb-find-file-unhook)
2485            ;; in case gud or gdb-ui is just loaded
2486            gud-comint-buffer
2487            (buffer-name gud-comint-buffer)
2488            (with-current-buffer gud-comint-buffer
2489              (eq gud-minor-mode 'gdba)))
2490       (condition-case nil
2491         (gdb-enqueue-input
2492          (list (concat gdb-server-prefix "list "
2493                        (file-name-nondirectory buffer-file-name)
2494                        ":1\n")
2495                `(lambda () (gdb-set-gud-minor-mode ,(current-buffer)))))
2496         (error (setq gdb-find-file-unhook t)))))
2497
2498 ;;from put-image
2499 (defun gdb-put-string (putstring pos &optional dprop &rest sprops)
2500   "Put string PUTSTRING in front of POS in the current buffer.
2501 PUTSTRING is displayed by putting an overlay into the current buffer with a
2502 `before-string' string that has a `display' property whose value is
2503 PUTSTRING."
2504   (let ((string (make-string 1 ?x))
2505         (buffer (current-buffer)))
2506     (setq putstring (copy-sequence putstring))
2507     (let ((overlay (make-overlay pos pos buffer))
2508           (prop (or dprop
2509                     (list (list 'margin 'left-margin) putstring))))
2510       (put-text-property 0 1 'display prop string)
2511       (if sprops
2512           (add-text-properties 0 1 sprops string))
2513       (overlay-put overlay 'put-break t)
2514       (overlay-put overlay 'before-string string))))
2515
2516 ;;from remove-images
2517 (defun gdb-remove-strings (start end &optional buffer)
2518   "Remove strings between START and END in BUFFER.
2519 Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
2520 BUFFER nil or omitted means use the current buffer."
2521   (unless buffer
2522     (setq buffer (current-buffer)))
2523   (dolist (overlay (overlays-in start end))
2524     (when (overlay-get overlay 'put-break)
2525           (delete-overlay overlay))))
2526
2527 (defun gdb-put-breakpoint-icon (enabled bptno)
2528   (let ((start (- (line-beginning-position) 1))
2529         (end (+ (line-end-position) 1))
2530         (putstring (if enabled "B" "b"))
2531         (source-window (get-buffer-window (current-buffer) 0)))
2532     (add-text-properties
2533      0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt")
2534      putstring)
2535     (if enabled
2536         (add-text-properties
2537          0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
2538       (add-text-properties
2539        0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
2540     (gdb-remove-breakpoint-icons start end)
2541     (if (display-images-p)
2542         (if (>= (or left-fringe-width
2543                     (if source-window (car (window-fringes source-window)))
2544                     gdb-buffer-fringe-width) 8)
2545             (gdb-put-string
2546              nil (1+ start)
2547              `(left-fringe breakpoint
2548                            ,(if enabled
2549                                 'breakpoint-enabled
2550                               'breakpoint-disabled))
2551              'gdb-bptno bptno
2552              'gdb-enabled enabled)
2553           (when (< left-margin-width 2)
2554             (save-current-buffer
2555               (setq left-margin-width 2)
2556               (if source-window
2557                   (set-window-margins
2558                    source-window
2559                    left-margin-width right-margin-width))))
2560           (put-image
2561            (if enabled
2562                (or breakpoint-enabled-icon
2563                    (setq breakpoint-enabled-icon
2564                          (find-image `((:type xpm :data
2565                                               ,breakpoint-xpm-data
2566                                               :ascent 100 :pointer hand)
2567                                        (:type pbm :data
2568                                               ,breakpoint-enabled-pbm-data
2569                                               :ascent 100 :pointer hand)))))
2570              (or breakpoint-disabled-icon
2571                  (setq breakpoint-disabled-icon
2572                        (find-image `((:type xpm :data
2573                                             ,breakpoint-xpm-data
2574                                             :conversion disabled
2575                                             :ascent 100 :pointer hand)
2576                                      (:type pbm :data
2577                                             ,breakpoint-disabled-pbm-data
2578                                             :ascent 100 :pointer hand))))))
2579            (+ start 1)
2580            putstring
2581            'left-margin))
2582       (when (< left-margin-width 2)
2583         (save-current-buffer
2584           (setq left-margin-width 2)
2585           (let ((window (get-buffer-window (current-buffer) 0)))
2586             (if window
2587               (set-window-margins
2588                window left-margin-width right-margin-width)))))
2589       (gdb-put-string
2590        (propertize putstring
2591                    'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
2592        (1+ start)))))
2593
2594 (defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
2595   (gdb-remove-strings start end)
2596   (if (display-images-p)
2597       (remove-images start end))
2598   (when remove-margin
2599     (setq left-margin-width 0)
2600     (let ((window (get-buffer-window (current-buffer) 0)))
2601       (if window
2602           (set-window-margins
2603            window left-margin-width right-margin-width)))))
2604
2605 \f
2606 ;;
2607 ;; Assembler buffer.
2608 ;;
2609 (gdb-set-buffer-rules 'gdb-assembler-buffer
2610                       'gdb-assembler-buffer-name
2611                       'gdb-assembler-mode)
2612
2613 (def-gdb-auto-update-handler gdb-assembler-handler
2614   gdb-invalidate-assembler
2615   gdb-assembler-buffer
2616   gdb-assembler-custom)
2617
2618 (defun gdb-assembler-custom ()
2619   (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
2620         (pos 1) (address) (flag) (bptno))
2621     (with-current-buffer buffer
2622       (save-excursion
2623         (if (not (equal gdb-frame-address "main"))
2624             (progn
2625               (goto-char (point-min))
2626               (if (and gdb-frame-address
2627                        (re-search-forward gdb-frame-address nil t))
2628                   (progn
2629                     (setq pos (point))
2630                     (beginning-of-line)
2631                     (or gdb-overlay-arrow-position
2632                         (setq gdb-overlay-arrow-position (make-marker)))
2633                     (set-marker gdb-overlay-arrow-position
2634                                 (point) (current-buffer))))))
2635         ;; remove all breakpoint-icons in assembler buffer before updating.
2636         (gdb-remove-breakpoint-icons (point-min) (point-max))))
2637     (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
2638       (goto-char (point-min))
2639       (while (< (point) (- (point-max) 1))
2640         (forward-line 1)
2641         (if (looking-at "[^\t].*?breakpoint")
2642             (progn
2643               (looking-at
2644             "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)")
2645               (setq bptno (match-string 1))
2646               (setq flag (char-after (match-beginning 2)))
2647               (setq address (match-string 3))
2648               (with-current-buffer buffer
2649                 (save-excursion
2650                   (goto-char (point-min))
2651                   (if (re-search-forward address nil t)
2652                       (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))))
2653     (if (not (equal gdb-frame-address "main"))
2654         (set-window-point (get-buffer-window buffer 0) pos))))
2655
2656 (defvar gdb-assembler-mode-map
2657   (let ((map (make-sparse-keymap)))
2658     (suppress-keymap map)
2659     (define-key map "q" 'kill-this-buffer)
2660      map))
2661
2662 (defvar gdb-assembler-font-lock-keywords
2663   '(;; <__function.name+n>
2664     ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
2665      (1 font-lock-function-name-face))
2666     ;; 0xNNNNNNNN <__function.name+n>: opcode
2667     ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)"
2668      (4 font-lock-keyword-face))
2669     ;; %register(at least i386)
2670     ("%\\sw+" . font-lock-variable-name-face)
2671     ("^\\(Dump of assembler code for function\\) \\(.+\\):"
2672      (1 font-lock-comment-face)
2673      (2 font-lock-function-name-face))
2674     ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face))
2675   "Font lock keywords used in `gdb-assembler-mode'.")
2676
2677 (defun gdb-assembler-mode ()
2678   "Major mode for viewing code assembler.
2679
2680 \\{gdb-assembler-mode-map}"
2681   (kill-all-local-variables)
2682   (setq major-mode 'gdb-assembler-mode)
2683   (setq mode-name (concat "Machine:" gdb-selected-frame))
2684   (setq gdb-overlay-arrow-position nil)
2685   (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
2686   (setq fringes-outside-margins t)
2687   (setq buffer-read-only t)
2688   (use-local-map gdb-assembler-mode-map)
2689   (gdb-invalidate-assembler)
2690   (set (make-local-variable 'font-lock-defaults)
2691        '(gdb-assembler-font-lock-keywords))
2692   (run-mode-hooks 'gdb-assembler-mode-hook)
2693   'gdb-invalidate-assembler)
2694
2695 (defun gdb-assembler-buffer-name ()
2696   (with-current-buffer gud-comint-buffer
2697     (concat "*Disassembly of " (gdb-get-target-string) "*")))
2698
2699 (defun gdb-display-assembler-buffer ()
2700   "Display disassembly view."
2701   (interactive)
2702   (setq gdb-previous-frame nil)
2703   (gdb-display-buffer
2704    (gdb-get-create-buffer 'gdb-assembler-buffer)))
2705
2706 (defun gdb-frame-assembler-buffer ()
2707   "Display disassembly view in a new frame."
2708   (interactive)
2709   (setq gdb-previous-frame nil)
2710   (let ((special-display-regexps (append special-display-regexps '(".*")))
2711         (special-display-frame-alist gdb-frame-parameters))
2712     (display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))))
2713
2714 ;; modified because if gdb-frame-address has changed value a new command
2715 ;; must be enqueued to update the buffer with the new output
2716 (defun gdb-invalidate-assembler (&optional ignored)
2717   (if (gdb-get-buffer 'gdb-assembler-buffer)
2718       (progn
2719         (unless (and gdb-selected-frame
2720                      (string-equal gdb-selected-frame gdb-previous-frame))
2721           (if (or (not (member 'gdb-invalidate-assembler
2722                                gdb-pending-triggers))
2723                   (not (string-equal gdb-frame-address
2724                                      gdb-previous-frame-address)))
2725           (progn
2726             ;; take previous disassemble command, if any, off the queue
2727             (with-current-buffer gud-comint-buffer
2728               (let ((queue gdb-input-queue))
2729                 (dolist (item queue)
2730                   (if (equal (cdr item) '(gdb-assembler-handler))
2731                       (setq gdb-input-queue
2732                             (delete item gdb-input-queue))))))
2733             (gdb-enqueue-input
2734              (list
2735               (concat gdb-server-prefix "disassemble "
2736                       (if (member gdb-frame-address '(nil "main")) nil "0x")
2737                            gdb-frame-address "\n")
2738                    'gdb-assembler-handler))
2739             (push 'gdb-invalidate-assembler gdb-pending-triggers)
2740             (setq gdb-previous-frame-address gdb-frame-address)
2741             (setq gdb-previous-frame gdb-selected-frame)))))))
2742
2743 (defun gdb-get-selected-frame ()
2744   (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
2745       (progn
2746         (gdb-enqueue-input
2747          (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler))
2748         (push 'gdb-get-selected-frame
2749                gdb-pending-triggers))))
2750
2751 (defun gdb-frame-handler ()
2752   (setq gdb-pending-triggers
2753         (delq 'gdb-get-selected-frame gdb-pending-triggers))
2754   (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
2755     (goto-char (point-min))
2756     (if (re-search-forward  "Stack level \\([0-9]+\\)" nil t)
2757         (setq gdb-frame-number (match-string 1)))
2758     (goto-char (point-min))
2759     (if (re-search-forward
2760          ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? " nil t)
2761         (progn
2762           (setq gdb-selected-frame (match-string 2))
2763           (if (gdb-get-buffer 'gdb-locals-buffer)
2764               (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
2765                 (setq mode-name (concat "Locals:" gdb-selected-frame))))
2766           (if (gdb-get-buffer 'gdb-assembler-buffer)
2767               (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
2768                 (setq mode-name (concat "Machine:" gdb-selected-frame))))
2769           (setq gdb-frame-address (match-string 1))))
2770     (goto-char (point-min))
2771     (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
2772         (setq gdb-current-language (match-string 1))))
2773     (gdb-invalidate-assembler))
2774
2775 (provide 'gdb-ui)
2776
2777 ;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352
2778 ;;; gdb-ui.el ends here