emacs: lisp/progmodes/gdb-mi.el comparison

comparison lisp/progmodes/gdb-mi.el @ 104153:957779ca8cea

* progmodes/gdb-mi.el (gdb-get-buffer, gdb-get-buffer-create): Argument `key' renamed to `buffer-type'. (gdb-current-context-buffer-name): Do not add thread info to buffer name when no thread is selected. (gdbmi-record-list, gdb-shell): Try to handle GDB `shell' command (bug 3794). (gdb-thread-selected): Handle `=thread-selected' notification. (gdb-wait-for-pending): New macro to deal with congestion problems. (gdb-breakpoints-list-handler-custom): Don't fail on pending breakpoints. (gdb-invalidate-disassembly): Use 'fullname instead of 'file. This fixes problem similar to one described in bug 3947. (gud-menu-map): More menu items. (gdb-init-1): Reset `gdb-thread-number' to nil.

author	Dmitry Dzhus <dima@sphinx.net.ru>
date	Tue, 04 Aug 2009 15:51:58 +0000
parents	22070e4cdf2a
children	87373993f3bd

comparison

equal deleted inserted replaced

-:0727b216c5bf
+:957779ca8cea
 `(member ,item gdb-pending-triggers))
 (defmacro gdb-delete-pending (item)
 `(setq gdb-pending-triggers
 (delete ,item gdb-pending-triggers)))
