# HG changeset patch # User Nick Roberts # Date 1133905374 0 # Node ID 568e3be4fb8c48d0c8e068e053a947357ec0c027 # Parent a782b0b6ee12bbc8e906a903166267e646296e51 (gdb-error-regexp, gdb-first-post-prompt) (gdb-version): New variables. (gdb-source-file-list, gdb-register-names) (gdb-changed-registers): New variables for use with GDB 6.4+. (gdb-ann3): Replace with... (gdb-init-1, gdb-init-2): ...two new functions. (gdba, gdb-prompt): Call gdb-init-1. (gdb-get-version): New function. Call gdb-init-2 from here. (gud-watch): Make it work with mouse events too. (gdb-post-prompt): Don't add to queue until GDB version is known. (gdb-speedbar-expand-node, gdb-post-prompt, gdb-registers-mode) (gdb-locals-mode): Use gdb-version. (gdb-memory-format-map, gdb-memory-unit-map) (gdb-locals-watch-map): Rename from gdb-*-*-keymap. (gdb-locals-font-lock-keywords-1) (gdb-locals-font-lock-keywords-2): New variables. (gdb-find-file-hook): fgfg. (gdb-set-gud-minor-mode-existing-buffers-1) (gdb-var-list-children-1, gdb-var-list-children-handler-1) (gdb-var-update-1, gdb-var-update-handler-1) (gdb-data-list-register-values-handler) (gdb-data-list-register-values-custom) (gdb-get-changed-registers, gdb-get-changed-registers-handler) (gdb-stack-list-locals-handler, gdb-get-register-names): New functions for use with GDB 6.4+. (gdb-locals-watch-map-1): New variable for use with GDB 6.4+. (gdb-source-file-regexp, gdb-var-list-children-regexp-1) (gdb-var-update-regexp-1, gdb-data-list-register-values-regexp) (gdb-stack-list-locals-regexp) (gdb-data-list-register-names-regexp): New regexps for use with GDB 6.4+. diff -r a782b0b6ee12 -r 568e3be4fb8c lisp/progmodes/gdb-ui.el --- a/lisp/progmodes/gdb-ui.el Tue Dec 06 21:40:39 2005 +0000 +++ b/lisp/progmodes/gdb-ui.el Tue Dec 06 21:42:54 2005 +0000 @@ -93,6 +93,7 @@ (require 'gud) (defvar tool-bar-map) +(defvar speedbar-initial-expansion-list-name) (defvar gdb-frame-address "main" "Initialization for Assembler buffer.") (defvar gdb-previous-frame-address nil) @@ -156,7 +157,44 @@ "A list of trigger functions that have run later than their output handlers.") -;; end of gdb variables +(defvar gdb-first-post-prompt nil) +(defvar gdb-version nil) +(defvar gdb-locals-font-lock-keywords nil) +(defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"") + +(defvar gdb-locals-font-lock-keywords-1 + '( + ;; var = (struct struct_tag) value + ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)" + (1 font-lock-variable-name-face) + (3 font-lock-keyword-face) + (4 font-lock-type-face)) + ;; var = (type) value + ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)" + (1 font-lock-variable-name-face) + (3 font-lock-type-face)) + ;; var = val + ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]" + (1 font-lock-variable-name-face)) + ) + "Font lock keywords used in `gdb-local-mode'.") + +(defvar gdb-locals-font-lock-keywords-2 + '( + ;; var = type value + ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)" + (1 font-lock-variable-name-face) + (3 font-lock-type-face)) + ) + "Font lock keywords used in `gdb-local-mode'.") + +;; Variables for GDB 6.4+ + +(defvar gdb-source-file-list nil + "List of source files for the current executable") +(defvar gdb-register-names nil "List of register names.") +(defvar gdb-changed-registers nil + "List of changed register numbers (strings).") ;;;###autoload (defun gdba (command-line) @@ -213,7 +251,7 @@ ;; ;; Let's start with a basic gud-gdb buffer and then modify it a bit. (gdb command-line) - (gdb-ann3)) + (gdb-init-1)) (defvar gdb-debug-log nil) @@ -356,7 +394,7 @@ (setq expr (concat (car var1) "." (match-string 2 varno))))) expr)) -(defun gdb-ann3 () +(defun gdb-init-1 () (setq gdb-debug-log nil) (set (make-local-variable 'gud-minor-mode) 'gdba) (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) @@ -413,7 +451,7 @@ 'gdb-mouse-toggle-breakpoint-fringe) (setq comint-input-sender 'gdb-send) - ;; + ;; (re-)initialize (setq gdb-frame-address (if gdb-show-main "main" nil)) (setq gdb-previous-frame-address nil @@ -424,7 +462,7 @@ gdb-frame-number nil gdb-var-list nil gdb-var-changed nil - gdb-first-prompt nil + gdb-first-post-prompt t gdb-prompting nil gdb-input-queue nil gdb-current-item nil @@ -434,14 +472,21 @@ gdb-flush-pending-output nil gdb-location-alist nil gdb-find-file-unhook nil + gdb-source-file-list nil gdb-error nil gdb-macro-info nil gdb-buffer-fringe-width (car (window-fringes))) - ;; + (setq gdb-buffer-type 'gdba) - ;; + (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io)) - ;; + + ;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4) + (setq gdb-version nil) + (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n" + 'gdb-get-version))) + +(defun gdb-init-2 () (if (eq window-system 'w32) (gdb-enqueue-input (list "set new-console off\n" 'ignore))) (gdb-enqueue-input (list "set height 0\n" 'ignore)) @@ -450,10 +495,30 @@ (gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program (gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) - ;; - (gdb-set-gud-minor-mode-existing-buffers) + + (if (string-equal gdb-version "pre-6.4") + (progn + (gdb-set-gud-minor-mode-existing-buffers) + (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-1)) + (gdb-enqueue-input + (list "server interpreter mi -data-list-register-names\n" + 'gdb-get-register-names)) + ; Needs GDB 6.2 onwards. + (gdb-enqueue-input + (list "server interpreter mi \"-file-list-exec-source-files\"\n" + 'gdb-set-gud-minor-mode-existing-buffers-1)) + (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)) + (run-hooks 'gdba-mode-hook)) +(defun gdb-get-version () + (goto-char (point-min)) + (if (and (re-search-forward gdb-error-regexp nil t) + (string-match ".*(missing implementation)" (match-string 1))) + (setq gdb-version "pre-6.4") + (setq gdb-version "6.4+")) + (gdb-init-2)) + (defun gdb-mouse-until (event) "Execute source lines by dragging the overlay arrow (fringe) with the mouse." (interactive "e") @@ -504,9 +569,10 @@ :group 'gud :version "22.1") -(defun gud-watch () +(defun gud-watch (&optional event) "Watch expression at point." - (interactive) + (interactive (list last-input-event)) + (if event (posn-set-point (event-end event))) (require 'tooltip) (save-selected-window (let ((expr (tooltip-identifier-from-point (point)))) @@ -692,7 +758,9 @@ INDENT is the current indentation depth." (cond ((string-match "+" text) ;expand this node (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (gdb-var-list-children token) + (if (string-equal gdb-version "pre-6.4") + (gdb-var-list-children token) + (gdb-var-list-children-1 token)) (progn (gdbmi-var-update) (gdbmi-var-list-children token)))) @@ -781,7 +849,6 @@ ;; GUD buffers are an exception to the rules (gdb-set-buffer-rules 'gdba 'error) -;; ;; Partial-output buffer : This accumulates output from a command executed on ;; behalf of emacs (rather than the user). ;; @@ -877,7 +944,6 @@ (get-buffer-process gud-comint-buffer))) -;; ;; gdb communications ;; @@ -1031,7 +1097,9 @@ (defun gdb-prompt (ignored) "An annotation handler for `prompt'. This sends the next command (if any) to gdb." - (when gdb-first-prompt (gdb-ann3)) + (when gdb-first-prompt + (gdb-init-1) + (setq gdb-first-prompt nil)) (let ((sink gdb-output-sink)) (cond ((eq sink 'user) t) @@ -1128,16 +1196,25 @@ "An annotation handler for `post-prompt'. This begins the collection of output from the current command if that happens to be appropriate." - (unless gdb-pending-triggers + ;; Don't add to queue if there outstanding items or GDB is not known yet. + (unless (or gdb-pending-triggers gdb-first-post-prompt) (gdb-get-selected-frame) (gdb-invalidate-frames) (gdb-invalidate-breakpoints) ;; Do this through gdb-get-selected-frame -> gdb-frame-handler ;; so gdb-frame-address is updated. ;; (gdb-invalidate-assembler) - (gdb-invalidate-registers) + + (if (string-equal gdb-version "pre-6.4") + (gdb-invalidate-registers) + (gdb-get-changed-registers) + (gdb-invalidate-registers-1)) + (gdb-invalidate-memory) - (gdb-invalidate-locals) + (if (string-equal gdb-version "pre-6.4") + (gdb-invalidate-locals) + (gdb-invalidate-locals-1)) + (gdb-invalidate-threads) (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. ;; FIXME: with GDB-6 on Darwin, this might very well work. @@ -1146,7 +1223,10 @@ (setq gdb-var-changed t) ; force update (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) - (gdb-var-update)))) + (if (string-equal gdb-version "pre-6.4") + (gdb-var-update) + (gdb-var-update-1))))) + (setq gdb-first-post-prompt nil) (let ((sink gdb-output-sink)) (cond ((eq sink 'user) t) @@ -1908,13 +1988,15 @@ \\{gdb-registers-mode-map}" (kill-all-local-variables) (setq major-mode 'gdb-registers-mode) - (setq mode-name (if gdb-all-registers "Registers:All" "Registers:")) + (setq mode-name "Registers") (setq buffer-read-only t) (use-local-map gdb-registers-mode-map) (run-mode-hooks 'gdb-registers-mode-hook) - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - 'gdb-invalidate-registers - 'gdbmi-invalidate-registers)) + (if (string-equal gdb-version "pre-6.4") + (progn + (if gdb-all-registers (setq mode-name "Registers:All")) + 'gdb-invalidate-registers) + 'gdb-invalidate-registers-1)) (defun gdb-registers-buffer-name () (with-current-buffer gud-comint-buffer @@ -1934,19 +2016,20 @@ (display-buffer (gdb-get-create-buffer 'gdb-registers-buffer)))) (defun gdb-all-registers () - "Toggle the display of floating-point registers." + "Toggle the display of floating-point registers (pre GDB 6.4 only)." (interactive) - (if gdb-all-registers - (progn - (setq gdb-all-registers nil) - (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) - (setq mode-name "Registers:"))) - (setq gdb-all-registers t) - (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) - (setq mode-name "Registers:All"))) - (message (format "Display of floating-point registers %sabled" - (if gdb-all-registers "en" "dis"))) - (gdb-invalidate-registers)) + (when (string-equal gdb-version "pre-6.4") + (if gdb-all-registers + (progn + (setq gdb-all-registers nil) + (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) + (setq mode-name "Registers"))) + (setq gdb-all-registers t) + (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer) + (setq mode-name "Registers:All"))) + (message (format "Display of floating-point registers %sabled" + (if gdb-all-registers "en" "dis"))) + (gdb-invalidate-registers))) ;; Memory buffer. @@ -2050,7 +2133,7 @@ (customize-set-variable 'gdb-memory-format "x") (gdb-invalidate-memory)) -(defvar gdb-memory-format-keymap +(defvar gdb-memory-format-map (let ((map (make-sparse-keymap))) (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1) map) @@ -2112,7 +2195,7 @@ (customize-set-variable 'gdb-memory-unit "b") (gdb-invalidate-memory)) -(defvar gdb-memory-unit-keymap +(defvar gdb-memory-unit-map (let ((map (make-sparse-keymap))) (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1) map) @@ -2227,13 +2310,13 @@ 'face font-lock-warning-face 'help-echo "mouse-3: Select display format" 'mouse-face 'mode-line-highlight - 'local-map gdb-memory-format-keymap) + 'local-map gdb-memory-format-map) " Unit Size: " (propertize gdb-memory-unit 'face font-lock-warning-face 'help-echo "mouse-3: Select unit size" 'mouse-face 'mode-line-highlight - 'local-map gdb-memory-unit-keymap)))) + 'local-map gdb-memory-unit-map)))) (set (make-local-variable 'font-lock-defaults) '(gdb-memory-font-lock-keywords)) (run-mode-hooks 'gdb-memory-mode-hook) @@ -2268,7 +2351,7 @@ "server info locals\n" gdb-info-locals-handler) -(defvar gdb-locals-watch-keymap +(defvar gdb-locals-watch-map (let ((map (make-sparse-keymap))) (define-key map "\r" '(lambda () (interactive) (beginning-of-line) @@ -2284,13 +2367,13 @@ (concat (propertize "[struct/union]" 'mouse-face 'highlight 'help-echo "mouse-2: create watch expression" - 'local-map gdb-locals-watch-keymap) "\n")) + 'local-map gdb-locals-watch-map) "\n")) (defconst gdb-array-string (concat " " (propertize "[array]" 'mouse-face 'highlight 'help-echo "mouse-2: create watch expression" - 'local-map gdb-locals-watch-keymap) "\n")) + 'local-map gdb-locals-watch-map) "\n")) ;; Abbreviate for arrays and structures. ;; These can be expanded using gud-display. @@ -2326,23 +2409,6 @@ (define-key map "q" 'kill-this-buffer) map)) -(defvar gdb-locals-font-lock-keywords - '( - ;; var = (struct struct_tag) value - ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)" - (1 font-lock-variable-name-face) - (3 font-lock-keyword-face) - (4 font-lock-type-face)) - ;; var = (type) value - ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)" - (1 font-lock-variable-name-face) - (3 font-lock-type-face)) - ;; var = val - ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]" - (1 font-lock-variable-name-face)) - ) - "Font lock keywords used in `gdb-local-mode'.") - (defun gdb-locals-mode () "Major mode for gdb locals. @@ -2356,7 +2422,9 @@ '(gdb-locals-font-lock-keywords)) (run-mode-hooks 'gdb-locals-mode-hook) (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - 'gdb-invalidate-locals + (if (string-equal gdb-version "pre-6.4") + 'gdb-invalidate-locals + 'gdb-invalidate-locals-1) 'gdbmi-invalidate-locals)) (defun gdb-locals-buffer-name () @@ -2614,21 +2682,25 @@ (add-hook 'find-file-hook 'gdb-find-file-hook) (defun gdb-find-file-hook () -"Set up buffer for debugging if file is part of the source code + "Set up buffer for debugging if file is part of the source code of the current session." - (if (and (not gdb-find-file-unhook) + (if (and (buffer-name gud-comint-buffer) ;; in case gud or gdb-ui is just loaded gud-comint-buffer - (buffer-name gud-comint-buffer) (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)) - (condition-case nil - (gdb-enqueue-input - (list (concat gdb-server-prefix "list " - (file-name-nondirectory buffer-file-name) - ":1\n") - `(lambda () (gdb-set-gud-minor-mode ,(current-buffer))))) - (error (setq gdb-find-file-unhook t))))) + (if (string-equal gdb-version "pre-6.4") + (condition-case nil + (gdb-enqueue-input + (list (concat gdb-server-prefix "list " + (file-name-nondirectory buffer-file-name) + ":1\n") + `(lambda () (gdb-set-gud-minor-mode ,(current-buffer))))) + (error (setq gdb-find-file-unhook t))) + (if (member buffer-file-name gdb-source-file-list) + (with-current-buffer (find-buffer-visiting buffer-file-name) + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)))))) ;;from put-image (defun gdb-put-string (putstring pos &optional dprop &rest sprops) @@ -2907,6 +2979,249 @@ (setq gdb-current-language (match-string 1))) (gdb-invalidate-assembler)) +;; Code specific to GDB 6.4 + +(defconst gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") + +(defun gdb-set-gud-minor-mode-existing-buffers-1 () + "Create list of source files for current GDB session." + (goto-char (point-min)) + (while (re-search-forward gdb-source-file-regexp nil t) + (push (match-string 1) gdb-source-file-list)) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (member buffer-file-name gdb-source-file-list) + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (when gud-tooltip-mode + (make-local-variable 'gdb-define-alist) + (gdb-create-define-alist) + (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))) + +; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. +(defun gdb-var-list-children-1 (varnum) + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-update " varnum "\"\n") + 'ignore)) + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-list-children --all-values " + varnum "\"\n") + `(lambda () (gdb-var-list-children-handler-1 ,varnum))))) + +(defconst gdb-var-list-children-regexp-1 + "name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\ +value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") + +(defun gdb-var-list-children-handler-1 (varnum) + (goto-char (point-min)) + (let ((var-list nil)) + (catch 'child-already-watched + (dolist (var gdb-var-list) + (if (string-equal varnum (cadr var)) + (progn + (push var var-list) + (while (re-search-forward gdb-var-list-children-regexp-1 nil t) + (let ((varchild (list (match-string 2) + (match-string 1) + (match-string 3) + (match-string 5) + (read (match-string 4)) + nil))) + (dolist (var1 gdb-var-list) + (if (string-equal (cadr var1) (cadr varchild)) + (throw 'child-already-watched nil))) + (push varchild var-list)))) + (push var var-list))) + (setq gdb-var-changed t) + (setq gdb-var-list (nreverse var-list))))) + +; Uses "-var-update --all-values". Needs GDB 6.4 onwards. +(defun gdb-var-update-1 () + (if (not (member 'gdb-var-update gdb-pending-triggers)) + (progn + (gdb-enqueue-input + (list + (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) + "server interpreter mi \"-var-update --all-values *\"\n" + "-var-update --all-values *\n") + 'gdb-var-update-handler-1)) + (push 'gdb-var-update gdb-pending-triggers)))) + +(defconst gdb-var-update-regexp-1 "name=\"\\(.*?\\)\",value=\\(\".*?\"\\),") + +(defun gdb-var-update-handler-1 () + (goto-char (point-min)) + (while (re-search-forward gdb-var-update-regexp-1 nil t) + (let ((varnum (match-string 1))) + (catch 'var-found1 + (let ((num 0)) + (dolist (var gdb-var-list) + (if (string-equal varnum (cadr var)) + (progn + (setcar (nthcdr 5 var) t) + (setcar (nthcdr 4 var) (read (match-string 2))) + (setcar (nthcdr num gdb-var-list) var) + (throw 'var-found1 nil))) + (setq num (+ num 1)))))) + (setq gdb-var-changed t)) + (setq gdb-pending-triggers + (delq 'gdb-var-update gdb-pending-triggers)) + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) + ;; dummy command to update speedbar at right time + (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn)) + ;; keep gdb-pending-triggers non-nil till end + (push 'gdb-speedbar-timer gdb-pending-triggers))) + +;; Registers buffer. +;; +(gdb-set-buffer-rules 'gdb-registers-buffer + 'gdb-registers-buffer-name + 'gdb-registers-mode) + +(def-gdb-auto-update-trigger gdb-invalidate-registers-1 + (gdb-get-buffer 'gdb-registers-buffer) + (if (eq gud-minor-mode 'gdba) + "server interpreter mi \"-data-list-register-values x\"\n" + "-data-list-register-values x\n") + gdb-data-list-register-values-handler) + +(defconst gdb-data-list-register-values-regexp + "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"") + +(defun gdb-data-list-register-values-handler () + (setq gdb-pending-triggers (delq 'gdb-invalidate-registers + gdb-pending-triggers)) + (goto-char (point-min)) + (if (re-search-forward gdb-error-regexp nil t) + (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert (match-string 1)) + (goto-char (point-min)))) + (let ((register-list (reverse gdb-register-names)) + (register nil) (register-string nil) (register-values nil)) + (goto-char (point-min)) + (while (re-search-forward gdb-data-list-register-values-regexp nil t) + (setq register (pop register-list)) + (setq register-string (concat register "\t" (match-string 2) "\n")) + (if (member (match-string 1) gdb-changed-registers) + (put-text-property 0 (length register-string) + 'face 'font-lock-warning-face + register-string)) + (setq register-values + (concat register-values register-string))) + (let ((buf (gdb-get-buffer 'gdb-registers-buffer))) + (with-current-buffer buf + (let ((p (window-point (get-buffer-window buf 0))) + (buffer-read-only nil)) + (erase-buffer) + (insert register-values) + (set-window-point (get-buffer-window buf 0) p)))))) + (gdb-data-list-register-values-custom)) + +(defun gdb-data-list-register-values-custom () + (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) + (save-excursion + (let ((buffer-read-only nil) + start end) + (goto-char (point-min)) + (while (< (point) (point-max)) + (setq start (line-beginning-position)) + (setq end (line-end-position)) + (when (looking-at "^[^\t]+") + (unless (string-equal (match-string 0) "No registers.") + (put-text-property start (match-end 0) + 'face font-lock-variable-name-face) + (add-text-properties start end + '(help-echo "mouse-2: edit value" + mouse-face highlight)))) + (forward-line 1)))))) + +;; Needs GDB 6.4 onwards (used to fail with no stack). +(defun gdb-get-changed-registers () + (if (not (member 'gdb-get-changed-registers gdb-pending-triggers)) + (progn + (gdb-enqueue-input + (list + (if (eq gud-minor-mode 'gdba) + "server interpreter mi -data-list-changed-registers\n" + "-data-list-changed-registers\n") + 'gdb-get-changed-registers-handler)) + (push 'gdb-get-changed-registers gdb-pending-triggers)))) + +(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") + +(defun gdb-get-changed-registers-handler () + (setq gdb-pending-triggers + (delq 'gdb-get-changed-registers gdb-pending-triggers)) + (setq gdb-changed-registers nil) + (goto-char (point-min)) + (while (re-search-forward gdb-data-list-register-names-regexp nil t) + (push (match-string 1) gdb-changed-registers))) + + +;; Locals buffer. +;; +;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. +(gdb-set-buffer-rules 'gdb-locals-buffer + 'gdb-locals-buffer-name + 'gdb-locals-mode) + +(def-gdb-auto-update-trigger gdb-invalidate-locals-1 + (gdb-get-buffer 'gdb-locals-buffer) + "server interpreter mi -\"stack-list-locals --simple-values\"\n" + gdb-stack-list-locals-handler) + +(defconst gdb-stack-list-locals-regexp + "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") + +(defvar gdb-locals-watch-map-1 + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'gud-watch) + map) + "Keymap to create watch expression of a complex data type local variable.") + +;; Dont display values of arrays or structures. +;; These can be expanded using gud-watch. +(defun gdb-stack-list-locals-handler () + (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1 + gdb-pending-triggers)) + (let (local locals-list) + (goto-char (point-min)) + (while (re-search-forward gdb-stack-list-locals-regexp nil t) + (let ((local (list (match-string 1) + (match-string 2) + nil))) + (if (looking-at ",value=\\(\".*\"\\)}") + (setcar (nthcdr 2 local) (read (match-string 1)))) + (push local locals-list))) + (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) + (and buf (with-current-buffer buf + (let* ((window (get-buffer-window buf 0)) + (p (window-point window)) + (buffer-read-only nil)) + (erase-buffer) + (dolist (local locals-list) + (setq name (car local)) + (if (or (not (nth 2 local)) + (string-match "\\*$" (nth 1 local))) + (add-text-properties 0 (length name) + `(mouse-face highlight + help-echo "mouse-2: create watch expression" + local-map ,gdb-locals-watch-map-1) + name)) + (insert + (concat name "\t" (nth 1 local) + "\t" (nth 2 local) "\n"))) + (set-window-point window p))))))) + +(defun gdb-get-register-names () + "Create a list of register names." + (goto-char (point-min)) + (setq gdb-register-names nil) + (while (re-search-forward gdb-data-list-register-names-regexp nil t) + (push (match-string 1) gdb-register-names))) + (provide 'gdb-ui) ;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352