Mercurial > emacs

changeset 69475:3f8495af82a4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(gdb-var-list): Change order of first two elements. (gdb-find-watch-expression): Make it work for arrays too. Follow change to gdb-var-list. (gud-watch): Allow the user to enter variable name with a prexix arg. Create keybindings. (gdb-var-create-handler, gdb-var-evaluate-expression-handler) (gdb-var-list-children-handler, gdb-var-update-handler) (gdb-var-delete, gdb-edit-value, gdb-speedbar-expand-node) (gdb-var-list-children-handler-1, gdb-var-update-handler-1): Follow change to gdb-var-list. (gdb-starting): Don't show the overlay arrows when program is running.
author Nick Roberts <nickrob@snap.net.nz>
date Tue, 14 Mar 2006 20:26:57 +0000
parents 5cac5e03ca8d
children 1db3b0eac5a2
files lisp/progmodes/gdb-ui.el
diffstat 1 files changed, 89 insertions(+), 72 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/progmodes/gdb-ui.el	Tue Mar 14 20:25:42 2006 +0000
+++ b/lisp/progmodes/gdb-ui.el	Tue Mar 14 20:26:57 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.")
@@ -417,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)
@@ -648,24 +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)
-	  (unless (string-match "\\." (nth 1 var))
-	    (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=\"\\(.*?\\)\"")
@@ -674,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)))
@@ -691,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))))
@@ -702,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
@@ -723,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)))))
 
@@ -762,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 "
@@ -796,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)
@@ -809,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
@@ -851,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))
@@ -1221,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
@@ -3117,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)))))
@@ -3154,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))