Mercurial > emacs
changeset 104155:87373993f3bd
* 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)
| author | Dmitry Dzhus <dima@sphinx.net.ru> |
|---|---|
| date | Tue, 04 Aug 2009 17:16:58 +0000 |
| parents | c63f8623fb66 |
| children | 226d6219da5a |
| files | lisp/progmodes/gdb-mi.el lisp/progmodes/gud.el |
| diffstat | 2 files changed, 582 insertions(+), 316 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/gdb-mi.el Tue Aug 04 17:03:54 2009 +0000 +++ b/lisp/progmodes/gdb-mi.el Tue Aug 04 17:16:58 2009 +0000 @@ -102,6 +102,9 @@ (require 'gud) (require 'json) (require 'bindat) +(require 'speedbar) +(eval-when-compile + (require 'cl)) (defvar tool-bar-map) (defvar speedbar-initial-expansion-list-name) @@ -115,7 +118,6 @@ (defvar gdb-memory-prev-page nil "Address of previous memory page for program memory buffer.") -(defvar gdb-frame-number "0") (defvar gdb-thread-number nil "Main current thread. @@ -129,6 +131,11 @@ Only `gdb-setq-thread-number' should be used to change this value.") +(defvar gdb-frame-number nil + "Selected frame level for main current thread. + +Reset whenever current thread changes.") + ;; Used to show overlay arrow in source buffer. All set in ;; gdb-get-main-selected-frame. Disassembly buffer should not use ;; these but rely on buffer-local thread information instead. @@ -172,8 +179,11 @@ Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where STATUS is nil (unchanged), `changed' or `out-of-scope'.") (defvar gdb-main-file nil "Source file from which program execution begins.") -(defvar gdb-overlay-arrow-position nil) + +;; Overlay arrow markers (defvar gdb-stack-position nil) +(defvar gdb-thread-position nil) +(defvar gdb-disassembly-position nil) (defvar gdb-location-alist nil "Alist of breakpoint numbers and full filenames. Only used for files that @@ -204,6 +214,12 @@ This variable is updated in `gdb-done-or-error' and returned by `gud-gdbmi-marker-filter'.") +(defvar gdb-non-stop nil + "Indicates whether current GDB session is using non-stop mode. + +It is initialized to `gdb-non-stop-setting' at the beginning of +every GDB session.") + (defvar gdb-buffer-type nil "One of the symbols bound in `gdb-buffer-rules'.") (make-variable-buffer-local 'gdb-buffer-type) @@ -220,6 +236,9 @@ disposition of output generated by commands that gdb mode sends to gdb on its own behalf.") +;; Pending triggers prevent congestion: Emacs won't send two similar +;; consecutive requests. + (defvar gdb-pending-triggers '() "A list of trigger functions which have not yet been handled. @@ -235,18 +254,63 @@ (defvar gdb-wait-for-pending-timeout 0.5) -(defmacro gdb-wait-for-pending (&rest body) +(defun gdb-wait-for-pending (&rest body) "Wait until `gdb-pending-triggers' is empty and execute BODY. This function checks `gdb-pending-triggers' value every `gdb-wait-for-pending' seconds." - (run-with-timer - gdb-wait-for-pending-timeout nil - `(lambda () + `(run-with-timer + gdb-wait-for-pending-timeout nil + (lambda () (if (not gdb-pending-triggers) (progn ,@body) (gdb-wait-for-pending ,@body))))) + +;; Publish-subscribe + +(defmacro gdb-add-subscriber (publisher subscriber) + "Register new PUBLISHER's SUBSCRIBER. + +SUBSCRIBER must be a pair, where cdr is a function of one +argument (see `gdb-emit-signal')." + `(add-to-list ',publisher ,subscriber t)) + +(defmacro gdb-delete-subscriber (publisher subscriber) + "Unregister SUBSCRIBER from PUBLISHER." + `(setq ,publisher (delete ,subscriber + ,publisher))) + +(defun gdb-get-subscribers (publisher) + publisher) + +(defun gdb-emit-signal (publisher &optional signal) + "Call cdr for each subscriber of PUBLISHER with SIGNAL as argument." + (dolist (subscriber (gdb-get-subscribers publisher)) + (funcall (cdr subscriber) signal))) + +(defvar gdb-buf-publisher '() + "Used to invalidate GDB buffers by emitting a signal in +`gdb-update'. + +Must be a list of pairs with cars being buffers and cdr's being +valid signal handlers.") + +(defgroup gdb nil + "GDB graphical interface" + :group 'tools + :link '(info-link "(emacs)GDB Graphical Interface") + :version "23.2") + +(defgroup gdb-non-stop nil + "GDB non-stop debugging settings" + :group 'gdb + :version "23.2") + +(defgroup gdb-buffers nil + "GDB buffers" + :group 'gdb + :version "23.2") (defcustom gdb-debug-log-max 128 "Maximum size of `gdb-debug-log'. If nil, size is unlimited." @@ -255,21 +319,23 @@ (const :tag "Unlimited" nil)) :version "22.1") -(defcustom gdb-non-stop t +(defcustom gdb-non-stop-setting t "When in non-stop mode, stopped threads can be examined while -other threads continue to execute." +other threads continue to execute. + +GDB session needs to be restarted for this setting to take +effect." :type 'boolean - :group 'gdb + :group 'gdb-non-stop :version "23.2") ;; TODO Some commands can't be called with --all (give a notice about ;; it in setting doc) (defcustom gdb-gud-control-all-threads t "When enabled, GUD execution commands affect all threads when -in non-stop mode. Otherwise, only currently selected thread is -affected." +in non-stop mode. Otherwise, only current thread is affected." :type 'boolean - :group 'gdb + :group 'gdb-non-stop :version "23.2") (defcustom gdb-switch-reasons t @@ -296,7 +362,7 @@ (const :tag "End of stepping range reached." "end-stepping-range") (const :tag "Signal received (like interruption)." "signal-received")) (const :tag "None" nil)) - :group 'gdb + :group 'gdb-non-stop :version "23.2" :link '(info-link "(gdb)GDB/MI Async Records")) @@ -318,6 +384,8 @@ (addr . \"0x0804869e\")) (reason . \"end-stepping-range\")) +Note that \"reason\" is only present in non-stop debugging mode. + `gdb-get-field' may be used to access the fields of response. Each function is called after the new current thread was selected @@ -331,7 +399,50 @@ "When nil, Emacs won't switch to stopped thread if some other stopped thread is already selected." :type 'boolean - :group 'gdb + :group 'gdb-non-stop + :version "23.2") + +(defcustom gdb-stack-buffer-locations t + "Show file information or library names in stack buffers." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-stack-buffer-addresses nil + "Show frame addresses in stack buffers." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-verbose-names t + "Show long thread names in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-arguments t + "Show function arguments in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-locations t + "Show file information or library names in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-addresses nil + "Show addresses for thread frames in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-show-threads-by-default nil + "Show threads list buffer instead of breakpoints list by +default." + :type 'boolean + :group 'gdb-buffers :version "23.2") (defvar gdb-debug-log nil @@ -428,15 +539,6 @@ (setq varnumlet (concat varnumlet "." component))) expr))) -(defvar gdb-locals-font-lock-keywords - '( - ;; var = type value - ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)" - (1 font-lock-variable-name-face) - (3 font-lock-type-face)) - ) - "Font lock keywords used in `gdb-local-mode'.") - ;; noall is used for commands which don't take --all, but only ;; --thread. (defun gdb-gud-context-command (command &optional noall) @@ -450,7 +552,7 @@ (if (and gdb-gud-control-all-threads (not noall)) (concat command " --all ") - (gdb-current-context-command command)) + (gdb-current-context-command command t)) command)) ;; TODO Document this. We use noarg when not in gud-def @@ -504,7 +606,7 @@ | | | +-----------------------------------+----------------------------------+ | Stack buffer | Breakpoints buffer | -| RET gdb-frames-select | SPC gdb-toggle-breakpoint | +| RET gdb-select-frame | SPC gdb-toggle-breakpoint | | | RET gdb-goto-breakpoint | | | D gdb-delete-breakpoint | +-----------------------------------+----------------------------------+" @@ -653,7 +755,8 @@ gdb-continuation nil gdb-buf-publisher '() gdb-threads-list '() - gdb-breakpoints-list '()) + gdb-breakpoints-list '() + gdb-non-stop gdb-non-stop-setting) ;; (setq gdb-buffer-type 'gdbmi) ;; @@ -767,7 +870,7 @@ (gdb-if-arrow gud-overlay-arrow-position (setq line (line-number-at-pos (posn-point end))) (gud-call (concat "until " (number-to-string line)))) - (gdb-if-arrow gdb-overlay-arrow-position + (gdb-if-arrow gdb-disassembly-position (save-excursion (goto-line (line-number-at-pos (posn-point end))) (forward-char 2) @@ -787,7 +890,7 @@ (progn (gud-call (concat "tbreak " (number-to-string line))) (gud-call (concat "jump " (number-to-string line))))) - (gdb-if-arrow gdb-overlay-arrow-position + (gdb-if-arrow gdb-disassembly-position (save-excursion (goto-line (line-number-at-pos (posn-point end))) (forward-char 2) @@ -1085,6 +1188,8 @@ (nth 3 rules-entry)) (defun gdb-update-buffer-name () + "Rename current buffer according to name-maker associated with +it in `gdb-buffer-rules'." (let ((f (gdb-rules-name-maker (assoc gdb-buffer-type gdb-buffer-rules)))) (when f (rename-buffer (funcall f))))) @@ -1104,6 +1209,17 @@ "Get current stack frame object for thread of current buffer." (gdb-get-field (gdb-current-buffer-thread) 'frame)) +(defun gdb-buffer-type (buffer) + "Get value of `gdb-buffer-type' for BUFFER." + (with-current-buffer buffer + gdb-buffer-type)) + +(defun gdb-buffer-shows-main-thread-p () + "Return t if current GDB buffer shows main selected thread and +is not bound to it." + (current-buffer) + (not (local-variable-p 'gdb-thread-number))) + (defun gdb-get-buffer (buffer-type &optional thread) "Get a specific GDB buffer. @@ -1124,10 +1240,14 @@ If THREAD is non-nil, it is assigned to `gdb-thread-number' buffer-local variable of the new buffer. -If buffer's mode returns a symbol, it's used to register " +Buffer mode and name are selected according to buffer type. + +If buffer has trigger associated with it in `gdb-buffer-rules', +this trigger is subscribed to `gdb-buf-publisher' and called with +'update argument." (or (gdb-get-buffer buffer-type thread) (let ((rules (assoc buffer-type gdb-buffer-rules)) - (new (generate-new-buffer "limbo"))) + (new (generate-new-buffer "limbo"))) (with-current-buffer new (let ((mode (gdb-rules-buffer-mode rules)) (trigger (gdb-rules-update-trigger rules))) @@ -1143,7 +1263,7 @@ (gdb-add-subscriber gdb-buf-publisher (cons (current-buffer) (gdb-bind-function-to-buffer trigger (current-buffer)))) - (funcall trigger)) + (funcall trigger 'update)) (current-buffer)))))) (defun gdb-bind-function-to-buffer (expr buffer) @@ -1175,6 +1295,15 @@ (gdb-display-buffer (gdb-get-buffer-create ,buffer thread) t))) +;; Used to display windows with thread-bound buffers +(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc split-horizontal) + `(defun ,name (&optional thread) + ,(when doc doc) + (message thread) + (gdb-preempt-existing-or-display-buffer + (gdb-get-buffer-create ,buffer thread) + ,split-horizontal))) + ;; This assoc maps buffer type symbols to rules. Each rule is a list of ;; at least one and possible more functions. The functions have these ;; roles in defining a buffer type: @@ -1436,13 +1565,21 @@ (process-send-string (get-buffer-process gud-comint-buffer) (concat (car item) "\n"))) -(defun gdb-current-context-command (command) - "Add --thread option to gdb COMMAND. - -Option value is taken from `gdb-thread-number'. If -`gdb-thread-number' is nil, COMMAND is returned unchanged." +;; NOFRAME is used for gud execution control commands +(defun gdb-current-context-command (command &optional noframe) + "Add --thread and --frame options to gdb COMMAND. + +Option values are taken from `gdb-thread-number' and +`gdb-frame-number'. If `gdb-thread-number' is nil, COMMAND is +returned unchanged. If `gdb-frame-number' is nil of NOFRAME is t, +then no --frame option is added." + ;; gdb-frame-number may be nil while gdb-thread-number is non-nil + ;; (when current thread is running) (if gdb-thread-number - (concat command " --thread " gdb-thread-number " ") + (concat command " --thread " gdb-thread-number + (if (not (or noframe (not gdb-frame-number))) + (concat " --frame " gdb-frame-number) "") + " ") command)) (defun gdb-current-context-buffer-name (name) @@ -1450,11 +1587,9 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks." (concat "*" name - (format - (cond ((local-variable-p 'gdb-thread-number) " (bound to thread %s)") - (gdb-thread-number " (current thread %s)") - (t "")) - gdb-thread-number) + (if (local-variable-p 'gdb-thread-number) + (format " (bound to thread %s)" gdb-thread-number) + "") "*")) @@ -1468,35 +1603,6 @@ (setq gdb-output-sink 'user) (setq gdb-pending-triggers nil)) -;; Publish-subscribe - -(defmacro gdb-add-subscriber (publisher subscriber) - "Register new PUBLISHER's SUBSCRIBER. - -SUBSCRIBER must be a pair, where cdr is a function of one -argument (see `gdb-emit-signal')." - `(add-to-list ',publisher ,subscriber t)) - -(defmacro gdb-delete-subscriber (publisher subscriber) - "Unregister SUBSCRIBER from PUBLISHER." - `(setq ,publisher (delete ,subscriber - ,publisher))) - -(defun gdb-get-subscribers (publisher) - publisher) - -(defun gdb-emit-signal (publisher &optional signal) - "Call cdr for each subscriber of PUBLISHER with SIGNAL as argument." - (dolist (subscriber (gdb-get-subscribers publisher)) - (funcall (cdr subscriber) signal))) - -(defvar gdb-buf-publisher '() - "Used to invalidate GDB buffers by emitting a signal in -`gdb-update'. - -Must be a list of pairs with cars being buffers and cdr's being -valid signal handlers.") - (defun gdb-update () "Update buffers showing status of debug session." (when gdb-first-prompt @@ -1524,12 +1630,19 @@ ;; because we may need to update current gud-running value without ;; changing current thread (see gdb-running) (defun gdb-setq-thread-number (number) - "Set `gdb-thread-number' to NUMBER and update `gud-running'." + "Only this function must be used to change `gdb-thread-number' +value to NUMBER, because `gud-running' and `gdb-frame-number' +need to be updated appropriately when current thread changes." (setq gdb-thread-number number) + (setq gdb-frame-number "0") (gdb-update-gud-running)) (defun gdb-update-gud-running () - "Set `gud-running' according to the state of current thread. + "Set `gud-running' and `gdb-frame-number' according to the state +of current thread. + +`gdb-frame-number' is set to nil if new current thread is +running. Note that when `gdb-gud-control-all-threads' is t, `gud-running' cannot be reliably used to determine whether or not execution @@ -1539,9 +1652,34 @@ For all-stop mode, thread information is unavailable while target is running." - (setq gud-running - (string= (gdb-get-field (gdb-current-buffer-thread) 'state) - "running"))) + (let ((old-value gud-running)) + (setq gud-running + (string= (gdb-get-field (gdb-current-buffer-thread) 'state) + "running")) + ;; We change frame number only if the state of current thread has + ;; changed. + (when (not (eq gud-running old-value)) + (if gud-running + (setq gdb-frame-number nil) + (setq gdb-frame-number "0"))))) + +(defun gdb-show-run-p () + "Return t if \"Run/continue\" should be shown on the toolbar." + (or (and (or + (not gdb-gud-control-all-threads) + (not gdb-non-stop)) + (not gud-running)) + (and gdb-gud-control-all-threads + (> gdb-stopped-threads-count 0)))) + +(defun gdb-show-stop-p () + "Return t if \"Stop\" should be shown on the toolbar." + (or (and (or + (not gdb-gud-control-all-threads) + (not gdb-non-stop)) + gud-running) + (and gdb-gud-control-all-threads + (> gdb-running-threads-count 0)))) ;; GUD displays the selected GDB frame. This might might not be the current ;; GDB frame (after up, down etc). If no GDB frame is visible but the last @@ -1644,7 +1782,17 @@ ;; gdb-invalidate-threads is defined to accept 'update-threads signal (defun gdb-thread-created (output-field)) (defun gdb-thread-exited (output-field) - (gdb-emit-signal gdb-buf-publisher 'update-threads)) + "Handle =thread-exited async record: unset `gdb-thread-number' +if current thread exited and update threads list." + (let* ((thread-id (gdb-get-field (gdb-json-string output-field) 'id))) + (if (string= gdb-thread-number thread-id) + (gdb-setq-thread-number nil)) + ;; When we continue current thread and it quickly exits, + ;; gdb-pending-triggers left after gdb-running disallow us to + ;; properly call -thread-info without --thread option. Thus we + ;; need to use gdb-wait-for-pending. + (gdb-wait-for-pending + (gdb-emit-signal gdb-buf-publisher 'update-threads)))) (defun gdb-thread-selected (output-field) "Handler for =thread-selected MI output record. @@ -1653,10 +1801,25 @@ (let* ((result (gdb-json-string output-field)) (thread-id (gdb-get-field result 'id))) (gdb-setq-thread-number thread-id) + ;; Typing `thread N` in GUD buffer makes GDB emit `^done` followed + ;; by `=thread-selected` notification. `^done` causes `gdb-update` + ;; as usually. Things happen to fast and second call (from + ;; gdb-thread-selected handler) gets cut off by our beloved + ;; gdb-pending-triggers. + ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its + ;; body will get executed when `gdb-pending-triggers` is empty. (gdb-wait-for-pending (gdb-update)))) (defun gdb-running (output-field) + (let* ((thread-id (gdb-get-field (gdb-json-string output-field) 'thread-id))) + ;; We reset gdb-frame-number to nil if current thread has gone + ;; running. This can't be done in gdb-thread-list-handler-custom + ;; because we need correct gdb-frame-number by the time + ;; -thread-info command is sent. + (when (or (string-equal thread-id "all") + (string-equal thread-id gdb-thread-number)) + (setq gdb-frame-number nil))) (setq gdb-inferior-status "running") (gdb-force-mode-line-update (propertize gdb-inferior-status 'face font-lock-type-face)) @@ -1730,7 +1893,7 @@ ;; In all-stop this updates gud-running properly as well. (gdb-update) (setq gdb-first-done-or-error nil)) - (run-hook-with-args 'gdb-stopped-hook result))) + (run-hook-with-args 'gdb-stopped-hooks result))) ;; Remove the trimmings from log stream containing debugging messages ;; being produced by GDB's internals, use warning face and send to GUD @@ -1878,9 +2041,81 @@ (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) (gdb-json-read-buffer fix-key fix-list))) +(defmacro gdb-mark-line (line variable) + "Set VARIABLE marker to point at beginning of LINE. + +If current window has no fringes, inverse colors on LINE. + +Return position where LINE begins." + `(save-excursion + (let* ((offset (1+ (- ,line (line-number-at-pos)))) + (start-posn (line-beginning-position offset)) + (end-posn (line-end-position offset))) + (set-marker ,variable (copy-marker start-posn)) + (when (not (> (car (window-fringes)) 0)) + (put-text-property start-posn end-posn + 'font-lock-face '(:inverse-video t))) + start-posn))) + (defun gdb-pad-string (string padding) (format (concat "%" (number-to-string padding) "s") string)) +;; gdb-table struct is a way to programmatically construct simple +;; tables. It help to reliably align columns of data in GDB buffers +;; and provides +(defstruct + gdb-table + (column-sizes nil) + (rows nil) + (row-properties nil) + (right-align nil)) + +(defun gdb-table-add-row (table row &optional properties) + "Add ROW of string to TABLE and recalculate column sizes. + +When non-nil, PROPERTIES will be added to the whole row when +calling `gdb-table-string'." + (let ((rows (gdb-table-rows table)) + (row-properties (gdb-table-row-properties table)) + (column-sizes (gdb-table-column-sizes table)) + (right-align (gdb-table-right-align table))) + (when (not column-sizes) + (setf (gdb-table-column-sizes table) + (make-list (length row) 0))) + (setf (gdb-table-rows table) + (append rows (list row))) + (setf (gdb-table-row-properties table) + (append row-properties (list properties))) + (setf (gdb-table-column-sizes table) + (mapcar* (lambda (x s) + (let ((new-x + (max (abs x) (string-width s)))) + (if right-align new-x (- new-x)))) + (gdb-table-column-sizes table) + row)) + ;; Avoid trailing whitespace at eol + (if (not (gdb-table-right-align table)) + (setcar (last (gdb-table-column-sizes table)) 0)))) + +(defun gdb-table-string (table &optional sep) + "Return TABLE as a string with columns separated with SEP." + (let ((column-sizes (gdb-table-column-sizes table)) + (res "")) + (mapconcat + 'identity + (mapcar* + (lambda (row properties) + (apply 'propertize + (mapconcat 'identity + (mapcar* (lambda (s x) (gdb-pad-string s x)) + row column-sizes) + sep) + properties)) + (gdb-table-rows table) + (gdb-table-row-properties table)) + "\n"))) + +;; gdb-get-field goes deep, gdb-get-many-fields goes wide (defalias 'gdb-get-field 'bindat-get-field) (defun gdb-get-many-fields (struct &rest fields) @@ -1897,7 +2132,9 @@ buffer with `gdb-bind-function-to-buffer'. If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the -defined trigger is called with an argument from SIGNAL-LIST. +defined trigger is called with an argument from SIGNAL-LIST. It's +not recommended to define triggers with empty SIGNAL-LIST. +Normally triggers should respond at least to 'update signal. Normally the trigger defined by this command must be called from the buffer where HANDLER-NAME must work. This should be done so @@ -1922,7 +2159,8 @@ ;; Used by disassembly buffer only, the rest use ;; def-gdb-trigger-and-handler -(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun &optional nopreserve) +(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun + &optional nopreserve) "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN. Handlers are normally called from the buffers they put output in. @@ -1951,7 +2189,7 @@ "Define trigger and handler. TRIGGER-NAME trigger is defined to send GDB-COMMAND. See -`def-gdb-auto-update-trigger'. SIGNAL-LIST determines when +`def-gdb-auto-update-trigger'. HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See `def-gdb-auto-update-handler'." @@ -1967,7 +2205,8 @@ ;; Breakpoint buffer : This displays the output of `-break-list'. (def-gdb-trigger-and-handler gdb-invalidate-breakpoints "-break-list" - gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom) + gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom + '(update)) (gdb-set-buffer-rules 'gdb-breakpoints-buffer @@ -1978,44 +2217,39 @@ (defun gdb-breakpoints-list-handler-custom () (let ((breakpoints-list (gdb-get-field (gdb-json-partial-output "bkpt" "script") - 'BreakpointTable 'body))) + 'BreakpointTable 'body)) + (table (make-gdb-table))) (setq gdb-breakpoints-list nil) - (insert "Num\tType\t\tDisp\tEnb\tHits\tAddr What\n") + (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Hits" "Addr" "What")) (dolist (breakpoint breakpoints-list) (add-to-list 'gdb-breakpoints-list (cons (gdb-get-field breakpoint 'number) breakpoint)) - (insert - (concat - (gdb-get-field breakpoint 'number) "\t" - (gdb-get-field breakpoint 'type) "\t" - (gdb-get-field breakpoint 'disp) "\t" + (let ((at (gdb-get-field breakpoint 'at)) + (pending (gdb-get-field breakpoint 'pending)) + (func (gdb-get-field breakpoint 'func))) + (gdb-table-add-row table + (list + (gdb-get-field breakpoint 'number) + (gdb-get-field breakpoint 'type) + (gdb-get-field breakpoint 'disp) (let ((flag (gdb-get-field breakpoint 'enabled))) (if (string-equal flag "y") - (propertize "y" 'face font-lock-warning-face) - (propertize "n" 'face font-lock-comment-face))) "\t" - (gdb-get-field breakpoint 'times) "\t" - (gdb-get-field breakpoint 'addr))) - (let ((at (gdb-get-field breakpoint 'at)) - (pending (gdb-get-field breakpoint 'pending))) - (cond (pending (insert " " pending)) - (at (insert " " at)) - (t - (progn - (insert - (concat " in " - (propertize (gdb-get-field breakpoint 'func) - 'face font-lock-function-name-face))) - (gdb-insert-frame-location breakpoint) - (add-text-properties (line-beginning-position) - (line-end-position) - '(mouse-face highlight - help-echo "mouse-2, RET: visit breakpoint"))))) - (add-text-properties (line-beginning-position) - (line-end-position) - `(gdb-breakpoint ,breakpoint)) - (newline)) - (gdb-place-breakpoints)))) + (propertize "y" 'font-lock-face font-lock-warning-face) + (propertize "n" 'font-lock-face font-lock-comment-face))) + (gdb-get-field breakpoint 'times) + (gdb-get-field breakpoint 'addr) + (or pending at + (concat "in " + (propertize func 'font-lock-face font-lock-function-name-face) + (gdb-frame-location breakpoint)))) + ;; Add clickable properties only for breakpoints with file:line + ;; information + (append (list 'gdb-breakpoint breakpoint) + (when func '(help-echo "mouse-2, RET: visit breakpoint" + mouse-face highlight)))))) + (insert (gdb-table-string table " ")) + (gdb-place-breakpoints))) ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). (defun gdb-place-breakpoints () @@ -2182,6 +2416,9 @@ ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons. (define-key map "q" 'gdb-delete-frame-or-window) (define-key map "\r" 'gdb-goto-breakpoint) + (define-key map "\t" '(lambda () + (interactive) + (gdb-set-window-buffer (gdb-threads-buffer-name) t))) (define-key map [mouse-2] 'gdb-goto-breakpoint) (define-key map [follow-link] 'mouse-face) map)) @@ -2206,28 +2443,6 @@ ;; uses "-thread-info". Needs GDB 7.0 onwards. ;;; Threads view -(defun gdb-jump-to (file line) - (find-file-other-window file) - (goto-line line)) - -(define-button-type 'gdb-file-button - 'help-echo "Push to jump to source code" -; 'face 'bold - 'action - (lambda (b) - (gdb-jump-to (button-get b 'file) - (button-get b 'line)))) - -(defun gdb-insert-file-location-button (file line) - "Insert text button which allows jumping to FILE:LINE. - -FILE is a full path." - (insert-text-button - (format "%s:%d" (file-name-nondirectory file) line) - :type 'gdb-file-button - 'file file - 'line line)) - (defun gdb-threads-buffer-name () (concat "*threads of " (gdb-get-target-string) "*")) @@ -2242,7 +2457,7 @@ "Display GDB threads in a new frame.") (def-gdb-trigger-and-handler - gdb-invalidate-threads "-thread-info" + gdb-invalidate-threads (gdb-current-context-command "-thread-info" gud-running) gdb-thread-list-handler gdb-thread-list-handler-custom '(update update-threads)) @@ -2253,8 +2468,8 @@ 'gdb-invalidate-threads) (defvar gdb-threads-font-lock-keywords - '(("in \\([^ ]+\\) (" (1 font-lock-function-name-face)) - (" \\(stopped\\) in " (1 font-lock-warning-face)) + '(("in \\([^ ]+\\)" (1 font-lock-function-name-face)) + (" \\(stopped\\)" (1 font-lock-warning-face)) (" \\(running\\)" (1 font-lock-string-face)) ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face))) "Font lock keywords used in `gdb-threads-mode'.") @@ -2273,6 +2488,11 @@ (define-key map "i" 'gdb-interrupt-thread) (define-key map "c" 'gdb-continue-thread) (define-key map "s" 'gdb-step-thread) + (define-key map "\t" '(lambda () + (interactive) + (gdb-set-window-buffer (gdb-breakpoints-buffer-name) t))) + (define-key map [mouse-2] 'gdb-select-thread) + (define-key map [follow-link] 'mouse-face) map)) (defmacro gdb-propertize-header (name buffer help-echo mouse-face face) @@ -2286,11 +2506,9 @@ (lambda (event) (interactive "e") (save-selected-window (select-window (posn-window (event-start event))) - (set-window-dedicated-p (selected-window) nil) - (switch-to-buffer - (gdb-get-buffer-create ',buffer)) - (setq header-line-format(gdb-set-header ',buffer)) - (set-window-dedicated-p (selected-window) t)))))) + (gdb-set-window-buffer + (gdb-get-buffer-create ',buffer) t) + (setq header-line-format (gdb-set-header ',buffer))))))) (defvar gdb-breakpoints-header (list @@ -2299,6 +2517,7 @@ " " (gdb-propertize-header "Threads" gdb-threads-buffer "mouse-1: select" mode-line-highlight mode-line-inactive))) + (define-derived-mode gdb-threads-mode gdb-parent-mode "Threads" "Major mode for GDB threads. @@ -2312,8 +2531,9 @@ 'gdb-invalidate-threads) (defun gdb-thread-list-handler-custom () - (let* ((res (gdb-json-partial-output)) - (threads-list (gdb-get-field res 'threads))) + (let ((threads-list (gdb-get-field (gdb-json-partial-output) 'threads)) + (table (make-gdb-table)) + (marked-line nil)) (setq gdb-threads-list nil) (setq gdb-running-threads-count 0) (setq gdb-stopped-threads-count 0) @@ -2328,30 +2548,45 @@ (incf gdb-running-threads-count) (incf gdb-stopped-threads-count)) - (insert (apply 'format `("%s (%s) %s" - ,@(gdb-get-many-fields thread 'id 'target-id 'state)))) - ;; Include frame information for stopped threads - (when (not running) - (insert (concat " in " (gdb-get-field thread 'frame 'func))) - (insert " (") - (let ((args (gdb-get-field thread 'frame 'args))) - (dolist (arg args) - (insert (apply 'format `("%s=%s," ,@(gdb-get-many-fields arg 'name 'value))))) - (when args (kill-backward-chars 1))) - (insert ")") - (gdb-insert-frame-location (gdb-get-field thread 'frame)) - (insert (format " at %s" (gdb-get-field thread 'frame 'addr)))) - (add-text-properties (line-beginning-position) - (line-end-position) - `(gdb-thread ,thread)) - ;; We assume that gdb-thread-number is non-nil by this time + (gdb-table-add-row table + (list + (gdb-get-field thread 'id) + (concat + (if gdb-thread-buffer-verbose-names + (concat (gdb-get-field thread 'target-id) " ") "") + (gdb-get-field thread 'state) + ;; Include frame information for stopped threads + (if (not running) + (concat + " in " (gdb-get-field thread 'frame 'func) + (if gdb-thread-buffer-arguments + (concat + " (" + (let ((args (gdb-get-field thread 'frame 'args))) + (mapconcat + (lambda (arg) + (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))) + args ",")) + ")") + "") + (if gdb-thread-buffer-locations + (gdb-frame-location (gdb-get-field thread 'frame)) "") + (if gdb-thread-buffer-addresses + (concat " at " (gdb-get-field thread 'frame 'addr)) "")) + ""))) + (list + 'gdb-thread thread + 'mouse-face 'highlight + 'help-echo "mouse-2, RET: select thread"))) (when (string-equal gdb-thread-number (gdb-get-field thread 'id)) - (set-marker gdb-thread-position (line-beginning-position)))) - (newline)) - ;; We update gud-running here because we need to make sure that - ;; gdb-threads-list is up-to-date - (gdb-update-gud-running))) + (setq marked-line (length gdb-threads-list)))) + (insert (gdb-table-string table " ")) + (when marked-line + (gdb-mark-line marked-line gdb-thread-position))) + ;; We update gud-running here because we need to make sure that + ;; gdb-threads-list is up-to-date + (gdb-update-gud-running)) (defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc) "Define a NAME command which will act upon thread on the current line. @@ -2359,9 +2594,10 @@ CUSTOM-DEFUN may use locally bound `thread' variable, which will be the value of 'gdb-thread property of the current line. If 'gdb-thread is nil, error is signaled." - `(defun ,name () + `(defun ,name (&optional event) ,(when doc doc) (interactive) + (if event (posn-set-point (event-end event))) (save-excursion (beginning-of-line) (let ((thread (get-text-property (point) 'gdb-thread))) @@ -2383,39 +2619,39 @@ (gdb-update)) "Select the thread at current line of threads buffer.") -(def-gdb-thread-simple-buffer-command +(def-gdb-thread-buffer-simple-command gdb-display-stack-for-thread - gdb-display-stack-buffer + gdb-preemptively-display-stack-buffer "Display stack buffer for the thread at current line.") -(def-gdb-thread-simple-buffer-command +(def-gdb-thread-buffer-simple-command gdb-display-locals-for-thread - gdb-display-locals-buffer + gdb-preemptively-display-locals-buffer "Display locals buffer for the thread at current line.") -(def-gdb-thread-simple-buffer-command +(def-gdb-thread-buffer-simple-command gdb-display-registers-for-thread - gdb-display-registers-buffer + gdb-preemptively-display-registers-buffer "Display registers buffer for the thread at current line.") (def-gdb-thread-buffer-simple-command gdb-display-disassembly-for-thread - gdb-display-disassembly-buffer + gdb-preemptively-display-disassembly-buffer "Display disassembly buffer for the thread at current line.") -(def-gdb-thread-simple-buffer-command +(def-gdb-thread-buffer-simple-command gdb-frame-stack-for-thread gdb-frame-stack-buffer "Display a new frame with stack buffer for the thread at current line.") -(def-gdb-thread-simple-buffer-command +(def-gdb-thread-buffer-simple-command gdb-frame-locals-for-thread gdb-frame-locals-buffer "Display a new frame with locals buffer for the thread at current line.") -(def-gdb-thread-simple-buffer-command +(def-gdb-thread-buffer-simple-command gdb-frame-registers-for-thread gdb-frame-registers-buffer "Display a new frame with registers buffer for the thread at @@ -2427,32 +2663,31 @@ "Display a new frame with disassembly buffer for the thread at current line.") -(defmacro def-gdb-thread-buffer-gdb-command (name gdb-command &optional doc) - "Define a NAME which will execute send GDB-COMMAND with +(defmacro def-gdb-thread-buffer-gud-command (name gud-command &optional doc) + "Define a NAME which will execute GUD-COMMAND with `gdb-thread-number' locally bound to id of thread on the current line." `(def-gdb-thread-buffer-command ,name (if gdb-non-stop - (let ((gdb-thread-number (gdb-get-field thread 'id))) - (gdb-input (list (gdb-current-context-command ,gdb-command) - 'ignore))) - (error "Available in non-stop mode only, customize gdb-non-stop.")) - ,doc)) - -;; Does this make sense in all-stop mode? -(def-gdb-thread-buffer-gdb-command + (let ((gdb-thread-number (gdb-get-field thread 'id)) + (gdb-gud-control-all-threads nil)) + (call-interactively #',gud-command)) + (error "Available in non-stop mode only, customize gdb-non-stop-setting.")) + ,doc)) + +(def-gdb-thread-buffer-gud-command gdb-interrupt-thread - "-exec-interrupt" + gud-stop-subjob "Interrupt thread at current line.") -(def-gdb-thread-buffer-gdb-command +(def-gdb-thread-buffer-gud-command gdb-continue-thread - "-exec-continue" + gud-cont "Continue thread at current line.") -(def-gdb-thread-buffer-gdb-command +(def-gdb-thread-buffer-gud-command gdb-step-thread - "-exec-step" + gud-step "Step thread at current line.") (defun gdb-set-header (buffer) @@ -2528,7 +2763,8 @@ gdb-memory-rows gdb-memory-columns) gdb-read-memory-handler - gdb-read-memory-custom) + gdb-read-memory-custom + '(update)) (gdb-set-buffer-rules 'gdb-memory-buffer @@ -2886,6 +3122,10 @@ 'gdb-disassembly-buffer "Display disassembly for current stack frame.") +(def-gdb-preempt-display-buffer + gdb-preemptively-display-disassembly-buffer + 'gdb-disassembly-buffer) + (def-gdb-frame-for-buffer gdb-frame-disassembly-buffer 'gdb-disassembly-buffer @@ -2897,7 +3137,8 @@ (line (gdb-get-field frame 'line))) (when file (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line))) - gdb-disassembly-handler) + gdb-disassembly-handler + '(update)) (def-gdb-auto-update-handler gdb-disassembly-handler @@ -2938,46 +3179,41 @@ \\{gdb-disassembly-mode-map}" ;; TODO Rename overlay variable for disassembly mode - (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) + (add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position) (setq fringes-outside-margins t) - (setq gdb-overlay-arrow-position (make-marker)) + (set (make-local-variable 'gdb-disassembly-position) (make-marker)) (set (make-local-variable 'font-lock-defaults) '(gdb-disassembly-font-lock-keywords)) (run-mode-hooks 'gdb-disassembly-mode-hook) 'gdb-invalidate-disassembly) (defun gdb-disassembly-handler-custom () - (let* ((pos 1) + (let* ((instructions (gdb-get-field (gdb-json-partial-output) 'asm_insns)) (address (gdb-get-field (gdb-current-buffer-frame) 'addr)) - (res (gdb-json-partial-output)) - (instructions (gdb-get-field res 'asm_insns)) - (last-instr (car (last instructions))) - (column-padding (+ 2 (string-width - (apply 'format - `("<%s+%s>:" - ,@(gdb-get-many-fields last-instr 'func-name 'offset))))))) + (pos 1) + (table (make-gdb-table)) + (marked-line nil)) (dolist (instr instructions) - ;; Put overlay arrow + (gdb-table-add-row table + (list + (gdb-get-field instr 'address) + (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset))) + (gdb-get-field instr 'inst))) (when (string-equal (gdb-get-field instr 'address) address) (progn - (setq pos (point)) + (setq marked-line (length (gdb-table-rows table))) (setq fringe-indicator-alist (if (string-equal gdb-frame-number "0") nil - '((overlay-arrow . hollow-right-triangle)))) - (set-marker gdb-overlay-arrow-position (point)))) - (insert - (concat - (gdb-get-field instr 'address) - " " - (gdb-pad-string (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset))) - (- column-padding)) - (gdb-get-field instr 'inst) - "\n"))) + '((overlay-arrow . hollow-right-triangle))))))) + (insert (gdb-table-string table " ")) (gdb-disassembly-place-breakpoints) - (let ((window (get-buffer-window (current-buffer) 0))) - (set-window-point window pos)) + ;; Mark current position with overlay arrow and scroll window to + ;; that point + (when marked-line + (let ((window (get-buffer-window (current-buffer) 0))) + (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position)))) (setq mode-name (concat "Disassembly: " (gdb-get-field (gdb-current-buffer-frame) 'func))))) @@ -2996,7 +3232,6 @@ ;;; Breakpoints view - (define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints" "Major mode for gdb breakpoints. @@ -3061,7 +3296,8 @@ ;; (def-gdb-trigger-and-handler gdb-invalidate-frames (gdb-current-context-command "-stack-list-frames") - gdb-stack-list-frames-handler gdb-stack-list-frames-custom) + gdb-stack-list-frames-handler gdb-stack-list-frames-custom + '(update)) (gdb-set-buffer-rules 'gdb-stack-buffer @@ -3069,47 +3305,41 @@ 'gdb-frames-mode 'gdb-invalidate-frames) -(defun gdb-insert-frame-location (frame) - "Insert \"of file:line\" button or library name for structure FRAME. +(defun gdb-frame-location (frame) + "Return \" of file:line\" or \" of library\" for structure FRAME. FRAME must have either \"file\" and \"line\" members or \"from\" member." - (let ((file (gdb-get-field frame 'fullname)) + (let ((file (gdb-get-field frame 'file)) (line (gdb-get-field frame 'line)) (from (gdb-get-field frame 'from))) - (cond (file - ;; Filename with line number - (insert " of ") - (gdb-insert-file-location-button - file (string-to-number line))) - ;; Library - (from (insert (format " of %s" from)))))) + (let ((res (or (and file line (concat file ":" line)) + from))) + (if res (concat " of " res) "")))) (defun gdb-stack-list-frames-custom () - (let* ((res (gdb-json-partial-output "frame")) - (stack (gdb-get-field res 'stack))) + (let ((stack (gdb-get-field (gdb-json-partial-output "frame") 'stack)) + (table (make-gdb-table))) + (set-marker gdb-stack-position nil) (dolist (frame stack) - (insert (apply 'format `("%s in %s" ,@(gdb-get-many-fields frame 'level 'func)))) - (gdb-insert-frame-location frame) - (newline)) - (save-excursion - (goto-char (point-min)) - (while (< (point) (point-max)) - (add-text-properties (point-at-bol) (1+ (point-at-bol)) - '(mouse-face highlight - help-echo "mouse-2, RET: Select frame")) - (beginning-of-line) - (when (and (looking-at "^[0-9]+\\s-+\\S-+\\s-+\\(\\S-+\\)") - (equal (match-string 1) gdb-selected-frame)) - (if (> (car (window-fringes)) 0) - (progn - (or gdb-stack-position - (setq gdb-stack-position (make-marker))) - (set-marker gdb-stack-position (point))) - (let ((bl (point-at-bol))) - (put-text-property bl (+ bl 4) - 'face '(:inverse-video t))))) - (forward-line 1))))) + (gdb-table-add-row table + (list + (gdb-get-field frame 'level) + "in" + (concat + (gdb-get-field frame 'func) + (if gdb-stack-buffer-locations + (gdb-frame-location frame) "") + (if gdb-stack-buffer-addresses + (concat " at " (gdb-get-field frame 'addr)) ""))) + `(mouse-face highlight + help-echo "mouse-2, RET: Select frame" + gdb-frame ,frame))) + (insert (gdb-table-string table " "))) + (when (and gdb-frame-number + (gdb-buffer-shows-main-thread-p)) + (gdb-mark-line (1+ (string-to-number gdb-frame-number)) + gdb-stack-position))) (defun gdb-stack-buffer-name () (gdb-current-context-buffer-name @@ -3120,6 +3350,10 @@ 'gdb-stack-buffer "Display backtrace of current stack.") +(def-gdb-preempt-display-buffer + gdb-preemptively-display-stack-buffer + 'gdb-stack-buffer nil t) + (def-gdb-frame-for-buffer gdb-frame-stack-buffer 'gdb-stack-buffer @@ -3129,20 +3363,20 @@ (let ((map (make-sparse-keymap))) (suppress-keymap map) (define-key map "q" 'kill-this-buffer) - (define-key map "\r" 'gdb-frames-select) - (define-key map [mouse-2] 'gdb-frames-select) + (define-key map "\r" 'gdb-select-frame) + (define-key map [mouse-2] 'gdb-select-frame) (define-key map [follow-link] 'mouse-face) map)) (defvar gdb-frames-font-lock-keywords - '(("in \\([^ ]+\\) of " (1 font-lock-function-name-face))) + '(("in \\([^ ]+\\)" (1 font-lock-function-name-face))) "Font lock keywords used in `gdb-frames-mode'.") (define-derived-mode gdb-frames-mode gdb-parent-mode "Frames" "Major mode for gdb call stack. \\{gdb-frames-mode-map}" - (setq gdb-stack-position nil) + (setq gdb-stack-position (make-marker)) (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) (setq truncate-lines t) ;; Make it easier to see overlay arrow. (set (make-local-variable 'font-lock-defaults) @@ -3150,18 +3384,19 @@ (run-mode-hooks 'gdb-frames-mode-hook) 'gdb-invalidate-frames) -(defun gdb-get-frame-number () - (save-excursion - (end-of-line) - (let* ((pos (re-search-backward "^\\([0-9]+\\)" nil t)) - (n (or (and pos (match-string-no-properties 1)) "0"))) - n))) - -(defun gdb-frames-select (&optional event) +(defun gdb-select-frame (&optional event) "Select the frame and display the relevant source." (interactive (list last-input-event)) (if event (posn-set-point (event-end event))) - (gud-basic-call (concat "-stack-select-frame " (gdb-get-frame-number)))) + (let ((frame (get-text-property (point) 'gdb-frame))) + (if frame + (if (gdb-buffer-shows-main-thread-p) + (let ((new-level (gdb-get-field frame 'level))) + (setq gdb-frame-number new-level) + (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore)) + (gdb-update)) + (error "Could not select frame for non-current thread.")) + (error "Not recognized as frame line")))) ;; Locals buffer. @@ -3169,7 +3404,8 @@ (def-gdb-trigger-and-handler gdb-invalidate-locals (concat (gdb-current-context-command "-stack-list-locals") " --simple-values") - gdb-locals-handler gdb-locals-handler-custom) + gdb-locals-handler gdb-locals-handler-custom + '(update)) (gdb-set-buffer-rules 'gdb-locals-buffer @@ -3207,7 +3443,8 @@ ;; Dont display values of arrays or structures. ;; These can be expanded using gud-watch. (defun gdb-locals-handler-custom () - (let ((locals-list (gdb-get-field (gdb-json-partial-output) 'locals))) + (let ((locals-list (gdb-get-field (gdb-json-partial-output) 'locals)) + (table (make-gdb-table))) (dolist (local locals-list) (let ((name (gdb-get-field local 'name)) (value (gdb-get-field local 'value)) @@ -3223,10 +3460,15 @@ `(mouse-face highlight help-echo "mouse-2: edit value" local-map ,gdb-edit-locals-map-1) - value)) - (insert - (concat name "\t" type - "\t" value "\n")))) + value)) + (gdb-table-add-row + table + (list + (propertize type 'font-lock-face font-lock-type-face) + (propertize name 'font-lock-face font-lock-variable-name-face) + value) + '(mouse-face highlight)))) + (insert (gdb-table-string table " ")) (setq mode-name (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func))))) @@ -3249,8 +3491,6 @@ \\{gdb-locals-mode-map}" (setq header-line-format gdb-locals-header) - (set (make-local-variable 'font-lock-defaults) - '(gdb-locals-font-lock-keywords)) (run-mode-hooks 'gdb-locals-mode-hook) 'gdb-invalidate-locals) @@ -3263,6 +3503,10 @@ 'gdb-locals-buffer "Display local variables of current stack and their values.") +(def-gdb-preempt-display-buffer + gdb-preemptively-display-locals-buffer + 'gdb-locals-buffer nil t) + (def-gdb-frame-for-buffer gdb-frame-locals-buffer 'gdb-locals-buffer @@ -3275,7 +3519,8 @@ gdb-invalidate-registers (concat (gdb-current-context-command "-data-list-register-values") " x") gdb-registers-handler - gdb-registers-handler-custom) + gdb-registers-handler-custom + '(update)) (gdb-set-buffer-rules 'gdb-registers-buffer @@ -3285,20 +3530,22 @@ (defun gdb-registers-handler-custom () (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values)) - (register-names-list (reverse gdb-register-names))) + (register-names-list (reverse gdb-register-names)) + (table (make-gdb-table))) (dolist (register register-values) (let* ((register-number (gdb-get-field register 'number)) (value (gdb-get-field register 'value)) (register-name (nth (string-to-number register-number) register-names-list))) - (insert - (concat - (propertize register-name 'face font-lock-variable-name-face) - "\t" + (gdb-table-add-row + table + (list + (propertize register-name 'font-lock-face font-lock-variable-name-face) (if (member register-number gdb-changed-registers) - (propertize value 'face font-lock-warning-face) - value) - "\n")))))) + (propertize value 'font-lock-face font-lock-warning-face) + value)) + '(mouse-face highlight)))) + (insert (gdb-table-string table " ")))) (defvar gdb-registers-mode-map (let ((map (make-sparse-keymap))) @@ -3323,6 +3570,10 @@ 'gdb-registers-buffer "Display integer register contents.") +(def-gdb-preempt-display-buffer + gdb-preemptively-display-registers-buffer + 'gdb-registers-buffer nil t) + (def-gdb-frame-for-buffer gdb-frame-registers-buffer 'gdb-registers-buffer @@ -3378,12 +3629,11 @@ (gdb-add-pending 'gdb-get-main-selected-frame)))) (defun gdb-frame-handler () - "Sets `gdb-pc-address', `gdb-selected-frame' and - `gdb-selected-file' to show overlay arrow in source buffer." + "Sets `gdb-selected-frame' and `gdb-selected-file' to show +overlay arrow in source buffer." (gdb-delete-pending 'gdb-get-main-selected-frame) (let ((frame (gdb-get-field (gdb-json-partial-output) 'frame))) (when frame - (setq gdb-frame-number (gdb-get-field frame 'level)) (setq gdb-selected-frame (gdb-get-field frame 'func)) (setq gdb-selected-file (gdb-get-field frame 'fullname)) (let ((line (gdb-get-field frame 'line))) @@ -3438,6 +3688,33 @@ (set-window-buffer window buf) window))))) +(defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal) + "Find window displaying a buffer with the same +`gdb-buffer-type' as BUF and show BUF there. If no such window +exists, just call `gdb-display-buffer' for BUF. If the window +found is already dedicated, split window according to +SPLIT-HORIZONTAL and show BUF in the new window." + (if buf + (when (not (get-buffer-window buf)) + (let* ((buf-type (gdb-buffer-type buf)) + (existing-window + (get-window-with-predicate + #'(lambda (w) + (and (eq buf-type + (gdb-buffer-type (window-buffer w))) + (not (window-dedicated-p w))))))) + (if existing-window + (set-window-buffer existing-window buf) + (let ((dedicated-window + (get-window-with-predicate + #'(lambda (w) + (eq buf-type + (gdb-buffer-type (window-buffer w))))))) + (if dedicated-window + (set-window-buffer + (split-window dedicated-window nil split-horizontal) buf) + (gdb-display-buffer buf t)))))) + (error "Null buffer"))) ;;; Shared keymap initialization: @@ -3532,7 +3809,13 @@ (let ((same-window-regexps nil)) (select-window (display-buffer gud-comint-buffer nil 0)))) -(defun gdb-set-window-buffer (name) +(defun gdb-set-window-buffer (name &optional ignore-dedicated) + "Set buffer of selected window to NAME and dedicate window. + +When IGNORE-DEDICATED is non-nil, buffer is set even if selected +window is dedicated." + (when ignore-dedicated + (set-window-dedicated-p (selected-window) nil)) (set-window-buffer (selected-window) (get-buffer name)) (set-window-dedicated-p (selected-window) t)) @@ -3569,7 +3852,9 @@ (gdb-set-window-buffer (gdb-stack-buffer-name)) (split-window-horizontally) (other-window 1) - (gdb-set-window-buffer (gdb-breakpoints-buffer-name)) + (gdb-set-window-buffer (if gdb-show-threads-by-default + (gdb-threads-buffer-name) + (gdb-breakpoints-buffer-name))) (other-window 1)) (defcustom gdb-many-windows nil @@ -3629,9 +3914,9 @@ (setq gud-minor-mode nil) (kill-local-variable 'tool-bar-map) (kill-local-variable 'gdb-define-alist)))))) - (setq gdb-overlay-arrow-position nil) + (setq gdb-disassembly-position nil) (setq overlay-arrow-variable-list - (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) + (delq 'gdb-disassembly-position overlay-arrow-variable-list)) (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) (setq gdb-stack-position nil) (setq overlay-arrow-variable-list
--- a/lisp/progmodes/gud.el Tue Aug 04 17:03:54 2009 +0000 +++ b/lisp/progmodes/gud.el Tue Aug 04 17:16:58 2009 +0000 @@ -133,6 +133,8 @@ (and (eq gud-minor-mode 'gdbmi) (> (car (window-fringes)) 0))))) +(declare-function gdb-gud-context-call "gdb-mi.el") + (defun gud-stop-subjob () (interactive) (with-current-buffer gud-comint-buffer @@ -160,21 +162,10 @@ :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go :visible (and (eq gud-minor-mode 'gdbmi) - (or (and (or - (not gdb-gud-control-all-threads) - (not gdb-non-stop)) - (not gud-running)) - (and gdb-gud-control-all-threads - (> gdb-stopped-threads-count 0))))) + (gdb-show-run-p))) ([stop] menu-item "Stop" gud-stop-subjob :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) - (and (eq gud-minor-mode 'gdbmi) - (or (and (or - (not gdb-gud-control-all-threads) - (not gdb-non-stop)) - gud-running) - (and gdb-gud-control-all-threads - (> gdb-running-threads-count 0)))))) + (gdb-show-stop-p))) ([until] menu-item "Continue to selection" gud-until :enable (not gud-running) :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) @@ -262,21 +253,11 @@ ([menu-bar go] menu-item ,(propertize " go " 'face 'font-lock-doc-face) gud-go :visible (and (eq gud-minor-mode 'gdbmi) - (or (and (or - (not gdb-gud-control-all-threads) - (not gdb-non-stop)) - (not gud-running)) - (and gdb-gud-control-all-threads - (> gdb-stopped-threads-count 0))))) + (gdb-show-run-p))) ([menu-bar stop] menu-item ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob :visible (or (and (eq gud-minor-mode 'gdbmi) - (or (and (or - (not gdb-gud-control-all-threads) - (not gdb-non-stop)) - gud-running) - (and gdb-gud-control-all-threads - (> gdb-running-threads-count 0)))) + (gdb-show-stop-p)) (not (eq gud-minor-mode 'gdbmi)))) ([menu-bar print] . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print))