[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs/lisp ChangeLog progmodes/gdb-mi.el progmo...
From: |
Dmitry Dzhus |
Subject: |
[Emacs-diffs] emacs/lisp ChangeLog progmodes/gdb-mi.el progmo... |
Date: |
Tue, 04 Aug 2009 15:07:28 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Dmitry Dzhus <sphinx> 09/08/04 15:07:28
Modified files:
lisp : ChangeLog
lisp/progmodes : gdb-mi.el gud.el
Log message:
* progmodes/gud.el (gud-stop-subjob, gud-menu-map): Respect GDB
non-stop settings.
* progmodes/gdb-mi.el (gdb-thread-number): Initialize with nil.
(gdb-current-context-command): Do not append --thread if
`gdb-thread-number' is nil.
(gdb-running-threads-count, gdb-stopped-threads-count): New
variables.
(gdb-non-stop, gdb-gud-control-all-threads, gdb-switch-reasons)
(gdb-stopped-hooks, gdb-switch-when-another-stopped): New
customization options.
(gdb-gud-context-command, gdb-gud-context-call): New wrappers for
GUD commands.
(gdb): `gud-def' definitions changed to use `gdb-gud-context-call'
(gdb-init-1): Activate non-stop mode if `gdb-non-stop' is enabled.
(gdb-setq-thread-number, gdb-update-gud-running): New functions to
set `gdb-thread-number' and update `gud-running' properly.
(gdb-running): Update threads list when new threads appear.
(gdb-stopped): Support non-stop operation and new thread switching
logic.
(gdb-jsonify-buffer, gdb-json-read-buffer, gdb-json-string)
(gdb-json-partial-output): New set of JSON routines.
(def-gdb-auto-update-trigger): New `signal-list' optional
argument.
(gdb-thread-list-handler-custom): Update `gud-running',
`gdb-stopped-threads-count' and `gdb-running-threads-count'.
(def-gdb-thread-buffer-gdb-command, gdb-interrupt-thread)
(gdb-continue-thread, gdb-step-thread): New commands for fine
thread execution control.
(gud-menu-map): New menu items to switch non-stop options.
(gdb-reset): Cleanup `gdb-thread-position' overlay arrow marker.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.15891&r2=1.15892
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/gdb-mi.el?cvsroot=emacs&r1=1.23&r2=1.24
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/gud.el?cvsroot=emacs&r1=1.165&r2=1.166
Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.15891
retrieving revision 1.15892
diff -u -b -r1.15891 -r1.15892
--- ChangeLog 4 Aug 2009 14:40:33 -0000 1.15891
+++ ChangeLog 4 Aug 2009 15:07:23 -0000 1.15892
@@ -1,24 +1,52 @@
2009-08-04 Dmitry Dzhus <address@hidden>
- * progmodes/gdb-mi.el Basic thread selection support.
- (gdb-thread-number): New variable.
- (gdb-current-context-command): New macro which adds --thread
- option to command.
- (gdb-threads-mode-map): Select thread with SPC
- (gdb-thread-list-handler-custom): Mark current thread with overlay
- arrow. Synchronize GDB thread and Emacs thread.
- (gdb-select-thread): New command which selects current thread.
- (gdb-invalidate-frames, gdb-invalidate-locals)
- (gdb-invalidate-registers): Use --thread option.
- (gdb-breakpoints-buffer-name,gdb-locals-buffer-name)
- (gdb-registers-buffer-name)
- (gdb-memory-buffer-name, gdb-stack-buffer-name): Do not switch
- to (gud-comint-buffer) in *-buffer-name functions
- because (gdb-get-target-string) already does that.
- (gdb-locals-handler-custom, gdb-registers-handler-custom)
- (gdb-changed-registers-handler): Rewritten without regexps.
- (gdb-get-buffer, gdb-get-buffer-create, gdb-init-1)
- (gdb-bind-function-to-buffer, gdb-add-subscriber)
+ * progmodes/gud.el (gud-stop-subjob, gud-menu-map): Respect GDB
+ non-stop settings.
+
+ * progmodes/gdb-mi.el (gdb-thread-number): Initialize with nil.
+ (gdb-current-context-command): Do not append --thread if
+ `gdb-thread-number' is nil.
+ (gdb-running-threads-count, gdb-stopped-threads-count): New
+ variables.
+ (gdb-non-stop, gdb-gud-control-all-threads, gdb-switch-reasons)
+ (gdb-stopped-hooks, gdb-switch-when-another-stopped): New
+ customization options.
+ (gdb-gud-context-command, gdb-gud-context-call): New wrappers for
+ GUD commands.
+ (gdb): `gud-def' definitions changed to use `gdb-gud-context-call'
+ (gdb-init-1): Activate non-stop mode if `gdb-non-stop' is enabled.
+ (gdb-setq-thread-number, gdb-update-gud-running): New functions to
+ set `gdb-thread-number' and update `gud-running' properly.
+ (gdb-running): Update threads list when new threads appear.
+ (gdb-stopped): Support non-stop operation and new thread switching
+ logic.
+ (gdb-jsonify-buffer, gdb-json-read-buffer, gdb-json-string)
+ (gdb-json-partial-output): New set of JSON routines.
+ (def-gdb-auto-update-trigger): New `signal-list' optional
+ argument.
+ (gdb-thread-list-handler-custom): Update `gud-running',
+ `gdb-stopped-threads-count' and `gdb-running-threads-count'.
+ (def-gdb-thread-buffer-gdb-command, gdb-interrupt-thread)
+ (gdb-continue-thread, gdb-step-thread): New commands for fine
+ thread execution control.
+ (gud-menu-map): New menu items to switch non-stop options.
+ (gdb-reset): Cleanup `gdb-thread-position' overlay arrow marker.
+
+ * progmodes/gdb-mi.el (gdb-rules-name-maker)
+ (gdb-rules-buffer-mode, gdb-rules-update-trigger): Accessors for
+ gdb-buffer-rules.
+ (def-gdb-auto-update-handler): New nopreserve optional argument.
+ (gdb-stack-list-frames-custom): Print stack from top to bottom.
+
+ * progmodes/gdb-mi.el (gdb-pc-address): Removed unused variable.
+ (gdb-threads-list, gdb-breakpoints-list): New assoc lists.
+ (gdb-parent-mode): New mode to derive other GDB modes from.
+ (gdb-display-disassembly-for-thread)
+ (gdb-frame-disassembly-for-thread): New commands for threads
+ buffer.
+
+ * progmodes/gdb-mi.el (gdb-get-buffer, gdb-get-buffer-create)
+ (gdb-init-1, gdb-bind-function-to-buffer, gdb-add-subscriber)
(gdb-get-subscribers, gdb-emit-signal, gdb-buf-publisher)
(gdb-update): We now store all GDB buffers in a list so that they
can be updated by traversing a list instead of calling invalidate
@@ -35,16 +63,25 @@
(gdb-frame-locals-for-thread, gdb-frame-registers-for-thread): New
commands which show buffers bound to thread.
(gdb-stack-list-locals-regexp): Removed unused regexp.
- (gdb-pc-address): Removed unused variable.
- (gdb-threads-list, gdb-breakpoints-list): New assoc lists.
- (gdb-parent-mode): New mode to derive other GDB modes from.
- (gdb-display-disassembly-for-thread)
- (gdb-frame-disassembly-for-thread): New commands for threads
- buffer.
- (gdb-rules-name-maker, gdb-rules-buffer-mode)
- (gdb-rules-update-trigger): Accessors for gdb-buffer-rules.
- (def-gdb-auto-update-handler): New nopreserve optional argument.
- (gdb-stack-list-frames-custom): Print stack from top to bottom.
+
+ * progmodes/gdb-mi.el
(gdb-breakpoints-buffer-name,gdb-locals-buffer-name)
+ (gdb-registers-buffer-name)
+ (gdb-memory-buffer-name, gdb-stack-buffer-name): Do not switch
+ to (gud-comint-buffer) in *-buffer-name functions
+ because (gdb-get-target-string) already does that.
+ (gdb-locals-handler-custom, gdb-registers-handler-custom)
+ (gdb-changed-registers-handler): Rewritten without regexps.
+
+ * progmodes/gdb-mi.el Basic thread selection support.
+ (gdb-thread-number): New variable.
+ (gdb-current-context-command): New macro which adds --thread
+ option to command.
+ (gdb-threads-mode-map): Select thread with SPC
+ (gdb-thread-list-handler-custom): Mark current thread with overlay
+ arrow. Synchronize GDB thread and Emacs thread.
+ (gdb-select-thread): New command which selects current thread.
+ (gdb-invalidate-frames, gdb-invalidate-locals)
+ (gdb-invalidate-registers): Use --thread option.
2009-08-04 Michael Albinus <address@hidden>
Index: progmodes/gdb-mi.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/gdb-mi.el,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -b -r1.23 -r1.24
--- progmodes/gdb-mi.el 4 Aug 2009 14:40:40 -0000 1.23
+++ progmodes/gdb-mi.el 4 Aug 2009 15:07:27 -0000 1.24
@@ -116,16 +116,18 @@
"Address of previous memory page for program memory buffer.")
(defvar gdb-frame-number "0")
-(defvar gdb-thread-number "1"
+(defvar gdb-thread-number nil
"Main current thread.
Invalidation triggers use this variable to query GDB for
information on the specified thread by wrapping GDB/MI commands
in `gdb-current-context-command'.
-This variable may be updated implicitly by GDB via
-`gdb-thread-list-handler-custom' or explicitly by
-`gdb-select-thread'.")
+This variable may be updated implicitly by GDB via `gdb-stopped'
+or explicitly by `gdb-select-thread'.
+
+Only `gdb-setq-thread-number' should be used to change this
+value.")
;; Used to show overlay arrow in source buffer. All set in
;; gdb-get-main-selected-frame. Disassembly buffer should not use
@@ -141,14 +143,26 @@
"Associative list of threads provided by \"-thread-info\" MI command.
Keys are thread numbers (in strings) and values are structures as
-returned from -thread-info by `json-partial-output'. Updated in
+returned from -thread-info by `gdb-json-partial-output'. Updated in
`gdb-thread-list-handler-custom'.")
+(defvar gdb-running-threads-count nil
+ "Number of currently running threads.
+
+Nil means that no information is available.
+
+Updated in `gdb-thread-list-handler-custom'.")
+
+(defvar gdb-stopped-threads-count nil
+ "Number of currently stopped threads.
+
+See also `gdb-running-threads-count'.")
+
(defvar gdb-breakpoints-list nil
"Associative list of breakpoints provided by \"-break-list\" MI command.
Keys are breakpoint numbers (in string) and values are structures
-as returned from \"-break-list\" by `json-partial-output'
+as returned from \"-break-list\" by `gdb-json-partial-output'
\(\"body\" field is used). Updated in
`gdb-breakpoints-list-handler-custom'.")
@@ -226,6 +240,85 @@
(const :tag "Unlimited" nil))
:version "22.1")
+(defcustom gdb-non-stop t
+ "When in non-stop mode, stopped threads can be examined while
+other threads continue to execute."
+ :type 'boolean
+ :group 'gdb
+ :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."
+ :type 'boolean
+ :group 'gdb
+ :version "23.2")
+
+(defcustom gdb-switch-reasons t
+ "List of stop reasons which cause Emacs to switch to the thread
+which caused the stop. When t, switch to stopped thread no matter
+what the reason was. When nil, never switch to stopped thread
+automatically.
+
+This setting is used in non-stop mode only. In all-stop mode,
+Emacs always switches to the thread which caused the stop."
+ ;; exited, exited-normally and exited-signalled are not
+ ;; thread-specific stop reasons and therefore are not included in
+ ;; this list
+ :type '(choice
+ (const :tag "All reasons" t)
+ (set :tag "Selection of reasons..."
+ (const :tag "A breakpoint was reached." "breakpoint-hit")
+ (const :tag "A watchpoint was triggered." "watchpoint-trigger")
+ (const :tag "A read watchpoint was triggered."
"read-watchpoint-trigger")
+ (const :tag "An access watchpoint was triggered."
"access-watchpoint-trigger")
+ (const :tag "Function finished execution." "function-finished")
+ (const :tag "Location reached." "location-reached")
+ (const :tag "Watchpoint has gone out of scope"
"watchpoint-scope")
+ (const :tag "End of stepping range reached."
"end-stepping-range")
+ (const :tag "Signal received (like interruption)."
"signal-received"))
+ (const :tag "None" nil))
+ :group 'gdb
+ :version "23.2"
+ :link '(info-link "(gdb)GDB/MI Async Records"))
+
+(defcustom gdb-stopped-hooks nil
+ "This variable holds a list of functions to be called whenever
+GDB stops.
+
+Each function takes one argument, a parsed MI response, which
+contains fields of corresponding MI *stopped async record:
+
+ ((stopped-threads . \"all\")
+ (thread-id . \"1\")
+ (frame (line . \"38\")
+ (fullname . \"/home/sphinx/projects/gsoc/server.c\")
+ (file . \"server.c\")
+ (args ((value . \"0x804b038\")
+ (name . \"arg\")))
+ (func . \"hello\")
+ (addr . \"0x0804869e\"))
+ (reason . \"end-stepping-range\"))
+
+`gdb-get-field' may be used to access the fields of response.
+
+Each function is called after the new current thread was selected
+and GDB buffers were updated in `gdb-stopped'."
+ :type '(repeat function)
+ :group 'gdb
+ :version "23.2"
+ :link '(info-link "(gdb)GDB/MI Async Records"))
+
+(defcustom gdb-switch-when-another-stopped t
+ "When nil, Emacs won't switch to stopped thread if some other
+stopped thread is already selected."
+ :type 'boolean
+ :group 'gdb
+ :version "23.2")
+
(defvar gdb-debug-log nil
"List of commands sent to and replies received from GDB.
Most recent commands are listed first. This list stores only the last
@@ -329,6 +422,29 @@
)
"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)
+ "When `gdb-non-stop' is t, add --thread option to COMMAND if
+`gdb-gud-control-all-threads' is nil and --all option otherwise.
+If NOALL is t, always add --thread option no matter what
+`gdb-gud-control-all-threads' value is.
+
+When `gdb-non-stop' is nil, return COMMAND unchanged."
+ (if gdb-non-stop
+ (if (and gdb-gud-control-all-threads
+ (not noall))
+ (concat command " --all ")
+ (gdb-current-context-command command))
+ command))
+
+;; TODO Document this. We use noarg when not in gud-def
+(defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg)
+ `(gud-call
+ (concat
+ (gdb-gud-context-command ,cmd1 ,noall)
+ ,cmd2) ,(when (not noarg) 'arg)))
+
;;;###autoload
(defun gdb (command-line)
"Run gdb on program FILE in buffer *gud-FILE*.
@@ -404,27 +520,28 @@
(gud-def gud-pstar "print* %e" nil
"Evaluate C dereferenced pointer expression at point.")
- (gud-def gud-step "-exec-step %p" "\C-s"
+ (gud-def gud-step (gdb-gud-context-call "-exec-step" "%p" t)
+ "\C-s"
"Step one source line with display.")
- (gud-def gud-stepi "-exec-step-instruction %p" "\C-i"
+ (gud-def gud-stepi (gdb-gud-context-call "-exec-step-instruction" "%p" t)
+ "\C-i"
"Step one instruction with display.")
- (gud-def gud-next "-exec-next %p" "\C-n"
+ (gud-def gud-next (gdb-gud-context-call "-exec-next" "%p" t)
+ "\C-n"
"Step one line (skip functions).")
- (gud-def gud-nexti "nexti %p" nil
+ (gud-def gud-nexti (gdb-gud-context-call "-exec-next-instruction" "%p" t)
+ nil
"Step one instruction (skip functions).")
- (gud-def gud-cont "-exec-continue" "\C-r"
+ (gud-def gud-cont (gdb-gud-context-call "-exec-continue")
+ "\C-r"
"Continue with display.")
- (gud-def gud-finish "-exec-finish" "\C-f"
+ (gud-def gud-finish (gdb-gud-context-call "-exec-finish" nil t)
+ "\C-f"
"Finish executing current function.")
- (gud-def gud-run "-exec-run" nil "Runn the program.")
-
- (local-set-key "\C-i" 'gud-gdb-complete-command)
- (setq gdb-first-prompt t)
- (setq gud-running nil)
- (gdb-update)
- (run-hooks 'gdb-mode-hook))
+ (gud-def gud-run "-exec-run"
+ nil
+ "Run the program.")
-(defun gdb-init-1 ()
(gud-def gud-break (if (not (string-match "Disassembly" mode-name))
(gud-call "break %f:%l" arg)
(save-excursion
@@ -432,7 +549,7 @@
(forward-char 2)
(gud-call "break *%a" arg)))
"\C-b" "Set breakpoint at current line or address.")
- ;;
+
(gud-def gud-remove (if (not (string-match "Disassembly" mode-name))
(gud-call "clear %f:%l" arg)
(save-excursion
@@ -440,7 +557,8 @@
(forward-char 2)
(gud-call "clear *%a" arg)))
"\C-d" "Remove breakpoint at current line or address.")
- ;;
+
+ ;; -exec-until doesn't support --all yet
(gud-def gud-until (if (not (string-match "Disassembly" mode-name))
(gud-call "-exec-until %f:%l" arg)
(save-excursion
@@ -448,9 +566,11 @@
(forward-char 2)
(gud-call "-exec-until *%a" arg)))
"\C-u" "Continue to current line or address.")
- ;;
+ ;; TODO Why arg here?
(gud-def
- gud-go (gud-call (if gdb-active-process "-exec-continue" "-exec-run") arg)
+ gud-go (gud-call (if gdb-active-process
+ (gdb-gud-context-command "-exec-continue")
+ "-exec-run") arg)
nil "Start or continue execution.")
;; For debugging Emacs only.
@@ -488,7 +608,14 @@
'gdb-mouse-jump)
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
- ;;
+
+ (local-set-key "\C-i" 'gud-gdb-complete-command)
+ (setq gdb-first-prompt t)
+ (setq gud-running nil)
+ (gdb-update)
+ (run-hooks 'gdb-mode-hook))
+
+(defun gdb-init-1 ()
;; (re-)initialise
(setq gdb-selected-frame nil
gdb-frame-number nil
@@ -507,13 +634,15 @@
gdb-debug-log nil
gdb-source-window nil
gdb-inferior-status nil
- gdb-continuation nil)
+ gdb-continuation nil
+ gdb-buf-publisher '()
+ gdb-threads-list '()
+ gdb-breakpoints-list '())
;;
(setq gdb-buffer-type 'gdbmi)
;;
(gdb-force-mode-line-update
(propertize "initializing..." 'face font-lock-variable-name-face))
- (setq gdb-buf-publisher '())
(when gdb-use-separate-io-buffer
(gdb-get-buffer-create 'gdb-inferior-io)
(gdb-clear-inferior-io)
@@ -526,6 +655,11 @@
(if (eq window-system 'w32)
(gdb-input (list "-gdb-set new-console off" 'ignore)))
(gdb-input (list "-gdb-set height 0" 'ignore))
+
+ (when gdb-non-stop
+ (gdb-input (list "-gdb-set non-stop 1" 'ignore))
+ (gdb-input (list "-gdb-set target-async 1" 'ignore)))
+
;; find source file and compilation directory here
(gdb-input
; Needs GDB 6.2 onwards.
@@ -944,11 +1078,14 @@
(assoc gdb-buffer-type gdb-buffer-rules))
(defun gdb-current-buffer-thread ()
- "Get thread of current buffer from `gdb-threads-list'."
+ "Get thread object of current buffer from `gdb-threads-list'.
+
+When current buffer is not bound to any thread, return main
+thread."
(cdr (assoc gdb-thread-number gdb-threads-list)))
(defun gdb-current-buffer-frame ()
- "Get current stack frame for thread of current buffer."
+ "Get current stack frame object for thread of current buffer."
(gdb-get-field (gdb-current-buffer-thread) 'frame))
(defun gdb-get-buffer (key &optional thread)
@@ -1043,6 +1180,7 @@
(defun gdb-parent-mode ()
"Generic mode to derive all other GDB buffer modes from."
+ (kill-all-local-variables)
(setq buffer-read-only t)
(buffer-disable-undo)
;; Delete buffer from gdb-buf-publisher when it's killed
@@ -1256,7 +1394,7 @@
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(face))))
;; mimic <RET> key to repeat previous command in GDB
- (if (not (string-match "^\\s+$" string))
+ (if (not (string= "" string))
(setq gdb-last-command string)
(if gdb-last-command (setq string gdb-last-command)))
(if gdb-enable-debug
@@ -1285,8 +1423,11 @@
(defun gdb-current-context-command (command)
"Add --thread option to gdb COMMAND.
-Option value is taken from `gdb-thread-number'."
- (concat command " --thread " gdb-thread-number))
+Option value is taken from `gdb-thread-number'. If
+`gdb-thread-number' is nil, COMMAND is returned unchanged."
+ (if gdb-thread-number
+ (concat command " --thread " gdb-thread-number " ")
+ command))
(defun gdb-current-context-buffer-name (name)
"Add thread information and asterisks to string NAME."
@@ -1343,15 +1484,15 @@
(propertize "initializing..." 'face font-lock-variable-name-face))
(gdb-init-1)
(setq gdb-first-prompt nil))
- ;; We may need to update gdb-thread-number and gdb-threads-list
+ ;; We may need to update gdb-threads-list so we can use
(gdb-get-buffer-create 'gdb-threads-buffer)
;; gdb-break-list is maintained in breakpoints handler
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (gdb-get-main-selected-frame)
-
(gdb-emit-signal gdb-buf-publisher 'update)
+ (gdb-get-main-selected-frame)
+
(gdb-get-changed-registers)
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
@@ -1359,6 +1500,28 @@
(setcar (nthcdr 5 var) nil))
(gdb-var-update)))
+;; gdb-setq-thread-number and gdb-update-gud-running are decoupled
+;; 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'."
+ (setq gdb-thread-number number)
+ (gdb-update-gud-running))
+
+(defun gdb-update-gud-running ()
+ "Set `gud-running' according to the state of current thread.
+
+Note that when `gdb-gud-control-all-threads' is t, `gud-running'
+cannot be reliably used to determine whether or not execution
+control buttons should be shown in menu or toolbar. Use
+`gdb-running-threads-count' and `gdb-stopped-threads-count'
+instead.
+
+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")))
+
;; 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
;; visited breakpoint is, use that window.
@@ -1385,7 +1548,7 @@
(gdb-error . "\\([0-9]*\\)\\^error,\\(.*?\\)\n")
(gdb-console . "~\\(\".*?\"\\)\n")
(gdb-internals . "&\\(\".*?\"\\)\n")
- (gdb-stopped . "\\*stopped,?\\(.*?\n\\)")
+ (gdb-stopped . "\\*stopped,?\\(.*?\\)\n")
(gdb-running . "\\*running,\\(.*?\n\\)")
(gdb-thread-created . "=thread-created,\\(.*?\n\\)")
(gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")))
@@ -1446,15 +1609,20 @@
gdb-filter-output))
(defun gdb-gdb (output-field))
+
+;; gdb-invalidate-threads is defined to accept 'update-threads signal
(defun gdb-thread-created (output-field))
-(defun gdb-thread-exited (output-field))
+(defun gdb-thread-exited (output-field)
+ (gdb-emit-signal gdb-buf-publisher 'update-threads))
(defun gdb-running (output-field)
(setq gdb-inferior-status "running")
(gdb-force-mode-line-update
(propertize gdb-inferior-status 'face font-lock-type-face))
- (setq gdb-active-process t)
+ (when (not gdb-non-stop)
(setq gud-running t))
+ (setq gdb-active-process t)
+ (gdb-emit-signal gdb-buf-publisher 'update-threads))
(defun gdb-starting (output-field)
;; CLI commands don't emit ^running at the moment so use gdb-running too.
@@ -1464,17 +1632,18 @@
(gdb-force-mode-line-update
(propertize gdb-inferior-status 'face font-lock-type-face))
(setq gdb-active-process t)
- (setq gud-running t))
+ (when (not gdb-non-stop)
+ (setq gud-running t)))
;; -break-insert -t didn't give a reason before gdb 6.9
-(defconst gdb-stopped-regexp
-
"\\(reason=\"\\(.*?\\)\"\\)?\\(\\(,exit-code=.*?\\)*\n\\|.*?,file=\".*?\".*?,fullname=\"\\(.*?\\)\".*?,line=\"\\(.*?\\)\".*?\n\\)")
(defun gdb-stopped (output-field)
- (setq gud-running nil)
- (string-match gdb-stopped-regexp output-field)
- (let ((reason (match-string 2 output-field))
- (file (match-string 5 output-field)))
+ "Given the contents of *stopped MI async record, select new
+current thread and update GDB buffers."
+ ;; Reason is available with target-async only
+ (let* ((result (gdb-json-string output-field))
+ (reason (gdb-get-field result 'reason))
+ (thread-id (gdb-get-field result 'thread-id)))
;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler
;;; because synchronous GDB doesn't give these fields with CLI.
@@ -1485,16 +1654,42 @@
;;; (string-to-number
;;; (match-string 6 gud-marker-acc)))))
- (setq gdb-inferior-status (if reason reason "unknown"))
+ (setq gdb-inferior-status (or reason "unknown"))
(gdb-force-mode-line-update
(propertize gdb-inferior-status 'face font-lock-warning-face))
(if (string-equal reason "exited-normally")
- (setq gdb-active-process nil)))
+ (setq gdb-active-process nil))
+ ;; Select new current thread.
+
+ ;; Don't switch if we have no reasons selected
+ (when gdb-switch-reasons
+ ;; Switch from another stopped thread only if we have
+ ;; gdb-switch-when-another-stopped:
+ (when (or gdb-switch-when-another-stopped
+ (not (string= "stopped"
+ (gdb-get-field (gdb-current-buffer-thread)
'state))))
+ ;; Switch if current reason has been selected or we have no
+ ;; reasons
+ (if (or (eq gdb-switch-reasons t)
+ (member reason gdb-switch-reasons))
+ (progn
+ (gdb-setq-thread-number thread-id)
+ (message (concat "Switched to thread " thread-id)))
+ (message (format "Thread %s stopped" thread-id)))))
+
+ ;; Print "(gdb)" to GUD console
(when gdb-first-done-or-error
- (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))
+ (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
+
+ ;; In non-stop, we update information as soon as another thread gets
+ ;; stopped
+ (when (or gdb-first-done-or-error
+ gdb-non-stop)
+ ;; In all-stop this updates gud-running properly as well.
(gdb-update)
- (setq gdb-first-done-or-error nil)))
+ (setq gdb-first-done-or-error nil))
+ (run-hook-with-args 'gdb-stopped-hook result)))
;; Remove the trimmings from log stream containing debugging messages
;; being produced by GDB's internals, use warning face and send to GUD
@@ -1571,8 +1766,11 @@
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
(erase-buffer)))
-(defun json-partial-output (&optional fix-key fix-list)
- "Parse gdb-partial-output-buffer with `json-read'.
+(defun gdb-jsonify-buffer (&optional fix-key fix-list)
+ "Prepare GDB/MI output in current buffer for parsing with `json-read'.
+
+Field names are wrapped in double quotes and equal signs are
+replaced with semicolons.
If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from
partial output. This is used to get rid of useless keys in lists
@@ -1583,20 +1781,17 @@
If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with
\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken
-break-info output when it contains breakpoint script field
-incompatible with GDB/MI output syntax.
-
-Note that GDB/MI output syntax is different from JSON both
-cosmetically and (in some cases) structurally, so correct results
-are not guaranteed."
- (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
+incompatible with GDB/MI output syntax."
+ (save-excursion
(goto-char (point-min))
(when fix-key
(save-excursion
(while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
(replace-match "" nil nil nil 1))))
+ ;; Emacs bug #3794
(when fix-list
(save-excursion
- ;; Find positions of brackets which enclose broken list
+ ;; Find positions of braces which enclose broken list
(while (re-search-forward (concat fix-list "={\"") nil t)
(let ((p1 (goto-char (- (point) 2)))
(p2 (progn (forward-sexp)
@@ -1611,17 +1806,37 @@
(insert "]"))))))
(goto-char (point-min))
(insert "{")
- ;; Wrap field names in double quotes and replace equal sign with
- ;; semicolon.
;; TODO: This breaks badly with foo= inside constants
(while (re-search-forward "\\([[:alpha:]-_]+\\)=" nil t)
(replace-match "\"\\1\":" nil nil))
(goto-char (point-max))
- (insert "}")
+ (insert "}")))
+
+(defun gdb-json-read-buffer (&optional fix-key fix-list)
+ "Prepare and parse GDB/MI output in current buffer with `json-read'.
+
+FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
+ (gdb-jsonify-buffer fix-key fix-list)
+ (save-excursion
(goto-char (point-min))
(let ((json-array-type 'list))
(json-read))))
+(defun gdb-json-string (string &optional fix-key fix-list)
+ "Prepare and parse STRING containing GDB/MI output with `json-read'.
+
+FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
+ (with-temp-buffer
+ (insert string)
+ (gdb-json-read-buffer fix-key fix-list)))
+
+(defun gdb-json-partial-output (&optional fix-key fix-list)
+ "Prepare and parse gdb-partial-output-buffer with `json-read'.
+
+FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'."
+ (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
+ (gdb-json-read-buffer fix-key fix-list)))
+
(defun gdb-pad-string (string padding)
(format (concat "%" (number-to-string padding) "s") string))
@@ -1634,25 +1849,31 @@
(setq values (append values (list (gdb-get-field struct field)))))))
(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
- handler-name)
+ handler-name
+ &optional signal-list)
"Define a trigger TRIGGER-NAME which sends GDB-COMMAND and sets
HANDLER-NAME as its handler. HANDLER-NAME is bound to current
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.
+
Normally the trigger defined by this command must be called from
the buffer where HANDLER-NAME must work. This should be done so
that buffer-local thread number may be used in GDB-COMMAND (by
calling `gdb-current-context-command').
-`gdb-bind-function-to-buffer' is used to achieve this, see how
-it's done in `gdb-get-buffer-create'.
+`gdb-bind-function-to-buffer' is used to achieve this, see
+`gdb-get-buffer-create'.
Triggers defined by this command are meant to be used as a
trigger argument when describing buffer types with
`gdb-set-buffer-rules'."
`(defun ,trigger-name (&optional signal)
- (if (not (gdb-pending-p
+ (when
+ (or (not ,signal-list)
+ (memq signal ,signal-list))
+ (when (not (gdb-pending-p
(cons (current-buffer) ',trigger-name)))
- (progn
(gdb-input
(list ,gdb-command
(gdb-bind-function-to-buffer ',handler-name
(current-buffer))))
@@ -1665,9 +1886,9 @@
Handlers are normally called from the buffers they put output in.
-Delete ((current-buffer) . TRIGGER) from `gdb-pending-triggers',
-erase current buffer and evaluate CUSTOM-DEFUN. Then
-`gdb-update-buffer-name' is called.
+Delete ((current-buffer) . TRIGGER-NAME) from
+`gdb-pending-triggers', erase current buffer and evaluate
+CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called.
If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
`(defun ,handler-name ()
@@ -1684,18 +1905,19 @@
'(set-window-point window p)))))
(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
- handler-name custom-defun)
+ handler-name custom-defun
+ &optional signal-list)
"Define trigger and handler.
TRIGGER-NAME trigger is defined to send GDB-COMMAND. See
-`def-gdb-auto-update-trigger'.
+`def-gdb-auto-update-trigger'. SIGNAL-LIST determines when
HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
`def-gdb-auto-update-handler'."
`(progn
(def-gdb-auto-update-trigger ,trigger-name
,gdb-command
- ,handler-name)
+ ,handler-name ,signal-list)
(def-gdb-auto-update-handler ,handler-name
,trigger-name ,custom-defun)))
@@ -1714,7 +1936,7 @@
(defun gdb-breakpoints-list-handler-custom ()
(let ((breakpoints-list (gdb-get-field
- (json-partial-output "bkpt" "script")
+ (gdb-json-partial-output "bkpt" "script")
'BreakpointTable 'body)))
(setq gdb-breakpoints-list nil)
(insert "Num\tType\t\tDisp\tEnb\tHits\tAddr What\n")
@@ -1730,7 +1952,7 @@
(let ((flag (gdb-get-field breakpoint 'enabled)))
(if (string-equal flag "y")
(propertize "y" 'face font-lock-warning-face)
- (propertize "n" 'face font-lock-type-face))) "\t"
+ (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)))
@@ -2026,7 +2248,8 @@
(def-gdb-trigger-and-handler
gdb-invalidate-threads "-thread-info"
- gdb-thread-list-handler gdb-thread-list-handler-custom)
+ gdb-thread-list-handler gdb-thread-list-handler-custom
+ '(update update-threads))
(gdb-set-buffer-rules
'gdb-threads-buffer
@@ -2037,20 +2260,24 @@
(defvar gdb-threads-font-lock-keywords
'(("in \\([^ ]+\\) (" (1 font-lock-function-name-face))
(" \\(stopped\\) in " (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'.")
(defvar gdb-threads-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'gdb-select-thread)
- (define-key map "s" 'gdb-display-stack-for-thread)
- (define-key map "S" 'gdb-frame-stack-for-thread)
+ (define-key map "f" 'gdb-display-stack-for-thread)
+ (define-key map "F" 'gdb-frame-stack-for-thread)
(define-key map "l" 'gdb-display-locals-for-thread)
(define-key map "L" 'gdb-frame-locals-for-thread)
(define-key map "r" 'gdb-display-registers-for-thread)
(define-key map "R" 'gdb-frame-registers-for-thread)
(define-key map "d" 'gdb-display-disassembly-for-thread)
(define-key map "D" 'gdb-frame-disassembly-for-thread)
+ (define-key map "i" 'gdb-interrupt-thread)
+ (define-key map "c" 'gdb-continue-thread)
+ (define-key map "s" 'gdb-step-thread)
map))
(defvar gdb-breakpoints-header
@@ -2073,45 +2300,52 @@
'gdb-invalidate-threads)
(defun gdb-thread-list-handler-custom ()
- (let* ((res (json-partial-output))
- (threads-list (gdb-get-field res 'threads))
- (current-thread (gdb-get-field res 'current-thread-id)))
+ (let* ((res (gdb-json-partial-output))
+ (threads-list (gdb-get-field res 'threads)))
(setq gdb-threads-list nil)
- (when (and current-thread
- (not (string-equal current-thread gdb-thread-number)))
- ;; Implicitly switch thread (in case previous one dies)
- (message (concat "GDB switched to another thread: " current-thread))
- (setq gdb-thread-number current-thread))
+ (setq gdb-running-threads-count 0)
+ (setq gdb-stopped-threads-count 0)
(set-marker gdb-thread-position nil)
- (dolist (thread threads-list)
+
+ (dolist (thread (reverse threads-list))
+ (let ((running (string-equal (gdb-get-field thread 'state) "running")))
(add-to-list 'gdb-threads-list
(cons (gdb-get-field thread 'id)
thread))
- (insert (apply 'format `("%s (%s) %s in %s "
- ,@(gdb-get-many-fields thread 'id 'target-id
'state)
- ,(gdb-get-field thread 'frame 'func))))
- ;; Arguments
- (insert "(")
+ (if running
+ (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)))))
+ (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)))
+ (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
(when (string-equal gdb-thread-number
(gdb-get-field thread 'id))
- (set-marker gdb-thread-position (line-beginning-position)))
- (newline))))
+ (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)))
(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 propery of the current line. If
+be the value of 'gdb-thread property of the current line. If
'gdb-thread is nil, error is signaled."
`(defun ,name ()
,(when doc doc)
@@ -2131,12 +2365,10 @@
,doc))
(def-gdb-thread-buffer-command gdb-select-thread
- (if (string-equal (gdb-get-field thread 'state) "running")
- (error "Cannot select running thread")
(let ((new-id (gdb-get-field thread 'id)))
- (setq gdb-thread-number new-id)
+ (gdb-setq-thread-number new-id)
(gdb-input (list (concat "-thread-select " new-id) 'ignore))
- (gdb-update)))
+ (gdb-update))
"Select the thread at current line of threads buffer.")
(def-gdb-thread-simple-buffer-command
@@ -2183,6 +2415,34 @@
"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
+`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
+ gdb-interrupt-thread
+ "-exec-interrupt"
+ "Interrupt thread at current line.")
+
+(def-gdb-thread-buffer-gdb-command
+ gdb-continue-thread
+ "-exec-continue"
+ "Continue thread at current line.")
+
+(def-gdb-thread-buffer-gdb-command
+ gdb-step-thread
+ "-exec-step"
+ "Step thread at current line.")
+
;;; Memory view
@@ -2255,7 +2515,7 @@
(error "Unknown format"))))
(defun gdb-read-memory-custom ()
- (let* ((res (json-partial-output))
+ (let* ((res (gdb-json-partial-output))
(err-msg (gdb-get-field res 'msg)))
(if (not err-msg)
(let ((memory (gdb-get-field res 'memory)))
@@ -2635,6 +2895,7 @@
"Major mode for GDB disassembly information.
\\{gdb-disassembly-mode-map}"
+ ;; TODO Rename overlay variable for disassembly mode
(add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
(setq fringes-outside-margins t)
(setq gdb-overlay-arrow-position (make-marker))
@@ -2646,7 +2907,7 @@
(defun gdb-disassembly-handler-custom ()
(let* ((pos 1)
(address (gdb-get-field (gdb-current-buffer-frame) 'addr))
- (res (json-partial-output))
+ (res (gdb-json-partial-output))
(instructions (gdb-get-field res 'asm_insns))
(last-instr (car (last instructions)))
(column-padding (+ 2 (string-width
@@ -2783,7 +3044,7 @@
(from (insert (format " of %s" from))))))
(defun gdb-stack-list-frames-custom ()
- (let* ((res (json-partial-output "frame"))
+ (let* ((res (gdb-json-partial-output "frame"))
(stack (gdb-get-field res 'stack)))
(dolist (frame stack)
(insert (apply 'format `("%s in %s" ,@(gdb-get-many-fields frame
'level 'func))))
@@ -2904,7 +3165,7 @@
;; 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 (json-partial-output) 'locals)))
+ (let ((locals-list (gdb-get-field (gdb-json-partial-output) 'locals)))
(dolist (local locals-list)
(let ((name (gdb-get-field local 'name))
(value (gdb-get-field local 'value))
@@ -2981,7 +3242,7 @@
'gdb-invalidate-registers)
(defun gdb-registers-handler-custom ()
- (let ((register-values (gdb-get-field (json-partial-output)
'register-values))
+ (let ((register-values (gdb-get-field (gdb-json-partial-output)
'register-values))
(register-names-list (reverse gdb-register-names)))
(dolist (register register-values)
(let* ((register-number (gdb-get-field register 'number))
@@ -3039,14 +3300,14 @@
(defun gdb-changed-registers-handler ()
(gdb-delete-pending 'gdb-get-changed-registers)
(setq gdb-changed-registers nil)
- (dolist (register-number (gdb-get-field (json-partial-output)
'changed-registers))
+ (dolist (register-number (gdb-get-field (gdb-json-partial-output)
'changed-registers))
(push register-number gdb-changed-registers)))
(defun gdb-register-names-handler ()
;; Don't use gdb-pending-triggers because this handler is called
;; only once (in gdb-init-1)
(setq gdb-register-names nil)
- (dolist (register-name (gdb-get-field (json-partial-output) 'register-names))
+ (dolist (register-name (gdb-get-field (gdb-json-partial-output)
'register-names))
(push register-name gdb-register-names))
(setq gdb-register-names (reverse gdb-register-names)))
@@ -3078,7 +3339,7 @@
"Sets `gdb-pc-address', `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 (json-partial-output) '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))
@@ -3165,9 +3426,8 @@
(define-key menu [breakpoints]
'("Breakpoints" . gdb-frame-breakpoints-buffer)))
-(let ((menu (make-sparse-keymap "GDB-MI")))
- (define-key gud-menu-map [mi]
- `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi)))
+(let ((menu (make-sparse-keymap "GDB-MI"))
+ (submenu (make-sparse-keymap "GUD thread control mode")))
(define-key menu [gdb-customize]
'(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
:help "Customize Gdb Graphical Mode options."))
@@ -3177,7 +3437,37 @@
:button (:toggle . gdb-many-windows)))
(define-key menu [gdb-restore-windows]
'(menu-item "Restore Window Layout" gdb-restore-windows
- :help "Restore standard layout for debug session.")))
+ :help "Restore standard layout for debug session."))
+ (define-key menu [sep1]
+ '(menu-item "--"))
+ (define-key submenu [all-threads]
+ '(menu-item "All threads"
+ (lambda ()
+ (interactive)
+ (setq gdb-gud-control-all-threads t))
+ :help "GUD start/stop commands apply to all threads"
+ :button (:radio . gdb-gud-control-all-threads)))
+ (define-key submenu [current-thread]
+ '(menu-item "Current thread"
+ (lambda ()
+ (interactive)
+ (setq gdb-gud-control-all-threads nil))
+ :help "GUD start/stop commands apply to current thread only"
+ :button (:radio . (not gdb-gud-control-all-threads))))
+ (define-key menu [thread-control]
+ `("GUD thread control mode" . ,submenu))
+ (define-key gud-menu-map [mi]
+ `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi)))
+ (define-key menu [gdb-switch-when-another-stopped]
+ (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped
gdb-switch-when-another-stopped
+ "Automatically switch to stopped thread"
+ "GDB thread switching %s"
+ "Switch to stopped thread"))
+ (define-key menu [gdb-non-stop]
+ (menu-bar-make-toggle gdb-toggle-non-stop gdb-non-stop
+ "Non-stop mode"
+ "GDB non-stop mode %s"
+ "Allow examining stopped threads while others
continue to execute")))
(defun gdb-frame-gdb-buffer ()
"Display GUD buffer in a new frame."
@@ -3299,6 +3589,9 @@
(setq gdb-stack-position nil)
(setq overlay-arrow-variable-list
(delq 'gdb-stack-position overlay-arrow-variable-list))
+ (setq gdb-thread-position nil)
+ (setq overlay-arrow-variable-list
+ (delq 'gdb-thread-position overlay-arrow-variable-list))
(if (boundp 'speedbar-frame) (speedbar-timer-fn))
(setq gud-running nil)
(setq gdb-active-process nil)
Index: progmodes/gud.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/gud.el,v
retrieving revision 1.165
retrieving revision 1.166
diff -u -b -r1.165 -r1.166
--- progmodes/gud.el 3 Aug 2009 22:07:50 -0000 1.165
+++ progmodes/gud.el 4 Aug 2009 15:07:27 -0000 1.166
@@ -136,10 +136,13 @@
(defun gud-stop-subjob ()
(interactive)
(with-current-buffer gud-comint-buffer
- (if (string-equal gud-target-name "emacs")
- (comint-stop-subjob)
- (if (eq gud-minor-mode 'jdb)
- (gud-call "suspend")
+ (cond ((string-equal gud-target-name "emacs")
+ (comint-stop-subjob))
+ ((eq gud-minor-mode 'jdb)
+ (gud-call "suspend"))
+ ((eq gud-minor-mode 'gdbmi)
+ (gdb-gud-context-call "-exec-interrupt" nil nil t))
+ (t
(comint-interrupt-subjob)))))
(easy-mmode-defmap gud-menu-map
@@ -156,12 +159,22 @@
:enable (not gud-running)
:visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
- :visible (and (not gud-running)
- (eq gud-minor-mode 'gdbmi)))
+ :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)))))
([stop] menu-item "Stop" gud-stop-subjob
:visible (or (not (memq gud-minor-mode '(gdbmi pdb)))
- (and gud-running
- (eq gud-minor-mode 'gdbmi))))
+ (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))))))
([until] menu-item "Continue to selection" gud-until
:enable (not gud-running)
:visible (and (memq gud-minor-mode '(gdbmi gdb perldb))
@@ -248,11 +261,22 @@
:visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
([menu-bar go] menu-item
,(propertize " go " 'face 'font-lock-doc-face) gud-go
- :visible (and (not gud-running)
- (eq gud-minor-mode 'gdbmi)))
+ :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)))))
([menu-bar stop] menu-item
,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob
- :visible (or gud-running
+ :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))))
(not (eq gud-minor-mode 'gdbmi))))
([menu-bar print]
. (,(propertize "print" 'face 'font-lock-doc-face) . gud-print))
- [Emacs-diffs] emacs/lisp ChangeLog progmodes/gdb-mi.el progmo...,
Dmitry Dzhus <=