Mercurial > emacs
comparison lisp/progmodes/gdb-mi.el @ 104203:6deae7f783dc
(gdb-read-memory-custom)
(gdb-memory-set-address, def-gdb-set-positive-number)
(def-gdb-memory-format, def-gdb-memory-unit): Update memory buffer
after changing settings.
(gdb-invalidate-disassembly): Update when first shown.
(gdb-edit-locals-value): Fixed.
(gdb-registers-handler-custom): Print registers in right order and
allow changing register values (only for current thread yet).
author | Dmitry Dzhus <dima@sphinx.net.ru> |
---|---|
date | Sat, 08 Aug 2009 13:42:03 +0000 |
parents | 71fb0a824791 |
children | a67a0dcd448d |
comparison
equal
deleted
inserted
replaced
104202:6dd251e7ee9c | 104203:6deae7f783dc |
---|---|
250 `(member ,item gdb-pending-triggers)) | 250 `(member ,item gdb-pending-triggers)) |
251 (defmacro gdb-delete-pending (item) | 251 (defmacro gdb-delete-pending (item) |
252 `(setq gdb-pending-triggers | 252 `(setq gdb-pending-triggers |
253 (delete ,item gdb-pending-triggers))) | 253 (delete ,item gdb-pending-triggers))) |
254 | 254 |
255 (defvar gdb-wait-for-pending-timeout 0.5) | 255 (defmacro gdb-wait-for-pending (&rest body) |
256 | 256 "Wait until `gdb-pending-triggers' is empty and evaluate FORM. |
257 (defun gdb-wait-for-pending (&rest body) | |
258 "Wait until `gdb-pending-triggers' is empty and execute BODY. | |
259 | 257 |
260 This function checks `gdb-pending-triggers' value every | 258 This function checks `gdb-pending-triggers' value every |
261 `gdb-wait-for-pending' seconds." | 259 `gdb-wait-for-pending' seconds." |
262 `(run-with-timer | 260 (run-with-timer |
263 gdb-wait-for-pending-timeout nil | 261 0.5 nil |
264 (lambda () | 262 `(lambda () |
265 (if (not gdb-pending-triggers) | 263 (if (not gdb-pending-triggers) |
266 (progn | 264 (progn ,@body) |
267 ,@body) | |
268 (gdb-wait-for-pending ,@body))))) | 265 (gdb-wait-for-pending ,@body))))) |
269 | 266 |
270 ;; Publish-subscribe | 267 ;; Publish-subscribe |
271 | 268 |
272 (defmacro gdb-add-subscriber (publisher subscriber) | 269 (defmacro gdb-add-subscriber (publisher subscriber) |
2779 gdb-memory-format))))) | 2776 gdb-memory-format))))) |
2780 (newline))) | 2777 (newline))) |
2781 ;; Show last page instead of empty buffer when out of bounds | 2778 ;; Show last page instead of empty buffer when out of bounds |
2782 (progn | 2779 (progn |
2783 (let ((gdb-memory-address gdb-memory-last-address)) | 2780 (let ((gdb-memory-address gdb-memory-last-address)) |
2784 (gdb-invalidate-memory) | 2781 (gdb-invalidate-memory 'update) |
2785 (error err-msg)))))) | 2782 (error err-msg)))))) |
2786 | 2783 |
2787 (defvar gdb-memory-mode-map | 2784 (defvar gdb-memory-mode-map |
2788 (let ((map (make-sparse-keymap))) | 2785 (let ((map (make-sparse-keymap))) |
2789 (suppress-keymap map t) | 2786 (suppress-keymap map t) |
2815 (defun gdb-memory-set-address () | 2812 (defun gdb-memory-set-address () |
2816 "Set the start memory address." | 2813 "Set the start memory address." |
2817 (interactive) | 2814 (interactive) |
2818 (let ((arg (read-from-minibuffer "Memory address: "))) | 2815 (let ((arg (read-from-minibuffer "Memory address: "))) |
2819 (setq gdb-memory-address arg)) | 2816 (setq gdb-memory-address arg)) |
2820 (gdb-invalidate-memory)) | 2817 (gdb-invalidate-memory 'update)) |
2821 | 2818 |
2822 (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) | 2819 (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) |
2823 "Define a function NAME which reads new VAR value from minibuffer." | 2820 "Define a function NAME which reads new VAR value from minibuffer." |
2824 `(defun ,name (event) | 2821 `(defun ,name (event) |
2825 ,(when doc doc) | 2822 ,(when doc doc) |
2829 (let* ((arg (read-from-minibuffer ,echo-string)) | 2826 (let* ((arg (read-from-minibuffer ,echo-string)) |
2830 (count (string-to-number arg))) | 2827 (count (string-to-number arg))) |
2831 (if (<= count 0) | 2828 (if (<= count 0) |
2832 (error "Positive number only") | 2829 (error "Positive number only") |
2833 (customize-set-variable ',variable count) | 2830 (customize-set-variable ',variable count) |
2834 (gdb-invalidate-memory)))))) | 2831 (gdb-invalidate-memory 'update)))))) |
2835 | 2832 |
2836 (def-gdb-set-positive-number | 2833 (def-gdb-set-positive-number |
2837 gdb-memory-set-rows | 2834 gdb-memory-set-rows |
2838 gdb-memory-rows | 2835 gdb-memory-rows |
2839 "Rows: " | 2836 "Rows: " |
2850 | 2847 |
2851 DOC is an optional documentation string." | 2848 DOC is an optional documentation string." |
2852 `(defun ,name () ,(when doc doc) | 2849 `(defun ,name () ,(when doc doc) |
2853 (interactive) | 2850 (interactive) |
2854 (customize-set-variable 'gdb-memory-format ,format) | 2851 (customize-set-variable 'gdb-memory-format ,format) |
2855 (gdb-invalidate-memory))) | 2852 (gdb-invalidate-memory 'update))) |
2856 | 2853 |
2857 (def-gdb-memory-format | 2854 (def-gdb-memory-format |
2858 gdb-memory-format-binary "t" | 2855 gdb-memory-format-binary "t" |
2859 "Set the display format to binary.") | 2856 "Set the display format to binary.") |
2860 | 2857 |
2917 | 2914 |
2918 DOC is an optional documentation string." | 2915 DOC is an optional documentation string." |
2919 `(defun ,name () ,(when doc doc) | 2916 `(defun ,name () ,(when doc doc) |
2920 (interactive) | 2917 (interactive) |
2921 (customize-set-variable 'gdb-memory-unit ,unit-size) | 2918 (customize-set-variable 'gdb-memory-unit ,unit-size) |
2922 (gdb-invalidate-memory))) | 2919 (gdb-invalidate-memory 'update))) |
2923 | 2920 |
2924 (def-gdb-memory-unit gdb-memory-unit-giant 8 | 2921 (def-gdb-memory-unit gdb-memory-unit-giant 8 |
2925 "Set the unit size to giant words (eight bytes).") | 2922 "Set the unit size to giant words (eight bytes).") |
2926 | 2923 |
2927 (def-gdb-memory-unit gdb-memory-unit-word 4 | 2924 (def-gdb-memory-unit gdb-memory-unit-word 4 |
3107 (when file | 3104 (when file |
3108 (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line))) | 3105 (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line))) |
3109 gdb-disassembly-handler | 3106 gdb-disassembly-handler |
3110 ;; We update disassembly only after we have actual frame information | 3107 ;; We update disassembly only after we have actual frame information |
3111 ;; about all threads | 3108 ;; about all threads |
3112 '(update-disassembly)) | 3109 '(update update-disassembly)) |
3113 | 3110 |
3114 (def-gdb-auto-update-handler | 3111 (def-gdb-auto-update-handler |
3115 gdb-disassembly-handler | 3112 gdb-disassembly-handler |
3116 gdb-invalidate-disassembly | 3113 gdb-invalidate-disassembly |
3117 gdb-disassembly-handler-custom | 3114 gdb-disassembly-handler-custom |
3412 "Assign a value to a variable displayed in the locals buffer." | 3409 "Assign a value to a variable displayed in the locals buffer." |
3413 (interactive (list last-input-event)) | 3410 (interactive (list last-input-event)) |
3414 (save-excursion | 3411 (save-excursion |
3415 (if event (posn-set-point (event-end event))) | 3412 (if event (posn-set-point (event-end event))) |
3416 (beginning-of-line) | 3413 (beginning-of-line) |
3417 (let* ((var (current-word)) | 3414 (let* ((var (gdb-get-field |
3415 (get-text-property (point) 'gdb-local-variable) 'name)) | |
3418 (value (read-string (format "New value (%s): " var)))) | 3416 (value (read-string (format "New value (%s): " var)))) |
3419 (gud-basic-call | 3417 (gud-basic-call |
3420 (concat "-gdb-set variable " var " = " value))))) | 3418 (concat "-gdb-set variable " var " = " value))))) |
3421 | 3419 |
3422 ;; Dont display values of arrays or structures. | 3420 ;; Dont display values of arrays or structures. |
3444 table | 3442 table |
3445 (list | 3443 (list |
3446 (propertize type 'font-lock-face font-lock-type-face) | 3444 (propertize type 'font-lock-face font-lock-type-face) |
3447 (propertize name 'font-lock-face font-lock-variable-name-face) | 3445 (propertize name 'font-lock-face font-lock-variable-name-face) |
3448 value) | 3446 value) |
3449 '(mouse-face highlight)))) | 3447 `(gdb-local-variable ,local)))) |
3450 (insert (gdb-table-string table " ")) | 3448 (insert (gdb-table-string table " ")) |
3451 (setq mode-name | 3449 (setq mode-name |
3452 (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func))))) | 3450 (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func))))) |
3453 | 3451 |
3454 (defvar gdb-locals-header | 3452 (defvar gdb-locals-header |
3507 'gdb-registers-mode | 3505 'gdb-registers-mode |
3508 'gdb-invalidate-registers) | 3506 'gdb-invalidate-registers) |
3509 | 3507 |
3510 (defun gdb-registers-handler-custom () | 3508 (defun gdb-registers-handler-custom () |
3511 (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values)) | 3509 (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values)) |
3512 (register-names-list (reverse gdb-register-names)) | |
3513 (table (make-gdb-table))) | 3510 (table (make-gdb-table))) |
3514 (dolist (register register-values) | 3511 (dolist (register register-values) |
3515 (let* ((register-number (gdb-get-field register 'number)) | 3512 (let* ((register-number (gdb-get-field register 'number)) |
3516 (value (gdb-get-field register 'value)) | 3513 (value (gdb-get-field register 'value)) |
3517 (register-name (nth (string-to-number register-number) | 3514 (register-name (nth (string-to-number register-number) |
3518 register-names-list))) | 3515 gdb-register-names))) |
3519 (gdb-table-add-row | 3516 (gdb-table-add-row |
3520 table | 3517 table |
3521 (list | 3518 (list |
3522 (propertize register-name 'font-lock-face font-lock-variable-name-face) | 3519 (propertize register-name 'font-lock-face font-lock-variable-name-face) |
3523 (if (member register-number gdb-changed-registers) | 3520 (if (member register-number gdb-changed-registers) |
3524 (propertize value 'font-lock-face font-lock-warning-face) | 3521 (propertize value 'font-lock-face font-lock-warning-face) |
3525 value)) | 3522 value)) |
3526 '(mouse-face highlight)))) | 3523 `(mouse-face highlight |
3524 help-echo "mouse-2: edit value" | |
3525 gdb-register-name ,register-name)))) | |
3527 (insert (gdb-table-string table " ")))) | 3526 (insert (gdb-table-string table " ")))) |
3527 | |
3528 (defun gdb-edit-register-value (&optional event) | |
3529 "Assign a value to a register displayed in the registers buffer." | |
3530 (interactive (list last-input-event)) | |
3531 (save-excursion | |
3532 (if event (posn-set-point (event-end event))) | |
3533 (beginning-of-line) | |
3534 (let* ((var (gdb-get-field | |
3535 (get-text-property (point) 'gdb-register-name))) | |
3536 (value (read-string (format "New value (%s): " var)))) | |
3537 (gud-basic-call | |
3538 (concat "-gdb-set variable $" var " = " value))))) | |
3528 | 3539 |
3529 (defvar gdb-registers-mode-map | 3540 (defvar gdb-registers-mode-map |
3530 (let ((map (make-sparse-keymap))) | 3541 (let ((map (make-sparse-keymap))) |
3531 (suppress-keymap map) | 3542 (suppress-keymap map) |
3543 (define-key map "\r" 'gdb-edit-register-value) | |
3544 (define-key map [mouse-2] 'gdb-edit-register-value) | |
3532 (define-key map "q" 'kill-this-buffer) | 3545 (define-key map "q" 'kill-this-buffer) |
3533 map)) | 3546 map)) |
3534 | 3547 |
3535 (defvar gdb-registers-header | 3548 (defvar gdb-registers-header |
3536 (list | 3549 (list |
3537 (gdb-propertize-header "Locals" gdb-locals-buffer | 3550 (gdb-propertize-header "Locals" gdb-locals-buffer |
3538 "mouse-1: select" mode-line-highlight mode-line-inactive) | 3551 "mouse-1: select" mode-line-highlight mode-line-inactive) |