aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDmitry Dzhus2009-08-04 17:16:58 +0000
committerDmitry Dzhus2009-08-04 17:16:58 +0000
commitad07fb8d75aabca34e04f594b6742aa44b2a664c (patch)
tree5c0191eb14f64e5b6b43d377cf7c88119915182c
parent78b9fb289effe0b75f69d7038b57ce2e23473826 (diff)
downloademacs-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.el865
-rw-r--r--lisp/progmodes/gud.el31
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'.
129Only `gdb-setq-thread-number' should be used to change this 131Only `gdb-setq-thread-number' should be used to change this
130value.") 132value.")
131 133
134(defvar gdb-frame-number nil
135 "Selected frame level for main current thread.
136
137Reset 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'
172Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where 179Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where
173STATUS is nil (unchanged), `changed' or `out-of-scope'.") 180STATUS 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.")
204This variable is updated in `gdb-done-or-error' and returned by 214This 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
220It is initialized to `gdb-non-stop-setting' at the beginning of
221every 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
241This function checks `gdb-pending-triggers' value every 260This 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
275SUBSCRIBER must be a pair, where cdr is a function of one
276argument (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
296Must be a list of pairs with cars being buffers and cdr's being
297valid 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
260other threads continue to execute." 324other threads continue to execute.
325
326GDB session needs to be restarted for this setting to take
327effect."
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
269in non-stop mode. Otherwise, only currently selected thread is 336in non-stop mode. Otherwise, only current thread is affected."
270affected."
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
387Note 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
323Each function is called after the new current thread was selected 391Each 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
332stopped thread is already selected." 400stopped 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
443default."
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
1192it 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
1219is 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'.
1124If THREAD is non-nil, it is assigned to `gdb-thread-number' 1240If THREAD is non-nil, it is assigned to `gdb-thread-number'
1125buffer-local variable of the new buffer. 1241buffer-local variable of the new buffer.
1126 1242
1127If buffer's mode returns a symbol, it's used to register " 1243Buffer mode and name are selected according to buffer type.
1244
1245If buffer has trigger associated with it in `gdb-buffer-rules',
1246this 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
1442Option value is taken from `gdb-thread-number'. If 1572Option 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
1574returned unchanged. If `gdb-frame-number' is nil of NOFRAME is t,
1575then 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
1451If `gdb-thread-number' is nil, just wrap NAME in asterisks." 1588If `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
1476SUBSCRIBER must be a pair, where cdr is a function of one
1477argument (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
1497Must be a list of pairs with cars being buffers and cdr's being
1498valid 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'
1634value to NUMBER, because `gud-running' and `gdb-frame-number'
1635need 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
1642of current thread.
1643
1644`gdb-frame-number' is set to nil if new current thread is
1645running.
1533 1646
1534Note that when `gdb-gud-control-all-threads' is t, `gud-running' 1647Note that when `gdb-gud-control-all-threads' is t, `gud-running'
1535cannot be reliably used to determine whether or not execution 1648cannot be reliably used to determine whether or not execution
@@ -1539,9 +1652,34 @@ instead.
1539 1652
1540For all-stop mode, thread information is unavailable while target 1653For all-stop mode, thread information is unavailable while target
1541is running." 1654is 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'
1786if 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
2047If current window has no fringes, inverse colors on LINE.
2048
2049Return 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
2076When non-nil, PROPERTIES will be added to the whole row when
2077calling `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
1897buffer with `gdb-bind-function-to-buffer'. 2132buffer with `gdb-bind-function-to-buffer'.
1898 2133
1899If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the 2134If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the
1900defined trigger is called with an argument from SIGNAL-LIST. 2135defined trigger is called with an argument from SIGNAL-LIST. It's
2136not recommended to define triggers with empty SIGNAL-LIST.
2137Normally triggers should respond at least to 'update signal.
1901 2138
1902Normally the trigger defined by this command must be called from 2139Normally the trigger defined by this command must be called from
1903the buffer where HANDLER-NAME must work. This should be done so 2140the 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
1928Handlers are normally called from the buffers they put output in. 2166Handlers 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
1953TRIGGER-NAME trigger is defined to send GDB-COMMAND. See 2191TRIGGER-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
1956HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See 2194HANDLER-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
2224FILE 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."
2359CUSTOM-DEFUN may use locally bound `thread' variable, which will 2594CUSTOM-DEFUN may use locally bound `thread' variable, which will
2360be the value of 'gdb-thread property of the current line. If 2595be 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
2410current line.") 2646current 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
2416current line.") 2652current 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
2428current line.") 2664current 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
2433line." 2669line."
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
3075FRAME must have either \"file\" and \"line\" members or \"from\" 3311FRAME must have either \"file\" and \"line\" members or \"from\"
3076member." 3312member."
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." 3633overlay 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
3694exists, just call `gdb-display-buffer' for BUF. If the window
3695found is already dedicated, split window according to
3696SPLIT-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
3815When IGNORE-DEDICATED is non-nil, buffer is set even if selected
3816window 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))