Mercurial > emacs
comparison lisp/progmodes/gdb-ui.el @ 69000:0dcc5b9decbf
(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)) |