(require 'gud)
(require 'json)
(require 'bindat)
+(require 'speedbar)
+(eval-when-compile
+ (require 'cl))
(defvar tool-bar-map)
(defvar speedbar-initial-expansion-list-name)
(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.
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.
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
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)
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.
(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."
(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
(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"))
(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
"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
(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)
(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
| | |
+-----------------------------------+----------------------------------+
| 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 |
+-----------------------------------+----------------------------------+"
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)
;;
(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)
(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)
(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)))))
"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.
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)))
(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)
(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:
(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.
+;; 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 value is taken from `gdb-thread-number'. If
-`gdb-thread-number' is nil, COMMAND is returned unchanged."
+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)
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)
+ "")
"*"))
\f
(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
;; 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
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
;; 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.
(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))
;; 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
(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)
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
;; 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.
"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'."
;; 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
(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 ()
;; 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))
;; 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) "*"))
"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))
'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'.")
(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)
(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
" "
(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.
'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)
(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.
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)))
(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
"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)
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
'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
(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
\\{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)))))
\f
;;; Breakpoints view
-
(define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints"
"Major mode for gdb breakpoints.
;;
(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
'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
'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
(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)
(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"))))
\f
;; Locals buffer.
(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
;; 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))
`(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)))))
\\{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)
'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
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
(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)))
'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
(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)))
(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")))
\f
;;; Shared keymap initialization:
(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))
(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
(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