Commit e7086683 authored by Dmitry Dzhus's avatar Dmitry Dzhus
Browse files

(gdb-add-pending, gdb-pending-p, gdb-delete-pending): Macros to

handle pending triggers.
(gdb-threads-mode-map, def-gdb-thread-buffer-command)
(def-gdb-thread-buffer-simple-command)
(gdb-display-stack-for-thread, gdb-display-locals-for-thread)
(gdb-display-registers-for-thread, gdb-frame-stack-for-thread)
(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.
parent a5c9f540
......@@ -26,6 +26,15 @@
(def-gdb-trigger-and-handler): New macro to define trigger-handler
pair for GDB buffer.
(gdb-stack-buffer-name): Add thread information.
(gdb-add-pending, gdb-pending-p, gdb-delete-pending): Macros to
handle pending triggers.
(gdb-threads-mode-map, def-gdb-thread-buffer-command)
(def-gdb-thread-buffer-simple-command)
(gdb-display-stack-for-thread, gdb-display-locals-for-thread)
(gdb-display-registers-for-thread, gdb-frame-stack-for-thread)
(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.
2009-08-04 Michael Albinus <michael.albinus@gmx.de>
......
......@@ -191,7 +191,17 @@ Possible values are these symbols:
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."
......@@ -724,17 +734,16 @@ With arg, enter name of variable to be watched in the minibuffer."
(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)
......@@ -831,10 +840,10 @@ numchild=\"\\(.+?\\)\".*?,value=\\(\".*?\"\\).*?,type=\"\\(.+?\\)\".*?}")
; 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=\\(\".*?\"\\),\\)?.*?\
......@@ -859,8 +868,7 @@ in_scope=\"\\(.*?\\)\".*?}")
(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)
......@@ -916,13 +924,15 @@ INDENT is the current indentation depth."
"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)
......@@ -1222,11 +1232,19 @@ static char *magick[] = {
(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 ")*"))
(defcustom gud-gdb-command-name "gdb -i=mi"
......@@ -1567,13 +1585,13 @@ are not guaranteed."
(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
......@@ -1583,9 +1601,7 @@ are not guaranteed."
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)
......@@ -1619,8 +1635,6 @@ HANDLER-NAME handler uses customization of 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)))
......@@ -1946,6 +1960,12 @@ FILE is a full path."
(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
......@@ -2005,19 +2025,69 @@ FILE is a full path."
(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.")
;;; Memory view
......@@ -2654,7 +2724,8 @@ member."
(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
......@@ -2724,9 +2795,6 @@ member."
'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)
......@@ -2809,7 +2877,8 @@ member."
'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
......@@ -2874,7 +2943,8 @@ member."
'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
......@@ -2889,17 +2959,16 @@ member."
;; 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)))
......@@ -2928,7 +2997,7 @@ is set in them."
(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))
......@@ -2936,8 +3005,7 @@ is set in them."
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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment