gdb mode sends to gdb on its own behalf.")
(defvar gdb-pending-triggers '()
- "A list of trigger functions that have run later than their output handlers.")
+ "A list of trigger functions which have not yet been handled.
+
+Elements are either function names or pairs (buffer . function)")
+
+(defmacro gdb-add-pending (item)
+ `(push ,item gdb-pending-triggers))
+(defmacro gdb-pending-p (item)
+ `(member ,item gdb-pending-triggers))
+(defmacro gdb-delete-pending (item)
+ `(setq gdb-pending-triggers
+ (delete ,item gdb-pending-triggers)))
(defcustom gdb-debug-log-max 128
"Maximum size of `gdb-debug-log'. If nil, size is unlimited."
(defun gdb-speedbar-update ()
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
- (not (member 'gdb-speedbar-timer gdb-pending-triggers)))
+ (not (gdb-pending-p 'gdb-speedbar-timer)))
;; Dummy command to update speedbar even when idle.
(gdb-input (list "-environment-pwd" 'gdb-speedbar-timer-fn))
;; Keep gdb-pending-triggers non-nil till end.
- (push 'gdb-speedbar-timer gdb-pending-triggers)))
+ (gdb-add-pending 'gdb-speedbar-timer)))
(defun gdb-speedbar-timer-fn ()
(if gdb-speedbar-auto-raise
(raise-frame speedbar-frame))
- (setq gdb-pending-triggers
- (delq 'gdb-speedbar-timer gdb-pending-triggers))
+ (gdb-delete-pending 'gdb-speedbar-timer)
(speedbar-timer-fn))
(defun gdb-var-evaluate-expression-handler (varnum changed)
; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-update ()
- (if (not (member 'gdb-var-update gdb-pending-triggers))
+ (if (not (gdb-pending-p 'gdb-var-update))
(gdb-input
(list "-var-update --all-values *" 'gdb-var-update-handler)))
- (push 'gdb-var-update gdb-pending-triggers))
+ (gdb-add-pending 'gdb-var-update))
(defconst gdb-var-update-regexp
"{.*?name=\"\\(.*?\\)\".*?,\\(?:value=\\(\".*?\"\\),\\)?.*?\
(read (match-string 2))))
((string-equal match "invalid")
(gdb-var-delete-1 varnum)))))))
- (setq gdb-pending-triggers
- (delq 'gdb-var-update gdb-pending-triggers))
+ (gdb-delete-pending 'gdb-var-update)
(gdb-speedbar-update))
(defun gdb-speedbar-expand-node (text token indent)
"Get a specific GDB buffer.
In that buffer, `gdb-buffer-type' must be equal to KEY and
-`gdb-thread-number' (if provided) must be equal to THREAD."
+`gdb-thread-number' (if provided) must be equal to THREAD.
+
+When THREAD is nil, global `gdb-thread-number' value is used."
+ (when (not thread) (setq thread gdb-thread-number))
(catch 'found
(dolist (buffer (buffer-list) nil)
(with-current-buffer buffer
(when (and (eq gdb-buffer-type key)
- (or (not thread)
- (equal gdb-thread-number thread)))
+ (equal gdb-thread-number thread))
(throw 'found buffer))))))
(defun gdb-get-buffer-create (key &optional thread)
(process-send-string (get-buffer-process gud-comint-buffer)
(concat (car item) "\n")))
-(defmacro gdb-current-context-command (command)
+(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))
+
+(defun gdb-current-context-buffer-name (name)
+ "Add thread information and asterisks to string NAME."
+ (concat "*" name
+ (if (local-variable-p 'gdb-thread-number)
+ " (bound to thread "
+ " (current thread ")
+ gdb-thread-number ")*"))
\f
(defcustom gud-gdb-command-name "gdb -i=mi"
(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
handler-name)
`(defun ,trigger-name (&optional signal)
- (if (not (member (cons (current-buffer) ',trigger-name)
- gdb-pending-triggers))
+ (if (not (gdb-pending-p
+ (cons (current-buffer) ',trigger-name)))
(progn
(gdb-input
(list ,gdb-command
(gdb-bind-function-to-buffer ',handler-name (current-buffer))))
- (push (cons (current-buffer) ',trigger-name) gdb-pending-triggers)))))
+ (gdb-add-pending (cons (current-buffer) ',trigger-name))))))
;; Used by disassembly buffer only, the rest use
;; def-gdb-trigger-and-handler
Delete ((current-buffer) . TRIGGER) from `gdb-pending-triggers',
erase current buffer and evaluate CUSTOM-DEFUN."
`(defun ,handler-name ()
- (setq gdb-pending-triggers
- (delq (cons (current-buffer) ',trigger-name)
- gdb-pending-triggers))
+ (gdb-delete-pending (cons (current-buffer) ',trigger-name))
(let* ((buffer-read-only nil))
(erase-buffer)
(,custom-defun)
'gdb-invalidate-breakpoints)
(defun gdb-breakpoints-list-handler-custom ()
- (setq gdb-pending-triggers (delq 'gdb-invalidate-breakpoints
- gdb-pending-triggers))
(let ((breakpoints-list (gdb-get-field
(json-partial-output "bkpt" "script")
'BreakpointTable 'body)))
(defvar gdb-threads-mode-map
(let ((map (make-sparse-keymap)))
(define-key map " " 'gdb-select-thread)
+ (define-key map "s" 'gdb-display-stack-for-thread)
+ (define-key map "S" '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)
map))
(defvar gdb-breakpoints-header
(set-marker gdb-thread-position (line-beginning-position)))
(newline))))
-(defun gdb-select-thread ()
- "Select the thread at current line of threads buffer."
- (interactive)
- (save-excursion
- (beginning-of-line)
- (let ((thread (get-text-property (point) 'gdb-thread)))
- (if 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)
- (gud-basic-call (concat "-thread-select " new-id))))
- (error "Not recognized as thread line")))))
+(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
+'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
+ (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)
+ (gud-basic-call (concat "-thread-select " new-id))))
+ "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-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.")
\f
;;; Memory view
(forward-line 1)))))
(defun gdb-stack-buffer-name ()
- (concat "*stack frames of " (gdb-get-target-string) " (thread " gdb-thread-number ")*"))
+ (gdb-current-context-buffer-name
+ (concat "stack frames of " (gdb-get-target-string))))
(def-gdb-display-buffer
gdb-display-stack-buffer
'gdb-locals-mode
'gdb-invalidate-locals)
-(defconst gdb-stack-list-locals-regexp
- (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))
-
(defvar gdb-locals-watch-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
'gdb-invalidate-locals)
(defun gdb-locals-buffer-name ()
- (concat "*locals of " (gdb-get-target-string) "*"))
+ (gdb-current-context-buffer-name
+ (concat "locals of " (gdb-get-target-string))))
(def-gdb-display-buffer
gdb-display-locals-buffer
'gdb-invalidate-registers)
(defun gdb-registers-buffer-name ()
- (concat "*registers of " (gdb-get-target-string) "*"))
+ (gdb-current-context-buffer-name
+ (concat "registers of " (gdb-get-target-string))))
(def-gdb-display-buffer
gdb-display-registers-buffer
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
(if (and (gdb-get-buffer 'gdb-registers-buffer)
- (not (member 'gdb-get-changed-registers gdb-pending-triggers)))
+ (not (gdb-pending-p 'gdb-get-changed-registers)))
(progn
(gdb-input
(list
"-data-list-changed-registers"
'gdb-changed-registers-handler))
- (push 'gdb-get-changed-registers gdb-pending-triggers))))
+ (gdb-add-pending 'gdb-get-changed-registers))))
(defun gdb-changed-registers-handler ()
- (setq gdb-pending-triggers
- (delq 'gdb-get-changed-registers gdb-pending-triggers))
+ (gdb-delete-pending 'gdb-get-changed-registers)
(setq gdb-changed-registers nil)
(dolist (register-number (gdb-get-field (json-partial-output) 'changed-registers))
(push register-number gdb-changed-registers)))
(propertize "ready" 'face font-lock-variable-name-face)))
(defun gdb-get-selected-frame ()
- (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
+ (if (not (gdb-pending-p 'gdb-get-selected-frame))
(progn
(gdb-input
(list (gdb-current-context-command "-stack-info-frame") 'gdb-frame-handler))
gdb-pending-triggers))))
(defun gdb-frame-handler ()
- (setq gdb-pending-triggers
- (delq 'gdb-get-selected-frame gdb-pending-triggers))
+ (gdb-delete-pending 'gdb-get-selected-frame)
(let ((frame (gdb-get-field (json-partial-output) 'frame)))
(when frame
(setq gdb-frame-number (gdb-get-field frame 'level))