Mercurial > emacs

changeset 67356:568e3be4fb8c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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+.
author Nick Roberts <nickrob@snap.net.nz>
date Tue, 06 Dec 2005 21:42:54 +0000
parents a782b0b6ee12
children ad09fcb8cef5
files lisp/progmodes/gdb-ui.el
diffstat 1 files changed, 386 insertions(+), 71 deletions(-) [+]
line wrap: on
line diff
--- 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