Mercurial > emacs
diff lisp/progmodes/gdb-mi.el @ 103748:5a1769adb8af
Port memory buffer from gdb-ui.el
(gdb-memory-address): New variable which holds top address of
memory page shown in memory buffer
(gdb-memory-repeat-count, gdb-memory-format, gdb-memory-unit): New
customization variables.
New functions:
(gdb-display-memory-buffer, gdb-frame-memory-buffer): Functions to
display the memory buffer.
(gdb-memory-set-address, gdb-memory-set-repeat-count): Set memory
buffer display parameters.
(def-gdb-memory-format, gdb-memory-format-binary)
(gdb-memory-format-octal, gdb-memory-format-unsigned)
(gdb-memory-format-signed, gdb-memory-format-hexadecimal):
Functions for setting memory buffer format.
(gdb-memory-unit-word, gdb-memory-unit-halfword)
(gdb-memory-unit-giant, gdb-memory-unit-byte): Functions to set
unit size used in memory buffer.
(gdb-memory-show-next-page, gdb-memory-show-previous-page): Switch
to next/previous page of memory buffer.
author | Dmitry Dzhus <dima@sphinx.net.ru> |
---|---|
date | Tue, 07 Jul 2009 16:57:41 +0000 |
parents | 1c5f849edf58 |
children | f3eef698a354 |
line wrap: on
line diff
--- a/lisp/progmodes/gdb-mi.el Tue Jul 07 15:06:00 2009 +0000 +++ b/lisp/progmodes/gdb-mi.el Tue Jul 07 16:57:41 2009 +0000 @@ -91,7 +91,6 @@ ;; line information, e.g., a routine in libc (just a TODO item). ;; TODO: -;; 1) Use MI command -data-read-memory for memory window. ;; 2) Watch windows to work with threads. ;; 3) Use treebuffer.el instead of the speedbar for watch-expressions? ;; 4) Mark breakpoint locations on scroll-bar of source buffer? @@ -107,6 +106,14 @@ (defvar gdb-pc-address nil "Initialization for Assembler buffer. Set to \"main\" at start if `gdb-show-main' is t.") +(defvar gdb-memory-address "main") +(defvar gdb-memory-last-address nil + "Last successfully accessed memory address.") +(defvar gdb-memory-next-page nil + "Address of next memory page for program memory buffer.") +(defvar gdb-memory-prev-page nil + "Address of previous memory page for program memory buffer.") + (defvar gdb-selected-frame nil) (defvar gdb-selected-file nil) (defvar gdb-selected-line nil) @@ -1207,6 +1214,7 @@ (gdb-get-changed-registers) (gdb-invalidate-registers) (gdb-invalidate-locals) + (gdb-invalidate-memory) (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) @@ -1861,10 +1869,385 @@ ;;; Memory view -(defun gdb-todo-memory () + +(defcustom gdb-memory-rows 8 + "Number of data rows in memory window." + :type 'integer + :group 'gud + :version "23.2") + +(defcustom gdb-memory-columns 4 + "Number of data columns in memory window." + :type 'integer + :group 'gud + :version "23.2") + +(defcustom gdb-memory-format "x" + "Display format of data items in memory window." + :type '(choice (const :tag "Hexadecimal" "x") + (const :tag "Signed decimal" "d") + (const :tag "Unsigned decimal" "u") + (const :tag "Octal" "o") + (const :tag "Binary" "t")) + :group 'gud + :version "22.1") + +(defcustom gdb-memory-unit 4 + "Unit size of data items in memory window." + :type '(choice (const :tag "Byte" 1) + (const :tag "Halfword" 2) + (const :tag "Word" 4) + (const :tag "Giant word" 8)) + :group 'gud + :version "23.2") + +(gdb-set-buffer-rules 'gdb-memory-buffer + 'gdb-memory-buffer-name + 'gdb-memory-mode) + +(def-gdb-auto-updated-buffer gdb-memory-buffer + gdb-invalidate-memory + (format "-data-read-memory %s %s %d %d %d\n" + gdb-memory-address + gdb-memory-format + gdb-memory-unit + gdb-memory-rows + gdb-memory-columns) + gdb-read-memory-handler + gdb-read-memory-custom) + +(defun gdb-read-memory-custom () + (let* ((res (json-partial-output)) + (err-msg (fadr-q "res.msg"))) + (if (not err-msg) + (let ((memory (fadr-q "res.memory"))) + (setq gdb-memory-address (fadr-q "res.addr")) + (setq gdb-memory-next-page (fadr-q "res.next-page")) + (setq gdb-memory-prev-page (fadr-q "res.prev-page")) + (setq gdb-memory-last-address gdb-memory-address) + (dolist (row memory) + (insert (concat (fadr-q "row.addr") ": ")) + (dolist (column (fadr-q "row.data")) + (insert (concat column "\t"))) + (newline))) + (progn + (let ((gdb-memory-address gdb-memory-last-address)) + (gdb-invalidate-memory) + (error err-msg)))))) + +(defvar gdb-memory-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map t) + (define-key map "q" 'kill-this-buffer) + (define-key map "n" 'gdb-memory-show-next-page) + (define-key map "p" 'gdb-memory-show-previous-page) + (define-key map "a" 'gdb-memory-set-address) + (define-key map "t" 'gdb-memory-format-binary) + (define-key map "o" 'gdb-memory-format-octal) + (define-key map "u" 'gdb-memory-format-unsigned) + (define-key map "d" 'gdb-memory-format-signed) + (define-key map "x" 'gdb-memory-format-hexadecimal) + (define-key map "b" 'gdb-memory-unit-byte) + (define-key map "h" 'gdb-memory-unit-halfword) + (define-key map "w" 'gdb-memory-unit-word) + (define-key map "g" 'gdb-memory-unit-giant) + (define-key map "R" 'gdb-memory-set-rows) + (define-key map "C" 'gdb-memory-set-columns) + map)) + +(defun gdb-memory-set-address-event (event) + "Handle a click on address field in memory buffer header." + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (gdb-memory-set-address-1))) + +;; Non-event version for use within keymap +(defun gdb-memory-set-address () + "Set the start memory address." (interactive) - (message-box - "TODO: Implement memory buffer using\nMI command -data-read-memory")) + (let ((arg (read-from-minibuffer "Memory address: "))) + (setq gdb-memory-address arg)) + (gdb-invalidate-memory)) + +(defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) + "Define a function NAME which reads new VAR value from minibuffer." + `(defun ,name (event) + ,(when doc doc) + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (let* ((arg (read-from-minibuffer ,echo-string)) + (count (string-to-number arg))) + (if (<= count 0) + (error "Positive number only") + (customize-set-variable ',variable count) + (gdb-invalidate-memory)))))) + +(def-gdb-set-positive-number + gdb-memory-set-rows + gdb-memory-rows + "Rows: " + "Set the number of data rows in memory window.") + +(def-gdb-set-positive-number + gdb-memory-set-columns + gdb-memory-columns + "Columns: " + "Set the number of data columns in memory window.") + +(defmacro def-gdb-memory-format (name format doc) + "Define a function NAME to switch memory buffer to use FORMAT. + +DOC is an optional documentation string." + `(defun ,name () ,(when doc doc) + (interactive) + (customize-set-variable 'gdb-memory-format ,format) + (gdb-invalidate-memory))) + +(def-gdb-memory-format + gdb-memory-format-binary "t" + "Set the display format to binary.") + +(def-gdb-memory-format + gdb-memory-format-octal "o" + "Set the display format to octal.") + +(def-gdb-memory-format + gdb-memory-format-unsigned "u" + "Set the display format to unsigned decimal.") + +(def-gdb-memory-format + gdb-memory-format-signed "d" + "Set the display format to decimal.") + +(def-gdb-memory-format + gdb-memory-format-hexadecimal "x" + "Set the display format to hexadecimal.") + +(defvar gdb-memory-format-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1) + map) + "Keymap to select format in the header line.") + +(defvar gdb-memory-format-menu (make-sparse-keymap "Format") + "Menu of display formats in the header line.") + +(define-key gdb-memory-format-menu [binary] + '(menu-item "Binary" gdb-memory-format-binary + :button (:radio . (equal gdb-memory-format "t")))) +(define-key gdb-memory-format-menu [octal] + '(menu-item "Octal" gdb-memory-format-octal + :button (:radio . (equal gdb-memory-format "o")))) +(define-key gdb-memory-format-menu [unsigned] + '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned + :button (:radio . (equal gdb-memory-format "u")))) +(define-key gdb-memory-format-menu [signed] + '(menu-item "Signed Decimal" gdb-memory-format-signed + :button (:radio . (equal gdb-memory-format "d")))) +(define-key gdb-memory-format-menu [hexadecimal] + '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal + :button (:radio . (equal gdb-memory-format "x")))) + +(defun gdb-memory-format-menu (event) + (interactive "@e") + (x-popup-menu event gdb-memory-format-menu)) + +(defun gdb-memory-format-menu-1 (event) + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (let* ((selection (gdb-memory-format-menu event)) + (binding (and selection (lookup-key gdb-memory-format-menu + (vector (car selection)))))) + (if binding (call-interactively binding))))) + +(defun gdb-memory-unit-giant () + "Set the unit size to giant words (eight bytes)." + (interactive) + (customize-set-variable 'gdb-memory-unit 8) + (gdb-invalidate-memory)) + +(defun gdb-memory-unit-word () + "Set the unit size to words (four bytes)." + (interactive) + (customize-set-variable 'gdb-memory-unit 4) + (gdb-invalidate-memory)) + +(defun gdb-memory-unit-halfword () + "Set the unit size to halfwords (two bytes)." + (interactive) + (customize-set-variable 'gdb-memory-unit 2) + (gdb-invalidate-memory)) + +(defun gdb-memory-unit-byte () + "Set the unit size to bytes." + (interactive) + (customize-set-variable 'gdb-memory-unit 1) + (gdb-invalidate-memory)) + +(defmacro def-gdb-memory-show-page (name address-var &optional doc) + "Define a function NAME which show new address in memory buffer. + +The defined function switches Memory buffer to show address +stored in ADDRESS-VAR variable. + +DOC is an optional documentation string." + `(defun ,name + ,(when doc doc) + (interactive) + (let ((gdb-memory-address ,address-var)) + (gdb-invalidate-memory)))) + +(def-gdb-memory-show-page gdb-memory-show-previous-page + gdb-memory-prev-page) + +(def-gdb-memory-show-page gdb-memory-show-next-page + gdb-memory-next-page) + +(defvar gdb-memory-unit-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1) + map) + "Keymap to select units in the header line.") + +(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit") + "Menu of units in the header line.") + +(define-key gdb-memory-unit-menu [giantwords] + '(menu-item "Giant words" gdb-memory-unit-giant + :button (:radio . (equal gdb-memory-unit 8)))) +(define-key gdb-memory-unit-menu [words] + '(menu-item "Words" gdb-memory-unit-word + :button (:radio . (equal gdb-memory-unit 4)))) +(define-key gdb-memory-unit-menu [halfwords] + '(menu-item "Halfwords" gdb-memory-unit-halfword + :button (:radio . (equal gdb-memory-unit 2)))) +(define-key gdb-memory-unit-menu [bytes] + '(menu-item "Bytes" gdb-memory-unit-byte + :button (:radio . (equal gdb-memory-unit 1)))) + +(defun gdb-memory-unit-menu (event) + (interactive "@e") + (x-popup-menu event gdb-memory-unit-menu)) + +(defun gdb-memory-unit-menu-1 (event) + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (let* ((selection (gdb-memory-unit-menu event)) + (binding (and selection (lookup-key gdb-memory-unit-menu + (vector (car selection)))))) + (if binding (call-interactively binding))))) + +;;from make-mode-line-mouse-map +(defun gdb-make-header-line-mouse-map (mouse function) "\ +Return a keymap with single entry for mouse key MOUSE on the header line. +MOUSE is defined to run function FUNCTION with no args in the buffer +corresponding to the mode line clicked." + (let ((map (make-sparse-keymap))) + (define-key map (vector 'header-line mouse) function) + (define-key map (vector 'header-line 'down-mouse-1) 'ignore) + map)) + +(defvar gdb-memory-font-lock-keywords + '(;; <__function.name+n> + ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face)) + ) + "Font lock keywords used in `gdb-memory-mode'.") + +(defvar gdb-memory-header + '(:eval + (concat + "Start address[" + (propertize "-" + 'face font-lock-warning-face + 'help-echo "mouse-1: decrement address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-show-previous-page)) + "|" + (propertize "+" + 'face font-lock-warning-face + 'help-echo "mouse-1: increment address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-show-next-page)) + "]: " + (propertize gdb-memory-address + 'face font-lock-warning-face + 'help-echo "mouse-1: set start address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-address-event)) + " Rows: " + (propertize (number-to-string gdb-memory-rows) + 'face font-lock-warning-face + 'help-echo "mouse-1: set number of columns" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-rows)) + " Columns: " + (propertize (number-to-string gdb-memory-columns) + 'face font-lock-warning-face + 'help-echo "mouse-1: set number of columns" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-columns)) + " Display Format: " + (propertize gdb-memory-format + 'face font-lock-warning-face + 'help-echo "mouse-3: select display format" + 'mouse-face 'mode-line-highlight + 'local-map gdb-memory-format-map) + " Unit Size: " + (propertize (number-to-string gdb-memory-unit) + 'face font-lock-warning-face + 'help-echo "mouse-3: select unit size" + 'mouse-face 'mode-line-highlight + 'local-map gdb-memory-unit-map))) + "Header line used in `gdb-memory-mode'.") + +(defun gdb-memory-mode () + "Major mode for examining memory. + +\\{gdb-memory-mode-map}" + (kill-all-local-variables) + (setq major-mode 'gdb-memory-mode) + (setq mode-name "Memory") + (use-local-map gdb-memory-mode-map) + (setq buffer-read-only t) + (setq header-line-format gdb-memory-header) + (set (make-local-variable 'font-lock-defaults) + '(gdb-memory-font-lock-keywords)) + (run-mode-hooks 'gdb-memory-mode-hook) + 'gdb-invalidate-memory) + +(defun gdb-memory-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*memory of " (gdb-get-target-string) "*"))) + +(def-gdb-display-buffer + gdb-display-memory-buffer + 'gdb-memory-buffer + "Display memory contents.") + +(defun gdb-frame-memory-buffer () + "Display memory contents in a new frame." + (interactive) + (let* ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist + (cons '(left-fringe . 0) + (cons '(right-fringe . 0) + (cons '(width . 83) gdb-frame-parameters))))) + (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) + ;;; Disassembly view