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) |
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)) |
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)) |
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 |
|
|