Use more functions from gdb-ui.el.

(gdb-break-list-regexp): Match "what" field if present.
(gdb-stack-list-frames-regexp): Match "from" field if present.
(gdb-stack-list-frames-handler): Present output like "info
breakpoints" so regexps can be shared with gdb-ui
This commit is contained in:
Nick Roberts 2006-02-14 09:20:07 +00:00
parent 7314787aef
commit 48fc115b2a
1 changed files with 40 additions and 285 deletions

View File

@ -58,10 +58,6 @@
(require 'gud) (require 'gud)
(require 'gdb-ui) (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-last-command nil)
(defvar gdb-prompt-name nil) (defvar gdb-prompt-name nil)
@ -190,7 +186,6 @@ detailed description of this mode.
gdb-server-prefix nil gdb-server-prefix nil
gdb-flush-pending-output nil gdb-flush-pending-output nil
gdb-location-alist nil gdb-location-alist nil
gdb-find-file-unhook nil
gdb-source-file-list nil gdb-source-file-list nil
gdb-last-command nil gdb-last-command nil
gdb-prompt-name nil gdb-prompt-name nil
@ -207,7 +202,8 @@ detailed description of this mode.
;; find source file and compilation directory here ;; find source file and compilation directory here
(gdb-enqueue-input (gdb-enqueue-input
; Needs GDB 6.2 onwards. ; 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 (gdb-enqueue-input
; Needs GDB 6.0 onwards. ; Needs GDB 6.0 onwards.
(list "-file-list-exec-source-file\n" 'gdb-get-source-file)) (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) (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
(run-hooks 'gdbmi-mode-hook)) (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) (defun gdbmi-send (proc string)
"A comint send filter for gdb." "A comint send filter for gdb."
@ -335,13 +268,13 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")
(setq gdb-var-changed t) ; force update (setq gdb-var-changed t) ; force update
(dolist (var gdb-var-list) (dolist (var gdb-var-list)
(setcar (nthcdr 5 var) nil)) (setcar (nthcdr 5 var) nil))
(gdbmi-var-update)) (gdb-var-update-1))
(gdbmi-get-selected-frame) (gdbmi-get-selected-frame)
(gdbmi-invalidate-frames) (gdbmi-invalidate-frames)
(gdbmi-invalidate-breakpoints) (gdbmi-invalidate-breakpoints)
(gdb-get-changed-registers) (gdb-get-changed-registers)
(gdbmi-invalidate-registers) (gdb-invalidate-registers-1)
(gdbmi-invalidate-locals))) (gdb-invalidate-locals-1)))
(defun gdbmi-prompt2 () (defun gdbmi-prompt2 ()
"Handle any output and send next GDB command." "Handle any output and send next GDB command."
@ -468,8 +401,9 @@ value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")
(defconst gdb-break-list-regexp (defconst gdb-break-list-regexp
"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",\ "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",\
addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",fullname=\".*?\",\ addr=\"\\(.*?\\)\",\
line=\"\\(.*?\\)\"") \\(?:func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",fullname=\".*?\",line=\"\\(.*?\\)\",\
\\|\\(?:what=\"\\(.*?\\)\",\\)*\\)times=\"\\(.*?\\)\"")
(defun gdb-break-list-handler () (defun gdb-break-list-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
@ -485,84 +419,37 @@ line=\"\\(.*?\\)\"")
(match-string 5) (match-string 5)
(match-string 6) (match-string 6)
(match-string 7) (match-string 7)
(match-string 8)))) (match-string 8)
(match-string 9)
(match-string 10))))
(push breakpoint breakpoints-list)))) (push breakpoint breakpoints-list))))
(let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer))) (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
(and buf (with-current-buffer buf (and buf (with-current-buffer buf
(let ((p (point)) (let ((p (point))
(buffer-read-only nil)) (buffer-read-only nil))
(erase-buffer) (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) (dolist (breakpoint breakpoints-list)
(insert (concat (insert
(nth 0 breakpoint) " " (concat
(nth 1 breakpoint) " " (nth 0 breakpoint) " "
(nth 2 breakpoint) " " (nth 1 breakpoint) " "
(nth 3 breakpoint) " " (nth 2 breakpoint) " "
(nth 5 breakpoint) "\t" (nth 3 breakpoint) " "
(nth 6 breakpoint) ":" (nth 7 breakpoint) "\t" (nth 9 breakpoint) " "
(nth 4 breakpoint) "\n"))) (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)))))) (goto-char p))))))
(gdb-break-list-custom)) (gdb-info-breakpoints-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=\"\\(.*?\\)\"")
(defun gdbmi-get-location (bptno line flag) (defun gdbmi-get-location (bptno line flag)
"Find the directory containing the relevant source file. "Find the directory containing the relevant source file.
Put in buffer and place breakpoint icon." Put in buffer and place breakpoint icon."
(goto-char (point-min)) (goto-char (point-min))
(catch 'file-not-found (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) (delete (cons bptno "File not found") gdb-location-alist)
(push (cons bptno (match-string 1)) gdb-location-alist) (push (cons bptno (match-string 1)) gdb-location-alist)
(gdb-resync) (gdb-resync)
@ -588,10 +475,10 @@ Add directory to search path for source files using the GDB command, dir."))
"-stack-list-frames\n" "-stack-list-frames\n"
gdb-stack-list-frames-handler) gdb-stack-list-frames-handler)
(defconst gdb-stack-list-frames-regexp (defconst gdb-stack-list-frames-regexp
"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\ "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\
file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") \\(?:file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"\\|\
from=\"\\(.*?\\)\"\\)")
(defun gdb-stack-list-frames-handler () (defun gdb-stack-list-frames-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
@ -605,20 +492,24 @@ file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
(match-string 2) (match-string 2)
(match-string 3) (match-string 3)
(match-string 4) (match-string 4)
(match-string 5)))) (match-string 5)
(match-string 6))))
(push frame call-stack)))) (push frame call-stack))))
(let ((buf (gdb-get-buffer 'gdb-stack-buffer))) (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
(and buf (with-current-buffer buf (and buf (with-current-buffer buf
(let ((p (point)) (let ((p (point))
(buffer-read-only nil)) (buffer-read-only nil))
(erase-buffer) (erase-buffer)
(insert "Level\tFunc\tFile:Line\tAddr\n") (insert "Level\tAddr\tFunc\tFile:Line\n")
(dolist (frame (nreverse call-stack)) (dolist (frame (nreverse call-stack))
(insert (concat (insert
(nth 0 frame) "\t" (concat
(nth 2 frame) "\t" (nth 0 frame) "\t"
(nth 3 frame) ":" (nth 4 frame) "\t" (nth 1 frame) "\t"
(nth 1 frame) "\n"))) (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)))))) (goto-char p))))))
(gdb-stack-list-frames-custom)) (gdb-stack-list-frames-custom))
@ -639,143 +530,13 @@ file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
'face '(:inverse-video t))) 'face '(:inverse-video t)))
(forward-line 1)))))) (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. ;; gdb-ui.el uses "info source" to find out if macro information is present.
;;
(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)
(defun gdb-get-source-file () (defun gdb-get-source-file ()
"Find the source file where the program starts and display it with related "Find the source file where the program starts and display it with related
buffers, if required." buffers, if required."
(goto-char (point-min)) (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))) (setq gdb-main-file (match-string 1)))
(if gdb-many-windows (if gdb-many-windows
(gdb-setup-windows) (gdb-setup-windows)
@ -784,12 +545,6 @@ buffers, if required."
(let ((pop-up-windows t)) (let ((pop-up-windows t))
(display-buffer (gud-find-file gdb-main-file)))))) (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 () (defun gdbmi-get-selected-frame ()
(if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers)) (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers))
(progn (progn