comparison 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.

103747:4f648d5b56cd

;; 1) Stack buffer doesn't parse MI output if you stop in a routine without
;;    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?

;;; Code:

(defvar tool-bar-map)
(defvar speedbar-initial-expansion-list-name)

(defvar gdb-pc-address nil "Initialization for Assembler buffer.
Set to \"main\" at start if `gdb-show-main' is t.")
(defvar gdb-selected-frame nil)
(defvar gdb-selected-file nil)
(defvar gdb-selected-line nil)
(defvar gdb-frame-number nil)
(defvar gdb-current-language nil)

  (gdb-invalidate-breakpoints)
  (gdb-invalidate-threads)
  (gdb-get-changed-registers)
  (gdb-invalidate-registers)
  (gdb-invalidate-locals)
  (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
    (dolist (var gdb-var-list)
      (setcar (nthcdr 5 var) nil))
    (gdb-var-update)))

      (gdb-insert-frame-location (fadr-q "thread.frame"))
      (insert (fadr-format " at ~.frame.addr\n" thread)))))


;;; Memory view
(defun gdb-todo-memory ()
  (interactive)
  (message-box
   "TODO: Implement memory buffer using\nMI command -data-read-memory"))

;;; Disassembly view

(defun gdb-disassembly-buffer-name ()
  (concat "*disassembly of " (gdb-get-target-string) "*"))

103748:5a1769adb8af

;; 1) Stack buffer doesn't parse MI output if you stop in a routine without
;;    line information, e.g., a routine in libc (just a TODO item).

;; TODO:
;; 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?

;;; Code:

(defvar tool-bar-map)
(defvar speedbar-initial-expansion-list-name)

(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)
(defvar gdb-frame-number nil)
(defvar gdb-current-language nil)

  (gdb-invalidate-breakpoints)
  (gdb-invalidate-threads)
  (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))
    (gdb-var-update)))

      (gdb-insert-frame-location (fadr-q "thread.frame"))
      (insert (fadr-format " at ~.frame.addr\n" thread)))))


;;; Memory view

(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)
  (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

(defun gdb-disassembly-buffer-name ()
  (concat "*disassembly of " (gdb-get-target-string) "*"))