[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs/lisp/progmodes gdb-mi.el gud.el
|
From: |
Dmitry Dzhus |
|
Subject: |
[Emacs-diffs] emacs/lisp/progmodes gdb-mi.el gud.el |
|
Date: |
Tue, 04 Aug 2009 17:16:59 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Dmitry Dzhus <sphinx> 09/08/04 17:16:58
Modified files:
lisp/progmodes : gdb-mi.el gud.el
Log message:
* 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)
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/gdb-mi.el?cvsroot=emacs&r1=1.25&r2=1.26
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/gud.el?cvsroot=emacs&r1=1.166&r2=1.167
Patches:
Index: gdb-mi.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/gdb-mi.el,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -b -r1.25 -r1.26
--- gdb-mi.el 4 Aug 2009 15:52:01 -0000 1.25
+++ gdb-mi.el 4 Aug 2009 17:16:58 -0000 1.26
@@ -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,19 +254,64 @@
(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
+ `(run-with-timer
gdb-wait-for-pending-timeout nil
- `(lambda ()
+ (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."
:group 'gdb
@@ -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,7 +1240,11 @@
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")))
@@ -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."
+ (let ((old-value gud-running))
(setq gud-running
(string= (gdb-get-field (gdb-current-buffer-thread) 'state)
- "running")))
+ "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))))
+ (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
- (when (not running)
- (insert (concat " in " (gdb-get-field thread 'frame 'func)))
- (insert " (")
+ (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)))
- (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
+ (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))
+ (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)))
+ (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."))
+ (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))
-;; Does this make sense in all-stop mode?
-(def-gdb-thread-buffer-gdb-command
+(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)
+ ;; 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 pos))
+ (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))
@@ -3224,9 +3461,14 @@
help-echo "mouse-2: edit value"
local-map ,gdb-edit-locals-map-1)
value))
- (insert
- (concat name "\t" type
- "\t" value "\n"))))
+ (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
Index: gud.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/gud.el,v
retrieving revision 1.166
retrieving revision 1.167
diff -u -b -r1.166 -r1.167
--- gud.el 4 Aug 2009 15:07:27 -0000 1.166
+++ gud.el 4 Aug 2009 17:16:58 -0000 1.167
@@ -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))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] emacs/lisp/progmodes gdb-mi.el gud.el,
Dmitry Dzhus <=