gdb-mi.el 149 KB
Newer Older
1 2
;;; gdb-mi.el --- User Interface for running GDB

Glenn Morris's avatar
Glenn Morris committed
3 4 5
;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.

;; Author: Nick Roberts <nickrob@gnu.org>
6 7 8
;; Maintainer: FSF
;; Keywords: unix, tools

Glenn Morris's avatar
Glenn Morris committed
9
;; This file is part of GNU Emacs.
10

11 12
;; Homepage: http://www.emacswiki.org/emacs/GDB-MI

13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Credits:

;; This file was written by by Nick Roberts following the general design
;; used in gdb-ui.el for Emacs 22.1 - 23.1.  It is currently being developed
;; by Dmitry Dzhus <dima@sphinx.net.ru> as part of the Google Summer
;; of Code 2009 Project "Emacs GDB/MI migration".

;;; Commentary:

;; This mode acts as a graphical user interface to GDB.  You can interact with
;; GDB through the GUD buffer in the usual way, but there are also further
;; buffers which control the execution and describe the state of your program.
;; It separates the input/output of your program from that of GDB and displays
;; expressions and their current values in their own buffers.  It also uses
;; features of Emacs 21 such as the fringe/display margin for breakpoints, and
;; the toolbar (see the GDB Graphical Interface section in the Emacs info
;; manual).

;; M-x gdb will start the debugger.

;; This file uses GDB/MI as the primary interface to GDB.  It is still under
;; development and is part of a process to migrate Emacs from annotations (as
;; used in gdb-ui.el) to GDB/MI.  It runs gdb with GDB/MI (-interp=mi) and
;; access CLI using "-interpreter-exec console cli-command".  This code works
;; without gdb-ui.el and uses MI tokens instead of queues. Eventually MI
;; should be asynchronous.

;; This mode will PARTLY WORK WITH RECENT GDB RELEASES (status in modeline
;; doesn't update properly when execution commands are issued from GUD buffer)
;; and WORKS BEST when GDB runs asynchronously: maint set linux-async on.
;;
;; You need development version of GDB 7.0 for the thread buffer to work.

;; This file replaces gdb-ui.el and is for development with GDB.  Use the
;; release branch of Emacs 22 for the latest version of gdb-ui.el.

;; Windows Platforms:

;; If you are using Emacs and GDB on Windows you will need to flush the buffer
;; explicitly in your program if you want timely display of I/O in Emacs.
;; Alternatively you can make the output stream unbuffered, for example, by
;; using a macro:

;;           #ifdef UNBUFFERED
;;	     setvbuf (stdout, (char *) NULL, _IONBF, 0);
;;	     #endif

;; and compiling with -DUNBUFFERED while debugging.

;; If you are using Cygwin GDB and find that the source is not being displayed
;; in Emacs when you step through it, possible solutions are to:

;;   1) Use Cygwin X Windows and Cygwin Emacs.
;;        (Since 22.1 Emacs builds under Cygwin.)
;;   2) Use MinGW GDB instead.
;;   3) Use cygwin-mount.el

;;; Mac OSX:

;; GDB in Emacs on Mac OSX works best with FSF GDB as Apple have made
;; some changes to the version that they include as part of Mac OSX.
;; This requires GDB version 7.0 or later (estimated release date Aug 2009)
;; as earlier versions don not compile on Mac OSX.

;;; Known Bugs:

;; 1) Stack buffer doesn't parse MI output if you stop in a routine without
;;    line information, e.g., a routine in libc (just a TODO item).

;; TODO:
;; 2) Watch windows to work with threads.
;; 3) Use treebuffer.el instead of the speedbar for watch-expressions?
;; 4) Mark breakpoint locations on scroll-bar of source buffer?

;;; Code:

