diff lisp/progmodes/gdb-ui.el @ 83492:203c9b24206b

Merged from [e-mail] Patches applied: * [e-mail]/emacs--devo--0--patch-153 Update from CVS * [e-mail]/emacs--devo--0--patch-154 Update from CVS * [e-mail]/emacs--devo--0--patch-155 Remove nick-abbrevs stuff from rcirc.el * [e-mail]/emacs--devo--0--patch-156 rcirc.el update from Ryan Yeske * [e-mail]/emacs--devo--0--patch-157 Update from CVS * [e-mail]/emacs--devo--0--patch-158 Update from CVS * [e-mail]/emacs--devo--0--patch-159 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-532

--- a/lisp/progmodes/gdb-ui.el	Sun Mar 12 05:02:59 2006 +0000
+++ b/lisp/progmodes/gdb-ui.el	Wed Mar 15 17:22:12 2006 +0000
@@ -81,7 +81,7 @@
 
 ;; 1) They go out of scope when the inferior is re-run.
 ;; 2) -stack-list-locals has a type field but also prints type in values field.
-;; 3) VARNUM increments even when vairable object is not created (maybe trivial).
+;; 3) VARNUM increments even when variable object is not created (maybe trivial).
 
 ;;; TODO:
 
@@ -107,7 +107,7 @@
 (defvar gdb-current-language nil)
 (defvar gdb-var-list nil
  "List of variables in watch window.
-Each element has the form (EXPRESSION VARNUM NUMCHILD TYPE VALUE STATUS) where
+Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where
 STATUS is nil (unchanged), `changed' or `out-of-scope'.")
 (defvar gdb-force-update t
  "Non-nil means that view of watch expressions will be updated in the speedbar.")
@@ -301,12 +301,38 @@
   :group 'gud
   :version "22.1")
 
