/[emacs]/emacs/lisp/progmodes/gdb-ui.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/gdb-ui.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.123 by nickrob, Sun Dec 4 09:12:07 2005 UTC revision 1.124 by nickrob, Tue Dec 6 02:31:16 2005 UTC
# Line 528  With arg, use separate IO iff arg is pos Line 528  With arg, use separate IO iff arg is pos
528    "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")    "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
529    
530  (defun gdb-var-create-handler (expr)  (defun gdb-var-create-handler (expr)
531    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)    (goto-char (point-min))
532      (goto-char (point-min))    (if (re-search-forward gdb-var-create-regexp nil t)
533      (if (re-search-forward gdb-var-create-regexp nil t)        (let ((var (list expr
534          (let ((var (list expr                         (match-string 1)
535                           (match-string 1)                         (match-string 2)
536                           (match-string 2)                         (match-string 3)
537                           (match-string 3)                         nil nil)))
538                           nil nil)))          (push var gdb-var-list)
539            (push var gdb-var-list)          (speedbar 1)
540            (speedbar 1)          (unless (string-equal
541            (unless (string-equal                   speedbar-initial-expansion-list-name "GUD")
542                     speedbar-initial-expansion-list-name "GUD")            (speedbar-change-initial-expansion-list "GUD"))
543              (speedbar-change-initial-expansion-list "GUD"))          (gdb-enqueue-input
544            (gdb-enqueue-input           (list
545             (list            (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
546              (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)                    'gdba)
547                      'gdba)                (concat "server interpreter mi \"-var-evaluate-expression "
548                  (concat "server interpreter mi \"-var-evaluate-expression "                        (nth 1 var) "\"\n")
549                          (nth 1 var) "\"\n")              (concat "-var-evaluate-expression " (nth 1 var) "\n"))
550                (concat "-var-evaluate-expression " (nth 1 var) "\n"))            `(lambda () (gdb-var-evaluate-expression-handler
551              `(lambda () (gdb-var-evaluate-expression-handler                         ,(nth 1 var) nil))))
552                           ,(nth 1 var) nil))))          (setq gdb-var-changed t))
553              (setq gdb-var-changed t))      (if (search-forward "Undefined command" nil t)
554        (if (search-forward "Undefined command" nil t)          (message-box "Watching expressions requires gdb 6.0 onwards")
555            (message-box "Watching expressions requires gdb 6.0 onwards")        (message "No symbol \"%s\" in current context." expr))))
         (message "No symbol \"%s\" in current context." expr)))))  