(require 'gud)
(require 'json)
104
(require 'bindat)
105
(require 'speedbar)
Glenn Morris's avatar
Glenn Morris committed
106
(eval-when-compile
107
  (require 'cl))
108 109 110

(defvar tool-bar-map)
(defvar speedbar-initial-expansion-list-name)
111
(defvar speedbar-frame)
112

113 114 115 116 117 118 119 120
(defvar	gdb-memory-address "main")
(defvar	gdb-memory-last-address nil
  "Last successfully accessed memory address.")
(defvar	gdb-memory-next-page nil
  "Address of next memory page for program memory buffer.")
(defvar	gdb-memory-prev-page nil
  "Address of previous memory page for program memory buffer.")

121
(defvar gdb-thread-number nil
122 123 124
  "Main current thread.

Invalidation triggers use this variable to query GDB for
125 126
information on the specified thread by wrapping GDB/MI commands
in `gdb-current-context-command'.
127

128 129 130 131 132
This variable may be updated implicitly by GDB via `gdb-stopped'
or explicitly by `gdb-select-thread'.

Only `gdb-setq-thread-number' should be used to change this
value.")
133

134 135 136
(defvar gdb-frame-number nil
  "Selected frame level for main current thread.

Dmitry Dzhus's avatar
Dmitry Dzhus committed
137 138 139 140 141 142 143 144
Updated according to the following rules:

When a thread is selected or current thread stops, set to \"0\".

When current thread goes running (and possibly exits eventually),
set to nil.

May be manually changed by user with `gdb-select-frame'.")
145

146 147
(defvar gdb-frame-address nil "Identity of frame for watch expression.")

148 149 150 151 152 153 154 155 156 157 158 159 160 161
;; Used to show overlay arrow in source buffer. All set in
;; gdb-get-main-selected-frame. Disassembly buffer should not use
;; these but rely on buffer-local thread information instead.
(defvar gdb-selected-frame nil
  "Name of selected function for main current thread.")
(defvar gdb-selected-file nil
  "Name of selected file for main current thread.")
(defvar gdb-selected-line nil
  "Number of selected line for main current thread.")

(defvar gdb-threads-list nil
  "Associative list of threads provided by \"-thread-info\" MI command.

Keys are thread numbers (in strings) and values are structures as
162
returned from -thread-info by `gdb-json-partial-output'. Updated in
163 164
`gdb-thread-list-handler-custom'.")

165 166 167 168 169 170 171 172 173 174 175 176
(defvar gdb-running-threads-count nil
  "Number of currently running threads.

Nil means that no information is available.

Updated in `gdb-thread-list-handler-custom'.")

(defvar gdb-stopped-threads-count nil
  "Number of currently stopped threads.

See also `gdb-running-threads-count'.")

177 178 179 180
(defvar gdb-breakpoints-list nil
  "Associative list of breakpoints provided by \"-break-list\" MI command.

Keys are breakpoint numbers (in string) and values are structures
181
as returned from \"-break-list\" by `gdb-json-partial-output'
182 183 184
\(\"body\" field is used). Updated in
`gdb-breakpoints-list-handler-custom'.")

185 186 187
(defvar gdb-current-language nil)
(defvar gdb-var-list nil
  "List of variables in watch window.
188 189 190
Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP)
where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame
address for root variables.")
191
(defvar gdb-main-file nil "Source file from which program execution begins.")
192 193

;; Overlay arrow markers
194
(defvar gdb-stack-position nil)
195 196
(defvar gdb-thread-position nil)
(defvar gdb-disassembly-position nil)
197

198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
(defvar gdb-location-alist nil
  "Alist of breakpoint numbers and full filenames.  Only used for files that
Emacs can't find.")
(defvar gdb-active-process nil
  "GUD tooltips display variable values when t, and macro definitions otherwise.")
(defvar gdb-error "Non-nil when GDB is reporting an error.")
(defvar gdb-macro-info nil
  "Non-nil if GDB knows that the inferior includes preprocessor macro info.")
(defvar gdb-register-names nil "List of register names.")
(defvar gdb-changed-registers nil
  "List of changed register numbers (strings).")
(defvar gdb-buffer-fringe-width nil)
(defvar gdb-last-command nil)
(defvar gdb-prompt-name nil)
(defvar gdb-token-number 0)
(defvar gdb-handler-alist '())
(defvar gdb-handler-number nil)
(defvar gdb-source-file-list nil
  "List of source files for the current executable.")
(defvar gdb-first-done-or-error t)
(defvar gdb-source-window nil)
(defvar gdb-inferior-status nil)
(defvar gdb-continuation nil)
Nick Roberts's avatar
Nick Roberts committed
221
(defvar gdb-version nil)
222 223 224 225 226 227
(defvar gdb-filter-output nil
  "Message to be shown in GUD console.

This variable is updated in `gdb-done-or-error' and returned by
`gud-gdbmi-marker-filter'.")

228 229 230 231 232 233
(defvar gdb-non-stop nil
  "Indicates whether current GDB session is using non-stop mode.

It is initialized to `gdb-non-stop-setting' at the beginning of
every GDB session.")

234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
(defvar gdb-buffer-type nil
  "One of the symbols bound in `gdb-buffer-rules'.")
(make-variable-buffer-local 'gdb-buffer-type)

(defvar gdb-output-sink 'nil
  "The disposition of the output of the current gdb command.
Possible values are these symbols:

    `user' -- gdb output should be copied to the GUD buffer
              for the user to see.

    `emacs' -- output should be collected in the partial-output-buffer
	       for subsequent processing by a command.  This is the
	       disposition of output generated by commands that
	       gdb mode sends to gdb on its own behalf.")

250 251 252
;; Pending triggers prevent congestion: Emacs won't send two similar
;; consecutive requests.

253
(defvar gdb-pending-triggers '()
254 255 256 257 258 259 260 261 262 263 264
  "A list of trigger functions which have not yet been handled.

Elements are either function names or pairs (buffer . function)")

(defmacro gdb-add-pending (item)
  `(push ,item gdb-pending-triggers))
(defmacro gdb-pending-p (item)
  `(member ,item gdb-pending-triggers))
(defmacro gdb-delete-pending (item)
  `(setq gdb-pending-triggers
         (delete ,item gdb-pending-triggers)))
265

Dmitry Dzhus's avatar
Dmitry Dzhus committed
266 267
(defmacro gdb-wait-for-pending (&rest body)
  "Wait until `gdb-pending-triggers' is empty and evaluate FORM.
268 269 270

This function checks `gdb-pending-triggers' value every
`gdb-wait-for-pending' seconds."
Glenn Morris's avatar
Glenn Morris committed
271
  (run-with-timer
Dmitry Dzhus's avatar
Dmitry Dzhus committed
272 273
   0.5 nil
   `(lambda ()
274
      (if (not gdb-pending-triggers)
Dmitry Dzhus's avatar
Dmitry Dzhus committed
275
          (progn ,@body)
276
        (gdb-wait-for-pending ,@body)))))
277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299

;; Publish-subscribe

(defmacro gdb-add-subscriber (publisher subscriber)
  "Register new PUBLISHER's SUBSCRIBER.

SUBSCRIBER must be a pair, where cdr is a function of one
argument (see `gdb-emit-signal')."
  `(add-to-list ',publisher ,subscriber t))

(defmacro gdb-delete-subscriber (publisher subscriber)
  "Unregister SUBSCRIBER from PUBLISHER."
  `(setq ,publisher (delete ,subscriber
                            ,publisher)))

(defun gdb-get-subscribers (publisher)
  publisher)

(defun gdb-emit-signal (publisher &optional signal)
  "Call cdr for each subscriber of PUBLISHER with SIGNAL as argument."
  (dolist (subscriber (gdb-get-subscribers publisher))
    (funcall (cdr subscriber) signal)))

Glenn Morris's avatar
Glenn Morris committed
300
(defvar gdb-buf-publisher '()
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321
  "Used to invalidate GDB buffers by emitting a signal in
`gdb-update'.

Must be a list of pairs with cars being buffers and cdr's being
valid signal handlers.")

(defgroup gdb nil
  "GDB graphical interface"
  :group 'tools
  :link '(info-link "(emacs)GDB Graphical Interface")
  :version "23.2")

(defgroup gdb-non-stop nil
  "GDB non-stop debugging settings"
  :group 'gdb
  :version "23.2")

(defgroup gdb-buffers nil
  "GDB buffers"
  :group 'gdb
  :version "23.2")
Glenn Morris's avatar
Glenn Morris committed
322

323 324 325 326 327 328 329
(defcustom gdb-debug-log-max 128
  "Maximum size of `gdb-debug-log'.  If nil, size is unlimited."
  :group 'gdb
  :type '(choice (integer :tag "Number of elements")
		 (const   :tag "Unlimited" nil))
  :version "22.1")

330
(defcustom gdb-non-stop-setting t
331
  "When in non-stop mode, stopped threads can be examined while
332 333 334 335
other threads continue to execute.

GDB session needs to be restarted for this setting to take
effect."
336
  :type 'boolean
337
  :group 'gdb-non-stop
338 339 340 341 342 343
  :version "23.2")

;; TODO Some commands can't be called with --all (give a notice about
;; it in setting doc)
(defcustom gdb-gud-control-all-threads t
  "When enabled, GUD execution commands affect all threads when
344
in non-stop mode. Otherwise, only current thread is affected."
345
  :type 'boolean
346
  :group 'gdb-non-stop
347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
  :version "23.2")

(defcustom gdb-switch-reasons t
  "List of stop reasons which cause Emacs to switch to the thread
which caused the stop. When t, switch to stopped thread no matter
what the reason was. When nil, never switch to stopped thread
automatically.

This setting is used in non-stop mode only. In all-stop mode,
Emacs always switches to the thread which caused the stop."
  ;; exited, exited-normally and exited-signalled are not
  ;; thread-specific stop reasons and therefore are not included in
  ;; this list
  :type '(choice
          (const :tag "All reasons" t)
          (set :tag "Selection of reasons..."
               (const :tag "A breakpoint was reached." "breakpoint-hit")
               (const :tag "A watchpoint was triggered." "watchpoint-trigger")
               (const :tag "A read watchpoint was triggered." "read-watchpoint-trigger")
               (const :tag "An access watchpoint was triggered." "access-watchpoint-trigger")
               (const :tag "Function finished execution." "function-finished")
               (const :tag "Location reached." "location-reached")
               (const :tag "Watchpoint has gone out of scope" "watchpoint-scope")
               (const :tag "End of stepping range reached." "end-stepping-range")
               (const :tag "Signal received (like interruption)." "signal-received"))
          (const :tag "None" nil))
373
  :group 'gdb-non-stop
374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394
  :version "23.2"
  :link '(info-link "(gdb)GDB/MI Async Records"))

(defcustom gdb-stopped-hooks nil
  "This variable holds a list of functions to be called whenever
GDB stops.

Each function takes one argument, a parsed MI response, which
contains fields of corresponding MI *stopped async record:

    ((stopped-threads . \"all\")
     (thread-id . \"1\")
     (frame (line . \"38\")
            (fullname . \"/home/sphinx/projects/gsoc/server.c\")
            (file . \"server.c\")
            (args ((value . \"0x804b038\")
                   (name . \"arg\")))
            (func . \"hello\")
            (addr . \"0x0804869e\"))
     (reason . \"end-stepping-range\"))

395 396
Note that \"reason\" is only present in non-stop debugging mode.

397
`bindat-get-field' may be used to access the fields of response.
398 399 400 401 402 403 404 405 406 407 408 409

Each function is called after the new current thread was selected
and GDB buffers were updated in `gdb-stopped'."
  :type '(repeat function)
  :group 'gdb
  :version "23.2"
  :link '(info-link "(gdb)GDB/MI Async Records"))

(defcustom gdb-switch-when-another-stopped t
  "When nil, Emacs won't switch to stopped thread if some other
stopped thread is already selected."
  :type 'boolean
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
  :group 'gdb-non-stop
  :version "23.2")

(defcustom gdb-stack-buffer-locations t
  "Show file information or library names in stack buffers."
  :type 'boolean
  :group 'gdb-buffers
  :version "23.2")

(defcustom gdb-stack-buffer-addresses nil
  "Show frame addresses in stack buffers."
  :type 'boolean
  :group 'gdb-buffers
  :version "23.2")

(defcustom gdb-thread-buffer-verbose-names t
  "Show long thread names in threads buffer."
  :type 'boolean
  :group 'gdb-buffers
  :version "23.2")

(defcustom gdb-thread-buffer-arguments t
  "Show function arguments in threads buffer."
  :type 'boolean
  :group 'gdb-buffers
  :version "23.2")

(defcustom gdb-thread-buffer-locations t
  "Show file information or library names in threads buffer."
  :type 'boolean
  :group 'gdb-buffers
  :version "23.2")

(defcustom gdb-thread-buffer-addresses nil
  "Show addresses for thread frames in threads buffer."
  :type 'boolean
  :group 'gdb-buffers
  :version "23.2")

(defcustom gdb-show-threads-by-default nil
  "Show threads list buffer instead of breakpoints list by
default."
  :type 'boolean
  :group 'gdb-buffers
454 455
  :version "23.2")

456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529
(defvar gdb-debug-log nil
  "List of commands sent to and replies received from GDB.
Most recent commands are listed first.  This list stores only the last
`gdb-debug-log-max' values.  This variable is used to debug GDB-MI.")

;;;###autoload
(defcustom gdb-enable-debug nil
  "Non-nil means record the process input and output in `gdb-debug-log'."
  :type 'boolean
  :group 'gdb
  :version "22.1")

(defcustom gdb-cpp-define-alist-program "gcc -E -dM -"
  "Shell command for generating a list of defined macros in a source file.
This list is used to display the #define directive associated
with an identifier as a tooltip.  It works in a debug session with
GDB, when `gud-tooltip-mode' is t.

Set `gdb-cpp-define-alist-flags' for any include paths or
predefined macros."
  :type 'string
  :group 'gdb
  :version "22.1")

(defcustom gdb-cpp-define-alist-flags ""
  "Preprocessor flags for `gdb-cpp-define-alist-program'."
  :type 'string
  :group 'gdb
  :version "22.1")

 (defcustom gdb-create-source-file-list t
   "Non-nil means create a list of files from which the executable was built.
 Set this to nil if the GUD buffer displays \"initializing...\" in the mode
 line for a long time when starting, possibly because your executable was
 built from a large number of files.  This allows quicker initialization
 but means that these files are not automatically enabled for debugging,
 e.g., you won't be able to click in the fringe to set a breakpoint until
 execution has already stopped there."
   :type 'boolean
   :group 'gdb
   :version "23.1")

(defcustom gdb-show-main nil
  "Non-nil means display source file containing the main routine at startup.
Also display the main routine in the disassembly buffer if present."
  :type 'boolean
  :group 'gdb
  :version "22.1")

(defun gdb-force-mode-line-update (status)
  (let ((buffer gud-comint-buffer))
    (if (and buffer (buffer-name buffer))
	(with-current-buffer buffer
	  (setq mode-line-process
		(format ":%s [%s]"
			(process-status (get-buffer-process buffer)) status))
	  ;; Force mode line redisplay soon.
	  (force-mode-line-update)))))

(defun gdb-enable-debug (arg)
  "Toggle logging of transaction between Emacs and Gdb.
The log is stored in `gdb-debug-log' as an alist with elements
whose cons is send, send-item or recv and whose cdr is the string
being transferred.  This list may grow up to a size of
`gdb-debug-log-max' after which the oldest element (at the end of
the list) is deleted every time a new one is added (at the front)."
  (interactive "P")
  (setq gdb-enable-debug
	(if (null arg)
	    (not gdb-enable-debug)
	  (> (prefix-numeric-value arg) 0)))
  (message (format "Logging of transaction %sabled"
		   (if gdb-enable-debug "en" "dis"))))

Dmitry Dzhus's avatar
Dmitry Dzhus committed
530 531 532 533 534
;; These two are used for menu and toolbar
(defun gdb-control-all-threads ()
  "Switch to non-stop/A mode."
  (interactive)
  (setq gdb-gud-control-all-threads t)
Nick Roberts's avatar
Nick Roberts committed
535 536
  ;; Actually forcing the tool-bar to update.
  (force-mode-line-update)
Dmitry Dzhus's avatar
Dmitry Dzhus committed
537 538 539 540 541 542
  (message "Now in non-stop/A mode."))

(defun gdb-control-current-thread ()
  "Switch to non-stop/T mode."
  (interactive)
  (setq gdb-gud-control-all-threads nil)
Nick Roberts's avatar
Nick Roberts committed
543 544
  ;; Actually forcing the tool-bar to update.
  (force-mode-line-update)
Dmitry Dzhus's avatar
Dmitry Dzhus committed
545 546
  (message "Now in non-stop/T mode."))

547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563
(defun gdb-find-watch-expression ()
  (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
	 (varnum (car var)) expr array)
    (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum)
    (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet
	  (component-list (split-string (match-string 2 varnum) "\\." t)))
      (setq expr (nth 1 var1))
      (setq varnumlet (car var1))
      (dolist (component component-list)
	(setq var2 (assoc varnumlet gdb-var-list))
	(setq expr (concat expr
			   (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2))
			       (concat "[" component "]")
			     (concat "." component))))
	(setq varnumlet (concat varnumlet "." component)))
      expr)))

564 565 566 567 568 569 570 571 572 573 574
;; noall is used for commands which don't take --all, but only
;; --thread.
(defun gdb-gud-context-command (command &optional noall)
  "When `gdb-non-stop' is t, add --thread option to COMMAND if
`gdb-gud-control-all-threads' is nil and --all option otherwise.
If NOALL is t, always add --thread option no matter what
`gdb-gud-control-all-threads' value is.

When `gdb-non-stop' is nil, return COMMAND unchanged."
  (if gdb-non-stop
      (if (and gdb-gud-control-all-threads
Nick Roberts's avatar
Nick Roberts committed
575 576
               (not noall)
	       (string-equal gdb-version "7.0+"))
577
          (concat command " --all ")
Nick Roberts's avatar
Nick Roberts committed
578
        (gdb-current-context-command command))
579 580
    command))

Dmitry Dzhus's avatar
Dmitry Dzhus committed
581 582 583 584 585 586
(defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg)
  "`gud-call' wrapper which adds --thread/--all options between
CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'.

NOARG must be t when this macro is used outside `gud-def'"
  `(gud-call
587 588
    (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
    ,(when (not noarg) 'arg)))
589

590 591 592 593 594 595 596 597 598 599 600 601
;;;###autoload
(defun gdb (command-line)
  "Run gdb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.

If `gdb-many-windows' is nil (the default value) then gdb just
pops up the GUD buffer unless `gdb-show-main' is t.  In this case
it starts with two windows: one displaying the GUD buffer and the
other with the source file with the main routine of the inferior.

If `gdb-many-windows' is t, regardless of the value of
Nick Roberts's avatar
Nick Roberts committed
602 603
`gdb-show-main', the layout below will appear.  Keybindings are
shown in some of the buffers.
604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633

Watch expressions appear in the speedbar/slowbar.

The following commands help control operation :

`gdb-many-windows'    - Toggle the number of windows gdb uses.
`gdb-restore-windows' - To restore the window layout.

See Info node `(emacs)GDB Graphical Interface' for a more
detailed description of this mode.


+----------------------------------------------------------------------+
|                               GDB Toolbar                            |
+-----------------------------------+----------------------------------+
| GUD buffer (I/O of GDB)           | Locals buffer                    |
|                                   |                                  |
|                                   |                                  |
|                                   |                                  |
+-----------------------------------+----------------------------------+
| Source buffer                     | I/O buffer (of debugged program) |
|                                   | (comint-mode)                    |
|                                   |                                  |
|                                   |                                  |
|                                   |                                  |
|                                   |                                  |
|                                   |                                  |
|                                   |                                  |
+-----------------------------------+----------------------------------+
| Stack buffer                      | Breakpoints buffer               |
634
| RET      gdb-select-frame         | SPC    gdb-toggle-breakpoint     |
635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664
|                                   | RET    gdb-goto-breakpoint       |
|                                   | D      gdb-delete-breakpoint     |
+-----------------------------------+----------------------------------+"
  ;;
  (interactive (list (gud-query-cmdline 'gdb)))

  (when (and gud-comint-buffer
	   (buffer-name gud-comint-buffer)
	   (get-buffer-process gud-comint-buffer)
	   (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
	(gdb-restore-windows)
	(error
	 "Multiple debugging requires restarting in text command mode"))
  ;;
  (gud-common-init command-line nil 'gud-gdbmi-marker-filter)
  (set (make-local-variable 'gud-minor-mode) 'gdbmi)
  (setq comint-input-sender 'gdb-send)

  (gud-def gud-tbreak "tbreak %f:%l" "\C-t"
	   "Set temporary breakpoint at current line.")
  (gud-def gud-jump
	   (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l"))
	   "\C-j" "Set execution address to current line.")

  (gud-def gud-up     "up %p"     "<" "Up N stack frames (numeric arg).")
  (gud-def gud-down   "down %p"   ">" "Down N stack frames (numeric arg).")
  (gud-def gud-print  "print %e"  "\C-p" "Evaluate C expression at point.")
  (gud-def gud-pstar  "print* %e" nil
	   "Evaluate C dereferenced pointer expression at point.")

665 666
  (gud-def gud-step   (gdb-gud-context-call "-exec-step" "%p" t)
           "\C-s"
667
	   "Step one source line with display.")
668 669
  (gud-def gud-stepi  (gdb-gud-context-call "-exec-step-instruction" "%p" t)
           "\C-i"
670
	   "Step one instruction with display.")
671 672
  (gud-def gud-next   (gdb-gud-context-call "-exec-next" "%p" t)
           "\C-n"
673
	   "Step one line (skip functions).")
674 675
  (gud-def gud-nexti  (gdb-gud-context-call "-exec-next-instruction" "%p" t)
           nil
676
	   "Step one instruction (skip functions).")
677 678
  (gud-def gud-cont   (gdb-gud-context-call "-exec-continue")
           "\C-r"
679
	   "Continue with display.")
680 681
  (gud-def gud-finish (gdb-gud-context-call "-exec-finish" nil t)
           "\C-f"
682
	   "Finish executing current function.")
683 684 685
  (gud-def gud-run    "-exec-run"
           nil
           "Run the program.")
686

687
  (gud-def gud-break (if (not (string-match "Disassembly" mode-name))
688 689 690 691 692 693
			 (gud-call "break %f:%l" arg)
		       (save-excursion
			 (beginning-of-line)
			 (forward-char 2)
			 (gud-call "break *%a" arg)))
	   "\C-b" "Set breakpoint at current line or address.")
694

695
  (gud-def gud-remove (if (not (string-match "Disassembly" mode-name))
696 697 698 699 700 701
			  (gud-call "clear %f:%l" arg)
			(save-excursion
			  (beginning-of-line)
			  (forward-char 2)
			  (gud-call "clear *%a" arg)))
	   "\C-d" "Remove breakpoint at current line or address.")
702 703

  ;; -exec-until doesn't support --all yet
704
  (gud-def gud-until  (if (not (string-match "Disassembly" mode-name))
705 706 707 708 709 710
			  (gud-call "-exec-until %f:%l" arg)
			(save-excursion
			  (beginning-of-line)
			  (forward-char 2)
			  (gud-call "-exec-until *%a" arg)))
	   "\C-u" "Continue to current line or address.")
711
  ;; TODO Why arg here?
712
  (gud-def
713 714 715
   gud-go (gud-call (if gdb-active-process
                        (gdb-gud-context-command "-exec-continue")
                      "-exec-run") arg)
716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752
   nil "Start or continue execution.")

  ;; For debugging Emacs only.
  (gud-def gud-pp
	   (gud-call
	    (concat
	     "pp1 " (if (eq (buffer-local-value
			     'major-mode (window-buffer)) 'speedbar-mode)
			(gdb-find-watch-expression) "%e")) arg)
	   nil   "Print the Emacs s-expression.")

  (define-key gud-minor-mode-map [left-margin mouse-1]
    'gdb-mouse-set-clear-breakpoint)
  (define-key gud-minor-mode-map [left-fringe mouse-1]
    'gdb-mouse-set-clear-breakpoint)
   (define-key gud-minor-mode-map [left-margin C-mouse-1]
    'gdb-mouse-toggle-breakpoint-margin)
  (define-key gud-minor-mode-map [left-fringe C-mouse-1]
    'gdb-mouse-toggle-breakpoint-fringe)

  (define-key gud-minor-mode-map [left-margin drag-mouse-1]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-margin mouse-3]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-fringe mouse-3]
    'gdb-mouse-until)

  (define-key gud-minor-mode-map [left-margin C-drag-mouse-1]
    'gdb-mouse-jump)
  (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1]
    'gdb-mouse-jump)
  (define-key gud-minor-mode-map [left-fringe C-mouse-3]
    'gdb-mouse-jump)
  (define-key gud-minor-mode-map [left-margin C-mouse-3]
    'gdb-mouse-jump)
753 754 755 756

  (local-set-key "\C-i" 'gud-gdb-complete-command)
  (setq gdb-first-prompt t)
  (setq gud-running nil)
757

758
  (gdb-update)
759

760
  (run-hooks 'gdb-mode-hook))
Glenn Morris's avatar
Glenn Morris committed
761

762
(defun gdb-init-1 ()
763 764 765
  ;; (re-)initialise
  (setq gdb-selected-frame nil
	gdb-frame-number nil
766
        gdb-thread-number nil
767 768 769 770 771 772 773 774 775 776 777 778 779 780 781
	gdb-var-list nil
	gdb-pending-triggers nil
	gdb-output-sink 'user
	gdb-location-alist nil
	gdb-source-file-list nil
	gdb-last-command nil
	gdb-token-number 0
	gdb-handler-alist '()
	gdb-handler-number nil
	gdb-prompt-name nil
	gdb-first-done-or-error t
	gdb-buffer-fringe-width (car (window-fringes))
	gdb-debug-log nil
	gdb-source-window nil
	gdb-inferior-status nil
782 783 784
	gdb-continuation nil
        gdb-buf-publisher '()
        gdb-threads-list '()
785
        gdb-breakpoints-list '()
786
        gdb-register-names '()
787
        gdb-non-stop gdb-non-stop-setting)
788 789 790 791 792
  ;;
  (setq gdb-buffer-type 'gdbmi)
  ;;
  (gdb-force-mode-line-update
   (propertize "initializing..." 'face font-lock-variable-name-face))
793 794 795 796 797 798 799 800 801

  (gdb-get-buffer-create 'gdb-inferior-io)
  (gdb-clear-inferior-io)
  (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter)
  (gdb-input
   ;; Needs GDB 6.4 onwards
   (list (concat "-inferior-tty-set "
		 (process-tty-name (get-process "gdb-inferior")))
	 'ignore))
802
  (if (eq window-system 'w32)
803 804
      (gdb-input (list "-gdb-set new-console off" 'ignore)))
  (gdb-input (list "-gdb-set height 0" 'ignore))
805 806

  (when gdb-non-stop
Nick Roberts's avatar
Nick Roberts committed
807
    (gdb-input (list "-gdb-set non-stop 1" 'gdb-non-stop-handler)))
808

809 810 811
  ;; find source file and compilation directory here
  (gdb-input
   ; Needs GDB 6.2 onwards.
812
   (list "-file-list-exec-source-files" 'gdb-get-source-file-list))
813 814 815
  (if gdb-create-source-file-list
      (gdb-input
        ; Needs GDB 6.0 onwards.
816
       (list "-file-list-exec-source-file" 'gdb-get-source-file)))
817
  (gdb-input
818
   (list "-gdb-show prompt" 'gdb-get-prompt)))
819

Nick Roberts's avatar
Nick Roberts committed
820 821 822 823 824
(defun gdb-non-stop-handler ()
  (goto-char (point-min))
  (if (re-search-forward "No symbol" nil t)
      (progn
	(message "This version of GDB doesn't support non-stop mode.  Turning it off.")
Nick Roberts's avatar
Nick Roberts committed
825 826 827
	(setq gdb-non-stop nil)
	(setq gdb-version "pre-7.0"))
    (setq gdb-version "7.0+")
828 829
    (gdb-input (list "-gdb-set target-async 1" 'ignore))
    (gdb-input (list "-enable-pretty-printing" 'ignore))))
Nick Roberts's avatar
Nick Roberts committed
830

831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859
(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")

(defun gdb-create-define-alist ()
  "Create an alist of #define directives for GUD tooltips."
  (let* ((file (buffer-file-name))
	 (output
	  (with-output-to-string
	    (with-current-buffer standard-output
 	      (and file
		   (file-exists-p file)
 		   ;; call-process doesn't work with remote file names.
		   (not (file-remote-p default-directory))
 		   (call-process shell-file-name file
				 (list t nil) nil "-c"
				 (concat gdb-cpp-define-alist-program " "
					 gdb-cpp-define-alist-flags))))))
	(define-list (split-string output "\n" t))
	(name))
    (setq gdb-define-alist nil)
    (dolist (define define-list)
      (setq name (nth 1 (split-string define "[( ]")))
      (push (cons name define) gdb-define-alist))))

(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
(defvar tooltip-use-echo-area)

(defun gdb-tooltip-print (expr)
   (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
     (goto-char (point-min))
860 861 862 863 864
     (if (re-search-forward ".*value=\\(\".*\"\\)" nil t)
	 (tooltip-show
	  (concat expr " = " (read (match-string 1)))
	  (or gud-tooltip-echo-area tooltip-use-echo-area
	      (not (display-graphic-p)))))))
Glenn Morris's avatar
Glenn Morris committed
865

866 867 868 869 870 871 872 873 874
;; If expr is a macro for a function don't print because of possible dangerous
;; side-effects. Also printing a function within a tooltip generates an
;; unexpected starting annotation (phase error).
(defun gdb-tooltip-print-1 (expr)
  (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
    (goto-char (point-min))
    (if (search-forward "expands to: " nil t)
	(unless (looking-at "\\S-+.*(.*).*")
	  (gdb-input
875
	   (list  (concat "-data-evaluate-expression " expr)
876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906
		  `(lambda () (gdb-tooltip-print ,expr))))))))

(defun gdb-init-buffer ()
  (set (make-local-variable 'gud-minor-mode) 'gdbmi)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (when gud-tooltip-mode
    (make-local-variable 'gdb-define-alist)
    (gdb-create-define-alist)
    (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))

(defmacro gdb-if-arrow (arrow-position &rest body)
  `(if ,arrow-position
      (let ((buffer (marker-buffer ,arrow-position)) (line))
	(if (equal buffer (window-buffer (posn-window end)))
	    (with-current-buffer buffer
	      (when (or (equal start end)
			(equal (posn-point start)
			       (marker-position ,arrow-position)))
		,@body))))))

(defun gdb-mouse-until (event)
  "Continue running until a source line past the current line.
The destination source line can be selected either by clicking
with mouse-3 on the fringe/margin or dragging the arrow
with mouse-1 (default bindings)."
  (interactive "e")
  (let ((start (event-start event))
	(end (event-end event)))
    (gdb-if-arrow gud-overlay-arrow-position
		  (setq line (line-number-at-pos (posn-point end)))
		  (gud-call (concat "until " (number-to-string line))))
907
    (gdb-if-arrow gdb-disassembly-position
908
		  (save-excursion
909 910
		    (goto-char (point-min))
		    (forward-line (1- (line-number-at-pos (posn-point end))))
911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927
		    (forward-char 2)
		    (gud-call (concat "until *%a"))))))

(defun gdb-mouse-jump (event)
  "Set execution address/line.
The destination source line can be selected either by clicking with C-mouse-3
on the fringe/margin or dragging the arrow with C-mouse-1 (default bindings).
Unlike `gdb-mouse-until' the destination address can be before the current
line, and no execution takes place."
  (interactive "e")
  (let ((start (event-start event))
	(end (event-end event)))
    (gdb-if-arrow gud-overlay-arrow-position
		  (setq line (line-number-at-pos (posn-point end)))
		  (progn
		    (gud-call (concat "tbreak " (number-to-string line)))
		    (gud-call (concat "jump " (number-to-string line)))))
928
    (gdb-if-arrow gdb-disassembly-position
929
		  (save-excursion
930 931
		    (goto-char (point-min))
		    (forward-line (1- (line-number-at-pos (posn-point end))))
932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006
		    (forward-char 2)
		    (progn
		      (gud-call (concat "tbreak *%a"))
		      (gud-call (concat "jump *%a")))))))

(defcustom gdb-show-changed-values t
  "If non-nil change the face of out of scope variables and changed values.
Out of scope variables are suppressed with `shadow' face.
Changed values are highlighted with the face `font-lock-warning-face'."
  :type 'boolean
  :group 'gdb
  :version "22.1")

(defcustom gdb-max-children 40
  "Maximum number of children before expansion requires confirmation."
  :type 'integer
  :group 'gdb
  :version "22.1")

(defcustom gdb-delete-out-of-scope t
  "If non-nil delete watch expressions automatically when they go out of scope."
  :type 'boolean
  :group 'gdb
  :version "22.2")

(defcustom gdb-speedbar-auto-raise nil
  "If non-nil raise speedbar every time display of watch expressions is\
 updated."
  :type 'boolean
  :group 'gdb
  :version "22.1")

(defcustom gdb-use-colon-colon-notation nil
  "If non-nil use FUN::VAR format to display variables in the speedbar."
  :type 'boolean
  :group 'gdb
  :version "22.1")

(defun gdb-speedbar-auto-raise (arg)
  "Toggle automatic raising of the speedbar for watch expressions.
With prefix argument ARG, automatically raise speedbar if ARG is
positive, otherwise don't automatically raise it."
  (interactive "P")
  (setq gdb-speedbar-auto-raise
	(if (null arg)
	    (not gdb-speedbar-auto-raise)
	  (> (prefix-numeric-value arg) 0)))
  (message (format "Auto raising %sabled"
		   (if gdb-speedbar-auto-raise "en" "dis"))))

(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)

(declare-function tooltip-identifier-from-point "tooltip" (point))

(defun gud-watch (&optional arg event)
  "Watch expression at point.
With arg, enter name of variable to be watched in the minibuffer."
  (interactive (list current-prefix-arg last-input-event))
  (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer)))
    (if (eq minor-mode 'gdbmi)
	(progn
	  (if event (posn-set-point (event-end event)))
	  (require 'tooltip)
	  (save-selected-window
	    (let ((expr
		   (if arg
		       (completing-read "Name of variable: "
					'gud-gdb-complete-command)
		     (if (and transient-mark-mode mark-active)
			 (buffer-substring (region-beginning) (region-end))
		       (concat (if (eq major-mode 'gdb-registers-mode) "$")
			       (tooltip-identifier-from-point (point)))))))
	      (set-text-properties 0 (length expr) nil expr)
	      (gdb-input
1007
	       (list (concat"-var-create - * "  expr "")
1008 1009 1010 1011
		     `(lambda () (gdb-var-create-handler ,expr)))))))
      (message "gud-watch is a no-op in this mode."))))

(defun gdb-var-create-handler (expr)
1012
  (let* ((result (gdb-json-partial-output)))
1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031
    (if (not (bindat-get-field result 'msg))
        (let ((var
	       (list (bindat-get-field result 'name)
		     (if (and (string-equal gdb-current-language "c")
			      gdb-use-colon-colon-notation gdb-selected-frame)
			 (setq expr (concat gdb-selected-frame "::" expr))
		       expr)
		     (bindat-get-field result 'numchild)
		     (bindat-get-field result 'type)
		     (bindat-get-field result 'value)
		     nil
		     (bindat-get-field result 'has_more)
		      gdb-frame-address)))
	  (push var gdb-var-list)
	  (speedbar 1)
	  (unless (string-equal
		   speedbar-initial-expansion-list-name "GUD")
	    (speedbar-change-initial-expansion-list "GUD")))
      (message-box "No symbol \"%s\" in current context." expr))))
1032 1033 1034

(defun gdb-speedbar-update ()
  (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
1035
	     (not (gdb-pending-p 'gdb-speedbar-timer)))
1036
    ;; Dummy command to update speedbar even when idle.
1037
    (gdb-input (list "-environment-pwd" 'gdb-speedbar-timer-fn))
1038
    ;; Keep gdb-pending-triggers non-nil till end.
1039
    (gdb-add-pending 'gdb-speedbar-timer)))
1040 1041 1042 1043

(defun gdb-speedbar-timer-fn ()
  (if gdb-speedbar-auto-raise
      (raise-frame speedbar-frame))
1044
  (gdb-delete-pending 'gdb-speedbar-timer)
1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058
  (speedbar-timer-fn))

(defun gdb-var-evaluate-expression-handler (varnum changed)
  (goto-char (point-min))
  (re-search-forward ".*value=\\(\".*\"\\)" nil t)
  (let ((var (assoc varnum gdb-var-list)))
    (when var
      (if changed (setcar (nthcdr 5 var) 'changed))
      (setcar (nthcdr 4 var) (read (match-string 1)))))
  (gdb-speedbar-update))

; Uses "-var-list-children --all-values".  Needs GDB 6.1 onwards.
(defun gdb-var-list-children (varnum)
  (gdb-input
1059
   (list (concat "-var-update " varnum) 'ignore))
1060 1061
  (gdb-input
   (list (concat "-var-list-children --all-values "
1062
		varnum)
1063 1064 1065
	     `(lambda () (gdb-var-list-children-handler ,varnum)))))

(defun gdb-var-list-children-handler (varnum)
1066 1067 1068
  (let* ((var-list nil)
	 (output (bindat-get-field (gdb-json-partial-output "child")))
	 (children (bindat-get-field output 'children)))
1069
   (catch 'child-already-watched
1070 1071 1072
      (dolist (var gdb-var-list)
	(if (string-equal varnum (car var))
	    (progn
1073 1074
	      ;; With dynamic varobjs numchild may have increased.
	      (setcar (nthcdr 2 var) (bindat-get-field output 'numchild))
1075
	      (push var var-list)
1076
	      (dolist (child children)
1077 1078 1079 1080 1081 1082 1083
		(let ((varchild (list (bindat-get-field child 'name)
				      (bindat-get-field child 'exp)
				      (bindat-get-field child 'numchild)
				      (bindat-get-field child 'type)
				      (bindat-get-field child 'value)
				      nil
				      (bindat-get-field child 'has_more))))
1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095
		  (if (assoc (car varchild) gdb-var-list)
		      (throw 'child-already-watched nil))
		  (push varchild var-list))))
	  (push var var-list)))
      (setq gdb-var-list (nreverse var-list))))
  (gdb-speedbar-update))

(defun gdb-var-set-format (format)
  "Set the output format for a variable displayed in the speedbar."
  (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
	 (varnum (car var)))
    (gdb-input
1096
     (list (concat "-var-set-format " varnum " " format) 'ignore))
1097 1098
    (gdb-var-update)))

1099
(defun gdb-var-delete-1 (var varnum)
1100
  (gdb-input
1101
   (list (concat "-var-delete " varnum) 'ignore))
1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115
  (setq gdb-var-list (delq var gdb-var-list))
  (dolist (varchild gdb-var-list)
    (if (string-match (concat (car var) "\\.") (car varchild))
	(setq gdb-var-list (delq varchild gdb-var-list)))))

(defun gdb-var-delete ()
  "Delete watch expression at point from the speedbar."
  (interactive)
  (let ((text (speedbar-line-text)))
    (string-match "\\(\\S-+\\)" text)
       (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
	      (varnum (car var)))
	 (if (string-match "\\." (car var))
	     (message-box "Can only delete a root expression")
1116
	   (gdb-var-delete-1 var varnum)))))
1117 1118 1119 1120

(defun gdb-var-delete-children (varnum)
  "Delete children of variable object at point from the speedbar."
  (gdb-input
1121
   (list (concat "-var-delete -c " varnum) 'ignore)))
1122 1123 1124 1125 1126 1127 1128

(defun gdb-edit-value (text token indent)
  "Assign a value to a variable displayed in the speedbar."
  (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
	 (varnum (car var)) (value))
    (setq value (read-string "New value: "))
    (gdb-input
1129
     (list (concat "-var-assign " varnum " " value)
1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140
	   `(lambda () (gdb-edit-value-handler ,value))))))

(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)")

(defun gdb-edit-value-handler (value)
  (goto-char (point-min))
  (if (re-search-forward gdb-error-regexp nil t)
      (message-box "Invalid number or expression (%s)" value)))

; Uses "-var-update --all-values".  Needs GDB 6.4 onwards.
(defun gdb-var-update ()
1141
  (if (not (gdb-pending-p 'gdb-var-update))
1142
      (gdb-input
1143
       (list "-var-update --all-values *" 'gdb-var-update-handler)))
1144
  (gdb-add-pending 'gdb-var-update))
1145 1146

(defun gdb-var-update-handler ()
1147 1148 1149 1150 1151 1152 1153 1154 1155
  (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist)))
    (dolist (var gdb-var-list)
      (setcar (nthcdr 5 var) nil))
    (let ((temp-var-list gdb-var-list))
      (dolist (change changelist)
	(let* ((varnum (bindat-get-field change 'name))
	       (var (assoc varnum gdb-var-list))
	       (new-num (bindat-get-field change 'new_num_children)))
	  (when var
1156 1157
	    (let ((scope (bindat-get-field change 'in_scope))
		  (has-more (bindat-get-field change 'has_more)))
1158 1159 1160 1161 1162
	      (cond ((string-equal scope "false")
		     (if gdb-delete-out-of-scope
			 (gdb-var-delete-1 var varnum)
		       (setcar (nthcdr 5 var) 'out-of-scope)))
		    ((string-equal scope "true")
1163 1164 1165
		     (setcar (nthcdr 6 var) has-more)
		     (when (and (or (not has-more)
				    (string-equal has-more "0"))
1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208
				(not new-num)
				(string-equal (nth 2 var) "0"))
		       (setcar (nthcdr 4 var)
			       (bindat-get-field change 'value))
		       (setcar (nthcdr 5 var) 'changed)))
		    ((string-equal scope "invalid")
		     (gdb-var-delete-1 var varnum)))))
	  (let ((var-list nil) var1
		(children (bindat-get-field change 'new_children)))
	    (if new-num
		(progn
		  (setq var1 (pop temp-var-list))
		  (while var1
		    (if (string-equal varnum (car var1))
			(let ((new (string-to-number new-num))
			      (previous (string-to-number (nth 2 var1))))
			  (setcar (nthcdr 2 var1) new-num)
			  (push var1 var-list)
			  (cond ((> new previous)
				 ;; Add new children to list.
				 (dotimes (dummy previous)
				   (push (pop temp-var-list) var-list))
				 (dolist (child children)
				   (let ((varchild
					  (list (bindat-get-field child 'name)
						(bindat-get-field child 'exp)
						(bindat-get-field child 'numchild)
						(bindat-get-field child 'type)
						(bindat-get-field child 'value)
						'changed
						(bindat-get-field child 'has_more))))
				     (push varchild var-list))))
				;; Remove deleted children from list.
				((< new previous)
				 (dotimes (dummy new)
				     (push (pop temp-var-list) var-list))
				 (dotimes (dummy (- previous new))
				     (pop temp-var-list)))))
		      (push var1 var-list))
		    (setq var1 (pop temp-var-list)))
		  (setq gdb-var-list (nreverse var-list)))))))))
  (setq gdb-pending-triggers
	(delq 'gdb-var-update gdb-pending-triggers))
1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247
  (gdb-speedbar-update))

(defun gdb-speedbar-expand-node (text token indent)
  "Expand the node the user clicked on.
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node.
INDENT is the current indentation depth."
  (cond ((string-match "+" text)        ;expand this node
	 (let* ((var (assoc token gdb-var-list))
		(expr (nth 1 var)) (children (nth 2 var)))
	   (if (or (<= (string-to-number children) gdb-max-children)
		   (y-or-n-p
		    (format "%s has %s children. Continue? " expr children)))
	       (gdb-var-list-children token))))
	((string-match "-" text)	;contract this node
	 (dolist (var gdb-var-list)
	   (if (string-match (concat token "\\.") (car var))
	       (setq gdb-var-list (delq var gdb-var-list))))
	 (gdb-var-delete-children token)
	 (speedbar-change-expand-button-char ?+)
	 (speedbar-delete-subblock indent))
	(t (error "Ooops...  not sure what to do")))
  (speedbar-center-buffer-smartly))

(defun gdb-get-target-string ()
  (with-current-buffer gud-comint-buffer
    gud-target-name))


;;
;; gdb buffers.
;;
;; Each buffer has a TYPE -- a symbol that identifies the function
;; of that particular buffer.
;;
;; The usual gdb interaction buffer is given the type `gdbmi' and
;; is constructed specially.
;;
;; Others are constructed by gdb-get-buffer-create and
1248
;; named according to the rules set forth in the gdb-buffer-rules
1249

1250
(defvar gdb-buffer-rules '())
1251 1252 1253 1254 1255 1256 1257

(defun gdb-rules-name-maker (rules-entry)
  (cadr rules-entry))
(defun gdb-rules-buffer-mode (rules-entry)
  (nth 2 rules-entry))
(defun gdb-rules-update-trigger (rules-entry)
  (nth 3 rules-entry))
1258

1259
(defun gdb-update-buffer-name ()
1260 1261
  "Rename current buffer according to name-maker associated with
it in `gdb-buffer-rules'."
1262 1263 1264 1265
  (let ((f (gdb-rules-name-maker (assoc gdb-buffer-type
                                        gdb-buffer-rules))))
    (when f (rename-buffer (funcall f)))))

1266 1267 1268 1269 1270
(defun gdb-current-buffer-rules ()
  "Get `gdb-buffer-rules' entry for current buffer type."
  (assoc gdb-buffer-type gdb-buffer-rules))

(defun gdb-current-buffer-thread ()
1271 1272 1273 1274
  "Get thread object of current buffer from `gdb-threads-list'.

When current buffer is not bound to any thread, return main
thread."
1275 1276 1277
  (cdr (assoc gdb-thread-number gdb-threads-list)))

(defun gdb-current-buffer-frame ()
1278
  "Get current stack frame object for thread of current buffer."
1279
  (bindat-get-field (gdb-current-buffer-thread) 'frame))
1280

1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291
(defun gdb-buffer-type (buffer)
  "Get value of `gdb-buffer-type' for BUFFER."
  (with-current-buffer buffer
    gdb-buffer-type))

(defun gdb-buffer-shows-main-thread-p ()
  "Return t if current GDB buffer shows main selected thread and
is not bound to it."
  (current-buffer)
  (not (local-variable-p 'gdb-thread-number)))

1292
(defun gdb-get-buffer (buffer-type &optional thread)
1293 1294
  "Get a specific GDB buffer.

1295 1296
In that buffer, `gdb-buffer-type' must be equal to BUFFER-TYPE
and `gdb-thread-number' (if provided) must be equal to THREAD."
1297 1298 1299
  (catch 'found
    (dolist (buffer (buffer-list) nil)
      (with-current-buffer buffer
1300
        (when (and (eq gdb-buffer-type buffer-type)
1301 1302
                   (or (not thread)
                       (equal gdb-thread-number thread)))
1303 1304
          (throw 'found buffer))))))

1305 1306 1307
(defun gdb-get-buffer-create (buffer-type &optional thread)
  "Create a new GDB buffer of the type specified by BUFFER-TYPE.
The buffer-type should be one of the cars in `gdb-buffer-rules'.
1308 1309 1310 1311

If THREAD is non-nil, it is assigned to `gdb-thread-number'
buffer-local variable of the new buffer.

1312 1313 1314 1315 1316
Buffer mode and name are selected according to buffer type.

If buffer has trigger associated with it in `gdb-buffer-rules',
this trigger is subscribed to `gdb-buf-publisher' and called with
'update argument."
1317 1318
  (or (gdb-get-buffer buffer-type thread)
      (let ((rules (assoc buffer-type gdb-buffer-rules))
1319
            (new (generate-new-buffer "limbo")))
1320
	(with-current-buffer new
1321 1322 1323
	  (let ((mode (gdb-rules-buffer-mode rules))
                (trigger (gdb-rules-update-trigger rules)))
	    (when mode (funcall mode))
1324
	    (setq gdb-buffer-type buffer-type)
1325 1326
            (when thread
              (set (make-local-variable 'gdb-thread-number) thread))
1327 1328 1329
	    (set (make-local-variable 'gud-minor-mode)
		 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
	    (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
1330 1331 1332 1333 1334
            (rename-buffer (funcall (gdb-rules-name-maker rules)))
	    (when trigger
              (gdb-add-subscriber gdb-buf-publisher
                                  (cons (current-buffer)
                                        (gdb-bind-function-to-buffer trigger (current-buffer))))
1335
              (funcall trigger 'start))
1336 1337 1338 1339 1340 1341 1342
            (current-buffer))))))

(defun gdb-bind-function-to-buffer (expr buffer)
  "Return a function which will evaluate EXPR in BUFFER."
  `(lambda (&rest args)
     (with-current-buffer ,buffer
       (apply ',expr args))))
1343 1344

;; Used to define all gdb-frame-*-buffer functions except
1345
;; `gdb-frame-io-buffer'
1346
(defmacro def-gdb-frame-for-buffer (name buffer &optional doc)
1347 1348 1349
  "Define a function NAME which shows gdb BUFFER in a separate frame.

DOC is an optional documentation string."
1350
  `(defun ,name (&optional thread)
1351 1352 1353 1354
     ,(when doc doc)
     (interactive)
     (let ((special-display-regexps (append special-display-regexps '(".*")))
           (special-display-frame-alist gdb-frame-parameters))
1355
       (display-buffer (gdb-get-buffer-create ,buffer thread)))))
1356