comparison lisp/progmodes/gdb-mi.el @ 104145:ff7110a449a4

(gdb-thread-number): New variable. (gdb-current-context-command): New macro which adds --thread option to command. (gdb-threads-mode-map): Select thread with SPC (gdb-thread-list-handler-custom): Mark current thread with overlay arrow. Synchronize GDB thread and Emacs thread. (gdb-select-thread): New command which selects current thread. (gdb-invalidate-frames, gdb-invalidate-locals) (gdb-invalidate-registers): Use --thread option.

104144:f60678899ee6

(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)
(defvar gdb-var-list nil
  "List of variables in watch window.
Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where
STATUS is nil (unchanged), `changed' or `out-of-scope'.")

  (setq gdb-token-number (1+ gdb-token-number))
  (setcar item (concat (number-to-string gdb-token-number) (car item)))
  (push (cons gdb-token-number (car (cdr item))) gdb-handler-alist)
  (process-send-string (get-buffer-process gud-comint-buffer)
		       (concat (car item) "\n")))


(defcustom gud-gdb-command-name "gdb -i=mi"
  "Default command to execute an executable under the GDB debugger."
  :type 'string

  (when gdb-first-prompt
    (gdb-force-mode-line-update
     (propertize "initializing..." 'face font-lock-variable-name-face))
    (gdb-init-1)
    (setq gdb-first-prompt nil))
  (gdb-get-selected-frame)
  (gdb-invalidate-frames)
  ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted.
  (gdb-get-buffer-create 'gdb-breakpoints-buffer)
  (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))

    (" \\(stopped\\) in "  (1 font-lock-warning-face))
    ("\\(\\(\\sw\\|[_.]\\)+\\)="  (1 font-lock-variable-name-face)))
  "Font lock keywords used in `gdb-threads-mode'.")

(defvar gdb-threads-mode-map
  ;; TODO
  (make-sparse-keymap))

(defvar gdb-breakpoints-header
  (list
   (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
			  nil nil mode-line)

  (setq major-mode 'gdb-threads-mode)
  (setq mode-name "Threads")
  (use-local-map gdb-threads-mode-map)
  (setq buffer-read-only t)
  (buffer-disable-undo)
  (setq header-line-format gdb-breakpoints-header)
  (set (make-local-variable 'font-lock-defaults)
       '(gdb-threads-font-lock-keywords))
  (run-mode-hooks 'gdb-threads-mode-hook)
  'gdb-invalidate-threads)

(defun gdb-thread-list-handler-custom ()
  (let* ((res (json-partial-output))
         (threads-list (gdb-get-field res 'threads)))
    (dolist (thread threads-list)
      (insert (apply 'format `("%s (%s) %s in %s "
                               ,@(gdb-get-many-fields thread 'id 'target-id 'state)
                               ,(gdb-get-field thread 'frame 'func))))
      ;; Arguments

        (dolist (arg args)
          (insert (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))))
        (when args (kill-backward-chars 1)))
      (insert ")")
      (gdb-insert-frame-location (gdb-get-field thread 'frame))
      (insert (format " at %s\n" (gdb-get-field thread 'frame 'addr))))))


;;; Memory view

(defcustom gdb-memory-rows 8

		      'gdb-stack-buffer-name
		      'gdb-frames-mode)

(def-gdb-auto-updated-buffer gdb-stack-buffer
  gdb-invalidate-frames
  "-stack-list-frames"
  gdb-stack-list-frames-handler
  gdb-stack-list-frames-custom)

(defun gdb-insert-frame-location (frame)
  "Insert \"of file:line\" button or library name for structure FRAME.

		      'gdb-locals-buffer-name
		      'gdb-locals-mode)

(def-gdb-auto-update-trigger gdb-invalidate-locals
  (gdb-get-buffer 'gdb-locals-buffer)
  "-stack-list-locals --simple-values"
  gdb-stack-list-locals-handler)

(defconst gdb-stack-list-locals-regexp
  (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))

		      'gdb-registers-buffer-name
		      'gdb-registers-mode)

(def-gdb-auto-update-trigger gdb-invalidate-registers
  (gdb-get-buffer 'gdb-registers-buffer)
  "-data-list-register-values x"
  gdb-data-list-register-values-handler)

(defconst gdb-data-list-register-values-regexp
  "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"")

(defun gdb-get-selected-frame ()
  (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
      (progn
	(gdb-input
	 (list "-stack-info-frame" 'gdb-frame-handler))
	(push 'gdb-get-selected-frame
	       gdb-pending-triggers))))

(defun gdb-frame-handler ()
  (setq gdb-pending-triggers

104145:ff7110a449a4

(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-frame-number "0")
(defvar gdb-thread-number "1"
  "Main current thread.

Invalidation triggers use this variable to query GDB for
information on the specified thread.

This variable may be updated implicitly by GDB via
`gdb-thread-list-handler-custom' or explicitly by
`gdb-select-thread'.")

(defvar gdb-selected-frame nil)
(defvar gdb-selected-file nil)
(defvar gdb-selected-line nil)
(defvar gdb-current-language nil)
(defvar gdb-var-list nil
  "List of variables in watch window.
Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where
STATUS is nil (unchanged), `changed' or `out-of-scope'.")

  (setq gdb-token-number (1+ gdb-token-number))
  (setcar item (concat (number-to-string gdb-token-number) (car item)))
  (push (cons gdb-token-number (car (cdr item))) gdb-handler-alist)
  (process-send-string (get-buffer-process gud-comint-buffer)
		       (concat (car item) "\n")))

(defmacro gdb-current-context-command (command)
  "Add --thread option to gdb COMMAND.

Option value is taken from `gdb-thread-number'."
  (concat command " --thread " gdb-thread-number))


(defcustom gud-gdb-command-name "gdb -i=mi"
  "Default command to execute an executable under the GDB debugger."
  :type 'string

  (when gdb-first-prompt
    (gdb-force-mode-line-update
     (propertize "initializing..." 'face font-lock-variable-name-face))
    (gdb-init-1)
    (setq gdb-first-prompt nil))
  ;; We may need to update gdb-thread-number, so we call threads buffer
  (gdb-get-buffer-create 'gdb-threads-buffer)
  (gdb-invalidate-threads)
  (gdb-get-selected-frame)
  (gdb-invalidate-frames)
  ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted.
  (gdb-get-buffer-create 'gdb-breakpoints-buffer)
  (gdb-invalidate-breakpoints)
  (gdb-get-changed-registers)
  (gdb-invalidate-registers)
  (gdb-invalidate-locals)
  (gdb-invalidate-memory)
  (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))

    (" \\(stopped\\) in "  (1 font-lock-warning-face))
    ("\\(\\(\\sw\\|[_.]\\)+\\)="  (1 font-lock-variable-name-face)))
  "Font lock keywords used in `gdb-threads-mode'.")

(defvar gdb-threads-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map " " 'gdb-select-thread)
    map))

(defvar gdb-breakpoints-header
  (list
   (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer
			  nil nil mode-line)

  (setq major-mode 'gdb-threads-mode)
  (setq mode-name "Threads")
  (use-local-map gdb-threads-mode-map)
  (setq buffer-read-only t)
  (buffer-disable-undo)
  (setq gdb-thread-position (make-marker))
  (add-to-list 'overlay-arrow-variable-list 'gdb-thread-position)
  (setq header-line-format gdb-breakpoints-header)
  (set (make-local-variable 'font-lock-defaults)
       '(gdb-threads-font-lock-keywords))
  (run-mode-hooks 'gdb-threads-mode-hook)
  'gdb-invalidate-threads)

(defun gdb-thread-list-handler-custom ()
  (let* ((res (json-partial-output))
         (threads-list (gdb-get-field res 'threads))
         (current-thread (gdb-get-field res 'current-thread-id)))
    (when (and current-thread
               (not (string-equal current-thread gdb-thread-number)))
      ;; Implicitly switch thread (in case previous one dies)
      (message (concat "GDB switched to another thread: " current-thread))
      (setq gdb-thread-number current-thread))
    (set-marker gdb-thread-position nil)
    (dolist (thread threads-list)
      (insert (apply 'format `("%s (%s) %s in %s "
                               ,@(gdb-get-many-fields thread 'id 'target-id 'state)
                               ,(gdb-get-field thread 'frame 'func))))
      ;; Arguments

        (dolist (arg args)
          (insert (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))))
        (when args (kill-backward-chars 1)))
      (insert ")")
      (gdb-insert-frame-location (gdb-get-field thread 'frame))
      (insert (format " at %s" (gdb-get-field thread 'frame 'addr)))
      (add-text-properties (line-beginning-position)
                           (line-end-position)
                           `(gdb-thread ,thread))
      (when (string-equal gdb-thread-number
                          (gdb-get-field thread 'id))
        (set-marker gdb-thread-position (line-beginning-position)))
      (newline))))

(defun gdb-select-thread ()
  "Select the thread at current line of threads buffer."
  (interactive)
  (save-excursion
  (beginning-of-line)
  (let ((thread (get-text-property (point) 'gdb-thread)))
    (if thread
        (if (string-equal (gdb-get-field thread 'state) "running")
            (error "Cannot select running thread")
          (let ((new-id (gdb-get-field thread 'id)))
            (setq gdb-thread-number new-id)
            (gud-basic-call (concat "-thread-select " new-id))))
      (error "Not recognized as thread line")))))


;;; Memory view

(defcustom gdb-memory-rows 8

		      'gdb-stack-buffer-name
		      'gdb-frames-mode)

(def-gdb-auto-updated-buffer gdb-stack-buffer
  gdb-invalidate-frames
  (gdb-current-context-command "-stack-list-frames")
  gdb-stack-list-frames-handler
  gdb-stack-list-frames-custom)

(defun gdb-insert-frame-location (frame)
  "Insert \"of file:line\" button or library name for structure FRAME.

		      'gdb-locals-buffer-name
		      'gdb-locals-mode)

(def-gdb-auto-update-trigger gdb-invalidate-locals
  (gdb-get-buffer 'gdb-locals-buffer)
  (concat (gdb-current-context-command "-stack-list-locals") " --simple-values")
  gdb-stack-list-locals-handler)

(defconst gdb-stack-list-locals-regexp
  (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))

		      'gdb-registers-buffer-name
		      'gdb-registers-mode)

(def-gdb-auto-update-trigger gdb-invalidate-registers
  (gdb-get-buffer 'gdb-registers-buffer)
  (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-get-selected-frame ()
  (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
      (progn
	(gdb-input
	 (list (gdb-current-context-command "-stack-info-frame") 'gdb-frame-handler))
	(push 'gdb-get-selected-frame
	       gdb-pending-triggers))))

(defun gdb-frame-handler ()
  (setq gdb-pending-triggers