+(defvar gdb-wait-for-pending-timeout 0.5)
+(defmacro gdb-wait-for-pending (&rest body)
+"Wait until `gdb-pending-triggers' is empty and execute BODY.
+This function checks `gdb-pending-triggers' value every
+`gdb-wait-for-pending' seconds."
+(run-with-timer
+gdb-wait-for-pending-timeout nil
+`(lambda ()
+(if (not gdb-pending-triggers)
+(progn
+,@body)
+(gdb-wait-for-pending ,@body)))))
 (defcustom gdb-debug-log-max 128
 "Maximum size of `gdb-debug-log'.  If nil, size is unlimited."
 :group 'gdb
 :type '(choice (integer :tag "Number of elements")
 		 (const   :tag "Unlimited" nil))
 (defun gdb-init-1 ()
 ;; (re-)initialise
 (setq gdb-selected-frame nil
 	gdb-frame-number nil
+gdb-thread-number nil
 	gdb-var-list nil
 	gdb-pending-triggers nil
 	gdb-output-sink 'user
 	gdb-location-alist nil
 	gdb-source-file-list nil
 (defun gdb-current-buffer-frame ()
 "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)
+(defun gdb-get-buffer (buffer-type &optional thread)
 "Get a specific GDB buffer.
-In that buffer, `gdb-buffer-type' must be equal to KEY and
+In that buffer, `gdb-buffer-type' must be equal to BUFFER-TYPE
-`gdb-thread-number' (if provided) must be equal to THREAD."
+and `gdb-thread-number' (if provided) must be equal to THREAD."
 (catch 'found
 (dolist (buffer (buffer-list) nil)
 (with-current-buffer buffer
-(when (and (eq gdb-buffer-type key)
+(when (and (eq gdb-buffer-type buffer-type)
 (or (not thread)
 (equal gdb-thread-number thread)))
 (throw 'found buffer))))))
-(defun gdb-get-buffer-create (key &optional thread)
+(defun gdb-get-buffer-create (buffer-type &optional thread)
-"Create a new GDB buffer of the type specified by KEY.
+"Create a new GDB buffer of the type specified by BUFFER-TYPE.
-The key should be one of the cars in `gdb-buffer-rules'.
+The buffer-type should be one of the cars in `gdb-buffer-rules'.
 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 "
-(or (gdb-get-buffer key thread)
+(or (gdb-get-buffer buffer-type thread)
-(let ((rules (assoc key gdb-buffer-rules))
+(let ((rules (assoc buffer-type gdb-buffer-rules))
 	     (new (generate-new-buffer "limbo")))
 	(with-current-buffer new
 	  (let ((mode (gdb-rules-buffer-mode rules))
 (trigger (gdb-rules-update-trigger rules)))
 	    (when mode (funcall mode))
-	    (setq gdb-buffer-type key)
+	    (setq gdb-buffer-type buffer-type)
 (when thread
 (set (make-local-variable 'gdb-thread-number) thread))
 	    (set (make-local-variable 'gud-minor-mode)
 		 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
 	    (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
 (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."
+"Add thread information and asterisks to string NAME.
+If `gdb-thread-number' is nil, just wrap NAME in asterisks."
 (concat "*" name
-(if (local-variable-p 'gdb-thread-number)
+(format
-" (bound to thread "
+(cond ((local-variable-p 'gdb-thread-number) " (bound to thread %s)")
-" (current thread ")
+(gdb-thread-number " (current thread %s)")
-gdb-thread-number ")*"))
+(t ""))
+gdb-thread-number)
+"*"))
 (defcustom gud-gdb-command-name "gdb -i=mi"
 "Default command to execute an executable under the GDB debugger."
 :type 'string
 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"
+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-console . "~\\(\".*?\"\\)\n")
 (gdb-internals . "&\\(\".*?\"\\)\n")
 (gdb-stopped . "\\*stopped,?\\(.*?\\)\n")
 (gdb-running . "\\*running,\\(.*?\n\\)")
 (gdb-thread-created . "=thread-created,\\(.*?\n\\)")
-(gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")))
+(gdb-thread-selected . "=thread-selected,\\(.*?\\)\n")
+(gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")
+(gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n")
+(gdb-shell . "\\(\\(?:^.+\n\\)+\\)")))
 (defun gud-gdbmi-marker-filter (string)
 "Filter GDB/MI output."
 ;; Record transactions if logging is enabled.
 gdb-filter-output))
 (defun gdb-gdb (output-field))
+(defun gdb-shell (output-field)
+(let ((gdb-output-sink gdb-output-sink))
+(setq gdb-filter-output
+(concat output-field gdb-filter-output))))
+(defun gdb-ignored-notification (output-field))
 ;; 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))
+(defun gdb-thread-selected (output-field)
+"Handler for =thread-selected MI output record.
+Sets `gdb-thread-number' to new id."
+(let* ((result (gdb-json-string output-field))
+(thread-id (gdb-get-field result 'id)))
+(gdb-setq-thread-number thread-id)
+(gdb-wait-for-pending
+(gdb-update))))
 (defun gdb-running (output-field)
 (setq gdb-inferior-status "running")
 (gdb-force-mode-line-update
 (propertize gdb-inferior-status 'face font-lock-type-face))
 (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)))
+(let ((at (gdb-get-field breakpoint 'at))
-(cond ((not 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"))))
+help-echo "mouse-2, RET: visit breakpoint")))))
-(at (insert (concat " " at)))
-(t (insert (gdb-get-field breakpoint 'original-location)))))
 (add-text-properties (line-beginning-position)
 (line-end-position)
 `(gdb-breakpoint ,breakpoint))
 (newline))
-(gdb-place-breakpoints)))
+(gdb-place-breakpoints))))
 ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
 (defun gdb-place-breakpoints ()
 (let ((flag) (bptno))
 ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
 (let ((map (make-sparse-keymap)))
 (define-key map (vector 'header-line mouse) function)
 (define-key map (vector 'header-line 'down-mouse-1) 'ignore)
 map))
+;; uses "-thread-info". Needs GDB 7.0 onwards.
+;;; Threads view
+(defun gdb-jump-to (file line)
+(find-file-other-window file)
+(goto-line line))
+(define-button-type 'gdb-file-button
+'help-echo "Push to jump to source code"
+;  'face 'bold
+'action
+(lambda (b)
+(gdb-jump-to (button-get b 'file)
+(button-get b 'line))))
+(defun gdb-insert-file-location-button (file line)
+"Insert text button which allows jumping to FILE:LINE.
+FILE is a full path."
+(insert-text-button
+(format "%s:%d" (file-name-nondirectory file) line)
+:type 'gdb-file-button
+'file file
+'line line))
+(defun gdb-threads-buffer-name ()
+(concat "*threads of " (gdb-get-target-string) "*"))
+(def-gdb-display-buffer
+gdb-display-threads-buffer
+'gdb-threads-buffer
+"Display GDB threads.")
+(def-gdb-frame-for-buffer
+gdb-frame-threads-buffer
+'gdb-threads-buffer
+"Display GDB threads in a new frame.")
+(def-gdb-trigger-and-handler
+gdb-invalidate-threads "-thread-info"
+gdb-thread-list-handler gdb-thread-list-handler-custom
+'(update update-threads))
+(gdb-set-buffer-rules
+'gdb-threads-buffer
+'gdb-threads-buffer-name
+'gdb-threads-mode
+'gdb-invalidate-threads)
+(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 "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))
 (defmacro gdb-propertize-header (name buffer help-echo mouse-face face)
 `(propertize ,name
 	       'help-echo ,help-echo
 	       'mouse-face ',mouse-face
 	       'face ',face
 		    (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))))))
+(defvar gdb-breakpoints-header
+(list
+(gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
+			  nil nil mode-line)
+" "
+(gdb-propertize-header "Threads" gdb-threads-buffer
+			  "mouse-1: select" mode-line-highlight mode-line-inactive)))
+(define-derived-mode gdb-threads-mode gdb-parent-mode "Threads"
+"Major mode for GDB threads.
+\\{gdb-threads-mode-map}"
+(setq gdb-thread-position (make-marker))
+(add-to-list 'overlay-arrow-variable-list 'gdb-thread-position)
+(setq header-line-format gdb-breakpoints-header)
+(set (make-local-variable 'font-lock-defaults)
+'(gdb-threads-font-lock-keywords))
+(run-mode-hooks 'gdb-threads-mode-hook)
+'gdb-invalidate-threads)
+(defun gdb-thread-list-handler-custom ()
+(let* ((res (gdb-json-partial-output))
+(threads-list (gdb-get-field res 'threads)))
+(setq gdb-threads-list nil)
+(setq gdb-running-threads-count 0)
+(setq gdb-stopped-threads-count 0)
+(set-marker gdb-thread-position nil)
+(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))
+(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)))))
+(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
+(when (string-equal gdb-thread-number
+(gdb-get-field thread 'id))
+(set-marker gdb-thread-position (line-beginning-position))))
+(newline))
+;; We update gud-running here because we need to make sure that
+;; gdb-threads-list is up-to-date
+(gdb-update-gud-running)))
+(defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc)
+"Define a NAME command which will act upon thread on the current line.
+CUSTOM-DEFUN may use locally bound `thread' variable, which will
+be the value of 'gdb-thread property of the current line. If
+'gdb-thread is nil, error is signaled."
+`(defun ,name ()
+,(when doc doc)
+(interactive)
+(save-excursion
+(beginning-of-line)
+(let ((thread (get-text-property (point) 'gdb-thread)))
+(if thread
+,custom-defun
+(error "Not recognized as thread line"))))))
+(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional doc)
+"Define a NAME which will call BUFFER-COMMAND with id of thread
+on the current line."
+`(def-gdb-thread-buffer-command ,name
+(,buffer-command (gdb-get-field thread 'id))
+,doc))
+(def-gdb-thread-buffer-command gdb-select-thread
+(let ((new-id (gdb-get-field thread 'id)))
+(gdb-setq-thread-number new-id)
+(gdb-input (list (concat "-thread-select " new-id) 'ignore))
+(gdb-update))
+"Select the thread at current line of threads buffer.")
+(def-gdb-thread-simple-buffer-command
+gdb-display-stack-for-thread
+gdb-display-stack-buffer
+"Display stack buffer for the thread at current line.")
+(def-gdb-thread-simple-buffer-command
+gdb-display-locals-for-thread
+gdb-display-locals-buffer
+"Display locals buffer for the thread at current line.")
+(def-gdb-thread-simple-buffer-command
+gdb-display-registers-for-thread
+gdb-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
+"Display disassembly buffer for the thread at current line.")
+(def-gdb-thread-simple-buffer-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
+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
+gdb-frame-registers-for-thread
+gdb-frame-registers-buffer
+"Display a new frame with registers buffer for the thread at
+current line.")
+(def-gdb-thread-buffer-simple-command
+gdb-frame-disassembly-for-thread
+gdb-frame-disassembly-buffer
+"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.")
 (defun gdb-set-header (buffer)
 (cond ((eq buffer 'gdb-locals-buffer)
 	 (list
 	  (gdb-propertize-header "Locals" gdb-locals-buffer
 	  (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
 				 "mouse-1: select" mode-line-highlight mode-line-inactive)
 	  " "
 	  (gdb-propertize-header "Threads" gdb-threads-buffer
 				 nil nil mode-line)))))
-;; 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) "*"))
-(def-gdb-display-buffer
-gdb-display-threads-buffer
-'gdb-threads-buffer
-"Display GDB threads.")
-(def-gdb-frame-for-buffer
-gdb-frame-threads-buffer
-'gdb-threads-buffer
-"Display GDB threads in a new frame.")
-(def-gdb-trigger-and-handler
-gdb-invalidate-threads "-thread-info"
-gdb-thread-list-handler gdb-thread-list-handler-custom
-'(update update-threads))
-(gdb-set-buffer-rules
-'gdb-threads-buffer
-'gdb-threads-buffer-name
-'gdb-threads-mode
-'gdb-invalidate-threads)
-(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 "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
-(list
-(gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
-			  nil nil mode-line)
-" "
-(gdb-propertize-header "Threads" gdb-threads-buffer
-			  "mouse-1: select" mode-line-highlight mode-line-inactive)))
-(define-derived-mode gdb-threads-mode gdb-parent-mode "Threads"
-"Major mode for GDB threads.
-\\{gdb-threads-mode-map}"
-(setq gdb-thread-position (make-marker))
-(add-to-list 'overlay-arrow-variable-list 'gdb-thread-position)
-(setq header-line-format gdb-breakpoints-header)
-(set (make-local-variable 'font-lock-defaults)
-'(gdb-threads-font-lock-keywords))
-(run-mode-hooks 'gdb-threads-mode-hook)
-'gdb-invalidate-threads)
-(defun gdb-thread-list-handler-custom ()
-(let* ((res (gdb-json-partial-output))
-(threads-list (gdb-get-field res 'threads)))
-(setq gdb-threads-list nil)
-(setq gdb-running-threads-count 0)
-(setq gdb-stopped-threads-count 0)
-(set-marker gdb-thread-position nil)
-(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))
-(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)))))
-(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
-(when (string-equal gdb-thread-number
-(gdb-get-field thread 'id))
-(set-marker gdb-thread-position (line-beginning-position))))
-(newline))
-;; We update gud-running here because we need to make sure that
-;; gdb-threads-list is up-to-date
-(gdb-update-gud-running)))
-(defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc)
-"Define a NAME command which will act upon thread on the current line.
-CUSTOM-DEFUN may use locally bound `thread' variable, which will
-be the value of 'gdb-thread property of the current line. If
-'gdb-thread is nil, error is signaled."
-`(defun ,name ()
-,(when doc doc)
-(interactive)
-(save-excursion
-(beginning-of-line)
-(let ((thread (get-text-property (point) 'gdb-thread)))
-(if thread
-,custom-defun
-(error "Not recognized as thread line"))))))
-(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional doc)
-"Define a NAME which will call BUFFER-COMMAND with id of thread
-on the current line."
-`(def-gdb-thread-buffer-command ,name
-(,buffer-command (gdb-get-field thread 'id))
-,doc))
-(def-gdb-thread-buffer-command gdb-select-thread
-(let ((new-id (gdb-get-field thread 'id)))
-(gdb-setq-thread-number new-id)
-(gdb-input (list (concat "-thread-select " new-id) 'ignore))
-(gdb-update))
-"Select the thread at current line of threads buffer.")
-(def-gdb-thread-simple-buffer-command
-gdb-display-stack-for-thread
-gdb-display-stack-buffer
-"Display stack buffer for the thread at current line.")
-(def-gdb-thread-simple-buffer-command
-gdb-display-locals-for-thread
-gdb-display-locals-buffer
-"Display locals buffer for the thread at current line.")
-(def-gdb-thread-simple-buffer-command
-gdb-display-registers-for-thread
-gdb-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
-"Display disassembly buffer for the thread at current line.")
-(def-gdb-thread-simple-buffer-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
-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
-gdb-frame-registers-for-thread
-gdb-frame-registers-buffer
-"Display a new frame with registers buffer for the thread at
-current line.")
-(def-gdb-thread-buffer-simple-command
-gdb-frame-disassembly-for-thread
-gdb-frame-disassembly-buffer
-"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
 (defcustom gdb-memory-rows 8
 'gdb-disassembly-buffer
 "Display disassembly in a new frame.")
 (def-gdb-auto-update-trigger gdb-invalidate-disassembly
 (let* ((frame (gdb-current-buffer-frame))
-(file (gdb-get-field frame 'file))
+(file (gdb-get-field frame 'fullname))
 (line (gdb-get-field frame 'line)))
 (when file
 (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
 gdb-disassembly-handler)
 ;; Insert first prompt.
 (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
 ;;;; Window management
 (defun gdb-display-buffer (buf dedicated &optional frame)
+"Show buffer BUF.
+If BUF is already displayed in some window, show it, deiconifying
+the frame if necessary. Otherwise, find least recently used
+window and show BUF there, if the window is not used for GDB
+already, in which case that window is splitted first."
 (let ((answer (get-buffer-window buf (or frame 0))))
 (if answer
 	(display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary.
 (let ((window (get-lru-window)))
 	(if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
 (define-key menu [breakpoints]
 '("Breakpoints" . gdb-frame-breakpoints-buffer)))
-(let ((menu (make-sparse-keymap "GDB-MI"))
+(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."))
 (define-key menu [gdb-many-windows]
 '(menu-item "Display Other Windows" gdb-many-windows
 (define-key menu [gdb-restore-windows]
 '(menu-item "Restore Window Layout" gdb-restore-windows
 	      :help "Restore standard layout for debug session."))
 (define-key menu [sep1]
 '(menu-item "--"))
-(define-key submenu [all-threads]
+(define-key menu [all-threads]
-'(menu-item "All threads"
+'(menu-item "GUD controls 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]
+(define-key menu [current-thread]
-'(menu-item "Current thread"
+'(menu-item "GUD controls 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]
+(define-key menu [sep2]
-`("GUD thread control mode" . ,submenu))
+'(menu-item "--"))
-(define-key gud-menu-map [mi]
+(define-key menu [gdb-customize-reasons]
-`(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi)))
+'(menu-item "Customize switching..."
+(lambda ()
+(interactive)
+(customize-option 'gdb-switch-reasons))))
 (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]
+(define-key gud-menu-map [mi]
-(menu-bar-make-toggle gdb-toggle-non-stop gdb-non-stop
+`(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi))))
-"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."
 (interactive)
 (let ((special-display-regexps (append special-display-regexps '(".*")))

Mercurial > emacs

comparison lisp/progmodes/gdb-mi.el @ 104153:957779ca8cea