From e70866834ebd63f1647a4395cafb1d50ebd927d3 Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Tue, 4 Aug 2009 13:27:21 +0000 Subject: [PATCH] (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. --- lisp/ChangeLog | 9 +++ lisp/progmodes/gdb-mi.el | 162 +++++++++++++++++++++++++++------------ 2 files changed, 124 insertions(+), 47 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dd15af771b4..078d66bbf29 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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 diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 48e8e37de46..f0d5664f74c 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -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)) -- 2.39.2