+(defcustom gdb-many-windows nil
+  "Nil means just pop up the GUD buffer unless `gdb-show-main' is t.
+In this case it starts with two windows: one displaying the GUD
+buffer and the other with the source file with the main routine
+of the inferior.  Non-nil means display the layout shown for
+`gdba'."
+  :type 'boolean
+  :group 'gud
+  :version "22.1")
+
 (defcustom gdb-use-separate-io-buffer nil
   "Non-nil means display output from the inferior in a separate buffer."
   :type 'boolean
   :group 'gud
   :version "22.1")
 
+(defun gdb-many-windows (arg)
+  "Toggle the number of windows in the basic arrangement.
+With arg, display additional buffers iff arg is positive."
+  (interactive "P")
+  (setq gdb-many-windows
+	(if (null arg)
+	    (not gdb-many-windows)
+	  (> (prefix-numeric-value arg) 0)))
+  (message (format "Display of other windows %sabled"
+		   (if gdb-many-windows "en" "dis")))
+  (if (and gud-comint-buffer
+	   (buffer-name gud-comint-buffer))
+      (condition-case nil
+	  (gdb-restore-windows)
+	(error nil))))
+
 (defun gdb-use-separate-io-buffer (arg)
   "Toggle separate IO for inferior.
 With arg, use separate IO iff arg is positive."
@@ -391,12 +417,20 @@
 
 (defun gdb-find-watch-expression ()
   (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
-	 (varno (nth 1 var)) (expr))
-    (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varno)
-    (dolist (var1 gdb-var-list)
-      (if (string-equal (nth 1 var1) (match-string 1 varno))
-	  (setq expr (concat (car var1) "." (match-string 2 varno)))))
-    expr))
+	 (varnum (car var)) expr array)
+    (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum)
+    (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet
+	  (component-list (split-string (match-string 2 varnum) "\\." t)))
+      (setq expr (nth 1 var1))
+      (setq varnumlet (car var1))
+      (dolist (component component-list)
+	(setq var2 (assoc varnumlet gdb-var-list))
+	(setq expr (concat expr
+			   (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2))
+			       (concat "[" component "]")
+			     (concat "." component))))
+	(setq varnumlet (concat varnumlet "." component)))
+      expr)))
 
 (defun gdb-init-1 ()
   (set (make-local-variable 'gud-minor-mode) 'gdba)
@@ -622,23 +656,36 @@
   :group 'gud
   :version "22.1")
 
-(defun gud-watch (&optional event)
-  "Watch expression at point."
-  (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))))
-      (catch 'already-watched
-	(dolist (var gdb-var-list)
-	  (if (string-equal expr (car var)) (throw 'already-watched nil)))
-	(set-text-properties 0 (length expr) nil expr)
-	(gdb-enqueue-input
-	 (list
-	  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
-	      (concat "server interpreter mi \"-var-create - * "  expr "\"\n")
-	    (concat"-var-create - * "  expr "\n"))
-	  `(lambda () (gdb-var-create-handler ,expr))))))))
+(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
+(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
+
+(defun gud-watch (&optional arg event)
+  "Watch expression at point.
+With arg, enter name of variable to be watched in the minibuffer."
+  (interactive (list current-prefix-arg last-input-event))
+  (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer)))
+    (if (memq minor-mode '(gdbmi gdba))
+	(progn
+	  (if event (posn-set-point (event-end event)))
+	  (require 'tooltip)
+	  (save-selected-window
+	    (let ((expr (if arg
+			    (read-string "Name of variable: ")
+			  (tooltip-identifier-from-point (point)))))
+	      (catch 'already-watched
+		(dolist (var gdb-var-list)
+		  (unless (string-match "\\." (car var))
+		    (if (string-equal expr (nth 1 var))
+			(throw 'already-watched nil))))
+		(set-text-properties 0 (length expr) nil expr)
+		(gdb-enqueue-input
+		 (list
+		  (if (eq minor-mode 'gdba)
+		      (concat
+		       "server interpreter mi \"-var-create - * "  expr "\"\n")
+		    (concat"-var-create - * "  expr "\n"))
+		  `(lambda () (gdb-var-create-handler ,expr))))))))
+      (message "gud-watch is a no-op in this mode."))))
 
 (defconst gdb-var-create-regexp
   "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
@@ -647,11 +694,11 @@
   (goto-char (point-min))
   (if (re-search-forward gdb-var-create-regexp nil t)
       (let ((var (list
+		  (match-string 1)
 		  (if (and (string-equal gdb-current-language "c")
 			   gdb-use-colon-colon-notation gdb-selected-frame)
 		      (setq expr (concat gdb-selected-frame "::" expr))
 		    expr)
-		  (match-string 1)
 		  (match-string 2)
 		  (match-string 3)
 		  nil nil)))
@@ -664,10 +711,10 @@
 	 (list
 	  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
 	      (concat "server interpreter mi \"-var-evaluate-expression "
-		      (nth 1 var) "\"\n")
-	    (concat "-var-evaluate-expression " (nth 1 var) "\n"))
+		      (car var) "\"\n")
+	    (concat "-var-evaluate-expression " (car var) "\n"))
 	  `(lambda () (gdb-var-evaluate-expression-handler
-		       ,(nth 1 var) nil)))))
+		       ,(car var) nil)))))
     (if (search-forward "Undefined command" nil t)
 	(message-box "Watching expressions requires gdb 6.0 onwards")
       (message-box "No symbol \"%s\" in current context." expr))))
@@ -675,12 +722,10 @@
 (defun gdb-var-evaluate-expression-handler (varnum changed)
   (goto-char (point-min))
   (re-search-forward ".*value=\\(\".*\"\\)" nil t)
-  (catch 'var-found
-    (dolist (var gdb-var-list)
-      (when (string-equal varnum (cadr var))
-	(if changed (setcar (nthcdr 5 var) 'changed))
-	(setcar (nthcdr 4 var) (read (match-string 1)))
-	(throw 'var-found nil)))))
+  (let ((var (assoc varnum gdb-var-list)))
+    (when var
+      (if changed (setcar (nthcdr 5 var) 'changed))
+      (setcar (nthcdr 4 var) (read (match-string 1))))))
 
 (defun gdb-var-list-children (varnum)
   (gdb-enqueue-input
@@ -696,26 +741,25 @@
   (let ((var-list nil))
     (catch 'child-already-watched
       (dolist (var gdb-var-list)
-	(if (string-equal varnum (cadr var))
+	(if (string-equal varnum (car var))
 	    (progn
 	      (push var var-list)
 	      (while (re-search-forward gdb-var-list-children-regexp nil t)
-		(let ((varchild (list (match-string 2)
-				      (match-string 1)
+		(let ((varchild (list (match-string 1)
+				      (match-string 2)
 				      (match-string 3)
 				      (match-string 4)
 				      nil nil)))
-		  (dolist (var1 gdb-var-list)
-		    (if (string-equal (cadr var1) (cadr varchild))
-			(throw 'child-already-watched nil)))
+		  (if (assoc (car varchild) gdb-var-list)
+		      (throw 'child-already-watched nil))
 		  (push varchild var-list)
 		  (gdb-enqueue-input
 		   (list
 		    (concat
 		     "server interpreter mi \"-var-evaluate-expression "
-		     (nth 1 varchild) "\"\n")
+		     (car varchild) "\"\n")
 		    `(lambda () (gdb-var-evaluate-expression-handler
-				 ,(nth 1 varchild) nil)))))))
+				 ,(car varchild) nil)))))))
 	  (push var var-list)))
       (setq gdb-var-list (nreverse var-list)))))
 
@@ -735,11 +779,8 @@
   (while (re-search-forward gdb-var-update-regexp nil t)
     (let ((varnum (match-string 1)))
       (if  (string-equal (match-string 2) "false")
-	  (catch 'var-found
-	    (dolist (var gdb-var-list)
-	      (when (string-equal varnum (cadr var))
-		(setcar (nthcdr 5 var) 'out-of-scope)
-		(throw 'var-found nil))))
+	  (let ((var (assoc varnum gdb-var-list)))
+	    (if var (setcar (nthcdr 5 var) 'out-of-scope)))
 	(gdb-enqueue-input
 	 (list
 	  (concat "server interpreter mi \"-var-evaluate-expression "
@@ -757,7 +798,8 @@
   (setq gdb-pending-triggers
 	(delq 'gdb-speedbar-refresh gdb-pending-triggers))
   (with-current-buffer gud-comint-buffer
-    (let ((speedbar-verbosity-level 0))
+    (let ((speedbar-verbosity-level 0)
+	  (speedbar-shown-directories nil))
       (save-excursion
 	(speedbar-refresh)))))
 
@@ -768,10 +810,14 @@
 	    '(gdbmi gdba))
       (let ((text (speedbar-line-text)))
 	(string-match "\\(\\S-+\\)" text)
-	(let* ((expr (match-string 1 text))
-	       (var (assoc expr gdb-var-list))
-	       (varnum (cadr var)))
-	  (unless (string-match "\\." varnum)
+	(let ((expr (match-string 1 text)) var varnum)
+	  (catch 'expr-found
+	    (dolist (var1 gdb-var-list)
+	      (when (string-equal expr (nth 1 var1))
+		(setq var var1)
+		(setq varnum (car var1))
+		(throw 'expr-found nil))))
+	  (unless (string-match "\\." (car var))
 	    (gdb-enqueue-input
 	     (list
 	      (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
@@ -781,13 +827,13 @@
 		   'ignore))
 	    (setq gdb-var-list (delq var gdb-var-list))
 	    (dolist (varchild gdb-var-list)
-	      (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild))
+	      (if (string-match (concat (car var) "\\.") (car varchild))
 		  (setq gdb-var-list (delq varchild gdb-var-list)))))))))
 
 (defun gdb-edit-value (text token indent)
   "Assign a value to a variable displayed in the speedbar."
   (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
-	 (varnum (cadr var)) (value))
+	 (varnum (car var)) (value))
     (setq value (read-string "New value: "))
     (gdb-enqueue-input
      (list
@@ -823,7 +869,7 @@
 	   (gdb-var-list-children-1 token)))
 	((string-match "-" text)	;contract this node
 	 (dolist (var gdb-var-list)
-	   (if (string-match (concat token "\\.") (nth 1 var))
+	   (if (string-match (concat token "\\.") (car var))
 	       (setq gdb-var-list (delq var gdb-var-list))))
 	 (speedbar-change-expand-button-char ?+)
 	 (speedbar-delete-subblock indent))
@@ -1193,6 +1239,8 @@
       (progn
 	(setq gud-running t)
 	(gdb-remove-text-properties)
+	(setq gud-overlay-arrow-position nil)
+	(setq gdb-overlay-arrow-position nil)
 	(if gdb-use-separate-io-buffer
 	    (setq gdb-output-sink 'inferior))))
      (t
@@ -2671,32 +2719,6 @@
   (gdb-set-window-buffer (gdb-breakpoints-buffer-name))
   (other-window 1))
 
-(defcustom gdb-many-windows nil
-  "Nil means just pop up the GUD buffer unless `gdb-show-main' is t.
-In this case it starts with two windows: one displaying the GUD
-buffer and the other with the source file with the main routine
-of the inferior.  Non-nil means display the layout shown for
-`gdba'."
-  :type 'boolean
-  :group 'gud
-  :version "22.1")
-
-(defun gdb-many-windows (arg)
-  "Toggle the number of windows in the basic arrangement.
-With arg, display additional buffers iff arg is positive."
-  (interactive "P")
-  (setq gdb-many-windows
-	(if (null arg)
-	    (not gdb-many-windows)
-	  (> (prefix-numeric-value arg) 0)))
-  (message (format "Display of other windows %sabled"
-		   (if gdb-many-windows "en" "dis")))
-  (if (and gud-comint-buffer
-	   (buffer-name gud-comint-buffer))
-      (condition-case nil
-	  (gdb-restore-windows)
-	(error nil))))
-
 (defun gdb-restore-windows ()
   "Restore the basic arrangement of windows used by gdba.
 This arrangement depends on the value of `gdb-many-windows'."
@@ -3115,19 +3137,18 @@
   (let ((var-list nil))
     (catch 'child-already-watched
       (dolist (var gdb-var-list)
-	(if (string-equal varnum (cadr var))
+	(if (string-equal varnum (car 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)
+		(let ((varchild (list (match-string 1)
+				      (match-string 2)
 				      (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)))
+		  (if (assoc (car varchild) gdb-var-list)
+		      (throw 'child-already-watched nil))
 		  (push varchild var-list))))
 	  (push var var-list)))
       (setq gdb-var-list (nreverse var-list)))))
@@ -3152,16 +3173,14 @@
     (setcar (nthcdr 5 var) nil))
   (goto-char (point-min))
   (while (re-search-forward gdb-var-update-regexp-1 nil t)
-    (let ((varnum (match-string 1)))
-      (catch 'var-found
-	(dolist (var gdb-var-list)
-	  (when (string-equal varnum (cadr var))
-	    (if (string-equal (match-string 3) "false")
-		(setcar (nthcdr 5 var) 'out-of-scope)
-	      (setcar (nthcdr 5 var) 'changed)
-	      (setcar (nthcdr 4 var)
-		      (read (match-string 2))))
-	    (throw 'var-found nil))))))
+    (let* ((varnum (match-string 1))
+	   (var (assoc varnum gdb-var-list)))
+      (when var
+	(if (string-equal (match-string 3) "false")
+	    (setcar (nthcdr 5 var) 'out-of-scope)
+	  (setcar (nthcdr 5 var) 'changed)
+	  (setcar (nthcdr 4 var)
+		  (read (match-string 2)))))))
   (setq gdb-pending-triggers
    (delq 'gdb-var-update gdb-pending-triggers))
   (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
@@ -3309,7 +3328,7 @@
 		   (dolist (local locals-list)
 		     (setq name (car local))
 		     (if (or (not (nth 2 local))
-			     (string-match "\\*$" (nth 1 local)))
+			     (string-match "\\0x" (nth 2 local)))
 		       (add-text-properties 0 (length name)
 			    `(mouse-face highlight
 			      help-echo "mouse-2: create watch expression"