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

104202:6dd251e7ee9c

  `(member ,item gdb-pending-triggers))
(defmacro gdb-delete-pending (item)
  `(setq gdb-pending-triggers
         (delete ,item gdb-pending-triggers)))

(defvar gdb-wait-for-pending-timeout 0.5)

(defun gdb-wait-for-pending (&rest body)
  "Wait until `gdb-pending-triggers' is empty and execute BODY.

This function checks `gdb-pending-triggers' value every
`gdb-wait-for-pending' seconds."
  `(run-with-timer 
    gdb-wait-for-pending-timeout nil
    (lambda ()
      (if (not gdb-pending-triggers)
          (progn
            ,@body)
        (gdb-wait-for-pending ,@body)))))

;; Publish-subscribe

(defmacro gdb-add-subscriber (publisher subscriber)

                                          gdb-memory-format)))))
          (newline)))
      ;; Show last page instead of empty buffer when out of bounds
      (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)

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

       (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: "

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.")

DOC is an optional documentation string."
  `(defun ,name () ,(when doc doc)
     (interactive)
     (customize-set-variable 'gdb-memory-unit ,unit-size)
     (gdb-invalidate-memory)))

(def-gdb-memory-unit gdb-memory-unit-giant 8
  "Set the unit size to giant words (eight bytes).")

(def-gdb-memory-unit gdb-memory-unit-word 4

    (when file
      (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
  gdb-disassembly-handler
  ;; We update disassembly only after we have actual frame information
  ;; about all threads
  '(update-disassembly))

(def-gdb-auto-update-handler
  gdb-disassembly-handler
  gdb-invalidate-disassembly
  gdb-disassembly-handler-custom

  "Assign a value to a variable displayed in the locals buffer."
  (interactive (list last-input-event))
  (save-excursion
    (if event (posn-set-point (event-end event)))
    (beginning-of-line)
    (let* ((var (current-word))
	   (value (read-string (format "New value (%s): " var))))
      (gud-basic-call
       (concat  "-gdb-set variable " var " = " value)))))

;; Dont display values of arrays or structures.

         table 
         (list
          (propertize type 'font-lock-face font-lock-type-face)
          (propertize name 'font-lock-face font-lock-variable-name-face)
          value)
         '(mouse-face highlight))))
    (insert (gdb-table-string table " "))
    (setq mode-name
          (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func)))))

(defvar gdb-locals-header

 'gdb-registers-mode
 'gdb-invalidate-registers)

(defun gdb-registers-handler-custom ()
  (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values))
        (register-names-list (reverse gdb-register-names))
        (table (make-gdb-table)))
    (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)))
        (gdb-table-add-row
         table
         (list
          (propertize register-name 'font-lock-face font-lock-variable-name-face)
          (if (member register-number gdb-changed-registers)
              (propertize value 'font-lock-face font-lock-warning-face)
            value))
         '(mouse-face highlight))))
    (insert (gdb-table-string table " "))))

(defvar gdb-registers-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "q" 'kill-this-buffer)
     map))

(defvar gdb-registers-header
  (list
   (gdb-propertize-header "Locals" gdb-locals-buffer
			  "mouse-1: select" mode-line-highlight mode-line-inactive)

104203:6deae7f783dc

  `(member ,item gdb-pending-triggers))
(defmacro gdb-delete-pending (item)
  `(setq gdb-pending-triggers
         (delete ,item gdb-pending-triggers)))

(defmacro gdb-wait-for-pending (&rest body)
  "Wait until `gdb-pending-triggers' is empty and evaluate FORM.

This function checks `gdb-pending-triggers' value every
`gdb-wait-for-pending' seconds."
  (run-with-timer 
   0.5 nil
   `(lambda ()
      (if (not gdb-pending-triggers)
          (progn ,@body)
        (gdb-wait-for-pending ,@body)))))

;; Publish-subscribe

(defmacro gdb-add-subscriber (publisher subscriber)

                                          gdb-memory-format)))))
          (newline)))
      ;; Show last page instead of empty buffer when out of bounds
      (progn
        (let ((gdb-memory-address gdb-memory-last-address))
          (gdb-invalidate-memory 'update)
          (error err-msg))))))

(defvar gdb-memory-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map t)

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

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

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

(def-gdb-set-positive-number
  gdb-memory-set-rows
  gdb-memory-rows
  "Rows: "

DOC is an optional documentation string."
  `(defun ,name () ,(when doc doc)
     (interactive)
     (customize-set-variable 'gdb-memory-format ,format)
     (gdb-invalidate-memory 'update)))

(def-gdb-memory-format
  gdb-memory-format-binary "t"
  "Set the display format to binary.")

DOC is an optional documentation string."
  `(defun ,name () ,(when doc doc)
     (interactive)
     (customize-set-variable 'gdb-memory-unit ,unit-size)
     (gdb-invalidate-memory 'update)))

(def-gdb-memory-unit gdb-memory-unit-giant 8
  "Set the unit size to giant words (eight bytes).")

(def-gdb-memory-unit gdb-memory-unit-word 4

    (when file
      (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
  gdb-disassembly-handler
  ;; We update disassembly only after we have actual frame information
  ;; about all threads
  '(update update-disassembly))

(def-gdb-auto-update-handler
  gdb-disassembly-handler
  gdb-invalidate-disassembly
  gdb-disassembly-handler-custom

  "Assign a value to a variable displayed in the locals buffer."
  (interactive (list last-input-event))
  (save-excursion
    (if event (posn-set-point (event-end event)))
    (beginning-of-line)
    (let* ((var (gdb-get-field
                 (get-text-property (point) 'gdb-local-variable) 'name))
	   (value (read-string (format "New value (%s): " var))))
      (gud-basic-call
       (concat  "-gdb-set variable " var " = " value)))))

;; Dont display values of arrays or structures.

         table 
         (list
          (propertize type 'font-lock-face font-lock-type-face)
          (propertize name 'font-lock-face font-lock-variable-name-face)
          value)
         `(gdb-local-variable ,local))))
    (insert (gdb-table-string table " "))
    (setq mode-name
          (concat "Locals: " (gdb-get-field (gdb-current-buffer-frame) 'func)))))

(defvar gdb-locals-header

 'gdb-registers-mode
 'gdb-invalidate-registers)

(defun gdb-registers-handler-custom ()
  (let ((register-values (gdb-get-field (gdb-json-partial-output) 'register-values))
        (table (make-gdb-table)))
    (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) 
                                 gdb-register-names)))
        (gdb-table-add-row
         table
         (list
          (propertize register-name 'font-lock-face font-lock-variable-name-face)
          (if (member register-number gdb-changed-registers)
              (propertize value 'font-lock-face font-lock-warning-face)
            value))
         `(mouse-face highlight
           help-echo "mouse-2: edit value"
           gdb-register-name ,register-name))))
    (insert (gdb-table-string table " "))))

(defun gdb-edit-register-value (&optional event)
  "Assign a value to a register displayed in the registers buffer."
  (interactive (list last-input-event))
  (save-excursion
    (if event (posn-set-point (event-end event)))
    (beginning-of-line)
    (let* ((var (gdb-get-field
                 (get-text-property (point) 'gdb-register-name)))
	   (value (read-string (format "New value (%s): " var))))
      (gud-basic-call
       (concat  "-gdb-set variable $" var " = " value)))))

(defvar gdb-registers-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "\r" 'gdb-edit-register-value)
    (define-key map [mouse-2] 'gdb-edit-register-value)
    (define-key map "q" 'kill-this-buffer)
    map))

(defvar gdb-registers-header
  (list
   (gdb-propertize-header "Locals" gdb-locals-buffer
			  "mouse-1: select" mode-line-highlight mode-line-inactive)