aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/progmodes/gdb-ui.el161
1 files changed, 89 insertions, 72 deletions
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index abd6add911d..db704985f2a 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -81,7 +81,7 @@
81 81
82;; 1) They go out of scope when the inferior is re-run. 82;; 1) They go out of scope when the inferior is re-run.
83;; 2) -stack-list-locals has a type field but also prints type in values field. 83;; 2) -stack-list-locals has a type field but also prints type in values field.
84;; 3) VARNUM increments even when vairable object is not created (maybe trivial). 84;; 3) VARNUM increments even when variable object is not created (maybe trivial).
85 85
86;;; TODO: 86;;; TODO:
87 87
@@ -107,7 +107,7 @@
107(defvar gdb-current-language nil) 107(defvar gdb-current-language nil)
108(defvar gdb-var-list nil 108(defvar gdb-var-list nil
109 "List of variables in watch window. 109 "List of variables in watch window.
110Each element has the form (EXPRESSION VARNUM NUMCHILD TYPE VALUE STATUS) where 110Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where
111STATUS is nil (unchanged), `changed' or `out-of-scope'.") 111STATUS is nil (unchanged), `changed' or `out-of-scope'.")
112(defvar gdb-force-update t 112(defvar gdb-force-update t
113 "Non-nil means that view of watch expressions will be updated in the speedbar.") 113 "Non-nil means that view of watch expressions will be updated in the speedbar.")
@@ -417,12 +417,20 @@ With arg, use separate IO iff arg is positive."
417 417
418(defun gdb-find-watch-expression () 418(defun gdb-find-watch-expression ()
419 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) 419 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
420 (varno (nth 1 var)) (expr)) 420 (varnum (car var)) expr array)
421 (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varno) 421 (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum)
422 (dolist (var1 gdb-var-list) 422 (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet
423 (if (string-equal (nth 1 var1) (match-string 1 varno)) 423 (component-list (split-string (match-string 2 varnum) "\\." t)))
424 (setq expr (concat (car var1) "." (match-string 2 varno))))) 424 (setq expr (nth 1 var1))
425 expr)) 425 (setq varnumlet (car var1))
426 (dolist (component component-list)
427 (setq var2 (assoc varnumlet gdb-var-list))
428 (setq expr (concat expr
429 (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2))
430 (concat "[" component "]")
431 (concat "." component))))
432 (setq varnumlet (concat varnumlet "." component)))
433 expr)))
426 434
427(defun gdb-init-1 () 435(defun gdb-init-1 ()
428 (set (make-local-variable 'gud-minor-mode) 'gdba) 436 (set (make-local-variable 'gud-minor-mode) 'gdba)
@@ -648,24 +656,36 @@ With arg, automatically raise speedbar iff arg is positive."
648 :group 'gud 656 :group 'gud
649 :version "22.1") 657 :version "22.1")
650 658
651(defun gud-watch (&optional event) 659(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
652 "Watch expression at point." 660(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
653 (interactive (list last-input-event)) 661
654 (if event (posn-set-point (event-end event))) 662(defun gud-watch (&optional arg event)
655 (require 'tooltip) 663 "Watch expression at point.
656 (save-selected-window 664With arg, enter name of variable to be watched in the minibuffer."
657 (let ((expr (tooltip-identifier-from-point (point)))) 665 (interactive (list current-prefix-arg last-input-event))
658 (catch 'already-watched 666 (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer)))
659 (dolist (var gdb-var-list) 667 (if (memq minor-mode '(gdbmi gdba))
660 (unless (string-match "\\." (nth 1 var)) 668 (progn
661 (if (string-equal expr (car var)) (throw 'already-watched nil)))) 669 (if event (posn-set-point (event-end event)))
662 (set-text-properties 0 (length expr) nil expr) 670 (require 'tooltip)
663 (gdb-enqueue-input 671 (save-selected-window
664 (list 672 (let ((expr (if arg
665 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 673 (read-string "Name of variable: ")
666 (concat "server interpreter mi \"-var-create - * " expr "\"\n") 674 (tooltip-identifier-from-point (point)))))
667 (concat"-var-create - * " expr "\n")) 675 (catch 'already-watched
668 `(lambda () (gdb-var-create-handler ,expr)))))))) 676 (dolist (var gdb-var-list)
677 (unless (string-match "\\." (car var))
678 (if (string-equal expr (nth 1 var))
679 (throw 'already-watched nil))))
680 (set-text-properties 0 (length expr) nil expr)
681 (gdb-enqueue-input
682 (list
683 (if (eq minor-mode 'gdba)
684 (concat
685 "server interpreter mi \"-var-create - * " expr "\"\n")
686 (concat"-var-create - * " expr "\n"))
687 `(lambda () (gdb-var-create-handler ,expr))))))))
688 (message "gud-watch is a no-op in this mode."))))
669 689
670(defconst gdb-var-create-regexp 690(defconst gdb-var-create-regexp
671 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") 691 "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
@@ -674,11 +694,11 @@ With arg, automatically raise speedbar iff arg is positive."
674 (goto-char (point-min)) 694 (goto-char (point-min))
675 (if (re-search-forward gdb-var-create-regexp nil t) 695 (if (re-search-forward gdb-var-create-regexp nil t)
676 (let ((var (list 696 (let ((var (list
697 (match-string 1)
677 (if (and (string-equal gdb-current-language "c") 698 (if (and (string-equal gdb-current-language "c")
678 gdb-use-colon-colon-notation gdb-selected-frame) 699 gdb-use-colon-colon-notation gdb-selected-frame)
679 (setq expr (concat gdb-selected-frame "::" expr)) 700 (setq expr (concat gdb-selected-frame "::" expr))
680 expr) 701 expr)
681 (match-string 1)
682 (match-string 2) 702 (match-string 2)
683 (match-string 3) 703 (match-string 3)
684 nil nil))) 704 nil nil)))
@@ -691,10 +711,10 @@ With arg, automatically raise speedbar iff arg is positive."
691 (list 711 (list
692 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 712 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
693 (concat "server interpreter mi \"-var-evaluate-expression " 713 (concat "server interpreter mi \"-var-evaluate-expression "
694 (nth 1 var) "\"\n") 714 (car var) "\"\n")
695 (concat "-var-evaluate-expression " (nth 1 var) "\n")) 715 (concat "-var-evaluate-expression " (car var) "\n"))
696 `(lambda () (gdb-var-evaluate-expression-handler 716 `(lambda () (gdb-var-evaluate-expression-handler
697 ,(nth 1 var) nil))))) 717 ,(car var) nil)))))
698 (if (search-forward "Undefined command" nil t) 718 (if (search-forward "Undefined command" nil t)
699 (message-box "Watching expressions requires gdb 6.0 onwards") 719 (message-box "Watching expressions requires gdb 6.0 onwards")
700 (message-box "No symbol \"%s\" in current context." expr)))) 720 (message-box "No symbol \"%s\" in current context." expr))))
@@ -702,12 +722,10 @@ With arg, automatically raise speedbar iff arg is positive."
702(defun gdb-var-evaluate-expression-handler (varnum changed) 722(defun gdb-var-evaluate-expression-handler (varnum changed)
703 (goto-char (point-min)) 723 (goto-char (point-min))
704 (re-search-forward ".*value=\\(\".*\"\\)" nil t) 724 (re-search-forward ".*value=\\(\".*\"\\)" nil t)
705 (catch 'var-found 725 (let ((var (assoc varnum gdb-var-list)))
706 (dolist (var gdb-var-list) 726 (when var
707 (when (string-equal varnum (cadr var)) 727 (if changed (setcar (nthcdr 5 var) 'changed))
708 (if changed (setcar (nthcdr 5 var) 'changed)) 728 (setcar (nthcdr 4 var) (read (match-string 1))))))
709 (setcar (nthcdr 4 var) (read (match-string 1)))
710 (throw 'var-found nil)))))
711 729
712(defun gdb-var-list-children (varnum) 730(defun gdb-var-list-children (varnum)
713 (gdb-enqueue-input 731 (gdb-enqueue-input
@@ -723,26 +741,25 @@ type=\"\\(.*?\\)\"")
723 (let ((var-list nil)) 741 (let ((var-list nil))
724 (catch 'child-already-watched 742 (catch 'child-already-watched
725 (dolist (var gdb-var-list) 743 (dolist (var gdb-var-list)
726 (if (string-equal varnum (cadr var)) 744 (if (string-equal varnum (car var))
727 (progn 745 (progn
728 (push var var-list) 746 (push var var-list)
729 (while (re-search-forward gdb-var-list-children-regexp nil t) 747 (while (re-search-forward gdb-var-list-children-regexp nil t)
730 (let ((varchild (list (match-string 2) 748 (let ((varchild (list (match-string 1)
731 (match-string 1) 749 (match-string 2)
732 (match-string 3) 750 (match-string 3)
733 (match-string 4) 751 (match-string 4)
734 nil nil))) 752 nil nil)))
735 (dolist (var1 gdb-var-list) 753 (if (assoc (car varchild) gdb-var-list)
736 (if (string-equal (cadr var1) (cadr varchild)) 754 (throw 'child-already-watched nil))
737 (throw 'child-already-watched nil)))
738 (push varchild var-list) 755 (push varchild var-list)
739 (gdb-enqueue-input 756 (gdb-enqueue-input
740 (list 757 (list
741 (concat 758 (concat
742 "server interpreter mi \"-var-evaluate-expression " 759 "server interpreter mi \"-var-evaluate-expression "
743 (nth 1 varchild) "\"\n") 760 (car varchild) "\"\n")
744 `(lambda () (gdb-var-evaluate-expression-handler 761 `(lambda () (gdb-var-evaluate-expression-handler
745 ,(nth 1 varchild) nil))))))) 762 ,(car varchild) nil)))))))
746 (push var var-list))) 763 (push var var-list)))
747 (setq gdb-var-list (nreverse var-list))))) 764 (setq gdb-var-list (nreverse var-list)))))
748 765
@@ -762,11 +779,8 @@ type=\"\\(.*?\\)\"")
762 (while (re-search-forward gdb-var-update-regexp nil t) 779 (while (re-search-forward gdb-var-update-regexp nil t)
763 (let ((varnum (match-string 1))) 780 (let ((varnum (match-string 1)))
764 (if (string-equal (match-string 2) "false") 781 (if (string-equal (match-string 2) "false")
765 (catch 'var-found 782 (let ((var (assoc varnum gdb-var-list)))
766 (dolist (var gdb-var-list) 783 (if var (setcar (nthcdr 5 var) 'out-of-scope)))
767 (when (string-equal varnum (cadr var))
768 (setcar (nthcdr 5 var) 'out-of-scope)
769 (throw 'var-found nil))))
770 (gdb-enqueue-input 784 (gdb-enqueue-input
771 (list 785 (list
772 (concat "server interpreter mi \"-var-evaluate-expression " 786 (concat "server interpreter mi \"-var-evaluate-expression "
@@ -796,10 +810,14 @@ type=\"\\(.*?\\)\"")
796 '(gdbmi gdba)) 810 '(gdbmi gdba))
797 (let ((text (speedbar-line-text))) 811 (let ((text (speedbar-line-text)))
798 (string-match "\\(\\S-+\\)" text) 812 (string-match "\\(\\S-+\\)" text)
799 (let* ((expr (match-string 1 text)) 813 (let ((expr (match-string 1 text)) var varnum)
800 (var (assoc expr gdb-var-list)) 814 (catch 'expr-found
801 (varnum (cadr var))) 815 (dolist (var1 gdb-var-list)
802 (unless (string-match "\\." varnum) 816 (when (string-equal expr (nth 1 var1))
817 (setq var var1)
818 (setq varnum (car var1))
819 (throw 'expr-found nil))))
820 (unless (string-match "\\." (car var))
803 (gdb-enqueue-input 821 (gdb-enqueue-input
804 (list 822 (list
805 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 823 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
@@ -809,13 +827,13 @@ type=\"\\(.*?\\)\"")
809 'ignore)) 827 'ignore))
810 (setq gdb-var-list (delq var gdb-var-list)) 828 (setq gdb-var-list (delq var gdb-var-list))
811 (dolist (varchild gdb-var-list) 829 (dolist (varchild gdb-var-list)
812 (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild)) 830 (if (string-match (concat (car var) "\\.") (car varchild))
813 (setq gdb-var-list (delq varchild gdb-var-list))))))))) 831 (setq gdb-var-list (delq varchild gdb-var-list)))))))))
814 832
815(defun gdb-edit-value (text token indent) 833(defun gdb-edit-value (text token indent)
816 "Assign a value to a variable displayed in the speedbar." 834 "Assign a value to a variable displayed in the speedbar."
817 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) 835 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
818 (varnum (cadr var)) (value)) 836 (varnum (car var)) (value))
819 (setq value (read-string "New value: ")) 837 (setq value (read-string "New value: "))
820 (gdb-enqueue-input 838 (gdb-enqueue-input
821 (list 839 (list
@@ -851,7 +869,7 @@ INDENT is the current indentation depth."
851 (gdb-var-list-children-1 token))) 869 (gdb-var-list-children-1 token)))
852 ((string-match "-" text) ;contract this node 870 ((string-match "-" text) ;contract this node
853 (dolist (var gdb-var-list) 871 (dolist (var gdb-var-list)
854 (if (string-match (concat token "\\.") (nth 1 var)) 872 (if (string-match (concat token "\\.") (car var))
855 (setq gdb-var-list (delq var gdb-var-list)))) 873 (setq gdb-var-list (delq var gdb-var-list))))
856 (speedbar-change-expand-button-char ?+) 874 (speedbar-change-expand-button-char ?+)
857 (speedbar-delete-subblock indent)) 875 (speedbar-delete-subblock indent))
@@ -1221,6 +1239,8 @@ not GDB."
1221 (progn 1239 (progn
1222 (setq gud-running t) 1240 (setq gud-running t)
1223 (gdb-remove-text-properties) 1241 (gdb-remove-text-properties)
1242 (setq gud-overlay-arrow-position nil)
1243 (setq gdb-overlay-arrow-position nil)
1224 (if gdb-use-separate-io-buffer 1244 (if gdb-use-separate-io-buffer
1225 (setq gdb-output-sink 'inferior)))) 1245 (setq gdb-output-sink 'inferior))))
1226 (t 1246 (t
@@ -3117,19 +3137,18 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")
3117 (let ((var-list nil)) 3137 (let ((var-list nil))
3118 (catch 'child-already-watched 3138 (catch 'child-already-watched
3119 (dolist (var gdb-var-list) 3139 (dolist (var gdb-var-list)
3120 (if (string-equal varnum (cadr var)) 3140 (if (string-equal varnum (car var))
3121 (progn 3141 (progn
3122 (push var var-list) 3142 (push var var-list)
3123 (while (re-search-forward gdb-var-list-children-regexp-1 nil t) 3143 (while (re-search-forward gdb-var-list-children-regexp-1 nil t)
3124 (let ((varchild (list (match-string 2) 3144 (let ((varchild (list (match-string 1)
3125 (match-string 1) 3145 (match-string 2)
3126 (match-string 3) 3146 (match-string 3)
3127 (match-string 5) 3147 (match-string 5)
3128 (read (match-string 4)) 3148 (read (match-string 4))
3129 nil))) 3149 nil)))
3130 (dolist (var1 gdb-var-list) 3150 (if (assoc (car varchild) gdb-var-list)
3131 (if (string-equal (cadr var1) (cadr varchild)) 3151 (throw 'child-already-watched nil))
3132 (throw 'child-already-watched nil)))
3133 (push varchild var-list)))) 3152 (push varchild var-list))))
3134 (push var var-list))) 3153 (push var var-list)))
3135 (setq gdb-var-list (nreverse var-list))))) 3154 (setq gdb-var-list (nreverse var-list)))))
@@ -3154,16 +3173,14 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")
3154 (setcar (nthcdr 5 var) nil)) 3173 (setcar (nthcdr 5 var) nil))
3155 (goto-char (point-min)) 3174 (goto-char (point-min))
3156 (while (re-search-forward gdb-var-update-regexp-1 nil t) 3175 (while (re-search-forward gdb-var-update-regexp-1 nil t)
3157 (let ((varnum (match-string 1))) 3176 (let* ((varnum (match-string 1))
3158 (catch 'var-found 3177 (var (assoc varnum gdb-var-list)))
3159 (dolist (var gdb-var-list) 3178 (when var
3160 (when (string-equal varnum (cadr var)) 3179 (if (string-equal (match-string 3) "false")
3161 (if (string-equal (match-string 3) "false") 3180 (setcar (nthcdr 5 var) 'out-of-scope)
3162 (setcar (nthcdr 5 var) 'out-of-scope) 3181 (setcar (nthcdr 5 var) 'changed)
3163 (setcar (nthcdr 5 var) 'changed) 3182 (setcar (nthcdr 4 var)
3164 (setcar (nthcdr 4 var) 3183 (read (match-string 2)))))))
3165 (read (match-string 2))))
3166 (throw 'var-found nil))))))
3167 (setq gdb-pending-triggers 3184 (setq gdb-pending-triggers
3168 (delq 'gdb-var-update gdb-pending-triggers)) 3185 (delq 'gdb-var-update gdb-pending-triggers))
3169 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) 3186 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))