Mercurial > emacs

comparison lisp/progmodes/gdb-ui.el @ 69000:0dcc5b9decbf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(gdb-force-update): Rename from gdb-var-changed. (gdb-post-prompt): Use it. (gdb-var-create-handler, gdb-var-evaluate-expression-handler) (gdb-var-update-handler, gdb-var-delete) (gdb-speedbar-expand-node, gdb-var-list-children-handler-1) (gdb-var-update-handler-1): Don't set gdb-var-changed, just set gdb-force-update in gdb-post-prompt. (gdb-reset): Clear watch expressions from speedbar when quitting.
author Nick Roberts <nickrob@snap.net.nz>
date Sun, 19 Feb 2006 05:21:50 +0000
parents 3d9e09ba3ace
children f01603b6b4ae
comparison
equal deleted inserted replaced
68999:eb53cd048942 69000:0dcc5b9decbf
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.
110 Each element has the form (EXPRESSION VARNUM NUMCHILD TYPE VALUE STATUS) where 110 Each element has the form (EXPRESSION VARNUM NUMCHILD TYPE VALUE STATUS) where
111 STATUS is nil (unchanged), `changed' or `out-of-scope'.") 111 STATUS is nil (unchanged), `changed' or `out-of-scope'.")
112 (defvar gdb-var-changed t "Non-nil means that `gdb-var-list' has changed.") 112 (defvar gdb-force-update t
113 "Non-nil means that view of watch expressions will be updated in the speedbar.")
113 (defvar gdb-main-file nil "Source file from which program execution begins.") 114 (defvar gdb-main-file nil "Source file from which program execution begins.")
114 (defvar gdb-overlay-arrow-position nil) 115 (defvar gdb-overlay-arrow-position nil)
115 (defvar gdb-server-prefix nil) 116 (defvar gdb-server-prefix nil)
116 (defvar gdb-flush-pending-output nil) 117 (defvar gdb-flush-pending-output nil)
117 (defvar gdb-location-alist nil 118 (defvar gdb-location-alist nil
453 gdb-previous-frame nil 454 gdb-previous-frame nil
454 gdb-selected-frame nil 455 gdb-selected-frame nil
455 gdb-current-language nil 456 gdb-current-language nil
456 gdb-frame-number nil 457 gdb-frame-number nil
457 gdb-var-list nil 458 gdb-var-list nil
458 ;; Set initially to t to force update. 459 gdb-force-update t
459 gdb-var-changed t
460 gdb-first-post-prompt t 460 gdb-first-post-prompt t
461 gdb-prompting nil 461 gdb-prompting nil
462 gdb-input-queue nil 462 gdb-input-queue nil
463 gdb-current-item nil 463 gdb-current-item nil
464 gdb-pending-triggers nil 464 gdb-pending-triggers nil
608 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) 608 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
609 (concat "server interpreter mi \"-var-evaluate-expression " 609 (concat "server interpreter mi \"-var-evaluate-expression "
610 (nth 1 var) "\"\n") 610 (nth 1 var) "\"\n")
611 (concat "-var-evaluate-expression " (nth 1 var) "\n")) 611 (concat "-var-evaluate-expression " (nth 1 var) "\n"))
612 `(lambda () (gdb-var-evaluate-expression-handler 612 `(lambda () (gdb-var-evaluate-expression-handler
613 ,(nth 1 var) nil)))) 613 ,(nth 1 var) nil)))))
614 (setq gdb-var-changed t))
615 (if (search-forward "Undefined command" nil t) 614 (if (search-forward "Undefined command" nil t)
616 (message-box "Watching expressions requires gdb 6.0 onwards") 615 (message-box "Watching expressions requires gdb 6.0 onwards")
617 (message "No symbol \"%s\" in current context." expr)))) 616 (message "No symbol \"%s\" in current context." expr))))
618 617
619 (defun gdb-var-evaluate-expression-handler (varnum changed) 618 (defun gdb-var-evaluate-expression-handler (varnum changed)
620 (goto-char (point-min)) 619 (goto-char (point-min))
621 (re-search-forward ".*value=\\(\".*\"\\)" nil t) 620 (re-search-forward ".*value=\\(\".*\"\\)" nil t)
622 (catch 'var-found 621 (catch 'var-found
623 (let ((num 0)) 622 (dolist (var gdb-var-list)
624 (dolist (var gdb-var-list) 623 (when (string-equal varnum (cadr var))
625 (if (string-equal varnum (cadr var)) 624 (if changed (setcar (nthcdr 5 var) 'changed))
626 (progn 625 (setcar (nthcdr 4 var) (read (match-string 1)))
627 (if changed (setcar (nthcdr 5 var) 'changed)) 626 (throw 'var-found nil)))))
628 (setcar (nthcdr 4 var) (read (match-string 1)))
629 (setcar (nthcdr num gdb-var-list) var)
630 (throw 'var-found nil)))
631 (setq num (+ num 1)))))
632 (setq gdb-var-changed t))
633 627
634 (defun gdb-var-list-children (varnum) 628 (defun gdb-var-list-children (varnum)
635 (gdb-enqueue-input 629 (gdb-enqueue-input
636 (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n") 630 (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n")
637 `(lambda () (gdb-var-list-children-handler ,varnum))))) 631 `(lambda () (gdb-var-list-children-handler ,varnum)))))
676 (push 'gdb-var-update gdb-pending-triggers))) 670 (push 'gdb-var-update gdb-pending-triggers)))
677 671
678 (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\",in_scope=\"\\(.*?\\)\"") 672 (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\",in_scope=\"\\(.*?\\)\"")
679 673
680 (defun gdb-var-update-handler () 674 (defun gdb-var-update-handler ()
681 (goto-char (point-min))
682 (dolist (var gdb-var-list) 675 (dolist (var gdb-var-list)
683 (when (and (eq (car (nthcdr 5 var)) 'out-of-scope)
684 (not (re-search-forward gdb-var-update-regexp-1 nil t))
685 (not gdb-var-changed))
686 (setq gdb-var-changed t))
687 (setcar (nthcdr 5 var) nil)) 676 (setcar (nthcdr 5 var) nil))
688 (goto-char (point-min)) 677 (goto-char (point-min))
689 (while (re-search-forward gdb-var-update-regexp nil t) 678 (while (re-search-forward gdb-var-update-regexp nil t)
690 (let ((varnum (match-string 1))) 679 (let ((varnum (match-string 1)))
691 (if (string-equal (match-string 2) "false") 680 (if (string-equal (match-string 2) "false")
692 (catch 'var-found 681 (catch 'var-found
693 (dolist (var gdb-var-list) 682 (dolist (var gdb-var-list)
694 (if (string-equal varnum (cadr var)) 683 (when (string-equal varnum (cadr var))
695 (setcar (nthcdr 5 var) 'out-of-scope) 684 (setcar (nthcdr 5 var) 'out-of-scope)
696 (throw 'var-found nil)))) 685 (throw 'var-found nil))))
697 (gdb-enqueue-input 686 (gdb-enqueue-input
698 (list 687 (list
699 (concat "server interpreter mi \"-var-evaluate-expression " 688 (concat "server interpreter mi \"-var-evaluate-expression "
700 varnum "\"\n") 689 varnum "\"\n")
732 (concat "-var-delete " varnum "\n")) 721 (concat "-var-delete " varnum "\n"))
733 'ignore)) 722 'ignore))
734 (setq gdb-var-list (delq var gdb-var-list)) 723 (setq gdb-var-list (delq var gdb-var-list))
735 (dolist (varchild gdb-var-list) 724 (dolist (varchild gdb-var-list)
736 (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild)) 725 (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild))
737 (setq gdb-var-list (delq varchild gdb-var-list)))) 726 (setq gdb-var-list (delq varchild gdb-var-list)))))))))
738 (setq gdb-var-changed t))))))
739 727
740 (defun gdb-edit-value (text token indent) 728 (defun gdb-edit-value (text token indent)
741 "Assign a value to a variable displayed in the speedbar." 729 "Assign a value to a variable displayed in the speedbar."
742 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) 730 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
743 (varnum (cadr var)) (value)) 731 (varnum (cadr var)) (value))
771 (gdb-var-list-children-1 token))) 759 (gdb-var-list-children-1 token)))
772 ((string-match "-" text) ;contract this node 760 ((string-match "-" text) ;contract this node
773 (dolist (var gdb-var-list) 761 (dolist (var gdb-var-list)
774 (if (string-match (concat token "\\.") (nth 1 var)) 762 (if (string-match (concat token "\\.") (nth 1 var))
775 (setq gdb-var-list (delq var gdb-var-list)))) 763 (setq gdb-var-list (delq var gdb-var-list))))
776 (setq gdb-var-changed t)
777 (with-current-buffer gud-comint-buffer 764 (with-current-buffer gud-comint-buffer
778 (speedbar-timer-fn))))) 765 (speedbar-timer-fn)))))
779 766
780 (defun gdb-get-target-string () 767 (defun gdb-get-target-string ()
781 (with-current-buffer gud-comint-buffer 768 (with-current-buffer gud-comint-buffer
1225 (gdb-invalidate-threads) 1212 (gdb-invalidate-threads)
1226 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. 1213 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
1227 ;; FIXME: with GDB-6 on Darwin, this might very well work. 1214 ;; FIXME: with GDB-6 on Darwin, this might very well work.
1228 ;; Only needed/used with speedbar/watch expressions. 1215 ;; Only needed/used with speedbar/watch expressions.
1229 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) 1216 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
1230 (setq gdb-var-changed t) ; force update 1217 (setq gdb-force-update t)
1231 (if (string-equal gdb-version "pre-6.4") 1218 (if (string-equal gdb-version "pre-6.4")
1232 (gdb-var-update) 1219 (gdb-var-update)
1233 (gdb-var-update-1))))) 1220 (gdb-var-update-1)))))
1234 (setq gdb-first-post-prompt nil) 1221 (setq gdb-first-post-prompt nil)
1235 (let ((sink gdb-output-sink)) 1222 (let ((sink gdb-output-sink))
2636 (when (markerp gdb-overlay-arrow-position) 2623 (when (markerp gdb-overlay-arrow-position)
2637 (move-marker gdb-overlay-arrow-position nil) 2624 (move-marker gdb-overlay-arrow-position nil)
2638 (setq gdb-overlay-arrow-position nil)) 2625 (setq gdb-overlay-arrow-position nil))
2639 (setq overlay-arrow-variable-list 2626 (setq overlay-arrow-variable-list
2640 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) 2627 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
2628 (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
2629 (speedbar-refresh))
2641 (setq gud-running nil) 2630 (setq gud-running nil)
2642 (setq gdb-active-process nil) 2631 (setq gdb-active-process nil)
2643 (setq gdb-var-list nil) 2632 (setq gdb-var-list nil)
2644 (remove-hook 'after-save-hook 'gdb-create-define-alist t)) 2633 (remove-hook 'after-save-hook 'gdb-create-define-alist t))
2645 2634
3032 (dolist (var1 gdb-var-list) 3021 (dolist (var1 gdb-var-list)
3033 (if (string-equal (cadr var1) (cadr varchild)) 3022 (if (string-equal (cadr var1) (cadr varchild))
3034 (throw 'child-already-watched nil))) 3023 (throw 'child-already-watched nil)))
3035 (push varchild var-list)))) 3024 (push varchild var-list))))
3036 (push var var-list))) 3025 (push var var-list)))
3037 (setq gdb-var-changed t)
3038 (setq gdb-var-list (nreverse var-list))))) 3026 (setq gdb-var-list (nreverse var-list)))))
3039 3027
3040 ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. 3028 ; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
3041 (defun gdb-var-update-1 () 3029 (defun gdb-var-update-1 ()
3042 (if (not (member 'gdb-var-update gdb-pending-triggers)) 3030 (if (not (member 'gdb-var-update gdb-pending-triggers))
3051 3039
3052 (defconst gdb-var-update-regexp-1 3040 (defconst gdb-var-update-regexp-1
3053 "name=\"\\(.*?\\)\",\\(?:value=\\(\".*?\"\\),\\)?in_scope=\"\\(.*?\\)\"") 3041 "name=\"\\(.*?\\)\",\\(?:value=\\(\".*?\"\\),\\)?in_scope=\"\\(.*?\\)\"")
3054 3042
3055 (defun gdb-var-update-handler-1 () 3043 (defun gdb-var-update-handler-1 ()
3056 (goto-char (point-min))
3057 (dolist (var gdb-var-list) 3044 (dolist (var gdb-var-list)
3058 (when (and (eq (car (nthcdr 5 var)) 'out-of-scope)
3059 (not (re-search-forward gdb-var-update-regexp-1 nil t))
3060 (not gdb-var-changed))
3061 (setq gdb-var-changed t))
3062 (setcar (nthcdr 5 var) nil)) 3045 (setcar (nthcdr 5 var) nil))
3063 (goto-char (point-min)) 3046 (goto-char (point-min))
3064 (while (re-search-forward gdb-var-update-regexp-1 nil t) 3047 (while (re-search-forward gdb-var-update-regexp-1 nil t)
3065 (let ((varnum (match-string 1))) 3048 (let ((varnum (match-string 1)))
3066 (catch 'var-found1 3049 (catch 'var-found
3067 (dolist (var gdb-var-list) 3050 (dolist (var gdb-var-list)
3068 (if (string-equal varnum (cadr var)) 3051 (when (string-equal varnum (cadr var))
3069 (progn 3052 (if (string-equal (match-string 3) "false")
3070 (if (string-equal (match-string 3) "false") 3053 (setcar (nthcdr 5 var) 'out-of-scope)
3071 (setcar (nthcdr 5 var) 'out-of-scope) 3054 (setcar (nthcdr 5 var) 'changed)
3072 (setcar (nthcdr 5 var) 'changed) 3055 (setcar (nthcdr 4 var)
3073 (setcar (nthcdr 4 var) 3056 (read (match-string 2))))
3074 (read (match-string 2)))) 3057 (throw 'var-found nil))))))
3075 (throw 'var-found1 nil))))))
3076 (setq gdb-var-changed t))
3077 (setq gdb-pending-triggers 3058 (setq gdb-pending-triggers
3078 (delq 'gdb-var-update gdb-pending-triggers)) 3059 (delq 'gdb-var-update gdb-pending-triggers))
3079 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) 3060 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
3080 ;; dummy command to update speedbar at right time 3061 ;; dummy command to update speedbar at right time
3081 (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn)) 3062 (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))