diff options
| -rw-r--r-- | gdb/mi/gdb-mi.el | 325 |
1 files changed, 40 insertions, 285 deletions
diff --git a/gdb/mi/gdb-mi.el b/gdb/mi/gdb-mi.el index 9a0aea7..4c4c30a 100644 --- a/gdb/mi/gdb-mi.el +++ b/gdb/mi/gdb-mi.el @@ -58,10 +58,6 @@ (require 'gud) (require 'gdb-ui) -(defvar gdb-source-file-list nil) -(defvar gdb-register-names nil "List of register names.") -(defvar gdb-changed-registers nil - "List of changed register numbers (strings).") (defvar gdb-last-command nil) (defvar gdb-prompt-name nil) @@ -190,7 +186,6 @@ detailed description of this mode. gdb-server-prefix nil gdb-flush-pending-output nil gdb-location-alist nil - gdb-find-file-unhook nil gdb-source-file-list nil gdb-last-command nil gdb-prompt-name nil @@ -207,7 +202,8 @@ detailed description of this mode. ;; find source file and compilation directory here (gdb-enqueue-input ; Needs GDB 6.2 onwards. - (list "-file-list-exec-source-files\n" 'gdb-get-source-file-list)) + (list "-file-list-exec-source-files\n" + 'gdb-set-gud-minor-mode-existing-buffers-1)) (gdb-enqueue-input ; Needs GDB 6.0 onwards. (list "-file-list-exec-source-file\n" 'gdb-get-source-file)) @@ -219,69 +215,6 @@ detailed description of this mode. (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2) (run-hooks 'gdbmi-mode-hook)) -; Force nil till fixed. -(defconst gdbmi-use-inferior-io-buffer nil) - -; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. -(defun gdbmi-var-list-children (varnum) - (gdb-enqueue-input - (list (concat "-var-list-children --all-values " - varnum "\n") - `(lambda () (gdbmi-var-list-children-handler ,varnum))))) - -(defconst gdbmi-var-list-children-regexp - "name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\ -value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") - -(defun gdbmi-var-list-children-handler (varnum) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (let ((var-list nil)) - (catch 'child-already-watched - (dolist (var gdb-var-list) - (if (string-equal varnum (cadr var)) - (progn - (push var var-list) - (while (re-search-forward gdbmi-var-list-children-regexp nil t) - (let ((varchild (list (match-string 2) - (match-string 1) - (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))) - (push varchild var-list)))) - (push var var-list))) - (setq gdb-var-changed t) - (setq gdb-var-list (nreverse var-list)))))) - -; Uses "-var-update --all-values". Needs CVS GDB (6.4+). -(defun gdbmi-var-update () - (gdb-enqueue-input - (list "-var-update --all-values *\n" 'gdbmi-var-update-handler))) - -(defconst gdbmi-var-update-regexp "name=\"\\(.*?\\)\",value=\\(\".*\"\\),") - -(defun gdbmi-var-update-handler () - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (while (re-search-forward gdbmi-var-update-regexp nil t) - (let ((varnum (match-string 1))) - (catch 'var-found-1 - (let ((num 0)) - (dolist (var gdb-var-list) - (if (string-equal varnum (cadr var)) - (progn - (setcar (nthcdr 5 var) t) - (setcar (nthcdr 4 var) (read (match-string 2))) - (setcar (nthcdr num gdb-var-list) var) - (throw 'var-found-1 nil))) - (setq num (+ num 1)))))) - (setq gdb-var-changed t))) - (with-current-buffer gud-comint-buffer - (speedbar-timer-fn))) (defun gdbmi-send (proc string) "A comint send filter for gdb." @@ -335,13 +268,13 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") (setq gdb-var-changed t) ; force update (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) - (gdbmi-var-update)) + (gdb-var-update-1)) (gdbmi-get-selected-frame) (gdbmi-invalidate-frames) (gdbmi-invalidate-breakpoints) (gdb-get-changed-registers) - (gdbmi-invalidate-registers) - (gdbmi-invalidate-locals))) + (gdb-invalidate-registers-1) + (gdb-invalidate-locals-1))) (defun gdbmi-prompt2 () "Handle any output and send next GDB command." @@ -468,8 +401,9 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") (defconst gdb-break-list-regexp "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",\ -addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",fullname=\".*?\",\ -line=\"\\(.*?\\)\"") +addr=\"\\(.*?\\)\",\ +\\(?:func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",fullname=\".*?\",line=\"\\(.*?\\)\",\ +\\|\\(?:what=\"\\(.*?\\)\",\\)*\\)times=\"\\(.*?\\)\"") (defun gdb-break-list-handler () (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints @@ -485,84 +419,37 @@ line=\"\\(.*?\\)\"") (match-string 5) (match-string 6) (match-string 7) - (match-string 8)))) + (match-string 8) + (match-string 9) + (match-string 10)))) (push breakpoint breakpoints-list)))) (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer))) (and buf (with-current-buffer buf (let ((p (point)) (buffer-read-only nil)) (erase-buffer) - (insert "Num Type Disp Enb Func\tFile:Line\tAddr\n") + (insert "Num Type Disp Enb Hits Addr What\n") (dolist (breakpoint breakpoints-list) - (insert (concat - (nth 0 breakpoint) " " - (nth 1 breakpoint) " " - (nth 2 breakpoint) " " - (nth 3 breakpoint) " " - (nth 5 breakpoint) "\t" - (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t" - (nth 4 breakpoint) "\n"))) + (insert + (concat + (nth 0 breakpoint) " " + (nth 1 breakpoint) " " + (nth 2 breakpoint) " " + (nth 3 breakpoint) " " + (nth 9 breakpoint) " " + (nth 4 breakpoint) " " + (if (nth 5 breakpoint) + (concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n") + (concat (nth 8 breakpoint) "\n"))))) (goto-char p)))))) - (gdb-break-list-custom)) - -;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) -(defun gdb-break-list-custom () - (let ((flag) (bptno)) - ;; - ;; remove all breakpoint-icons in source buffers but not assembler buffer - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (if (and (eq gud-minor-mode 'gdbmi) - (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) - (gdb-remove-breakpoint-icons (point-min) (point-max))))) - (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) - (save-excursion - (goto-char (point-min)) - (while (< (point) (- (point-max) 1)) - (forward-line 1) - (if (looking-at - "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+\\S-+\\s-+\ -\\(\\S-+\\):\\([0-9]+\\)") - (progn - (setq bptno (match-string 1)) - (setq flag (char-after (match-beginning 2))) - (let ((line (match-string 4)) (buffer-read-only nil) - (file (match-string 3))) - (add-text-properties (point-at-bol) (point-at-eol) - '(mouse-face highlight - help-echo "mouse-2, RET: visit breakpoint")) - (unless (file-exists-p file) - (setq file (cdr (assoc bptno gdb-location-alist)))) - (if (and file - (not (string-equal file "File not found"))) - (with-current-buffer (find-file-noselect file) - (set (make-local-variable 'gud-minor-mode) - 'gdbmi) - (set (make-local-variable 'tool-bar-map) - gud-tool-bar-map) - ;; only want one breakpoint icon at each location - (save-excursion - (goto-line (string-to-number line)) - (gdb-put-breakpoint-icon (eq flag ?y) bptno))) - (gdb-enqueue-input - (list (concat "list " - (match-string-no-properties 3) ":1\n") - 'ignore)) - (gdb-enqueue-input - (list "-file-list-exec-source-file\n" - `(lambda () (gdbmi-get-location - ,bptno ,line ,flag)))))))))) - (end-of-line))) - (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) - -(defvar gdbmi-source-file-regexp "fullname=\"\\(.*?\\)\"") + (gdb-info-breakpoints-custom)) (defun gdbmi-get-location (bptno line flag) "Find the directory containing the relevant source file. Put in buffer and place breakpoint icon." (goto-char (point-min)) (catch 'file-not-found - (if (re-search-forward gdbmi-source-file-regexp nil t) + (if (re-search-forward gdb-source-file-regexp-1 nil t) (delete (cons bptno "File not found") gdb-location-alist) (push (cons bptno (match-string 1)) gdb-location-alist) (gdb-resync) @@ -588,10 +475,10 @@ Add directory to search path for source files using the GDB command, dir.")) "-stack-list-frames\n" gdb-stack-list-frames-handler) - (defconst gdb-stack-list-frames-regexp "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\ -file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") +\\(?:file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"\\|\ +from=\"\\(.*?\\)\"\\)") (defun gdb-stack-list-frames-handler () (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames @@ -605,20 +492,24 @@ file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") (match-string 2) (match-string 3) (match-string 4) - (match-string 5)))) + (match-string 5) + (match-string 6)))) (push frame call-stack)))) (let ((buf (gdb-get-buffer 'gdb-stack-buffer))) (and buf (with-current-buffer buf (let ((p (point)) (buffer-read-only nil)) (erase-buffer) - (insert "Level\tFunc\tFile:Line\tAddr\n") + (insert "Level\tAddr\tFunc\tFile:Line\n") (dolist (frame (nreverse call-stack)) - (insert (concat - (nth 0 frame) "\t" - (nth 2 frame) "\t" - (nth 3 frame) ":" (nth 4 frame) "\t" - (nth 1 frame) "\n"))) + (insert + (concat + (nth 0 frame) "\t" + (nth 1 frame) "\t" + (nth 2 frame) "\t" + (if (nth 3 frame) + (concat "at "(nth 3 frame) ":" (nth 4 frame) "\n") + (concat "from " (nth 5 frame) "\n"))))) (goto-char p)))))) (gdb-stack-list-frames-custom)) @@ -639,143 +530,13 @@ file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") 'face '(:inverse-video t))) (forward-line 1)))))) -;; Locals buffer. -;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. -(def-gdb-auto-update-trigger gdbmi-invalidate-locals - (gdb-get-buffer 'gdb-locals-buffer) - "-stack-list-locals --simple-values\n" - gdb-stack-list-locals-handler) - -(defconst gdb-stack-list-locals-regexp - (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")) - -;; Dont display values of arrays or structures. -;; These can be expanded using gud-watch. -(defun gdb-stack-list-locals-handler nil - (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals - gdb-pending-triggers)) - (let ((local nil) - (locals-list nil)) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (while (re-search-forward gdb-stack-list-locals-regexp nil t) - (let ((local (list (match-string 1) - (match-string 2) - nil))) - (if (looking-at ",value=\\(\".*\"\\)}") - (setcar (nthcdr 2 local) (read (match-string 1)))) - (push local locals-list)))) - (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) - (and buf (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (p (window-point window)) - (buffer-read-only nil)) - (erase-buffer) - (dolist (local locals-list) - (insert - (concat (car local) "\t" (nth 1 local) "\t" - (or (nth 2 local) - (if (string-match "struct" (nth 1 local)) - "(structure)" - "(array)")) - "\n"))) - (set-window-point window p))))))) - - -;; Registers buffer. -;; -(def-gdb-auto-update-trigger gdbmi-invalidate-registers - (gdb-get-buffer 'gdb-registers-buffer) - "-data-list-register-values x\n" - gdb-data-list-register-values-handler) - -(defconst gdb-data-list-register-values-regexp - "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"") - -(defun gdb-data-list-register-values-handler () - (setq gdb-pending-triggers (delq 'gdbmi-invalidate-registers - gdb-pending-triggers)) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (if (re-search-forward gdb-error-regexp nil t) - (progn - (let ((match nil)) - (setq match (match-string 1)) - (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert match) - (goto-char (point-min)))))) - (let ((register-list (reverse gdb-register-names)) - (register nil) (register-string nil) (register-values nil)) - (goto-char (point-min)) - (while (re-search-forward gdb-data-list-register-values-regexp nil t) - (setq register (pop register-list)) - (setq register-string (concat register "\t" (match-string 2) "\n")) - (if (member (match-string 1) gdb-changed-registers) - (put-text-property 0 (length register-string) - 'face 'font-lock-warning-face - register-string)) - (setq register-values - (concat register-values register-string))) - (let ((buf (gdb-get-buffer 'gdb-registers-buffer))) - (with-current-buffer buf - (let ((p (window-point (get-buffer-window buf 0))) - (buffer-read-only nil)) - (erase-buffer) - (insert register-values) - (set-window-point (get-buffer-window buf 0) p))))))) - (gdb-data-list-register-values-custom)) - -(defun gdb-data-list-register-values-custom () - (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) - (save-excursion - (let ((buffer-read-only nil) - bl) - (goto-char (point-min)) - (while (< (point) (point-max)) - (setq bl (line-beginning-position)) - (when (looking-at "^[^\t]+") - (put-text-property bl (match-end 0) - 'face font-lock-variable-name-face)) - (forward-line 1)))))) - -(defun gdb-get-changed-registers () - (if (and (gdb-get-buffer 'gdb-registers-buffer) - (not (member 'gdb-get-changed-registers gdb-pending-triggers))) - (progn - (gdb-enqueue-input - (list - "-data-list-changed-registers\n" - 'gdb-get-changed-registers-handler)) - (push 'gdb-get-changed-registers gdb-pending-triggers)))) - -(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") - -(defun gdb-get-changed-registers-handler () - (setq gdb-pending-triggers - (delq 'gdb-get-changed-registers gdb-pending-triggers)) - (setq gdb-changed-registers nil) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (while (re-search-forward gdb-data-list-register-names-regexp nil t) - (push (match-string 1) gdb-changed-registers)))) - -(defun gdb-get-register-names () - "Create a list of register names." - (goto-char (point-min)) - (setq gdb-register-names nil) - (while (re-search-forward gdb-data-list-register-names-regexp nil t) - (push (match-string 1) gdb-register-names))) -;; these functions/variables may go into gdb-ui.el in the near future -;; (from gdb-nui.el) - +;; gdb-ui.el uses "info source" to find out if macro information is present. (defun gdb-get-source-file () "Find the source file where the program starts and display it with related buffers, if required." (goto-char (point-min)) - (if (re-search-forward gdbmi-source-file-regexp nil t) + (if (re-search-forward gdb-source-file-regexp-1 nil t) (setq gdb-main-file (match-string 1))) (if gdb-many-windows (gdb-setup-windows) @@ -784,12 +545,6 @@ buffers, if required." (let ((pop-up-windows t)) (display-buffer (gud-find-file gdb-main-file)))))) -(defun gdb-get-source-file-list () - "Create list of source files for current GDB session." - (goto-char (point-min)) - (while (re-search-forward gdbmi-source-file-regexp nil t) - (push (match-string 1) gdb-source-file-list))) - (defun gdbmi-get-selected-frame () (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers)) (progn |