Mercurial > emacs
diff lisp/progmodes/gdb-mi.el @ 104146:907e635649e5
* progmodes/gdb-mi.el (gdb-breakpoints-buffer-name)
(gdb-locals-buffer-name, gdb-registers-buffer-name)
(gdb-memory-buffer-name, gdb-stack-buffer-name): Do not switch
to (gud-comint-buffer) in *-buffer-name functions
because (gdb-get-target-string) already does that.
(gdb-locals-handler-custom, gdb-registers-handler-custom)
(gdb-changed-registers-handler): Rewritten without regexps.
author | Dmitry Dzhus <dima@sphinx.net.ru> |
---|---|
date | Tue, 04 Aug 2009 13:11:06 +0000 |
parents | ff7110a449a4 |
children | 9629847b09ed |
line wrap: on
line diff
--- a/lisp/progmodes/gdb-mi.el Tue Aug 04 12:46:26 2009 +0000 +++ b/lisp/progmodes/gdb-mi.el Tue Aug 04 13:11:06 2009 +0000 @@ -1756,8 +1756,7 @@ (get-text-property 0 'gdb-bptno obj))))))))) (defun gdb-breakpoints-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*breakpoints of " (gdb-get-target-string) "*"))) + (concat "*breakpoints of " (gdb-get-target-string) "*")) (def-gdb-display-buffer gdb-display-breakpoints-buffer @@ -2354,8 +2353,7 @@ 'gdb-invalidate-memory) (defun gdb-memory-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*memory of " (gdb-get-target-string) "*"))) + (concat "*memory of " (gdb-get-target-string) "*")) (def-gdb-display-buffer gdb-display-memory-buffer @@ -2614,8 +2612,7 @@ (forward-line 1))))) (defun gdb-stack-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*stack frames of " (gdb-get-target-string) "*"))) + (concat "*stack frames of " (gdb-get-target-string) "*")) (def-gdb-display-buffer gdb-display-stack-buffer @@ -2678,10 +2675,10 @@ 'gdb-locals-buffer-name 'gdb-locals-mode) -(def-gdb-auto-update-trigger gdb-invalidate-locals - (gdb-get-buffer 'gdb-locals-buffer) +(def-gdb-auto-updated-buffer gdb-locals-buffer + gdb-invalidate-locals (concat (gdb-current-context-command "-stack-list-locals") " --simple-values") - gdb-stack-list-locals-handler) + gdb-locals-handler gdb-locals-handler-custom) (defconst gdb-stack-list-locals-regexp (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")) @@ -2715,45 +2712,27 @@ ;; 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 'gdb-invalidate-locals - gdb-pending-triggers)) - (let (local locals-list) - (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)) - (start (window-start window)) - (p (window-point window)) - (buffer-read-only nil) (name) (value)) - (erase-buffer) - (dolist (local locals-list) - (setq name (car local)) - (setq value (nth 2 local)) - (if (or (not value) - (string-match "\\0x" value)) - (add-text-properties 0 (length name) +(defun gdb-locals-handler-custom () + (let ((locals-list (gdb-get-field (json-partial-output) 'locals))) + (dolist (local locals-list) + (let ((name (gdb-get-field local 'name)) + (value (gdb-get-field local 'value)) + (type (gdb-get-field local 'type))) + (if (or (not value) + (string-match "\\0x" value)) + (add-text-properties 0 (length name) `(mouse-face highlight help-echo "mouse-2: create watch expression" local-map ,gdb-locals-watch-map) name) - (add-text-properties 0 (length value) - `(mouse-face highlight + (add-text-properties 0 (length value) + `(mouse-face highlight help-echo "mouse-2: edit value" local-map ,gdb-edit-locals-map-1) value)) (insert - (concat name "\t" (nth 1 local) - "\t" (nth 2 local) "\n"))) - (set-window-start window start) - (set-window-point window p))))))) + (concat name "\t" type + "\t" value "\n")))))) (defvar gdb-locals-header (list @@ -2786,8 +2765,7 @@ 'gdb-invalidate-locals) (defun gdb-locals-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*locals of " (gdb-get-target-string) "*"))) + (concat "*locals of " (gdb-get-target-string) "*")) (def-gdb-display-buffer gdb-display-locals-buffer @@ -2806,60 +2784,28 @@ 'gdb-registers-buffer-name 'gdb-registers-mode) -(def-gdb-auto-update-trigger gdb-invalidate-registers - (gdb-get-buffer 'gdb-registers-buffer) +(def-gdb-auto-updated-buffer gdb-registers-buffer + gdb-invalidate-registers (concat (gdb-current-context-command "-data-list-register-values") " x") - 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 'gdb-invalidate-registers - gdb-pending-triggers)) - (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)))))) + gdb-registers-handler + gdb-registers-handler-custom) + +(defun gdb-registers-handler-custom () + (let ((register-values (gdb-get-field (json-partial-output) 'register-values)) + (register-names-list (reverse gdb-register-names))) + (dolist (register register-values) + (let* ((register-number (gdb-get-field register 'number)) + (value (gdb-get-field register 'value)) + (register-name (nth (string-to-number register-number) + register-names-list))) + (insert + (concat + (propertize register-name 'face font-lock-variable-name-face) + "\t" + (if (member register-number gdb-changed-registers) + (propertize value 'face font-lock-warning-face) + value) + "\n")))))) (defvar gdb-registers-mode-map (let ((map (make-sparse-keymap))) @@ -2882,8 +2828,7 @@ 'gdb-invalidate-registers) (defun gdb-registers-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*registers of " (gdb-get-target-string) "*"))) + (concat "*registers of " (gdb-get-target-string) "*")) (def-gdb-display-buffer gdb-display-registers-buffer @@ -2903,25 +2848,23 @@ (gdb-input (list "-data-list-changed-registers" - 'gdb-get-changed-registers-handler)) + 'gdb-changed-registers-handler)) (push 'gdb-get-changed-registers gdb-pending-triggers)))) -(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") - -(defun gdb-get-changed-registers-handler () +(defun gdb-changed-registers-handler () (setq gdb-pending-triggers - (delq 'gdb-get-changed-registers gdb-pending-triggers)) + (delq 'gdb-get-changed-registers gdb-pending-triggers)) (setq gdb-changed-registers nil) - (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)) + (dolist (register-number (gdb-get-field (json-partial-output) 'changed-registers)) + (push register-number gdb-changed-registers))) + +(defun gdb-register-names-handler () + ;; Don't use gdb-pending-triggers because this handler is called + ;; only once (in gdb-init-1) (setq gdb-register-names nil) - (while (re-search-forward gdb-data-list-register-names-regexp nil t) - (push (match-string 1) gdb-register-names))) + (dolist (register-name (gdb-get-field (json-partial-output) 'register-names)) + (push register-name gdb-register-names)) + (setq gdb-register-names (reverse gdb-register-names))) (defun gdb-get-source-file-list ()