Mercurial > emacs
diff lisp/progmodes/gdb-ui.el @ 83492:203c9b24206b
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-153
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-154
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-155
Remove nick-abbrevs stuff from rcirc.el
* emacs@sv.gnu.org/emacs--devo--0--patch-156
rcirc.el update from Ryan Yeske
* emacs@sv.gnu.org/emacs--devo--0--patch-157
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-158
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-159
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-532
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Wed, 15 Mar 2006 17:22:12 +0000 |
parents | 0cdee8b991e1 3f8495af82a4 |
children | b901f4f12f33 |
line wrap: on
line diff
--- 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"