diff options
| author | Dmitry Dzhus | 2009-08-04 17:16:58 +0000 |
|---|---|---|
| committer | Dmitry Dzhus | 2009-08-04 17:16:58 +0000 |
| commit | ad07fb8d75aabca34e04f594b6742aa44b2a664c (patch) | |
| tree | 5c0191eb14f64e5b6b43d377cf7c88119915182c | |
| parent | 78b9fb289effe0b75f69d7038b57ce2e23473826 (diff) | |
| download | emacs-ad07fb8d75aabca34e04f594b6742aa44b2a664c.tar.gz emacs-ad07fb8d75aabca34e04f594b6742aa44b2a664c.zip | |
* progmodes/gdb-mi.el (gdb-frame-number): Initialize with nil.
(gdb-overlay-arrow-position): Renamed to
`gdb-disassembly-position'.
(gdb-overlay-arrow-position, gdb-thread-position)
(gdb-disassembly-position): Declare variables.
(gdb-wait-for-pending): Function now.
(gdb-add-subscriber, gdb-delete-subscriber, gdb-get-subscribers)
(gdb-emit-signal, gdb-buf-publisher): Declare before first use so
compilation goes smoothly.
(gdb, gdb-non-stop, gdb-buffers): New customization groups.
(gdb-non-stop-setting): New customization setting which replaces
`gdb-non-stop' so changing it doesn't break active GDB session.
(gdb-stack-buffer-locations, gdb-stack-buffer-addresses)
(gdb-thread-buffer-verbose-names, gdb-thread-buffer-arguments)
(gdb-thread-buffer-locations, gdb-thread-buffer-addresses)
(gdb-show-threads-by-default): New customization options.
(gdb-buffer-type, gdb-buffer-shows-main-thread-p): New helper
routines.
(gdb-get-buffer-create): Send buffers update signal when they are
created.
(gdb-invalidate-locals, gdb-invalidate-registers)
(gdb-invalidate-breakpoints)
(gdb-invalidate-threads, gdb-invalidate-disassembly)
(gdb-invalidate-memory): Accept update signal.
(gdb-current-context-command): Use --frame option.
(gdb-update-gud-running, gdb-running, gdb-setq-thread-number):
Implement `gdb-frame-number' selection logic.
(gdb-show-run-p, gdb-show-stop-p): Helper functions which decide
whether to show GUD toolbar buttons.
(gdb-thread-exited): Unselect current thread when it exits.
(gdb-stopped): Typo fixed (now really runs `gdb-stopped-hooks').
(gdb-mark-line): Routine which sets overlay arrow or inverses
video on fringeless displays.
(gdb-table, gdb-table-add-row, gdb-table-string): Structure used
to build aligned columns of data in GDB buffers and set text
properties line-by-line.
(gdb-invalidate-breakpoints)
(gdb-breakpoints-list-handler-custom)
(gdb-thread-list-handler-custom, gdb-disassembly-handler-custom)
(gdb-stack-list-frames-custom, gdb-locals-handler-custom)
(gdb-registers-handler-custom): Align data columns.
(gdb-locals-handler-custom): Now prints data like in variable
declarations.
(gdb-jump-to, gdb-file-button, gdb-insert-file-location-button):
Removed confusing buttons.
(gdb-invalidate-threads): Append --frame.
(gdb-threads-mode-map, gdb-breakpoints-mode-map): TAB to switch
between breakpoints/threads buffers.
(gdb-set-window-buffer): Now can ignore dedicated windows.
(gdb-propertize-header): Use `gdb-set-window-buffer'.
(def-gdb-thread-buffer-simple-command): Numerous typos fixed.
(def-gdb-thread-buffer-gud-command): Replaces
`def-gdb-thread-buffer-gdb-command' and uses standard GUD commands
for fine thread control.
(gdb-preempt-existing-or-display-buffer): New function used to
display bound buffers without breaking window layout.
(gdb-frame-location): Replaces `gdb-insert-frame-location'.
(gdb-select-frame): New version of `gdb-frames-select' which now
sets `gdb-frame-number' so commands may use --frame option instead
of inner debugger state.
(gdb-frame-handler): Do not set `gdb-frame-number'.
(gdb-threads-mode-map): Select threads with mouse.
(I forgot to include sources in previous commit)
| -rw-r--r-- | lisp/progmodes/gdb-mi.el | 865 | ||||
| -rw-r--r-- | lisp/progmodes/gud.el | 31 |
2 files changed, 581 insertions, 315 deletions
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 195788b907c..7ff2613ea89 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el | |||
| @@ -102,6 +102,9 @@ | |||
| 102 | (require 'gud) | 102 | (require 'gud) |
| 103 | (require 'json) | 103 | (require 'json) |
| 104 | (require 'bindat) | 104 | (require 'bindat) |
| 105 | (require 'speedbar) | ||
| 106 | (eval-when-compile | ||
| 107 | (require 'cl)) | ||
| 105 | 108 | ||
| 106 | (defvar tool-bar-map) | 109 | (defvar tool-bar-map) |
| 107 | (defvar speedbar-initial-expansion-list-name) | 110 | (defvar speedbar-initial-expansion-list-name) |
| @@ -115,7 +118,6 @@ | |||
| 115 | (defvar gdb-memory-prev-page nil | 118 | (defvar gdb-memory-prev-page nil |
| 116 | "Address of previous memory page for program memory buffer.") | 119 | "Address of previous memory page for program memory buffer.") |
| 117 | 120 | ||
| 118 | (defvar gdb-frame-number "0") | ||
| 119 | (defvar gdb-thread-number nil | 121 | (defvar gdb-thread-number nil |
| 120 | "Main current thread. | 122 | "Main current thread. |
| 121 | 123 | ||
| @@ -129,6 +131,11 @@ or explicitly by `gdb-select-thread'. | |||
| 129 | Only `gdb-setq-thread-number' should be used to change this | 131 | Only `gdb-setq-thread-number' should be used to change this |
| 130 | value.") | 132 | value.") |
| 131 | 133 | ||
| 134 | (defvar gdb-frame-number nil | ||
| 135 | "Selected frame level for main current thread. | ||
| 136 | |||
| 137 | Reset whenever current thread changes.") | ||
| 138 | |||
| 132 | ;; Used to show overlay arrow in source buffer. All set in | 139 | ;; Used to show overlay arrow in source buffer. All set in |
| 133 | ;; gdb-get-main-selected-frame. Disassembly buffer should not use | 140 | ;; gdb-get-main-selected-frame. Disassembly buffer should not use |
| 134 | ;; these but rely on buffer-local thread information instead. | 141 | ;; these but rely on buffer-local thread information instead. |
| @@ -172,8 +179,11 @@ as returned from \"-break-list\" by `gdb-json-partial-output' | |||
| 172 | Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where | 179 | Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where |
| 173 | STATUS is nil (unchanged), `changed' or `out-of-scope'.") | 180 | STATUS is nil (unchanged), `changed' or `out-of-scope'.") |
| 174 | (defvar gdb-main-file nil "Source file from which program execution begins.") | 181 | (defvar gdb-main-file nil "Source file from which program execution begins.") |
| 175 | (defvar gdb-overlay-arrow-position nil) | 182 | |
| 183 | ;; Overlay arrow markers | ||
| 176 | (defvar gdb-stack-position nil) | 184 | (defvar gdb-stack-position nil) |
| 185 | (defvar gdb-thread-position nil) | ||
| 186 | (defvar gdb-disassembly-position nil) | ||
| 177 | 187 | ||
| 178 | (defvar gdb-location-alist nil | 188 | (defvar gdb-location-alist nil |
| 179 | "Alist of breakpoint numbers and full filenames. Only used for files that | 189 | "Alist of breakpoint numbers and full filenames. Only used for files that |
| @@ -204,6 +214,12 @@ Emacs can't find.") | |||
| 204 | This variable is updated in `gdb-done-or-error' and returned by | 214 | This variable is updated in `gdb-done-or-error' and returned by |
| 205 | `gud-gdbmi-marker-filter'.") | 215 | `gud-gdbmi-marker-filter'.") |
| 206 | 216 | ||
| 217 | (defvar gdb-non-stop nil | ||
| 218 | "Indicates whether current GDB session is using non-stop mode. | ||
| 219 | |||
| 220 | It is initialized to `gdb-non-stop-setting' at the beginning of | ||
| 221 | every GDB session.") | ||
| 222 | |||
| 207 | (defvar gdb-buffer-type nil | 223 | (defvar gdb-buffer-type nil |
| 208 | "One of the symbols bound in `gdb-buffer-rules'.") | 224 | "One of the symbols bound in `gdb-buffer-rules'.") |
| 209 | (make-variable-buffer-local 'gdb-buffer-type) | 225 | (make-variable-buffer-local 'gdb-buffer-type) |
| @@ -220,6 +236,9 @@ Possible values are these symbols: | |||
| 220 | disposition of output generated by commands that | 236 | disposition of output generated by commands that |
| 221 | gdb mode sends to gdb on its own behalf.") | 237 | gdb mode sends to gdb on its own behalf.") |
| 222 | 238 | ||
| 239 | ;; Pending triggers prevent congestion: Emacs won't send two similar | ||
| 240 | ;; consecutive requests. | ||
| 241 | |||
| 223 | (defvar gdb-pending-triggers '() | 242 | (defvar gdb-pending-triggers '() |
| 224 | "A list of trigger functions which have not yet been handled. | 243 | "A list of trigger functions which have not yet been handled. |
| 225 | 244 | ||
| @@ -235,18 +254,63 @@ Elements are either function names or pairs (buffer . function)") | |||
| 235 | 254 | ||
| 236 | (defvar gdb-wait-for-pending-timeout 0.5) | 255 | (defvar gdb-wait-for-pending-timeout 0.5) |
| 237 | 256 | ||
| 238 | (defmacro gdb-wait-for-pending (&rest body) | 257 | (defun gdb-wait-for-pending (&rest body) |
| 239 | "Wait until `gdb-pending-triggers' is empty and execute BODY. | 258 | "Wait until `gdb-pending-triggers' is empty and execute BODY. |
| 240 | 259 | ||
| 241 | This function checks `gdb-pending-triggers' value every | 260 | This function checks `gdb-pending-triggers' value every |
| 242 | `gdb-wait-for-pending' seconds." | 261 | `gdb-wait-for-pending' seconds." |
| 243 | (run-with-timer | 262 | `(run-with-timer |
| 244 | gdb-wait-for-pending-timeout nil | 263 | gdb-wait-for-pending-timeout nil |
| 245 | `(lambda () | 264 | (lambda () |
| 246 | (if (not gdb-pending-triggers) | 265 | (if (not gdb-pending-triggers) |
| 247 | (progn | 266 | (progn |
| 248 | ,@body) | 267 | ,@body) |
| 249 | (gdb-wait-for-pending ,@body))))) | 268 | (gdb-wait-for-pending ,@body))))) |
| 269 | |||
| 270 | ;; Publish-subscribe | ||
| 271 | |||
| 272 | (defmacro gdb-add-subscriber (publisher subscriber) | ||
| 273 | "Register new PUBLISHER's SUBSCRIBER. | ||
| 274 | |||
| 275 | SUBSCRIBER must be a pair, where cdr is a function of one | ||
| 276 | argument (see `gdb-emit-signal')." | ||
| 277 | `(add-to-list ',publisher ,subscriber t)) | ||
| 278 | |||
| 279 | (defmacro gdb-delete-subscriber (publisher subscriber) | ||
| 280 | "Unregister SUBSCRIBER from PUBLISHER." | ||
| 281 | `(setq ,publisher (delete ,subscriber | ||
| 282 | ,publisher))) | ||
| 283 | |||
| 284 | (defun gdb-get-subscribers (publisher) | ||
| 285 | publisher) | ||
| 286 | |||
| 287 | (defun gdb-emit-signal (publisher &optional signal) | ||
| 288 | "Call cdr for each subscriber of PUBLISHER with SIGNAL as argument." | ||
| 289 | (dolist (subscriber (gdb-get-subscribers publisher)) | ||
| 290 | (funcall (cdr subscriber) signal))) | ||
| 291 | |||
| 292 | (defvar gdb-buf-publisher '() | ||
| 293 | "Used to invalidate GDB buffers by emitting a signal in | ||
| 294 | `gdb-update'. | ||
| 295 | |||
| 296 | Must be a list of pairs with cars being buffers and cdr's being | ||
| 297 | valid signal handlers.") | ||
| 298 | |||
| 299 | (defgroup gdb nil | ||
| 300 | "GDB graphical interface" | ||
| 301 | :group 'tools | ||
| 302 | :link '(info-link "(emacs)GDB Graphical Interface") | ||
| 303 | :version "23.2") | ||
| 304 | |||
| 305 | (defgroup gdb-non-stop nil | ||
| 306 | "GDB non-stop debugging settings" | ||
| 307 | :group 'gdb | ||
| 308 | :version "23.2") | ||
| 309 | |||
| 310 | (defgroup gdb-buffers nil | ||
| 311 | "GDB buffers" | ||
| 312 | :group 'gdb | ||
| 313 | :version "23.2") | ||
| 250 | 314 | ||
| 251 | (defcustom gdb-debug-log-max 128 | 315 | (defcustom gdb-debug-log-max 128 |
| 252 | "Maximum size of `gdb-debug-log'. If nil, size is unlimited." | 316 | "Maximum size of `gdb-debug-log'. If nil, size is unlimited." |
| @@ -255,21 +319,23 @@ This function checks `gdb-pending-triggers' value every | |||
| 255 | (const :tag "Unlimited" nil)) | 319 | (const :tag "Unlimited" nil)) |
| 256 | :version "22.1") | 320 | :version "22.1") |
| 257 | 321 | ||
| 258 | (defcustom gdb-non-stop t | 322 | (defcustom gdb-non-stop-setting t |
| 259 | "When in non-stop mode, stopped threads can be examined while | 323 | "When in non-stop mode, stopped threads can be examined while |
| 260 | other threads continue to execute." | 324 | other threads continue to execute. |
| 325 | |||
| 326 | GDB session needs to be restarted for this setting to take | ||
| 327 | effect." | ||
| 261 | :type 'boolean | 328 | :type 'boolean |
| 262 | :group 'gdb | 329 | :group 'gdb-non-stop |
| 263 | :version "23.2") | 330 | :version "23.2") |
| 264 | 331 | ||
| 265 | ;; TODO Some commands can't be called with --all (give a notice about | 332 | ;; TODO Some commands can't be called with --all (give a notice about |
| 266 | ;; it in setting doc) | 333 | ;; it in setting doc) |
| 267 | (defcustom gdb-gud-control-all-threads t | 334 | (defcustom gdb-gud-control-all-threads t |
| 268 | "When enabled, GUD execution commands affect all threads when | 335 | "When enabled, GUD execution commands affect all threads when |
| 269 | in non-stop mode. Otherwise, only currently selected thread is | 336 | in non-stop mode. Otherwise, only current thread is affected." |
| 270 | affected." | ||
| 271 | :type 'boolean | 337 | :type 'boolean |
| 272 | :group 'gdb | 338 | :group 'gdb-non-stop |
| 273 | :version "23.2") | 339 | :version "23.2") |
| 274 | 340 | ||
| 275 | (defcustom gdb-switch-reasons t | 341 | (defcustom gdb-switch-reasons t |
| @@ -296,7 +362,7 @@ Emacs always switches to the thread which caused the stop." | |||
| 296 | (const :tag "End of stepping range reached." "end-stepping-range") | 362 | (const :tag "End of stepping range reached." "end-stepping-range") |
| 297 | (const :tag "Signal received (like interruption)." "signal-received")) | 363 | (const :tag "Signal received (like interruption)." "signal-received")) |
| 298 | (const :tag "None" nil)) | 364 | (const :tag "None" nil)) |
| 299 | :group 'gdb | 365 | :group 'gdb-non-stop |
| 300 | :version "23.2" | 366 | :version "23.2" |
| 301 | :link '(info-link "(gdb)GDB/MI Async Records")) | 367 | :link '(info-link "(gdb)GDB/MI Async Records")) |
| 302 | 368 | ||
| @@ -318,6 +384,8 @@ contains fields of corresponding MI *stopped async record: | |||
| 318 | (addr . \"0x0804869e\")) | 384 | (addr . \"0x0804869e\")) |
| 319 | (reason . \"end-stepping-range\")) | 385 | (reason . \"end-stepping-range\")) |
| 320 | 386 | ||
| 387 | Note that \"reason\" is only present in non-stop debugging mode. | ||
| 388 | |||
| 321 | `gdb-get-field' may be used to access the fields of response. | 389 | `gdb-get-field' may be used to access the fields of response. |
| 322 | 390 | ||
| 323 | Each function is called after the new current thread was selected | 391 | Each function is called after the new current thread was selected |
| @@ -331,7 +399,50 @@ and GDB buffers were updated in `gdb-stopped'." | |||
| 331 | "When nil, Emacs won't switch to stopped thread if some other | 399 | "When nil, Emacs won't switch to stopped thread if some other |
| 332 | stopped thread is already selected." | 400 | stopped thread is already selected." |
| 333 | :type 'boolean | 401 | :type 'boolean |
| 334 | :group 'gdb | 402 | :group 'gdb-non-stop |
| 403 | :version "23.2") | ||
| 404 | |||
| 405 | (defcustom gdb-stack-buffer-locations t | ||
| 406 | "Show file information or library names in stack buffers." | ||
| 407 | :type 'boolean | ||
| 408 | :group 'gdb-buffers | ||
| 409 | :version "23.2") | ||
| 410 | |||
| 411 | (defcustom gdb-stack-buffer-addresses nil | ||
| 412 | "Show frame addresses in stack buffers." | ||
| 413 | :type 'boolean | ||
| 414 | :group 'gdb-buffers | ||
| 415 | :version "23.2") | ||
| 416 | |||
| 417 | (defcustom gdb-thread-buffer-verbose-names t | ||
| 418 | "Show long thread names in threads buffer." | ||
| 419 | :type 'boolean | ||
| 420 | :group 'gdb-buffers | ||
| 421 | :version "23.2") | ||
| 422 | |||
| 423 | (defcustom gdb-thread-buffer-arguments t | ||
| 424 | "Show function arguments in threads buffer." | ||
| 425 | :type 'boolean | ||
| 426 | :group 'gdb-buffers | ||
| 427 | :version "23.2") | ||
| 428 | |||
| 429 | (defcustom gdb-thread-buffer-locations t | ||
| 430 | "Show file information or library names in threads buffer." | ||
| 431 | :type 'boolean | ||
| 432 | :group 'gdb-buffers | ||
| 433 | :version "23.2") | ||
| 434 | |||
| 435 | (defcustom gdb-thread-buffer-addresses nil | ||
| 436 | "Show addresses for thread frames in threads buffer." | ||
| 437 | :type 'boolean | ||
| 438 | :group 'gdb-buffers | ||
| 439 | :version "23.2") | ||
| 440 | |||
| 441 | (defcustom gdb-show-threads-by-default nil | ||
| 442 | "Show threads list buffer instead of breakpoints list by | ||
| 443 | default." | ||
| 444 | :type 'boolean | ||
| 445 | :group 'gdb-buffers | ||
| 335 | :version "23.2") | 446 | :version "23.2") |
| 336 | 447 | ||
| 337 | (defvar gdb-debug-log nil | 448 | (defvar gdb-debug-log nil |
| @@ -428,15 +539,6 @@ the list) is deleted every time a new one is added (at the front)." | |||
| 428 | (setq varnumlet (concat varnumlet "." component))) | 539 | (setq varnumlet (concat varnumlet "." component))) |
| 429 | expr))) | 540 | expr))) |
| 430 | 541 | ||
| 431 | (defvar gdb-locals-font-lock-keywords | ||
| 432 | '( | ||
| 433 | ;; var = type value | ||
| 434 | ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)" | ||
| 435 | (1 font-lock-variable-name-face) | ||
| 436 | (3 font-lock-type-face)) | ||
| 437 | ) | ||
| 438 | "Font lock keywords used in `gdb-local-mode'.") | ||
| 439 | |||
| 440 | ;; noall is used for commands which don't take --all, but only | 542 | ;; noall is used for commands which don't take --all, but only |
| 441 | ;; --thread. | 543 | ;; --thread. |
| 442 | (defun gdb-gud-context-command (command &optional noall) | 544 | (defun gdb-gud-context-command (command &optional noall) |
| @@ -450,7 +552,7 @@ When `gdb-non-stop' is nil, return COMMAND unchanged." | |||
| 450 | (if (and gdb-gud-control-all-threads | 552 | (if (and gdb-gud-control-all-threads |
| 451 | (not noall)) | 553 | (not noall)) |
| 452 | (concat command " --all ") | 554 | (concat command " --all ") |
| 453 | (gdb-current-context-command command)) | 555 | (gdb-current-context-command command t)) |
| 454 | command)) | 556 | command)) |
| 455 | 557 | ||
| 456 | ;; TODO Document this. We use noarg when not in gud-def | 558 | ;; TODO Document this. We use noarg when not in gud-def |
| @@ -504,7 +606,7 @@ detailed description of this mode. | |||
| 504 | | | | | 606 | | | | |
| 505 | +-----------------------------------+----------------------------------+ | 607 | +-----------------------------------+----------------------------------+ |
| 506 | | Stack buffer | Breakpoints buffer | | 608 | | Stack buffer | Breakpoints buffer | |
| 507 | | RET gdb-frames-select | SPC gdb-toggle-breakpoint | | 609 | | RET gdb-select-frame | SPC gdb-toggle-breakpoint | |
| 508 | | | RET gdb-goto-breakpoint | | 610 | | | RET gdb-goto-breakpoint | |
| 509 | | | D gdb-delete-breakpoint | | 611 | | | D gdb-delete-breakpoint | |
| 510 | +-----------------------------------+----------------------------------+" | 612 | +-----------------------------------+----------------------------------+" |
| @@ -653,7 +755,8 @@ detailed description of this mode. | |||
| 653 | gdb-continuation nil | 755 | gdb-continuation nil |
| 654 | gdb-buf-publisher '() | 756 | gdb-buf-publisher '() |
| 655 | gdb-threads-list '() | 757 | gdb-threads-list '() |
| 656 | gdb-breakpoints-list '()) | 758 | gdb-breakpoints-list '() |
| 759 | gdb-non-stop gdb-non-stop-setting) | ||
| 657 | ;; | 760 | ;; |
| 658 | (setq gdb-buffer-type 'gdbmi) | 761 | (setq gdb-buffer-type 'gdbmi) |
| 659 | ;; | 762 | ;; |
| @@ -767,7 +870,7 @@ with mouse-1 (default bindings)." | |||
| 767 | (gdb-if-arrow gud-overlay-arrow-position | 870 | (gdb-if-arrow gud-overlay-arrow-position |
| 768 | (setq line (line-number-at-pos (posn-point end))) | 871 | (setq line (line-number-at-pos (posn-point end))) |
| 769 | (gud-call (concat "until " (number-to-string line)))) | 872 | (gud-call (concat "until " (number-to-string line)))) |
| 770 | (gdb-if-arrow gdb-overlay-arrow-position | 873 | (gdb-if-arrow gdb-disassembly-position |
| 771 | (save-excursion | 874 | (save-excursion |
| 772 | (goto-line (line-number-at-pos (posn-point end))) | 875 | (goto-line (line-number-at-pos (posn-point end))) |
| 773 | (forward-char 2) | 876 | (forward-char 2) |
| @@ -787,7 +890,7 @@ line, and no execution takes place." | |||
| 787 | (progn | 890 | (progn |
| 788 | (gud-call (concat "tbreak " (number-to-string line))) | 891 | (gud-call (concat "tbreak " (number-to-string line))) |
| 789 | (gud-call (concat "jump " (number-to-string line))))) | 892 | (gud-call (concat "jump " (number-to-string line))))) |
| 790 | (gdb-if-arrow gdb-overlay-arrow-position | 893 | (gdb-if-arrow gdb-disassembly-position |
| 791 | (save-excursion | 894 | (save-excursion |
| 792 | (goto-line (line-number-at-pos (posn-point end))) | 895 | (goto-line (line-number-at-pos (posn-point end))) |
| 793 | (forward-char 2) | 896 | (forward-char 2) |
| @@ -1085,6 +1188,8 @@ INDENT is the current indentation depth." | |||
| 1085 | (nth 3 rules-entry)) | 1188 | (nth 3 rules-entry)) |
| 1086 | 1189 | ||
| 1087 | (defun gdb-update-buffer-name () | 1190 | (defun gdb-update-buffer-name () |
| 1191 | "Rename current buffer according to name-maker associated with | ||
| 1192 | it in `gdb-buffer-rules'." | ||
| 1088 | (let ((f (gdb-rules-name-maker (assoc gdb-buffer-type | 1193 | (let ((f (gdb-rules-name-maker (assoc gdb-buffer-type |
| 1089 | gdb-buffer-rules)))) | 1194 | gdb-buffer-rules)))) |
| 1090 | (when f (rename-buffer (funcall f))))) | 1195 | (when f (rename-buffer (funcall f))))) |
| @@ -1104,6 +1209,17 @@ thread." | |||
| 1104 | "Get current stack frame object for thread of current buffer." | 1209 | "Get current stack frame object for thread of current buffer." |
| 1105 | (gdb-get-field (gdb-current-buffer-thread) 'frame)) | 1210 | (gdb-get-field (gdb-current-buffer-thread) 'frame)) |
| 1106 | 1211 | ||
| 1212 | (defun gdb-buffer-type (buffer) | ||
| 1213 | "Get value of `gdb-buffer-type' for BUFFER." | ||
| 1214 | (with-current-buffer buffer | ||
| 1215 | gdb-buffer-type)) | ||
| 1216 | |||
| 1217 | (defun gdb-buffer-shows-main-thread-p () | ||
| 1218 | "Return t if current GDB buffer shows main selected thread and | ||
| 1219 | is not bound to it." | ||
| 1220 | (current-buffer) | ||
| 1221 | (not (local-variable-p 'gdb-thread-number))) | ||
| 1222 | |||
| 1107 | (defun gdb-get-buffer (buffer-type &optional thread) | 1223 | (defun gdb-get-buffer (buffer-type &optional thread) |
| 1108 | "Get a specific GDB buffer. | 1224 | "Get a specific GDB buffer. |
| 1109 | 1225 | ||
| @@ -1124,10 +1240,14 @@ The buffer-type should be one of the cars in `gdb-buffer-rules'. | |||
| 1124 | If THREAD is non-nil, it is assigned to `gdb-thread-number' | 1240 | If THREAD is non-nil, it is assigned to `gdb-thread-number' |
| 1125 | buffer-local variable of the new buffer. | 1241 | buffer-local variable of the new buffer. |
| 1126 | 1242 | ||
| 1127 | If buffer's mode returns a symbol, it's used to register " | 1243 | Buffer mode and name are selected according to buffer type. |
| 1244 | |||
| 1245 | If buffer has trigger associated with it in `gdb-buffer-rules', | ||
| 1246 | this trigger is subscribed to `gdb-buf-publisher' and called with | ||
| 1247 | 'update argument." | ||
| 1128 | (or (gdb-get-buffer buffer-type thread) | 1248 | (or (gdb-get-buffer buffer-type thread) |
| 1129 | (let ((rules (assoc buffer-type gdb-buffer-rules)) | 1249 | (let ((rules (assoc buffer-type gdb-buffer-rules)) |
| 1130 | (new (generate-new-buffer "limbo"))) | 1250 | (new (generate-new-buffer "limbo"))) |
| 1131 | (with-current-buffer new | 1251 | (with-current-buffer new |
| 1132 | (let ((mode (gdb-rules-buffer-mode rules)) | 1252 | (let ((mode (gdb-rules-buffer-mode rules)) |
| 1133 | (trigger (gdb-rules-update-trigger rules))) | 1253 | (trigger (gdb-rules-update-trigger rules))) |
| @@ -1143,7 +1263,7 @@ If buffer's mode returns a symbol, it's used to register " | |||
| 1143 | (gdb-add-subscriber gdb-buf-publisher | 1263 | (gdb-add-subscriber gdb-buf-publisher |
| 1144 | (cons (current-buffer) | 1264 | (cons (current-buffer) |
| 1145 | (gdb-bind-function-to-buffer trigger (current-buffer)))) | 1265 | (gdb-bind-function-to-buffer trigger (current-buffer)))) |
| 1146 | (funcall trigger)) | 1266 | (funcall trigger 'update)) |
| 1147 | (current-buffer)))))) | 1267 | (current-buffer)))))) |
| 1148 | 1268 | ||
| 1149 | (defun gdb-bind-function-to-buffer (expr buffer) | 1269 | (defun gdb-bind-function-to-buffer (expr buffer) |
| @@ -1175,6 +1295,15 @@ DOC is an optional documentation string." | |||
| 1175 | (gdb-display-buffer | 1295 | (gdb-display-buffer |
| 1176 | (gdb-get-buffer-create ,buffer thread) t))) | 1296 | (gdb-get-buffer-create ,buffer thread) t))) |
| 1177 | 1297 | ||
| 1298 | ;; Used to display windows with thread-bound buffers | ||
| 1299 | (defmacro def-gdb-preempt-display-buffer (name buffer &optional doc split-horizontal) | ||
| 1300 | `(defun ,name (&optional thread) | ||
| 1301 | ,(when doc doc) | ||
| 1302 | (message thread) | ||
| 1303 | (gdb-preempt-existing-or-display-buffer | ||
| 1304 | (gdb-get-buffer-create ,buffer thread) | ||
| 1305 | ,split-horizontal))) | ||
| 1306 | |||
| 1178 | ;; This assoc maps buffer type symbols to rules. Each rule is a list of | 1307 | ;; This assoc maps buffer type symbols to rules. Each rule is a list of |
| 1179 | ;; at least one and possible more functions. The functions have these | 1308 | ;; at least one and possible more functions. The functions have these |
| 1180 | ;; roles in defining a buffer type: | 1309 | ;; roles in defining a buffer type: |
| @@ -1436,13 +1565,21 @@ static char *magick[] = { | |||
| 1436 | (process-send-string (get-buffer-process gud-comint-buffer) | 1565 | (process-send-string (get-buffer-process gud-comint-buffer) |
| 1437 | (concat (car item) "\n"))) | 1566 | (concat (car item) "\n"))) |
| 1438 | 1567 | ||
| 1439 | (defun gdb-current-context-command (command) | 1568 | ;; NOFRAME is used for gud execution control commands |
| 1440 | "Add --thread option to gdb COMMAND. | 1569 | (defun gdb-current-context-command (command &optional noframe) |
| 1570 | "Add --thread and --frame options to gdb COMMAND. | ||
| 1441 | 1571 | ||
| 1442 | Option value is taken from `gdb-thread-number'. If | 1572 | Option values are taken from `gdb-thread-number' and |
| 1443 | `gdb-thread-number' is nil, COMMAND is returned unchanged." | 1573 | `gdb-frame-number'. If `gdb-thread-number' is nil, COMMAND is |
| 1574 | returned unchanged. If `gdb-frame-number' is nil of NOFRAME is t, | ||
| 1575 | then no --frame option is added." | ||
| 1576 | ;; gdb-frame-number may be nil while gdb-thread-number is non-nil | ||
| 1577 | ;; (when current thread is running) | ||
| 1444 | (if gdb-thread-number | 1578 | (if gdb-thread-number |
| 1445 | (concat command " --thread " gdb-thread-number " ") | 1579 | (concat command " --thread " gdb-thread-number |
| 1580 | (if (not (or noframe (not gdb-frame-number))) | ||
| 1581 | (concat " --frame " gdb-frame-number) "") | ||
| 1582 | " ") | ||
| 1446 | command)) | 1583 | command)) |
| 1447 | 1584 | ||
| 1448 | (defun gdb-current-context-buffer-name (name) | 1585 | (defun gdb-current-context-buffer-name (name) |
| @@ -1450,11 +1587,9 @@ Option value is taken from `gdb-thread-number'. If | |||
| 1450 | 1587 | ||
| 1451 | If `gdb-thread-number' is nil, just wrap NAME in asterisks." | 1588 | If `gdb-thread-number' is nil, just wrap NAME in asterisks." |
| 1452 | (concat "*" name | 1589 | (concat "*" name |
| 1453 | (format | 1590 | (if (local-variable-p 'gdb-thread-number) |
| 1454 | (cond ((local-variable-p 'gdb-thread-number) " (bound to thread %s)") | 1591 | (format " (bound to thread %s)" gdb-thread-number) |
| 1455 | (gdb-thread-number " (current thread %s)") | 1592 | "") |
| 1456 | (t "")) | ||
| 1457 | gdb-thread-number) | ||
| 1458 | "*")) | 1593 | "*")) |
| 1459 | 1594 | ||
| 1460 | 1595 | ||
| @@ -1468,35 +1603,6 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks." | |||
| 1468 | (setq gdb-output-sink 'user) | 1603 | (setq gdb-output-sink 'user) |
| 1469 | (setq gdb-pending-triggers nil)) | 1604 | (setq gdb-pending-triggers nil)) |
| 1470 | 1605 | ||
| 1471 | ;; Publish-subscribe | ||
| 1472 | |||
| 1473 | (defmacro gdb-add-subscriber (publisher subscriber) | ||
| 1474 | "Register new PUBLISHER's SUBSCRIBER. | ||
| 1475 | |||
| 1476 | SUBSCRIBER must be a pair, where cdr is a function of one | ||
| 1477 | argument (see `gdb-emit-signal')." | ||
| 1478 | `(add-to-list ',publisher ,subscriber t)) | ||
| 1479 | |||
| 1480 | (defmacro gdb-delete-subscriber (publisher subscriber) | ||
| 1481 | "Unregister SUBSCRIBER from PUBLISHER." | ||
| 1482 | `(setq ,publisher (delete ,subscriber | ||
| 1483 | ,publisher))) | ||
| 1484 | |||
| 1485 | (defun gdb-get-subscribers (publisher) | ||
| 1486 | publisher) | ||
| 1487 | |||
| 1488 | (defun gdb-emit-signal (publisher &optional signal) | ||
| 1489 | "Call cdr for each subscriber of PUBLISHER with SIGNAL as argument." | ||
| 1490 | (dolist (subscriber (gdb-get-subscribers publisher)) | ||
| 1491 | (funcall (cdr subscriber) signal))) | ||
| 1492 | |||
| 1493 | (defvar gdb-buf-publisher '() | ||
| 1494 | "Used to invalidate GDB buffers by emitting a signal in | ||
| 1495 | `gdb-update'. | ||
| 1496 | |||
| 1497 | Must be a list of pairs with cars being buffers and cdr's being | ||
| 1498 | valid signal handlers.") | ||
| 1499 | |||
| 1500 | (defun gdb-update () | 1606 | (defun gdb-update () |
| 1501 | "Update buffers showing status of debug session." | 1607 | "Update buffers showing status of debug session." |
| 1502 | (when gdb-first-prompt | 1608 | (when gdb-first-prompt |
| @@ -1524,12 +1630,19 @@ valid signal handlers.") | |||
| 1524 | ;; because we may need to update current gud-running value without | 1630 | ;; because we may need to update current gud-running value without |
| 1525 | ;; changing current thread (see gdb-running) | 1631 | ;; changing current thread (see gdb-running) |
| 1526 | (defun gdb-setq-thread-number (number) | 1632 | (defun gdb-setq-thread-number (number) |
| 1527 | "Set `gdb-thread-number' to NUMBER and update `gud-running'." | 1633 | "Only this function must be used to change `gdb-thread-number' |
| 1634 | value to NUMBER, because `gud-running' and `gdb-frame-number' | ||
| 1635 | need to be updated appropriately when current thread changes." | ||
| 1528 | (setq gdb-thread-number number) | 1636 | (setq gdb-thread-number number) |
| 1637 | (setq gdb-frame-number "0") | ||
| 1529 | (gdb-update-gud-running)) | 1638 | (gdb-update-gud-running)) |
| 1530 | 1639 | ||
| 1531 | (defun gdb-update-gud-running () | 1640 | (defun gdb-update-gud-running () |
| 1532 | "Set `gud-running' according to the state of current thread. | 1641 | "Set `gud-running' and `gdb-frame-number' according to the state |
| 1642 | of current thread. | ||
| 1643 | |||
| 1644 | `gdb-frame-number' is set to nil if new current thread is | ||
| 1645 | running. | ||
| 1533 | 1646 | ||
| 1534 | Note that when `gdb-gud-control-all-threads' is t, `gud-running' | 1647 | Note that when `gdb-gud-control-all-threads' is t, `gud-running' |
| 1535 | cannot be reliably used to determine whether or not execution | 1648 | cannot be reliably used to determine whether or not execution |
| @@ -1539,9 +1652,34 @@ instead. | |||
| 1539 | 1652 | ||
| 1540 | For all-stop mode, thread information is unavailable while target | 1653 | For all-stop mode, thread information is unavailable while target |
| 1541 | is running." | 1654 | is running." |
| 1542 | (setq gud-running | 1655 | (let ((old-value gud-running)) |
| 1543 | (string= (gdb-get-field (gdb-current-buffer-thread) 'state) | 1656 | (setq gud-running |
| 1544 | "running"))) | 1657 | (string= (gdb-get-field (gdb-current-buffer-thread) 'state) |
| 1658 | "running")) | ||
| 1659 | ;; We change frame number only if the state of current thread has | ||
| 1660 | ;; changed. | ||
| 1661 | (when (not (eq gud-running old-value)) | ||
| 1662 | (if gud-running | ||
| 1663 | (setq gdb-frame-number nil) | ||
| 1664 | (setq gdb-frame-number "0"))))) | ||
| 1665 | |||
| 1666 | (defun gdb-show-run-p () | ||
| 1667 | "Return t if \"Run/continue\" should be shown on the toolbar." | ||
| 1668 | (or (and (or | ||
| 1669 | (not gdb-gud-control-all-threads) | ||
| 1670 | (not gdb-non-stop)) | ||
| 1671 | (not gud-running)) | ||
| 1672 | (and gdb-gud-control-all-threads | ||
| 1673 | (> gdb-stopped-threads-count 0)))) | ||
| 1674 | |||
| 1675 | (defun gdb-show-stop-p () | ||
| 1676 | "Return t if \"Stop\" should be shown on the toolbar." | ||
| 1677 | (or (and (or | ||
| 1678 | (not gdb-gud-control-all-threads) | ||
| 1679 | (not gdb-non-stop)) | ||
| 1680 | gud-running) | ||
| 1681 | (and gdb-gud-control-all-threads | ||
| 1682 | (> gdb-running-threads-count 0)))) | ||
| 1545 | 1683 | ||
| 1546 | ;; GUD displays the selected GDB frame. This might might not be the current | 1684 | ;; GUD displays the selected GDB frame. This might might not be the current |
| 1547 | ;; GDB frame (after up, down etc). If no GDB frame is visible but the last | 1685 | ;; GDB frame (after up, down etc). If no GDB frame is visible but the last |
| @@ -1644,7 +1782,17 @@ is running." | |||
| 1644 | ;; gdb-invalidate-threads is defined to accept 'update-threads signal | 1782 | ;; gdb-invalidate-threads is defined to accept 'update-threads signal |
| 1645 | (defun gdb-thread-created (output-field)) | 1783 | (defun gdb-thread-created (output-field)) |
| 1646 | (defun gdb-thread-exited (output-field) | 1784 | (defun gdb-thread-exited (output-field) |
| 1647 | (gdb-emit-signal gdb-buf-publisher 'update-threads)) | 1785 | "Handle =thread-exited async record: unset `gdb-thread-number' |
| 1786 | if current thread exited and update threads list." | ||
| 1787 | (let* ((thread-id (gdb-get-field (gdb-json-string output-field) 'id))) | ||
| 1788 | (if (string= gdb-thread-number thread-id) | ||
| 1789 | (gdb-setq-thread-number nil)) | ||
| 1790 | ;; When we continue current thread and it quickly exits, | ||
| 1791 | ;; gdb-pending-triggers left after gdb-running disallow us to | ||
| 1792 | ;; properly call -thread-info without --thread option. Thus we | ||
| 1793 | ;; need to use gdb-wait-for-pending. | ||
| 1794 | (gdb-wait-for-pending | ||
| 1795 | (gdb-emit-signal gdb-buf-publisher 'update-threads)))) | ||
| 1648 | 1796 | ||
| 1649 | (defun gdb-thread-selected (output-field) | 1797 | (defun gdb-thread-selected (output-field) |
| 1650 | "Handler for =thread-selected MI output record. | 1798 | "Handler for =thread-selected MI output record. |
| @@ -1653,10 +1801,25 @@ Sets `gdb-thread-number' to new id." | |||
| 1653 | (let* ((result (gdb-json-string output-field)) | 1801 | (let* ((result (gdb-json-string output-field)) |
| 1654 | (thread-id (gdb-get-field result 'id))) | 1802 | (thread-id (gdb-get-field result 'id))) |
| 1655 | (gdb-setq-thread-number thread-id) | 1803 | (gdb-setq-thread-number thread-id) |
| 1804 | ;; Typing `thread N` in GUD buffer makes GDB emit `^done` followed | ||
| 1805 | ;; by `=thread-selected` notification. `^done` causes `gdb-update` | ||
| 1806 | ;; as usually. Things happen to fast and second call (from | ||
| 1807 | ;; gdb-thread-selected handler) gets cut off by our beloved | ||
| 1808 | ;; gdb-pending-triggers. | ||
| 1809 | ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its | ||
| 1810 | ;; body will get executed when `gdb-pending-triggers` is empty. | ||
| 1656 | (gdb-wait-for-pending | 1811 | (gdb-wait-for-pending |
| 1657 | (gdb-update)))) | 1812 | (gdb-update)))) |
| 1658 | 1813 | ||
| 1659 | (defun gdb-running (output-field) | 1814 | (defun gdb-running (output-field) |
| 1815 | (let* ((thread-id (gdb-get-field (gdb-json-string output-field) 'thread-id))) | ||
| 1816 | ;; We reset gdb-frame-number to nil if current thread has gone | ||
| 1817 | ;; running. This can't be done in gdb-thread-list-handler-custom | ||
| 1818 | ;; because we need correct gdb-frame-number by the time | ||
| 1819 | ;; -thread-info command is sent. | ||
| 1820 | (when (or (string-equal thread-id "all") | ||
| 1821 | (string-equal thread-id gdb-thread-number)) | ||
| 1822 | (setq gdb-frame-number nil))) | ||
| 1660 | (setq gdb-inferior-status "running") | 1823 | (setq gdb-inferior-status "running") |
| 1661 | (gdb-force-mode-line-update | 1824 | (gdb-force-mode-line-update |
| 1662 | (propertize gdb-inferior-status 'face font-lock-type-face)) | 1825 | (propertize gdb-inferior-status 'face font-lock-type-face)) |
| @@ -1730,7 +1893,7 @@ current thread and update GDB buffers." | |||
| 1730 | ;; In all-stop this updates gud-running properly as well. | 1893 | ;; In all-stop this updates gud-running properly as well. |
| 1731 | (gdb-update) | 1894 | (gdb-update) |
| 1732 | (setq gdb-first-done-or-error nil)) | 1895 | (setq gdb-first-done-or-error nil)) |
| 1733 | (run-hook-with-args 'gdb-stopped-hook result))) | 1896 | (run-hook-with-args 'gdb-stopped-hooks result))) |
| 1734 | 1897 | ||
| 1735 | ;; Remove the trimmings from log stream containing debugging messages | 1898 | ;; Remove the trimmings from log stream containing debugging messages |
| 1736 | ;; being produced by GDB's internals, use warning face and send to GUD | 1899 | ;; being produced by GDB's internals, use warning face and send to GUD |
| @@ -1878,9 +2041,81 @@ FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'." | |||
| 1878 | (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) | 2041 | (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) |
| 1879 | (gdb-json-read-buffer fix-key fix-list))) | 2042 | (gdb-json-read-buffer fix-key fix-list))) |
| 1880 | 2043 | ||
| 2044 | (defmacro gdb-mark-line (line variable) | ||
| 2045 | "Set VARIABLE marker to point at beginning of LINE. | ||
| 2046 | |||
| 2047 | If current window has no fringes, inverse colors on LINE. | ||
| 2048 | |||
| 2049 | Return position where LINE begins." | ||
| 2050 | `(save-excursion | ||
| 2051 | (let* ((offset (1+ (- ,line (line-number-at-pos)))) | ||
| 2052 | (start-posn (line-beginning-position offset)) | ||
| 2053 | (end-posn (line-end-position offset))) | ||
| 2054 | (set-marker ,variable (copy-marker start-posn)) | ||
| 2055 | (when (not (> (car (window-fringes)) 0)) | ||
| 2056 | (put-text-property start-posn end-posn | ||
| 2057 | 'font-lock-face '(:inverse-video t))) | ||
| 2058 | start-posn))) | ||
| 2059 | |||
| 1881 | (defun gdb-pad-string (string padding) | 2060 | (defun gdb-pad-string (string padding) |
| 1882 | (format (concat "%" (number-to-string padding) "s") string)) | 2061 | (format (concat "%" (number-to-string padding) "s") string)) |
| 1883 | 2062 | ||
| 2063 | ;; gdb-table struct is a way to programmatically construct simple | ||
| 2064 | ;; tables. It help to reliably align columns of data in GDB buffers | ||
| 2065 | ;; and provides | ||
| 2066 | (defstruct | ||
| 2067 | gdb-table | ||
| 2068 | (column-sizes nil) | ||
| 2069 | (rows nil) | ||
| 2070 | (row-properties nil) | ||
| 2071 | (right-align nil)) | ||
| 2072 | |||
| 2073 | (defun gdb-table-add-row (table row &optional properties) | ||
| 2074 | "Add ROW of string to TABLE and recalculate column sizes. | ||
| 2075 | |||
| 2076 | When non-nil, PROPERTIES will be added to the whole row when | ||
| 2077 | calling `gdb-table-string'." | ||
| 2078 | (let ((rows (gdb-table-rows table)) | ||
| 2079 | (row-properties (gdb-table-row-properties table)) | ||
| 2080 | (column-sizes (gdb-table-column-sizes table)) | ||
| 2081 | (right-align (gdb-table-right-align table))) | ||
| 2082 | (when (not column-sizes) | ||
| 2083 | (setf (gdb-table-column-sizes table) | ||
| 2084 | (make-list (length row) 0))) | ||
| 2085 | (setf (gdb-table-rows table) | ||
| 2086 | (append rows (list row))) | ||
| 2087 | (setf (gdb-table-row-properties table) | ||
| 2088 | (append row-properties (list properties))) | ||
| 2089 | (setf (gdb-table-column-sizes table) | ||
| 2090 | (mapcar* (lambda (x s) | ||
| 2091 | (let ((new-x | ||
| 2092 | (max (abs x) (string-width s)))) | ||
| 2093 | (if right-align new-x (- new-x)))) | ||
| 2094 | (gdb-table-column-sizes table) | ||
| 2095 | row)) | ||
| 2096 | ;; Avoid trailing whitespace at eol | ||
| 2097 | (if (not (gdb-table-right-align table)) | ||
| 2098 | (setcar (last (gdb-table-column-sizes table)) 0)))) | ||
| 2099 | |||
| 2100 | (defun gdb-table-string (table &optional sep) | ||
| 2101 | "Return TABLE as a string with columns separated with SEP." | ||
| 2102 | (let ((column-sizes (gdb-table-column-sizes table)) | ||
| 2103 | (res "")) | ||
| 2104 | (mapconcat | ||
| 2105 | 'identity | ||
| 2106 | (mapcar* | ||
| 2107 | (lambda (row properties) | ||
| 2108 | (apply 'propertize | ||
| 2109 | (mapconcat 'identity | ||
| 2110 | (mapcar* (lambda (s x) (gdb-pad-string s x)) | ||
| 2111 | row column-sizes) | ||
| 2112 | sep) | ||
| 2113 | properties)) | ||
| 2114 | (gdb-table-rows table) | ||
| 2115 | (gdb-table-row-properties table)) | ||
| 2116 | "\n"))) | ||
| 2117 | |||
| 2118 | ;; gdb-get-field goes deep, gdb-get-many-fields goes wide | ||
| 1884 | (defalias 'gdb-get-field 'bindat-get-field) | 2119 | (defalias 'gdb-get-field 'bindat-get-field) |
| 1885 | 2120 | ||
| 1886 | (defun gdb-get-many-fields (struct &rest fields) | 2121 | (defun gdb-get-many-fields (struct &rest fields) |
| @@ -1897,7 +2132,9 @@ HANDLER-NAME as its handler. HANDLER-NAME is bound to current | |||
| 1897 | buffer with `gdb-bind-function-to-buffer'. | 2132 | buffer with `gdb-bind-function-to-buffer'. |
| 1898 | 2133 | ||
| 1899 | If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the | 2134 | If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the |
| 1900 | defined trigger is called with an argument from SIGNAL-LIST. | 2135 | defined trigger is called with an argument from SIGNAL-LIST. It's |
| 2136 | not recommended to define triggers with empty SIGNAL-LIST. | ||
| 2137 | Normally triggers should respond at least to 'update signal. | ||
| 1901 | 2138 | ||
| 1902 | Normally the trigger defined by this command must be called from | 2139 | Normally the trigger defined by this command must be called from |
| 1903 | the buffer where HANDLER-NAME must work. This should be done so | 2140 | the buffer where HANDLER-NAME must work. This should be done so |
| @@ -1922,7 +2159,8 @@ trigger argument when describing buffer types with | |||
| 1922 | 2159 | ||
| 1923 | ;; Used by disassembly buffer only, the rest use | 2160 | ;; Used by disassembly buffer only, the rest use |
| 1924 | ;; def-gdb-trigger-and-handler | 2161 | ;; def-gdb-trigger-and-handler |
| 1925 | (defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun &optional nopreserve) | 2162 | (defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun |
| 2163 | &optional nopreserve) | ||
| 1926 | "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN. | 2164 | "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN. |
| 1927 | 2165 | ||
| 1928 | Handlers are normally called from the buffers they put output in. | 2166 | Handlers are normally called from the buffers they put output in. |
| @@ -1951,7 +2189,7 @@ If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." | |||
| 1951 | "Define trigger and handler. | 2189 | "Define trigger and handler. |
| 1952 | 2190 | ||
| 1953 | TRIGGER-NAME trigger is defined to send GDB-COMMAND. See | 2191 | TRIGGER-NAME trigger is defined to send GDB-COMMAND. See |
| 1954 | `def-gdb-auto-update-trigger'. SIGNAL-LIST determines when | 2192 | `def-gdb-auto-update-trigger'. |
| 1955 | 2193 | ||
| 1956 | HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See | 2194 | HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See |
| 1957 | `def-gdb-auto-update-handler'." | 2195 | `def-gdb-auto-update-handler'." |
| @@ -1967,7 +2205,8 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See | |||
| 1967 | ;; Breakpoint buffer : This displays the output of `-break-list'. | 2205 | ;; Breakpoint buffer : This displays the output of `-break-list'. |
| 1968 | (def-gdb-trigger-and-handler | 2206 | (def-gdb-trigger-and-handler |
| 1969 | gdb-invalidate-breakpoints "-break-list" | 2207 | gdb-invalidate-breakpoints "-break-list" |
| 1970 | gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom) | 2208 | gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom |
| 2209 | '(update)) | ||
| 1971 | 2210 | ||
| 1972 | (gdb-set-buffer-rules | 2211 | (gdb-set-buffer-rules |
| 1973 | 'gdb-breakpoints-buffer | 2212 | 'gdb-breakpoints-buffer |
| @@ -1978,44 +2217,39 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See | |||
| 1978 | (defun gdb-breakpoints-list-handler-custom () | 2217 | (defun gdb-breakpoints-list-handler-custom () |
| 1979 | (let ((breakpoints-list (gdb-get-field | 2218 | (let ((breakpoints-list (gdb-get-field |
| 1980 | (gdb-json-partial-output "bkpt" "script") | 2219 | (gdb-json-partial-output "bkpt" "script") |
| 1981 | 'BreakpointTable 'body))) | 2220 | 'BreakpointTable 'body)) |
| 2221 | (table (make-gdb-table))) | ||
| 1982 | (setq gdb-breakpoints-list nil) | 2222 | (setq gdb-breakpoints-list nil) |
| 1983 | (insert "Num\tType\t\tDisp\tEnb\tHits\tAddr What\n") | 2223 | (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Hits" "Addr" "What")) |
| 1984 | (dolist (breakpoint breakpoints-list) | 2224 | (dolist (breakpoint breakpoints-list) |
| 1985 | (add-to-list 'gdb-breakpoints-list | 2225 | (add-to-list 'gdb-breakpoints-list |
| 1986 | (cons (gdb-get-field breakpoint 'number) | 2226 | (cons (gdb-get-field breakpoint 'number) |
| 1987 | breakpoint)) | 2227 | breakpoint)) |
| 1988 | (insert | 2228 | (let ((at (gdb-get-field breakpoint 'at)) |
| 1989 | (concat | 2229 | (pending (gdb-get-field breakpoint 'pending)) |
| 1990 | (gdb-get-field breakpoint 'number) "\t" | 2230 | (func (gdb-get-field breakpoint 'func))) |
| 1991 | (gdb-get-field breakpoint 'type) "\t" | 2231 | (gdb-table-add-row table |
| 1992 | (gdb-get-field breakpoint 'disp) "\t" | 2232 | (list |
| 2233 | (gdb-get-field breakpoint 'number) | ||
| 2234 | (gdb-get-field breakpoint 'type) | ||
| 2235 | (gdb-get-field breakpoint 'disp) | ||
| 1993 | (let ((flag (gdb-get-field breakpoint 'enabled))) | 2236 | (let ((flag (gdb-get-field breakpoint 'enabled))) |
| 1994 | (if (string-equal flag "y") | 2237 | (if (string-equal flag "y") |
| 1995 | (propertize "y" 'face font-lock-warning-face) | 2238 | (propertize "y" 'font-lock-face font-lock-warning-face) |
| 1996 | (propertize "n" 'face font-lock-comment-face))) "\t" | 2239 | (propertize "n" 'font-lock-face font-lock-comment-face))) |
| 1997 | (gdb-get-field breakpoint 'times) "\t" | 2240 | (gdb-get-field breakpoint 'times) |
| 1998 | (gdb-get-field breakpoint 'addr))) | 2241 | (gdb-get-field breakpoint 'addr) |
| 1999 | (let ((at (gdb-get-field breakpoint 'at)) | 2242 | (or pending at |
| 2000 | (pending (gdb-get-field breakpoint 'pending))) | 2243 | (concat "in " |
| 2001 | (cond (pending (insert " " pending)) | 2244 | (propertize func 'font-lock-face font-lock-function-name-face) |
| 2002 | (at (insert " " at)) | 2245 | (gdb-frame-location breakpoint)))) |
| 2003 | (t | 2246 | ;; Add clickable properties only for breakpoints with file:line |
| 2004 | (progn | 2247 | ;; information |
| 2005 | (insert | 2248 | (append (list 'gdb-breakpoint breakpoint) |
| 2006 | (concat " in " | 2249 | (when func '(help-echo "mouse-2, RET: visit breakpoint" |
| 2007 | (propertize (gdb-get-field breakpoint 'func) | 2250 | mouse-face highlight)))))) |
| 2008 | 'face font-lock-function-name-face))) | 2251 | (insert (gdb-table-string table " ")) |
| 2009 | (gdb-insert-frame-location breakpoint) | 2252 | (gdb-place-breakpoints))) |
| 2010 | (add-text-properties (line-beginning-position) | ||
| 2011 | (line-end-position) | ||
| 2012 | '(mouse-face highlight | ||
| 2013 | help-echo "mouse-2, RET: visit breakpoint"))))) | ||
| 2014 | (add-text-properties (line-beginning-position) | ||
| 2015 | (line-end-position) | ||
| 2016 | `(gdb-breakpoint ,breakpoint)) | ||
| 2017 | (newline)) | ||
| 2018 | (gdb-place-breakpoints)))) | ||
| 2019 | 2253 | ||
| 2020 | ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). | 2254 | ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). |
| 2021 | (defun gdb-place-breakpoints () | 2255 | (defun gdb-place-breakpoints () |
| @@ -2182,6 +2416,9 @@ If not in a source or disassembly buffer just set point." | |||
| 2182 | ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons. | 2416 | ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons. |
| 2183 | (define-key map "q" 'gdb-delete-frame-or-window) | 2417 | (define-key map "q" 'gdb-delete-frame-or-window) |
| 2184 | (define-key map "\r" 'gdb-goto-breakpoint) | 2418 | (define-key map "\r" 'gdb-goto-breakpoint) |
| 2419 | (define-key map "\t" '(lambda () | ||
| 2420 | (interactive) | ||
| 2421 | (gdb-set-window-buffer (gdb-threads-buffer-name) t))) | ||
| 2185 | (define-key map [mouse-2] 'gdb-goto-breakpoint) | 2422 | (define-key map [mouse-2] 'gdb-goto-breakpoint) |
| 2186 | (define-key map [follow-link] 'mouse-face) | 2423 | (define-key map [follow-link] 'mouse-face) |
| 2187 | map)) | 2424 | map)) |
| @@ -2206,28 +2443,6 @@ corresponding to the mode line clicked." | |||
| 2206 | ;; uses "-thread-info". Needs GDB 7.0 onwards. | 2443 | ;; uses "-thread-info". Needs GDB 7.0 onwards. |
| 2207 | ;;; Threads view | 2444 | ;;; Threads view |
| 2208 | 2445 | ||
| 2209 | (defun gdb-jump-to (file line) | ||
| 2210 | (find-file-other-window file) | ||
| 2211 | (goto-line line)) | ||
| 2212 | |||
| 2213 | (define-button-type 'gdb-file-button | ||
| 2214 | 'help-echo "Push to jump to source code" | ||
| 2215 | ; 'face 'bold | ||
| 2216 | 'action | ||
| 2217 | (lambda (b) | ||
| 2218 | (gdb-jump-to (button-get b 'file) | ||
| 2219 | (button-get b 'line)))) | ||
| 2220 | |||
| 2221 | (defun gdb-insert-file-location-button (file line) | ||
| 2222 | "Insert text button which allows jumping to FILE:LINE. | ||
| 2223 | |||
| 2224 | FILE is a full path." | ||
| 2225 | (insert-text-button | ||
| 2226 | (format "%s:%d" (file-name-nondirectory file) line) | ||
| 2227 | :type 'gdb-file-button | ||
| 2228 | 'file file | ||
| 2229 | 'line line)) | ||
| 2230 | |||
| 2231 | (defun gdb-threads-buffer-name () | 2446 | (defun gdb-threads-buffer-name () |
| 2232 | (concat "*threads of " (gdb-get-target-string) "*")) | 2447 | (concat "*threads of " (gdb-get-target-string) "*")) |
| 2233 | 2448 | ||
| @@ -2242,7 +2457,7 @@ FILE is a full path." | |||
| 2242 | "Display GDB threads in a new frame.") | 2457 | "Display GDB threads in a new frame.") |
| 2243 | 2458 | ||
| 2244 | (def-gdb-trigger-and-handler | 2459 | (def-gdb-trigger-and-handler |
| 2245 | gdb-invalidate-threads "-thread-info" | 2460 | gdb-invalidate-threads (gdb-current-context-command "-thread-info" gud-running) |
| 2246 | gdb-thread-list-handler gdb-thread-list-handler-custom | 2461 | gdb-thread-list-handler gdb-thread-list-handler-custom |
| 2247 | '(update update-threads)) | 2462 | '(update update-threads)) |
| 2248 | 2463 | ||
| @@ -2253,8 +2468,8 @@ FILE is a full path." | |||
| 2253 | 'gdb-invalidate-threads) | 2468 | 'gdb-invalidate-threads) |
| 2254 | 2469 | ||
| 2255 | (defvar gdb-threads-font-lock-keywords | 2470 | (defvar gdb-threads-font-lock-keywords |
| 2256 | '(("in \\([^ ]+\\) (" (1 font-lock-function-name-face)) | 2471 | '(("in \\([^ ]+\\)" (1 font-lock-function-name-face)) |
| 2257 | (" \\(stopped\\) in " (1 font-lock-warning-face)) | 2472 | (" \\(stopped\\)" (1 font-lock-warning-face)) |
| 2258 | (" \\(running\\)" (1 font-lock-string-face)) | 2473 | (" \\(running\\)" (1 font-lock-string-face)) |
| 2259 | ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face))) | 2474 | ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face))) |
| 2260 | "Font lock keywords used in `gdb-threads-mode'.") | 2475 | "Font lock keywords used in `gdb-threads-mode'.") |
| @@ -2273,6 +2488,11 @@ FILE is a full path." | |||
| 2273 | (define-key map "i" 'gdb-interrupt-thread) | 2488 | (define-key map "i" 'gdb-interrupt-thread) |
| 2274 | (define-key map "c" 'gdb-continue-thread) | 2489 | (define-key map "c" 'gdb-continue-thread) |
| 2275 | (define-key map "s" 'gdb-step-thread) | 2490 | (define-key map "s" 'gdb-step-thread) |
| 2491 | (define-key map "\t" '(lambda () | ||
| 2492 | (interactive) | ||
| 2493 | (gdb-set-window-buffer (gdb-breakpoints-buffer-name) t))) | ||
| 2494 | (define-key map [mouse-2] 'gdb-select-thread) | ||
| 2495 | (define-key map [follow-link] 'mouse-face) | ||
| 2276 | map)) | 2496 | map)) |
| 2277 | 2497 | ||
| 2278 | (defmacro gdb-propertize-header (name buffer help-echo mouse-face face) | 2498 | (defmacro gdb-propertize-header (name buffer help-echo mouse-face face) |
| @@ -2286,11 +2506,9 @@ FILE is a full path." | |||
| 2286 | (lambda (event) (interactive "e") | 2506 | (lambda (event) (interactive "e") |
| 2287 | (save-selected-window | 2507 | (save-selected-window |
| 2288 | (select-window (posn-window (event-start event))) | 2508 | (select-window (posn-window (event-start event))) |
| 2289 | (set-window-dedicated-p (selected-window) nil) | 2509 | (gdb-set-window-buffer |
| 2290 | (switch-to-buffer | 2510 | (gdb-get-buffer-create ',buffer) t) |
| 2291 | (gdb-get-buffer-create ',buffer)) | 2511 | (setq header-line-format (gdb-set-header ',buffer))))))) |
| 2292 | (setq header-line-format(gdb-set-header ',buffer)) | ||
| 2293 | (set-window-dedicated-p (selected-window) t)))))) | ||
| 2294 | 2512 | ||
| 2295 | (defvar gdb-breakpoints-header | 2513 | (defvar gdb-breakpoints-header |
| 2296 | (list | 2514 | (list |
| @@ -2299,6 +2517,7 @@ FILE is a full path." | |||
| 2299 | " " | 2517 | " " |
| 2300 | (gdb-propertize-header "Threads" gdb-threads-buffer | 2518 | (gdb-propertize-header "Threads" gdb-threads-buffer |
| 2301 | "mouse-1: select" mode-line-highlight mode-line-inactive))) | 2519 | "mouse-1: select" mode-line-highlight mode-line-inactive))) |
| 2520 | |||
| 2302 | (define-derived-mode gdb-threads-mode gdb-parent-mode "Threads" | 2521 | (define-derived-mode gdb-threads-mode gdb-parent-mode "Threads" |
| 2303 | "Major mode for GDB threads. | 2522 | "Major mode for GDB threads. |
| 2304 | 2523 | ||
| @@ -2312,8 +2531,9 @@ FILE is a full path." | |||
| 2312 | 'gdb-invalidate-threads) | 2531 | 'gdb-invalidate-threads) |
| 2313 | 2532 | ||
| 2314 | (defun gdb-thread-list-handler-custom () | 2533 | (defun gdb-thread-list-handler-custom () |
| 2315 | (let* ((res (gdb-json-partial-output)) | 2534 | (let ((threads-list (gdb-get-field (gdb-json-partial-output) 'threads)) |
| 2316 | (threads-list (gdb-get-field res 'threads))) | 2535 | (table (make-gdb-table)) |
| 2536 | (marked-line nil)) | ||
| 2317 | (setq gdb-threads-list nil) | 2537 | (setq gdb-threads-list nil) |
| 2318 | (setq gdb-running-threads-count 0) | 2538 | (setq gdb-running-threads-count 0) |
| 2319 | (setq gdb-stopped-threads-count 0) | 2539 | (setq gdb-stopped-threads-count 0) |
| @@ -2328,30 +2548,45 @@ FILE is a full path." | |||
| 2328 | (incf gdb-running-threads-count) | 2548 | (incf gdb-running-threads-count) |
| 2329 | (incf gdb-stopped-threads-count)) | 2549 | (incf gdb-stopped-threads-count)) |
| 2330 | 2550 | ||
| 2331 | (insert (apply 'format `("%s (%s) %s" | 2551 | (gdb-table-add-row table |
| 2332 | ,@(gdb-get-many-fields thread 'id 'target-id 'state)))) | 2552 | (list |
| 2333 | ;; Include frame information for stopped threads | 2553 | (gdb-get-field thread 'id) |
| 2334 | (when (not running) | 2554 | (concat |
| 2335 | (insert (concat " in " (gdb-get-field thread 'frame 'func))) | 2555 | (if gdb-thread-buffer-verbose-names |
| 2336 | (insert " (") | 2556 | (concat (gdb-get-field thread 'target-id) " ") "") |
| 2337 | (let ((args (gdb-get-field thread 'frame 'args))) | 2557 | (gdb-get-field thread 'state) |
| 2338 | (dolist (arg args) | 2558 | ;; Include frame information for stopped threads |
| 2339 | (insert (apply 'format `("%s=%s," ,@(gdb-get-many-fields arg 'name 'value))))) | 2559 | (if (not running) |
| 2340 | (when args (kill-backward-chars 1))) | 2560 | (concat |
| 2341 | (insert ")") | 2561 | " in " (gdb-get-field thread 'frame 'func) |
| 2342 | (gdb-insert-frame-location (gdb-get-field thread 'frame)) | 2562 | (if gdb-thread-buffer-arguments |
| 2343 | (insert (format " at %s" (gdb-get-field thread 'frame 'addr)))) | 2563 | (concat |
| 2344 | (add-text-properties (line-beginning-position) | 2564 | " (" |
| 2345 | (line-end-position) | 2565 | (let ((args (gdb-get-field thread 'frame 'args))) |
| 2346 | `(gdb-thread ,thread)) | 2566 | (mapconcat |
| 2347 | ;; We assume that gdb-thread-number is non-nil by this time | 2567 | (lambda (arg) |
| 2568 | (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))) | ||
| 2569 | args ",")) | ||
| 2570 | ")") | ||
| 2571 | "") | ||
| 2572 | (if gdb-thread-buffer-locations | ||
| 2573 | (gdb-frame-location (gdb-get-field thread 'frame)) "") | ||
| 2574 | (if gdb-thread-buffer-addresses | ||
| 2575 | (concat " at " (gdb-get-field thread 'frame 'addr)) "")) | ||
| 2576 | ""))) | ||
| 2577 | (list | ||
| 2578 | 'gdb-thread thread | ||
| 2579 | 'mouse-face 'highlight | ||
| 2580 | 'help-echo "mouse-2, RET: select thread"))) | ||
| 2348 | (when (string-equal gdb-thread-number | 2581 | (when (string-equal gdb-thread-number |
| 2349 | (gdb-get-field thread 'id)) | 2582 | (gdb-get-field thread 'id)) |
| 2350 | (set-marker gdb-thread-position (line-beginning-position)))) | 2583 | (setq marked-line (length gdb-threads-list)))) |
| 2351 | (newline)) | 2584 | (insert (gdb-table-string table " ")) |
| 2352 | ;; We update gud-running here because we need to make sure that | 2585 | (when marked-line |
| 2353 | ;; gdb-threads-list is up-to-date | 2586 | (gdb-mark-line marked-line gdb-thread-position))) |
| 2354 | (gdb-update-gud-running))) | 2587 | ;; We update gud-running here because we need to make sure that |
| 2588 | ;; gdb-threads-list is up-to-date | ||
| 2589 | (gdb-update-gud-running)) | ||
| 2355 | 2590 | ||
| 2356 | (defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc) | 2591 | (defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc) |
| 2357 | "Define a NAME command which will act upon thread on the current line. | 2592 | "Define a NAME command which will act upon thread on the current line. |
| @@ -2359,9 +2594,10 @@ FILE is a full path." | |||
| 2359 | CUSTOM-DEFUN may use locally bound `thread' variable, which will | 2594 | CUSTOM-DEFUN may use locally bound `thread' variable, which will |
| 2360 | be the value of 'gdb-thread property of the current line. If | 2595 | be the value of 'gdb-thread property of the current line. If |
| 2361 | 'gdb-thread is nil, error is signaled." | 2596 | 'gdb-thread is nil, error is signaled." |
| 2362 | `(defun ,name () | 2597 | `(defun ,name (&optional event) |
| 2363 | ,(when doc doc) | 2598 | ,(when doc doc) |
| 2364 | (interactive) | 2599 | (interactive) |
| 2600 | (if event (posn-set-point (event-end event))) | ||
| 2365 | (save-excursion | 2601 | (save-excursion |
| 2366 | (beginning-of-line) | 2602 | (beginning-of-line) |
| 2367 | (let ((thread (get-text-property (point) 'gdb-thread))) | 2603 | (let ((thread (get-text-property (point) 'gdb-thread))) |
| @@ -2383,39 +2619,39 @@ on the current line." | |||
| 2383 | (gdb-update)) | 2619 | (gdb-update)) |
| 2384 | "Select the thread at current line of threads buffer.") | 2620 | "Select the thread at current line of threads buffer.") |
| 2385 | 2621 | ||
| 2386 | (def-gdb-thread-simple-buffer-command | 2622 | (def-gdb-thread-buffer-simple-command |
| 2387 | gdb-display-stack-for-thread | 2623 | gdb-display-stack-for-thread |
| 2388 | gdb-display-stack-buffer | 2624 | gdb-preemptively-display-stack-buffer |
| 2389 | "Display stack buffer for the thread at current line.") | 2625 | "Display stack buffer for the thread at current line.") |
| 2390 | 2626 | ||
| 2391 | (def-gdb-thread-simple-buffer-command | 2627 | (def-gdb-thread-buffer-simple-command |
| 2392 | gdb-display-locals-for-thread | 2628 | gdb-display-locals-for-thread |
| 2393 | gdb-display-locals-buffer | 2629 | gdb-preemptively-display-locals-buffer |
| 2394 | "Display locals buffer for the thread at current line.") | 2630 | "Display locals buffer for the thread at current line.") |
| 2395 | 2631 | ||
| 2396 | (def-gdb-thread-simple-buffer-command | 2632 | (def-gdb-thread-buffer-simple-command |
| 2397 | gdb-display-registers-for-thread | 2633 | gdb-display-registers-for-thread |
| 2398 | gdb-display-registers-buffer | 2634 | gdb-preemptively-display-registers-buffer |
| 2399 | "Display registers buffer for the thread at current line.") | 2635 | "Display registers buffer for the thread at current line.") |
| 2400 | 2636 | ||
| 2401 | (def-gdb-thread-buffer-simple-command | 2637 | (def-gdb-thread-buffer-simple-command |
| 2402 | gdb-display-disassembly-for-thread | 2638 | gdb-display-disassembly-for-thread |
| 2403 | gdb-display-disassembly-buffer | 2639 | gdb-preemptively-display-disassembly-buffer |
| 2404 | "Display disassembly buffer for the thread at current line.") | 2640 | "Display disassembly buffer for the thread at current line.") |
| 2405 | 2641 | ||
| 2406 | (def-gdb-thread-simple-buffer-command | 2642 | (def-gdb-thread-buffer-simple-command |
| 2407 | gdb-frame-stack-for-thread | 2643 | gdb-frame-stack-for-thread |
| 2408 | gdb-frame-stack-buffer | 2644 | gdb-frame-stack-buffer |
| 2409 | "Display a new frame with stack buffer for the thread at | 2645 | "Display a new frame with stack buffer for the thread at |
| 2410 | current line.") | 2646 | current line.") |
| 2411 | 2647 | ||
| 2412 | (def-gdb-thread-simple-buffer-command | 2648 | (def-gdb-thread-buffer-simple-command |
| 2413 | gdb-frame-locals-for-thread | 2649 | gdb-frame-locals-for-thread |
| 2414 | gdb-frame-locals-buffer | 2650 | gdb-frame-locals-buffer |
| 2415 | "Display a new frame with locals buffer for the thread at | 2651 | "Display a new frame with locals buffer for the thread at |
| 2416 | current line.") | 2652 | current line.") |
| 2417 | 2653 | ||
| 2418 | (def-gdb-thread-simple-buffer-command | 2654 | (def-gdb-thread-buffer-simple-command |
| 2419 | gdb-frame-registers-for-thread | 2655 | gdb-frame-registers-for-thread |
| 2420 | gdb-frame-registers-buffer | 2656 | gdb-frame-registers-buffer |
| 2421 | "Display a new frame with registers buffer for the thread at | 2657 | "Display a new frame with registers buffer for the thread at |
| @@ -2427,32 +2663,31 @@ current line.") | |||
| 2427 | "Display a new frame with disassembly buffer for the thread at | 2663 | "Display a new frame with disassembly buffer for the thread at |
| 2428 | current line.") | 2664 | current line.") |
| 2429 | 2665 | ||
| 2430 | (defmacro def-gdb-thread-buffer-gdb-command (name gdb-command &optional doc) | 2666 | (defmacro def-gdb-thread-buffer-gud-command (name gud-command &optional doc) |
| 2431 | "Define a NAME which will execute send GDB-COMMAND with | 2667 | "Define a NAME which will execute GUD-COMMAND with |
| 2432 | `gdb-thread-number' locally bound to id of thread on the current | 2668 | `gdb-thread-number' locally bound to id of thread on the current |
| 2433 | line." | 2669 | line." |
| 2434 | `(def-gdb-thread-buffer-command ,name | 2670 | `(def-gdb-thread-buffer-command ,name |
| 2435 | (if gdb-non-stop | 2671 | (if gdb-non-stop |
| 2436 | (let ((gdb-thread-number (gdb-get-field thread 'id))) | 2672 | (let ((gdb-thread-number (gdb-get-field thread 'id)) |
| 2437 | (gdb-input (list (gdb-current-context-command ,gdb-command) | 2673 | (gdb-gud-control-all-threads nil)) |
| 2438 | 'ignore))) | 2674 | (call-interactively #',gud-command)) |
| 2439 | (error "Available in non-stop mode only, customize gdb-non-stop.")) | 2675 | (error "Available in non-stop mode only, customize gdb-non-stop-setting.")) |
| 2440 | ,doc)) | 2676 | ,doc)) |
| 2441 | 2677 | ||
| 2442 | ;; Does this make sense in all-stop mode? | 2678 | (def-gdb-thread-buffer-gud-command |
| 2443 | (def-gdb-thread-buffer-gdb-command | ||
| 2444 | gdb-interrupt-thread | 2679 | gdb-interrupt-thread |
| 2445 | "-exec-interrupt" | 2680 | gud-stop-subjob |
| 2446 | "Interrupt thread at current line.") | 2681 | "Interrupt thread at current line.") |
| 2447 | 2682 | ||
| 2448 | (def-gdb-thread-buffer-gdb-command | 2683 | (def-gdb-thread-buffer-gud-command |
| 2449 | gdb-continue-thread | 2684 | gdb-continue-thread |
| 2450 | "-exec-continue" | 2685 | gud-cont |
| 2451 | "Continue thread at current line.") | 2686 | "Continue thread at current line.") |
| 2452 | 2687 | ||
| 2453 | (def-gdb-thread-buffer-gdb-command | 2688 | (def-gdb-thread-buffer-gud-command |
| 2454 | gdb-step-thread | 2689 | gdb-step-thread |
| 2455 | "-exec-step" | 2690 | gud-step |
| 2456 | "Step thread at current line.") | 2691 | "Step thread at current line.") |
| 2457 | 2692 | ||
| 2458 | (defun gdb-set-header (buffer) | 2693 | (defun gdb-set-header (buffer) |
| @@ -2528,7 +2763,8 @@ line." | |||
| 2528 | gdb-memory-rows | 2763 | gdb-memory-rows |
| 2529 | gdb-memory-columns) | 2764 | gdb-memory-columns) |
| 2530 | gdb-read-memory-handler | 2765 | gdb-read-memory-handler |
| 2531 | gdb-read-memory-custom) | 2766 | gdb-read-memory-custom |
| 2767 | '(update)) | ||
| 2532 | 2768 | ||
| 2533 | (gdb-set-buffer-rules | 2769 | (gdb-set-buffer-rules |
| 2534 | 'gdb-memory-buffer | 2770 | 'gdb-memory-buffer |
| @@ -2886,6 +3122,10 @@ DOC is an optional documentation string." | |||
| 2886 | 'gdb-disassembly-buffer | 3122 | 'gdb-disassembly-buffer |
| 2887 | "Display disassembly for current stack frame.") | 3123 | "Display disassembly for current stack frame.") |
| 2888 | 3124 | ||
| 3125 | (def-gdb-preempt-display-buffer | ||
| 3126 | gdb-preemptively-display-disassembly-buffer | ||
| 3127 | 'gdb-disassembly-buffer) | ||
| 3128 | |||
| 2889 | (def-gdb-frame-for-buffer | 3129 | (def-gdb-frame-for-buffer |
| 2890 | gdb-frame-disassembly-buffer | 3130 | gdb-frame-disassembly-buffer |
| 2891 | 'gdb-disassembly-buffer | 3131 | 'gdb-disassembly-buffer |
| @@ -2897,7 +3137,8 @@ DOC is an optional documentation string." | |||
| 2897 | (line (gdb-get-field frame 'line))) | 3137 | (line (gdb-get-field frame 'line))) |
| 2898 | (when file | 3138 | (when file |
| 2899 | (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line))) | 3139 | (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line))) |
| 2900 | gdb-disassembly-handler) | 3140 | gdb-disassembly-handler |
| 3141 | '(update)) | ||
| 2901 | 3142 | ||
| 2902 | (def-gdb-auto-update-handler | 3143 | (def-gdb-auto-update-handler |
| 2903 | gdb-disassembly-handler | 3144 | gdb-disassembly-handler |
| @@ -2938,46 +3179,41 @@ DOC is an optional documentation string." | |||
| 2938 | 3179 | ||
| 2939 | \\{gdb-disassembly-mode-map}" | 3180 | \\{gdb-disassembly-mode-map}" |
| 2940 | ;; TODO Rename overlay variable for disassembly mode | 3181 | ;; TODO Rename overlay variable for disassembly mode |
| 2941 | (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) | 3182 | (add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position) |
| 2942 | (setq fringes-outside-margins t) | 3183 | (setq fringes-outside-margins t) |
| 2943 | (setq gdb-overlay-arrow-position (make-marker)) | 3184 | (set (make-local-variable 'gdb-disassembly-position) (make-marker)) |
| 2944 | (set (make-local-variable 'font-lock-defaults) | 3185 | (set (make-local-variable 'font-lock-defaults) |
| 2945 | '(gdb-disassembly-font-lock-keywords)) | 3186 | '(gdb-disassembly-font-lock-keywords)) |
| 2946 | (run-mode-hooks 'gdb-disassembly-mode-hook) | 3187 | (run-mode-hooks 'gdb-disassembly-mode-hook) |
| 2947 | 'gdb-invalidate-disassembly) | 3188 | 'gdb-invalidate-disassembly) |
| 2948 | 3189 | ||
| 2949 | (defun gdb-disassembly-handler-custom () | 3190 | (defun gdb-disassembly-handler-custom () |
| 2950 | (let* ((pos 1) | 3191 | (let* ((instructions (gdb-get-field (gdb-json-partial-output) 'asm_insns)) |
| 2951 | (address (gdb-get-field (gdb-current-buffer-frame) 'addr)) | 3192 | (address (gdb-get-field (gdb-current-buffer-frame) 'addr)) |
| 2952 | (res (gdb-json-partial-output)) | 3193 | (pos 1) |
| 2953 | (instructions (gdb-get-field res 'asm_insns)) | 3194 | (table (make-gdb-table)) |
| 2954 | (last-instr (car (last instructions))) | 3195 | (marked-line nil)) |
| 2955 | (column-padding (+ 2 (string-width | ||
| 2956 | (apply 'format | ||
| 2957 | `("<%s+%s>:" | ||
| 2958 | ,@(gdb-get-many-fields last-instr 'func-name 'offset))))))) | ||
| 2959 | (dolist (instr instructions) | 3196 | (dolist (instr instructions) |
| 2960 | ;; Put overlay arrow | 3197 | (gdb-table-add-row table |
| 3198 | (list | ||
| 3199 | (gdb-get-field instr 'address) | ||
| 3200 | (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset))) | ||
| 3201 | (gdb-get-field instr 'inst))) | ||
| 2961 | (when (string-equal (gdb-get-field instr 'address) | 3202 | (when (string-equal (gdb-get-field instr 'address) |
| 2962 | address) | 3203 | address) |
| 2963 | (progn | 3204 | (progn |
| 2964 | (setq pos (point)) | 3205 | (setq marked-line (length (gdb-table-rows table))) |
| 2965 | (setq fringe-indicator-alist | 3206 | (setq fringe-indicator-alist |
| 2966 | (if (string-equal gdb-frame-number "0") | 3207 | (if (string-equal gdb-frame-number "0") |
| 2967 | nil | 3208 | nil |
| 2968 | '((overlay-arrow . hollow-right-triangle)))) | 3209 | '((overlay-arrow . hollow-right-triangle))))))) |
| 2969 | (set-marker gdb-overlay-arrow-position (point)))) | 3210 | (insert (gdb-table-string table " ")) |
| 2970 | (insert | ||
| 2971 | (concat | ||
| 2972 | (gdb-get-field instr 'address) | ||
| 2973 | " " | ||
| 2974 | (gdb-pad-string (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset))) | ||
| 2975 | (- column-padding)) | ||
| 2976 | (gdb-get-field instr 'inst) | ||
| 2977 | "\n"))) | ||
| 2978 | (gdb-disassembly-place-breakpoints) | 3211 | (gdb-disassembly-place-breakpoints) |
| 2979 | (let ((window (get-buffer-window (current-buffer) 0))) | 3212 | ;; Mark current position with overlay arrow and scroll window to |
| 2980 | (set-window-point window pos)) | 3213 | ;; that point |
| 3214 | (when marked-line | ||
| 3215 | (let ((window (get-buffer-window (current-buffer) 0))) | ||
| 3216 | (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position)))) | ||
| 2981 | (setq mode-name | 3217 | (setq mode-name |
| 2982 | (concat "Disassembly: " | 3218 | (concat "Disassembly: " |
| 2983 | (gdb-get-field (gdb-current-buffer-frame) 'func))))) | 3219 | (gdb-get-field (gdb-current-buffer-frame) 'func))))) |
| @@ -2996,7 +3232,6 @@ DOC is an optional documentation string." | |||
| 2996 | 3232 | ||
| 2997 | 3233 | ||
| 2998 | ;;; Breakpoints view | 3234 | ;;; Breakpoints view |
| 2999 | |||
| 3000 | (define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints" | 3235 | (define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints" |
| 3001 | "Major mode for gdb breakpoints. | 3236 | "Major mode for gdb breakpoints. |
| 3002 | 3237 | ||
| @@ -3061,7 +3296,8 @@ breakpoints buffer." | |||
| 3061 | ;; | 3296 | ;; |
| 3062 | (def-gdb-trigger-and-handler | 3297 | (def-gdb-trigger-and-handler |
| 3063 | gdb-invalidate-frames (gdb-current-context-command "-stack-list-frames") | 3298 | gdb-invalidate-frames (gdb-current-context-command "-stack-list-frames") |
| 3064 | gdb-stack-list-frames-handler gdb-stack-list-frames-custom) | 3299 | gdb-stack-list-frames-handler gdb-stack-list-frames-custom |
| 3300 | '(update)) | ||
| 3065 | 3301 | ||
| 3066 | (gdb-set-buffer-rules | 3302 | (gdb-set-buffer-rules |
| 3067 | 'gdb-stack-buffer | 3303 | 'gdb-stack-buffer |
| @@ -3069,47 +3305,41 @@ breakpoints buffer." | |||
| 3069 | 'gdb-frames-mode | 3305 | 'gdb-frames-mode |
| 3070 | 'gdb-invalidate-frames) | 3306 | 'gdb-invalidate-frames) |
| 3071 | 3307 | ||
| 3072 | (defun gdb-insert-frame-location (frame) | 3308 | (defun gdb-frame-location (frame) |
| 3073 | "Insert \"of file:line\" button or library name for structure FRAME. | 3309 | "Return \" of file:line\" or \" of library\" for structure FRAME. |
| 3074 | 3310 | ||
| 3075 | FRAME must have either \"file\" and \"line\" members or \"from\" | 3311 | FRAME must have either \"file\" and \"line\" members or \"from\" |
| 3076 | member." | 3312 | member." |
| 3077 | (let ((file (gdb-get-field frame 'fullname)) | 3313 | (let ((file (gdb-get-field frame 'file)) |
| 3078 | (line (gdb-get-field frame 'line)) | 3314 | (line (gdb-get-field frame 'line)) |
| 3079 | (from (gdb-get-field frame 'from))) | 3315 | (from (gdb-get-field frame 'from))) |
| 3080 | (cond (file | 3316 | (let ((res (or (and file line (concat file ":" line)) |
| 3081 | ;; Filename with line number | 3317 | from))) |
| 3082 | (insert " of ") | 3318 | (if res (concat " of " res) "")))) |
| 3083 | (gdb-insert-file-location-button | ||
| 3084 | file (string-to-number line))) | ||
| 3085 | ;; Library | ||
| 3086 | (from (insert (format " of %s" from)))))) | ||
| 3087 | 3319 | ||
| 3088 | (defun gdb-stack-list-frames-custom () | 3320 | (defun gdb-stack-list-frames-custom () |
| 3089 | (let* ((res (gdb-json-partial-output "frame")) | 3321 | (let ((stack (gdb-get-field (gdb-json-partial-output "frame") 'stack)) |
| 3090 | (stack (gdb-get-field res 'stack))) | 3322 | (table (make-gdb-table))) |
| 3323 | (set-marker gdb-stack-position nil) | ||
| 3091 | (dolist (frame stack) | 3324 | (dolist (frame stack) |
| 3092 | (insert (apply 'format `("%s in %s" ,@(gdb-get-many-fields frame 'level 'func)))) | 3325 | (gdb-table-add-row table |
| 3093 | (gdb-insert-frame-location frame) | 3326 | (list |
| 3094 | (newline)) | 3327 | (gdb-get-field frame 'level) |
| 3095 | (save-excursion | 3328 | "in" |
| 3096 | (goto-char (point-min)) | 3329 | (concat |
| 3097 | (while (< (point) (point-max)) | 3330 | (gdb-get-field frame 'func) |
| 3098 | (add-text-properties (point-at-bol) (1+ (point-at-bol)) | 3331 | (if gdb-stack-buffer-locations |
| 3099 | '(mouse-face highlight | 3332 | (gdb-frame-location frame) "") |
| 3100 | help-echo "mouse-2, RET: Select frame")) | 3333 | (if gdb-stack-buffer-addresses |
| 3101 | (beginning-of-line) | 3334 | (concat " at " (gdb-get-field frame 'addr)) ""))) |
| 3102 | (when (and (looking-at "^[0-9]+\\s-+\\S-+\\s-+\\(\\S-+\\)") | 3335 | `(mouse-face highlight |
| 3103 | (equal (match-string 1) gdb-selected-frame)) | 3336 | help-echo "mouse-2, RET: Select frame" |
| 3104 | (if (> (car (window-fringes)) 0) | 3337 | gdb-frame ,frame))) |
| 3105 | (progn | 3338 | (insert (gdb-table-string table " "))) |
| 3106 | (or gdb-stack-position | 3339 | (when (and gdb-frame-number |
| 3107 | (setq gdb-stack-position (make-marker))) | 3340 | (gdb-buffer-shows-main-thread-p)) |
| 3108 | (set-marker gdb-stack-position (point))) | 3341 | (gdb-mark-line (1+ (string-to-number gdb-frame-number)) |
| 3109 | (let ((bl (point-at-bol))) | 3342 | gdb-stack-position))) |
| 3110 | (put-text-property bl (+ bl 4) | ||
| 3111 | 'face '(:inverse-video t))))) | ||
| 3112 | (forward-line 1))))) | ||
| 3113 | 3343 | ||
| 3114 | (defun gdb-stack-buffer-name () | 3344 | (defun gdb-stack-buffer-name () |
| 3115 | (gdb-current-context-buffer-name | 3345 | (gdb-current-context-buffer-name |
| @@ -3120,6 +3350,10 @@ member." | |||
| 3120 | 'gdb-stack-buffer | 3350 | 'gdb-stack-buffer |
| 3121 | "Display backtrace of current stack.") | 3351 | "Display backtrace of current stack.") |
| 3122 | 3352 | ||
| 3353 | (def-gdb-preempt-display-buffer | ||
| 3354 | gdb-preemptively-display-stack-buffer | ||
| 3355 | 'gdb-stack-buffer nil t) | ||
| 3356 | |||
| 3123 | (def-gdb-frame-for-buffer | 3357 | (def-gdb-frame-for-buffer |
| 3124 | gdb-frame-stack-buffer | 3358 | gdb-frame-stack-buffer |
| 3125 | 'gdb-stack-buffer | 3359 | 'gdb-stack-buffer |
| @@ -3129,20 +3363,20 @@ member." | |||
| 3129 | (let ((map (make-sparse-keymap))) | 3363 | (let ((map (make-sparse-keymap))) |
| 3130 | (suppress-keymap map) | 3364 | (suppress-keymap map) |
| 3131 | (define-key map "q" 'kill-this-buffer) | 3365 | (define-key map "q" 'kill-this-buffer) |
| 3132 | (define-key map "\r" 'gdb-frames-select) | 3366 | (define-key map "\r" 'gdb-select-frame) |
| 3133 | (define-key map [mouse-2] 'gdb-frames-select) | 3367 | (define-key map [mouse-2] 'gdb-select-frame) |
| 3134 | (define-key map [follow-link] 'mouse-face) | 3368 | (define-key map [follow-link] 'mouse-face) |
| 3135 | map)) | 3369 | map)) |
| 3136 | 3370 | ||
| 3137 | (defvar gdb-frames-font-lock-keywords | 3371 | (defvar gdb-frames-font-lock-keywords |
| 3138 | '(("in \\([^ ]+\\) of " (1 font-lock-function-name-face))) | 3372 | '(("in \\([^ ]+\\)" (1 font-lock-function-name-face))) |
| 3139 | "Font lock keywords used in `gdb-frames-mode'.") | 3373 | "Font lock keywords used in `gdb-frames-mode'.") |
| 3140 | 3374 | ||
| 3141 | (define-derived-mode gdb-frames-mode gdb-parent-mode "Frames" | 3375 | (define-derived-mode gdb-frames-mode gdb-parent-mode "Frames" |
| 3142 | "Major mode for gdb call stack. | 3376 | "Major mode for gdb call stack. |
| 3143 | 3377 | ||
| 3144 | \\{gdb-frames-mode-map}" | 3378 | \\{gdb-frames-mode-map}" |
| 3145 | (setq gdb-stack-position nil) | 3379 | (setq gdb-stack-position (make-marker)) |
| 3146 | (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) | 3380 | (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) |
| 3147 | (setq truncate-lines t) ;; Make it easier to see overlay arrow. | 3381 | (setq truncate-lines t) ;; Make it easier to see overlay arrow. |
| 3148 | (set (make-local-variable 'font-lock-defaults) | 3382 | (set (make-local-variable 'font-lock-defaults) |
| @@ -3150,18 +3384,19 @@ member." | |||
| 3150 | (run-mode-hooks 'gdb-frames-mode-hook) | 3384 | (run-mode-hooks 'gdb-frames-mode-hook) |
| 3151 | 'gdb-invalidate-frames) | 3385 | 'gdb-invalidate-frames) |
| 3152 | 3386 | ||
| 3153 | (defun gdb-get-frame-number () | 3387 | (defun gdb-select-frame (&optional event) |
| 3154 | (save-excursion | ||
| 3155 | (end-of-line) | ||
| 3156 | (let* ((pos (re-search-backward "^\\([0-9]+\\)" nil t)) | ||
| 3157 | (n (or (and pos (match-string-no-properties 1)) "0"))) | ||
| 3158 | n))) | ||
| 3159 | |||
| 3160 | (defun gdb-frames-select (&optional event) | ||
| 3161 | "Select the frame and display the relevant source." | 3388 | "Select the frame and display the relevant source." |
| 3162 | (interactive (list last-input-event)) | 3389 | (interactive (list last-input-event)) |
| 3163 | (if event (posn-set-point (event-end event))) | 3390 | (if event (posn-set-point (event-end event))) |
| 3164 | (gud-basic-call (concat "-stack-select-frame " (gdb-get-frame-number)))) | 3391 | (let ((frame (get-text-property (point) 'gdb-frame))) |
| 3392 | (if frame | ||
| 3393 | (if (gdb-buffer-shows-main-thread-p) | ||
| 3394 | (let ((new-level (gdb-get-field frame 'level))) | ||
| 3395 | (setq gdb-frame-number new-level) | ||
| 3396 | (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore)) | ||
| 3397 | (gdb-update)) | ||
| 3398 | (error "Could not select frame for non-current thread.")) | ||
| 3399 | (error "Not recognized as frame line")))) | ||
| 3165 | 3400 | ||
| 3166 | 3401 | ||
| 3167 | ;; Locals buffer. | 3402 | ;; Locals buffer. |
| @@ -3169,7 +3404,8 @@ member." | |||
| 3169 | (def-gdb-trigger-and-handler | 3404 | (def-gdb-trigger-and-handler |
| 3170 | gdb-invalidate-locals | 3405 | gdb-invalidate-locals |
| 3171 | (concat (gdb-current-context-command "-stack-list-locals") " --simple-values") | 3406 | (concat (gdb-current-context-command "-stack-list-locals") " --simple-values") |
| 3172 | gdb-locals-handler gdb-locals-handler-custom) | 3407 | gdb-locals-handler gdb-locals-handler-custom |
| 3408 | '(update)) | ||
| 3173 | 3409 | ||
| 3174 | (gdb-set-buffer-rules | 3410 | (gdb-set-buffer-rules |
| 3175 | 'gdb-locals-buffer | 3411 | 'gdb-locals-buffer |
| @@ -3207,7 +3443,8 @@ member." | |||
| 3207 | ;; Dont display values of arrays or structures. | 3443 | ;; Dont display values of arrays or structures. |
| 3208 | ;; These can be expanded using gud-watch. | 3444 | ;; These can be expanded using gud-watch. |
| 3209 | (defun gdb-locals-handler-custom () | 3445 | (defun gdb-locals-handler-custom () |
| 3210 | (let ((locals-list (gdb-get-field (gdb-json-partial-output) 'locals))) | 3446 | (let ((locals-list (gdb-get-field (gdb-json-partial-output) 'locals)) |
| 3447 | (table (make-gdb-table))) | ||
| 3211 | (dolist (local locals-list) | 3448 | (dolist (local locals-list) |
| 3212 | (let ((name (gdb-get-field local 'name)) | 3449 | (let ((name (gdb-get-field local 'name)) |
| 3213 | (value (gdb-get-field local 'value)) | 3450 | (value (gdb-get-field local 'value)) |
| @@ -3223,10 +3460,15 @@ member." | |||
| 3223 | `(mouse-face highlight | 3460 | `(mouse-face highlight |
| 3224 | help-echo "mouse-2: edit value" | 3461 | help-echo "mouse-2: edit value" |
| 3225 | local-map ,gdb-edit-locals-map-1) | 3462 | local-map ,gdb-edit-locals-map-1) |
| 3226 | value)) | 3463 | value)) |
| 3227 | (insert | 3464 | (gdb-table-add-row |
| 3228 | (concat name "\t" type | 3465 | table |
| 3229 | "\t" value "\n")))) | 3466 | (list |
| 3467 | (propertize type 'font-lock-face font-lock-type-face) | ||
| 3468 | (propertize name 'font-lock-face font-lock-variable-name-face) | ||
| 3469 | value) | ||
| 3470 | '(mouse-face highlight)))) | ||
| 3471 | (insert (gdb-table-string table " ")) | ||
| 3230 | (setq mode-name | 3472 | (setq mode-name |
| 3231 | (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func))))) | 3473 | (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func))))) |
| 3232 | 3474 | ||
| @@ -3249,8 +3491,6 @@ member." | |||
| 3249 | 3491 | ||
| 3250 | \\{gdb-locals-mode-map}" | 3492 | \\{gdb-locals-mode-map}" |
| 3251 | (setq header-line-format gdb-locals-header) | 3493 | (setq header-line-format gdb-locals-header) |
| 3252 | (set (make-local-variable 'font-lock-defaults) | ||
| 3253 | '(gdb-locals-font-lock-keywords)) | ||
| 3254 | (run-mode-hooks 'gdb-locals-mode-hook) | 3494 | (run-mode-hooks 'gdb-locals-mode-hook) |
| 3255 | 'gdb-invalidate-locals) | 3495 | 'gdb-invalidate-locals) |
| 3256 | 3496 | ||
| @@ -3263,6 +3503,10 @@ member." | |||
| 3263 | 'gdb-locals-buffer | 3503 | 'gdb-locals-buffer |
| 3264 | "Display local variables of current stack and their values.") | 3504 | "Display local variables of current stack and their values.") |
| 3265 | 3505 | ||
| 3506 | (def-gdb-preempt-display-buffer | ||
| 3507 | gdb-preemptively-display-locals-buffer | ||
| 3508 | 'gdb-locals-buffer nil t) | ||
| 3509 | |||
| 3266 | (def-gdb-frame-for-buffer | 3510 | (def-gdb-frame-for-buffer |
| 3267 | gdb-frame-locals-buffer | 3511 | gdb-frame-locals-buffer |
| 3268 | 'gdb-locals-buffer | 3512 | 'gdb-locals-buffer |
| @@ -3275,7 +3519,8 @@ member." | |||
| 3275 | gdb-invalidate-registers | 3519 | gdb-invalidate-registers |
| 3276 | (concat (gdb-current-context-command "-data-list-register-values") " x") | 3520 | (concat (gdb-current-context-command "-data-list-register-values") " x") |
| 3277 | gdb-registers-handler | 3521 | gdb-registers-handler |
| 3278 | gdb-registers-handler-custom) | 3522 | gdb-registers-handler-custom |
| 3523 | '(update)) | ||
| 3279 | 3524 | ||
| 3280 | (gdb-set-buffer-rules | 3525 | (gdb-set-buffer-rules |
| 3281 | 'gdb-registers-buffer | 3526 | 'gdb-registers-buffer |
| @@ -3285,20 +3530,22 @@ member." | |||
| 3285 | 3530 | ||
| 3286 | (defun gdb-registers-handler-custom () | 3531 | (defun gdb-registers-handler-custom () |
| 3287 | (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values)) | 3532 | (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values)) |
| 3288 | (register-names-list (reverse gdb-register-names))) | 3533 | (register-names-list (reverse gdb-register-names)) |
| 3534 | (table (make-gdb-table))) | ||
| 3289 | (dolist (register register-values) | 3535 | (dolist (register register-values) |
| 3290 | (let* ((register-number (gdb-get-field register 'number)) | 3536 | (let* ((register-number (gdb-get-field register 'number)) |
| 3291 | (value (gdb-get-field register 'value)) | 3537 | (value (gdb-get-field register 'value)) |
| 3292 | (register-name (nth (string-to-number register-number) | 3538 | (register-name (nth (string-to-number register-number) |
| 3293 | register-names-list))) | 3539 | register-names-list))) |
| 3294 | (insert | 3540 | (gdb-table-add-row |
| 3295 | (concat | 3541 | table |
| 3296 | (propertize register-name 'face font-lock-variable-name-face) | 3542 | (list |
| 3297 | "\t" | 3543 | (propertize register-name 'font-lock-face font-lock-variable-name-face) |
| 3298 | (if (member register-number gdb-changed-registers) | 3544 | (if (member register-number gdb-changed-registers) |
| 3299 | (propertize value 'face font-lock-warning-face) | 3545 | (propertize value 'font-lock-face font-lock-warning-face) |
| 3300 | value) | 3546 | value)) |
| 3301 | "\n")))))) | 3547 | '(mouse-face highlight)))) |
| 3548 | (insert (gdb-table-string table " ")))) | ||
| 3302 | 3549 | ||
| 3303 | (defvar gdb-registers-mode-map | 3550 | (defvar gdb-registers-mode-map |
| 3304 | (let ((map (make-sparse-keymap))) | 3551 | (let ((map (make-sparse-keymap))) |
| @@ -3323,6 +3570,10 @@ member." | |||
| 3323 | 'gdb-registers-buffer | 3570 | 'gdb-registers-buffer |
| 3324 | "Display integer register contents.") | 3571 | "Display integer register contents.") |
| 3325 | 3572 | ||
| 3573 | (def-gdb-preempt-display-buffer | ||
| 3574 | gdb-preemptively-display-registers-buffer | ||
| 3575 | 'gdb-registers-buffer nil t) | ||
| 3576 | |||
| 3326 | (def-gdb-frame-for-buffer | 3577 | (def-gdb-frame-for-buffer |
| 3327 | gdb-frame-registers-buffer | 3578 | gdb-frame-registers-buffer |
| 3328 | 'gdb-registers-buffer | 3579 | 'gdb-registers-buffer |
| @@ -3378,12 +3629,11 @@ thread. Called from `gdb-update'." | |||
| 3378 | (gdb-add-pending 'gdb-get-main-selected-frame)))) | 3629 | (gdb-add-pending 'gdb-get-main-selected-frame)))) |
| 3379 | 3630 | ||
| 3380 | (defun gdb-frame-handler () | 3631 | (defun gdb-frame-handler () |
| 3381 | "Sets `gdb-pc-address', `gdb-selected-frame' and | 3632 | "Sets `gdb-selected-frame' and `gdb-selected-file' to show |
| 3382 | `gdb-selected-file' to show overlay arrow in source buffer." | 3633 | overlay arrow in source buffer." |
| 3383 | (gdb-delete-pending 'gdb-get-main-selected-frame) | 3634 | (gdb-delete-pending 'gdb-get-main-selected-frame) |
| 3384 | (let ((frame (gdb-get-field (gdb-json-partial-output) 'frame))) | 3635 | (let ((frame (gdb-get-field (gdb-json-partial-output) 'frame))) |
| 3385 | (when frame | 3636 | (when frame |
| 3386 | (setq gdb-frame-number (gdb-get-field frame 'level)) | ||
| 3387 | (setq gdb-selected-frame (gdb-get-field frame 'func)) | 3637 | (setq gdb-selected-frame (gdb-get-field frame 'func)) |
| 3388 | (setq gdb-selected-file (gdb-get-field frame 'fullname)) | 3638 | (setq gdb-selected-file (gdb-get-field frame 'fullname)) |
| 3389 | (let ((line (gdb-get-field frame 'line))) | 3639 | (let ((line (gdb-get-field frame 'line))) |
| @@ -3438,6 +3688,33 @@ already, in which case that window is splitted first." | |||
| 3438 | (set-window-buffer window buf) | 3688 | (set-window-buffer window buf) |
| 3439 | window))))) | 3689 | window))))) |
| 3440 | 3690 | ||
| 3691 | (defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal) | ||
| 3692 | "Find window displaying a buffer with the same | ||
| 3693 | `gdb-buffer-type' as BUF and show BUF there. If no such window | ||
| 3694 | exists, just call `gdb-display-buffer' for BUF. If the window | ||
| 3695 | found is already dedicated, split window according to | ||
| 3696 | SPLIT-HORIZONTAL and show BUF in the new window." | ||
| 3697 | (if buf | ||
| 3698 | (when (not (get-buffer-window buf)) | ||
| 3699 | (let* ((buf-type (gdb-buffer-type buf)) | ||
| 3700 | (existing-window | ||
| 3701 | (get-window-with-predicate | ||
| 3702 | #'(lambda (w) | ||
| 3703 | (and (eq buf-type | ||
| 3704 | (gdb-buffer-type (window-buffer w))) | ||
| 3705 | (not (window-dedicated-p w))))))) | ||
| 3706 | (if existing-window | ||
| 3707 | (set-window-buffer existing-window buf) | ||
| 3708 | (let ((dedicated-window | ||
| 3709 | (get-window-with-predicate | ||
| 3710 | #'(lambda (w) | ||
| 3711 | (eq buf-type | ||
| 3712 | (gdb-buffer-type (window-buffer w))))))) | ||
| 3713 | (if dedicated-window | ||
| 3714 | (set-window-buffer | ||
| 3715 | (split-window dedicated-window nil split-horizontal) buf) | ||
| 3716 | (gdb-display-buffer buf t)))))) | ||
| 3717 | (error "Null buffer"))) | ||
| 3441 | 3718 | ||
| 3442 | ;;; Shared keymap initialization: | 3719 | ;;; Shared keymap initialization: |
| 3443 | 3720 | ||
| @@ -3532,7 +3809,13 @@ already, in which case that window is splitted first." | |||
| 3532 | (let ((same-window-regexps nil)) | 3809 | (let ((same-window-regexps nil)) |
| 3533 | (select-window (display-buffer gud-comint-buffer nil 0)))) | 3810 | (select-window (display-buffer gud-comint-buffer nil 0)))) |
| 3534 | 3811 | ||
| 3535 | (defun gdb-set-window-buffer (name) | 3812 | (defun gdb-set-window-buffer (name &optional ignore-dedicated) |
| 3813 | "Set buffer of selected window to NAME and dedicate window. | ||
| 3814 | |||
| 3815 | When IGNORE-DEDICATED is non-nil, buffer is set even if selected | ||
| 3816 | window is dedicated." | ||
| 3817 | (when ignore-dedicated | ||
| 3818 | (set-window-dedicated-p (selected-window) nil)) | ||
| 3536 | (set-window-buffer (selected-window) (get-buffer name)) | 3819 | (set-window-buffer (selected-window) (get-buffer name)) |
| 3537 | (set-window-dedicated-p (selected-window) t)) | 3820 | (set-window-dedicated-p (selected-window) t)) |
| 3538 | 3821 | ||
| @@ -3569,7 +3852,9 @@ already, in which case that window is splitted first." | |||
| 3569 | (gdb-set-window-buffer (gdb-stack-buffer-name)) | 3852 | (gdb-set-window-buffer (gdb-stack-buffer-name)) |
| 3570 | (split-window-horizontally) | 3853 | (split-window-horizontally) |
| 3571 | (other-window 1) | 3854 | (other-window 1) |
| 3572 | (gdb-set-window-buffer (gdb-breakpoints-buffer-name)) | 3855 | (gdb-set-window-buffer (if gdb-show-threads-by-default |
| 3856 | (gdb-threads-buffer-name) | ||
| 3857 | (gdb-breakpoints-buffer-name))) | ||
| 3573 | (other-window 1)) | 3858 | (other-window 1)) |
| 3574 | 3859 | ||
| 3575 | (defcustom gdb-many-windows nil | 3860 | (defcustom gdb-many-windows nil |
| @@ -3629,9 +3914,9 @@ Kills the gdb buffers, and resets variables and the source buffers." | |||
| 3629 | (setq gud-minor-mode nil) | 3914 | (setq gud-minor-mode nil) |
| 3630 | (kill-local-variable 'tool-bar-map) | 3915 | (kill-local-variable 'tool-bar-map) |
| 3631 | (kill-local-variable 'gdb-define-alist)))))) | 3916 | (kill-local-variable 'gdb-define-alist)))))) |
| 3632 | (setq gdb-overlay-arrow-position nil) | 3917 | (setq gdb-disassembly-position nil) |
| 3633 | (setq overlay-arrow-variable-list | 3918 | (setq overlay-arrow-variable-list |
| 3634 | (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) | 3919 | (delq 'gdb-disassembly-position overlay-arrow-variable-list)) |
| 3635 | (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) | 3920 | (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) |
| 3636 | (setq gdb-stack-position nil) | 3921 | (setq gdb-stack-position nil) |
| 3637 | (setq overlay-arrow-variable-list | 3922 | (setq overlay-arrow-variable-list |
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e31ec2b0883..6e66b0fb261 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el | |||
| @@ -133,6 +133,8 @@ Used to grey out relevant toolbar icons.") | |||
| 133 | (and (eq gud-minor-mode 'gdbmi) | 133 | (and (eq gud-minor-mode 'gdbmi) |
| 134 | (> (car (window-fringes)) 0))))) | 134 | (> (car (window-fringes)) 0))))) |
| 135 | 135 | ||
| 136 | (declare-function gdb-gud-context-call "gdb-mi.el") | ||
| 137 | |||
| 136 | (defun gud-stop-subjob () | 138 | (defun gud-stop-subjob () |
| 137 | (interactive) | 139 | (interactive) |
| 138 | (with-current-buffer gud-comint-buffer | 140 | (with-current-buffer gud-comint-buffer |
| @@ -160,21 +162,10 @@ Used to grey out relevant toolbar icons.") | |||
| 160 | :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) | 162 | :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) |
| 161 | ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go | 163 | ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go |
| 162 | :visible (and (eq gud-minor-mode 'gdbmi) | 164 | :visible (and (eq gud-minor-mode 'gdbmi) |
| 163 | (or (and (or | 165 | (gdb-show-run-p))) |
| 164 | (not gdb-gud-control-all-threads) | ||
| 165 | (not gdb-non-stop)) | ||
| 166 | (not gud-running)) | ||
| 167 | (and gdb-gud-control-all-threads | ||
| 168 | (> gdb-stopped-threads-count 0))))) | ||
| 169 | ([stop] menu-item "Stop" gud-stop-subjob | 166 | ([stop] menu-item "Stop" gud-stop-subjob |
| 170 | :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) | 167 | :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) |
| 171 | (and (eq gud-minor-mode 'gdbmi) | 168 | (gdb-show-stop-p))) |
| 172 | (or (and (or | ||
| 173 | (not gdb-gud-control-all-threads) | ||
| 174 | (not gdb-non-stop)) | ||
| 175 | gud-running) | ||
| 176 | (and gdb-gud-control-all-threads | ||
| 177 | (> gdb-running-threads-count 0)))))) | ||
| 178 | ([until] menu-item "Continue to selection" gud-until | 169 | ([until] menu-item "Continue to selection" gud-until |
| 179 | :enable (not gud-running) | 170 | :enable (not gud-running) |
| 180 | :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) | 171 | :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) |
| @@ -262,21 +253,11 @@ Used to grey out relevant toolbar icons.") | |||
| 262 | ([menu-bar go] menu-item | 253 | ([menu-bar go] menu-item |
| 263 | ,(propertize " go " 'face 'font-lock-doc-face) gud-go | 254 | ,(propertize " go " 'face 'font-lock-doc-face) gud-go |
| 264 | :visible (and (eq gud-minor-mode 'gdbmi) | 255 | :visible (and (eq gud-minor-mode 'gdbmi) |
| 265 | (or (and (or | 256 | (gdb-show-run-p))) |
| 266 | (not gdb-gud-control-all-threads) | ||
| 267 | (not gdb-non-stop)) | ||
| 268 | (not gud-running)) | ||
| 269 | (and gdb-gud-control-all-threads | ||
| 270 | (> gdb-stopped-threads-count 0))))) | ||
| 271 | ([menu-bar stop] menu-item | 257 | ([menu-bar stop] menu-item |
| 272 | ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob | 258 | ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob |
| 273 | :visible (or (and (eq gud-minor-mode 'gdbmi) | 259 | :visible (or (and (eq gud-minor-mode 'gdbmi) |
| 274 | (or (and (or | 260 | (gdb-show-stop-p)) |
| 275 | (not gdb-gud-control-all-threads) | ||
| 276 | (not gdb-non-stop)) | ||
| 277 | gud-running) | ||
| 278 | (and gdb-gud-control-all-threads | ||
| 279 | (> gdb-running-threads-count 0)))) | ||
| 280 | (not (eq gud-minor-mode 'gdbmi)))) | 261 | (not (eq gud-minor-mode 'gdbmi)))) |
| 281 | ([menu-bar print] | 262 | ([menu-bar print] |
| 282 | . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) | 263 | . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) |