556    
557  (defun gdb-var-evaluate-expression-handler (varnum changed)  (defun gdb-var-evaluate-expression-handler (varnum changed)
558    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)    (goto-char (point-min))
559      (goto-char (point-min))    (re-search-forward ".*value=\\(\".*\"\\)" nil t)
560      (re-search-forward ".*value=\\(\".*\"\\)" nil t)    (catch 'var-found
561      (catch 'var-found      (let ((num 0))
562        (let ((num 0))        (dolist (var gdb-var-list)
563          (dolist (var gdb-var-list)          (if (string-equal varnum (cadr var))
564            (if (string-equal varnum (cadr var))              (progn
565                (progn                (if changed (setcar (nthcdr 5 var) t))
566                  (if changed (setcar (nthcdr 5 var) t))                (setcar (nthcdr 4 var) (read (match-string 1)))
567                  (setcar (nthcdr 4 var) (read (match-string 1)))                (setcar (nthcdr num gdb-var-list) var)
568                  (setcar (nthcdr num gdb-var-list) var)                (throw 'var-found nil)))
569                  (throw 'var-found nil)))          (setq num (+ num 1)))))
           (setq num (+ num 1))))))  
570    (setq gdb-var-changed t))    (setq gdb-var-changed t))
571    
572  (defun gdb-var-list-children (varnum)  (defun gdb-var-list-children (varnum)
# Line 581  With arg, use separate IO iff arg is pos Line 579  With arg, use separate IO iff arg is pos
579  type=\"\\(.*?\\)\"")  type=\"\\(.*?\\)\"")
580    
581  (defun gdb-var-list-children-handler (varnum)  (defun gdb-var-list-children-handler (varnum)
582    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)    (goto-char (point-min))
583      (goto-char (point-min))    (let ((var-list nil))
584      (let ((var-list nil))      (catch 'child-already-watched
585       (catch 'child-already-watched        (dolist (var gdb-var-list)
586         (dolist (var gdb-var-list)          (if (string-equal varnum (cadr var))
587           (if (string-equal varnum (cadr var))              (progn
588               (progn                (push var var-list)
589                 (push var var-list)                (while (re-search-forward gdb-var-list-children-regexp nil t)
590                 (while (re-search-forward gdb-var-list-children-regexp nil t)                  (let ((varchild (list (match-string 2)
591                   (let ((varchild (list (match-string 2)                                        (match-string 1)
592                                         (match-string 1)                                        (match-string 3)
593                                         (match-string 3)                                        (match-string 4)
594                                         (match-string 4)                                        nil nil)))
595                                         nil nil)))                    (dolist (var1 gdb-var-list)
596                     (dolist (var1 gdb-var-list)                      (if (string-equal (cadr var1) (cadr varchild))
597                       (if (string-equal (cadr var1) (cadr varchild))                          (throw 'child-already-watched nil)))
598                           (throw 'child-already-watched nil)))                    (push varchild var-list)
599                     (push varchild var-list)                    (gdb-enqueue-input
600                     (gdb-enqueue-input                     (list
601                      (list                      (concat
602                       (concat                       "server interpreter mi \"-var-evaluate-expression "
603                        "server interpreter mi \"-var-evaluate-expression "                       (nth 1 varchild) "\"\n")
604                        (nth 1 varchild) "\"\n")                      `(lambda () (gdb-var-evaluate-expression-handler
605                       `(lambda () (gdb-var-evaluate-expression-handler                                   ,(nth 1 varchild) nil)))))))
606                                    ,(nth 1 varchild) nil)))))))            (push var var-list)))
607             (push var var-list)))        (setq gdb-var-list (nreverse var-list)))))
        (setq gdb-var-list (nreverse var-list))))))  
608    
609  (defun gdb-var-update ()  (defun gdb-var-update ()
610    (when (not (member 'gdb-var-update gdb-pending-triggers))    (when (not (member 'gdb-var-update gdb-pending-triggers))
# Line 619  type=\"\\(.*?\\)\"") Line 616  type=\"\\(.*?\\)\"")
616  (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")  (defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"")
617    
618  (defun gdb-var-update-handler ()  (defun gdb-var-update-handler ()
619    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)    (goto-char (point-min))
620      (goto-char (point-min))    (while (re-search-forward gdb-var-update-regexp nil t)
621      (while (re-search-forward gdb-var-update-regexp nil t)      (catch 'var-found-1
622        (catch 'var-found-1        (let ((varnum (match-string 1)))
623          (let ((varnum (match-string 1)))          (dolist (var gdb-var-list)
624            (dolist (var gdb-var-list)            (gdb-enqueue-input
625              (gdb-enqueue-input             (list
626               (list              (concat "server interpreter mi \"-var-evaluate-expression "
627                (concat "server interpreter mi \"-var-evaluate-expression "                      varnum "\"\n")
628                        varnum "\"\n")              `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))
629                `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))            (throw 'var-found-1 nil)))))
             (throw 'var-found-1 nil))))))  
630    (setq gdb-pending-triggers    (setq gdb-pending-triggers
631     (delq 'gdb-var-update gdb-pending-triggers))          (delq 'gdb-var-update gdb-pending-triggers))
632    (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))    (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
633      ;; Dummy command to update speedbar at right time.      ;; Dummy command to update speedbar at right time.
634      (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))      (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))
# Line 2891  BUFFER nil or omitted means use the curr Line 2887  BUFFER nil or omitted means use the curr
2887  (defun gdb-frame-handler ()  (defun gdb-frame-handler ()
2888    (setq gdb-pending-triggers    (setq gdb-pending-triggers
2889          (delq 'gdb-get-selected-frame gdb-pending-triggers))          (delq 'gdb-get-selected-frame gdb-pending-triggers))
2890    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)    (goto-char (point-min))
2891      (goto-char (point-min))    (if (re-search-forward  "Stack level \\([0-9]+\\)" nil t)
2892      (if (re-search-forward  "Stack level \\([0-9]+\\)" nil t)        (setq gdb-frame-number (match-string 1)))
2893          (setq gdb-frame-number (match-string 1)))    (goto-char (point-min))
2894      (goto-char (point-min))    (if (re-search-forward
2895      (if (re-search-forward         ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? " nil t)
2896           ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? " nil t)        (progn
2897          (progn          (setq gdb-selected-frame (match-string 2))
2898            (setq gdb-selected-frame (match-string 2))          (if (gdb-get-buffer 'gdb-locals-buffer)
2899            (if (gdb-get-buffer 'gdb-locals-buffer)              (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
2900                (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)                (setq mode-name (concat "Locals:" gdb-selected-frame))))
2901                  (setq mode-name (concat "Locals:" gdb-selected-frame))))          (if (gdb-get-buffer 'gdb-assembler-buffer)
2902            (if (gdb-get-buffer 'gdb-assembler-buffer)              (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
2903                (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)                (setq mode-name (concat "Machine:" gdb-selected-frame))))
2904                  (setq mode-name (concat "Machine:" gdb-selected-frame))))          (setq gdb-frame-address (match-string 1))))
2905            (setq gdb-frame-address (match-string 1))))    (goto-char (point-min))
2906      (goto-char (point-min))    (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
2907      (if (re-search-forward " source language \\(\\S-*\\)\." nil t)        (setq gdb-current-language (match-string 1)))
2908          (setq gdb-current-language (match-string 1))))    (gdb-invalidate-assembler))
     (gdb-invalidate-assembler))  
2909    
2910  (provide 'gdb-ui)  (provide 'gdb-ui)
2911    

Legend:
Removed from v.1.123  
changed lines
  Added in v.1.124

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26