comparison lisp/gdb-ui.el @ 48884:f774c94b3b5e

(gdba-marker-filter, gdb-output-burst): Merge and rename gud-gdba-marker-filter. (gdb-append-to-inferior-io): Only pop up IO buffer if there is output. (gdb-make-instance): Remove (put into gdba). Use gdb-instance-enqueue-input instead of gdb-instance-enqueue-idle-input for user functions. (gdb-instance-target-string): Simplify. (in-gdb-instance-context): Remove. Expand Commentary.

48883:2bce492766d6

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;  Extension of gdba.el written by Jim Kingdon from gdb 5.0

;;; Code:

(require 'gud)

  ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
  (gdb command-line)

  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'gud-marker-filter) 'gdba-marker-filter)

  (gud-def gud-break (if (not (string-equal mode-name "Assembler"))
			 (gud-call "break %f:%l" arg)
		       (save-excursion
			 (beginning-of-line)

  (setq gdb-main-or-pc "main")
  (setq gdb-current-address nil)
  (setq gdb-display-in-progress nil)
  (setq gdb-dive nil)

  (gdb-make-instance)
  (gdb-clear-inferior-io)

  ;; find source file and compilation directory here
  (gdb-instance-enqueue-idle-input (list "server list\n" 'ignore))
  (gdb-instance-enqueue-idle-input (list "server info source\n"
					 'gdb-source-info))

  (run-hooks 'gdba-mode-hook))

(defun gud-display ()
  "Display (possibly dereferenced) C expression at point."
  (interactive)
  (save-excursion
    (let ((expr (gud-find-c-expr)))
      (gdb-instance-enqueue-idle-input
       (list (concat "server whatis " expr "\n")
	     `(lambda () (gud-display1 ,expr)))))))

(defun gud-display1 (expr)
  (goto-char (point-min))
  (if (re-search-forward "\*" nil t)
      (gdb-instance-enqueue-idle-input
       (list (concat "server display* " expr "\n") 'ignore))
    (gdb-instance-enqueue-idle-input
     (list (concat "server display " expr "\n") 'ignore))))


;; The completion process filter is installed temporarily to slurp the
;; output of GDB up to the next prompt and build the completion list.

(def-gdb-var pending-triggers '()
  "A list of trigger functions that have run later than their output
handlers.")

(defun in-gdb-instance-context (form)
  "Funcall FORM in the GUD buffer."
  (with-current-buffer gud-comint-buffer
    (funcall form)))

;; end of instance vars

(defun gdb-make-instance ()
  "Create a gdb instance object from the current buffer."
  (mapc 'make-local-variable gdb-instance-variables)
  (setq gdb-buffer-type 'gdba))

(defun gdb-instance-target-string ()
  "The apparent name of the program being debugged by a gdb instance.
For sure this the root string used in smashing together the gdb
buffer's name, even if that doesn't happen to be the name of a
program."
  (in-gdb-instance-context (lambda () gud-target-name)))


;;
;; Instance Buffers.
;;

(defcustom gud-gdba-command-name "gdb -annotate=2"
  "Default command to execute an executable under the GDB-UI debugger."
   :type 'string
   :group 'gud)

(defun gdba-marker-filter (string)
  "A gud marker filter for gdb."
  (gdb-output-burst string))

(defvar gdb-annotation-rules
  '(("frames-invalid" gdb-invalidate-frame-and-assembler)
    ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler)
    ("pre-prompt" gdb-pre-prompt)

  'action (lambda (button) (gdb-display-go-back)))

(defun gdb-display-go-back ()
  ;; delete display so they don't accumulate and delete buffer
  (let ((number gdb-display-number))
    (gdb-instance-enqueue-idle-input
     (list (concat "server delete display " number "\n") 'ignore))
    (switch-to-buffer (concat "*display " gdb-dive-display-number "*"))
    (kill-buffer (get-buffer (concat "*display " number "*")))))

;; prefix annotations with ## and process whole output in one chunk

      ;; * not needed for components of a pointer to a structure in gdb
      (if (string-equal "*" (substring gdb-full-expression 0 1))
	  (setq gdb-full-expression (substring gdb-full-expression 1 nil)))
      (setq gdb-full-expression
	    (concat gdb-full-expression gdb-part-expression "." gdb-last-field))
      (gdb-instance-enqueue-idle-input
       (list (concat "server display" gdb-display-char
		     " " gdb-full-expression "\n")
	     'ignore)))))

(defun gdb-insert-field ()

	(setq num (+ num 1)))
      (insert
       (concat "\n     Slice : " array-slice "\n\nIndex\tValues\n\n"))))
  (setq buffer-read-only t))

;; Handle a burst of output from a gdb instance.
;; This function is (indirectly) used as a gud-marker-filter.
;; It must return output (if any) to be inserted in the gdb
;; buffer.

(defun gdb-output-burst (string)
  "Handle a burst of output from a gdb instance.
This function is (indirectly) used as a gud-marker-filter.
It must return output (if any) to be insterted in the gdb
buffer."
  (save-match-data
    (let (
	  ;; Recall the left over burst from last time
	  (burst (concat (gdb-instance-burst) string))
	  ;; Start accumulating output for the GUD buffer

  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer 'gdb-inferior-io))
    (goto-char (point-max))
    (insert-before-markers string))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdb-inferior-io)))

(defun gdb-clear-inferior-io ()
  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer 'gdb-inferior-io))

  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
	(error "Not recognized as break/watchpoint line")
      (gdb-instance-enqueue-idle-input
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable "
	   "server enable ")

"Delete the breakpoint of the current line."
  (interactive)
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
	(error "Not recognized as break/watchpoint line")
      (gdb-instance-enqueue-idle-input
       (list
	(concat
	 "server delete "
	 (match-string 1)
	 "\n")
	'ignore))))

(defvar gdb-source-window nil)

(defun gdb-goto-bp-this-line ()
  "Display the file in the source buffer at the specified breakpoint."

	(goto-char (posn-point (event-end e)))
	(setq selection (gdb-get-frame-number))))
    (select-window (posn-window (event-end e)))
    (save-excursion
      (set-buffer gud-comint-buffer)
  (gdb-instance-enqueue-idle-input
   (list (gud-format-command "server frame %p\n" selection)
	 'ignore))
  (gud-display-frame))))



  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\):   \\([ny]\\)"))
	(error "No expression on this line")
      (gdb-instance-enqueue-idle-input
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable display "
	   "server enable display ")

     (gdb-get-instance-buffer 'gdb-display-buffer))
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\):   \\([ny]\\)"))
	(error "No expression on this line")
      (let ((number (match-string 1)))
	(gdb-instance-enqueue-idle-input
	 (list (concat "server delete display " number "\n")
	       'ignore))
	(if (not (display-graphic-p))
	    (kill-buffer (get-buffer (concat "*display " number "*")))
	  (catch 'frame-found

			       " 1 -T X"))))))

(defun gdb-delete-display ()
  "Delete displayed expression and its frame."
  (interactive)
  (gdb-instance-enqueue-idle-input
   (list (concat "server delete display " gdb-display-number "\n")
	 'ignore))
  (kill-buffer nil)
  (delete-frame))

48884:f774c94b3b5e

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;  This file is based on gdba.el written by Jim Kingdon from GDB 5.0 and uses
;;  GDB's annotation interface. You don't need to know about annotations but
;;  If you are interested developing this mode see the Annotations section in
;;  the GDB info manual).
;;
;;  It has been extended to use features of Emacs 21 such as the display
;;  margin for breakpoints and the toolbar. It also has new buffers and lots
;;  of other new features such as formatted auto-display of arrays and
;;  structures (see the GDB-UI in the Emacs info manual).

;;; Code:

(require 'gud)

  ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
  (gdb command-line)

  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)

  (gud-def gud-break (if (not (string-equal mode-name "Assembler"))
			 (gud-call "break %f:%l" arg)
		       (save-excursion
			 (beginning-of-line)

  (setq gdb-main-or-pc "main")
  (setq gdb-current-address nil)
  (setq gdb-display-in-progress nil)
  (setq gdb-dive nil)

  (mapc 'make-local-variable gdb-instance-variables)
  (setq gdb-buffer-type 'gdba)

  (gdb-clear-inferior-io)

  ;; find source file and compilation directory here
  (gdb-instance-enqueue-input (list "server list\n" 'ignore))
  (gdb-instance-enqueue-input (list "server info source\n"
					 'gdb-source-info))

  (run-hooks 'gdba-mode-hook))

(defun gud-display ()
  "Display (possibly dereferenced) C expression at point."
  (interactive)
  (save-excursion
    (let ((expr (gud-find-c-expr)))
      (gdb-instance-enqueue-input
       (list (concat "server whatis " expr "\n")
	     `(lambda () (gud-display1 ,expr)))))))

(defun gud-display1 (expr)
  (goto-char (point-min))
  (if (re-search-forward "\*" nil t)
      (gdb-instance-enqueue-input
       (list (concat "server display* " expr "\n") 'ignore))
    (gdb-instance-enqueue-input
     (list (concat "server display " expr "\n") 'ignore))))


;; The completion process filter is installed temporarily to slurp the
;; output of GDB up to the next prompt and build the completion list.

(def-gdb-var pending-triggers '()
  "A list of trigger functions that have run later than their output
handlers.")

;; end of instance vars

(defun gdb-instance-target-string ()
  (with-current-buffer gud-comint-buffer
    gud-target-name))


;;
;; Instance Buffers.
;;

(defcustom gud-gdba-command-name "gdb -annotate=2"
  "Default command to execute an executable under the GDB-UI debugger."
   :type 'string
   :group 'gud)

(defvar gdb-annotation-rules
  '(("frames-invalid" gdb-invalidate-frame-and-assembler)
    ("breakpoints-invalid" gdb-invalidate-breakpoints-and-assembler)
    ("pre-prompt" gdb-pre-prompt)

  'action (lambda (button) (gdb-display-go-back)))

(defun gdb-display-go-back ()
  ;; delete display so they don't accumulate and delete buffer
  (let ((number gdb-display-number))
    (gdb-instance-enqueue-input
     (list (concat "server delete display " number "\n") 'ignore))
    (switch-to-buffer (concat "*display " gdb-dive-display-number "*"))
    (kill-buffer (get-buffer (concat "*display " number "*")))))

;; prefix annotations with ## and process whole output in one chunk

      ;; * not needed for components of a pointer to a structure in gdb
      (if (string-equal "*" (substring gdb-full-expression 0 1))
	  (setq gdb-full-expression (substring gdb-full-expression 1 nil)))
      (setq gdb-full-expression
	    (concat gdb-full-expression gdb-part-expression "." gdb-last-field))
      (gdb-instance-enqueue-input
       (list (concat "server display" gdb-display-char
		     " " gdb-full-expression "\n")
	     'ignore)))))

(defun gdb-insert-field ()

	(setq num (+ num 1)))
      (insert
       (concat "\n     Slice : " array-slice "\n\nIndex\tValues\n\n"))))
  (setq buffer-read-only t))

(defun gud-gdba-marker-filter (string)
  "A gud marker filter for gdb. Handle a burst of output from a gdb instance.
It must return output (if any) to be insterted in the gdb buffer."
  (save-match-data
    (let (
	  ;; Recall the left over burst from last time
	  (burst (concat (gdb-instance-burst) string))
	  ;; Start accumulating output for the GUD buffer

  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer 'gdb-inferior-io))
    (goto-char (point-max))
    (insert-before-markers string))
  (if (not (string-equal string ""))
      (gdb-display-buffer
       (gdb-get-create-instance-buffer 'gdb-inferior-io))))

(defun gdb-clear-inferior-io ()
  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer 'gdb-inferior-io))

  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
	(error "Not recognized as break/watchpoint line")
      (gdb-instance-enqueue-input
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable "
	   "server enable ")

"Delete the breakpoint of the current line."
  (interactive)
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
	(error "Not recognized as break/watchpoint line")
      (gdb-instance-enqueue-input
       (list (concat "server delete " (match-string 1) "\n") 'ignore))))

(defvar gdb-source-window nil)

(defun gdb-goto-bp-this-line ()
  "Display the file in the source buffer at the specified breakpoint."

	(goto-char (posn-point (event-end e)))
	(setq selection (gdb-get-frame-number))))
    (select-window (posn-window (event-end e)))
    (save-excursion
      (set-buffer gud-comint-buffer)
  (gdb-instance-enqueue-input
   (list (gud-format-command "server frame %p\n" selection)
	 'ignore))
  (gud-display-frame))))



  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\):   \\([ny]\\)"))
	(error "No expression on this line")
      (gdb-instance-enqueue-input
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable display "
	   "server enable display ")

     (gdb-get-instance-buffer 'gdb-display-buffer))
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\):   \\([ny]\\)"))
	(error "No expression on this line")
      (let ((number (match-string 1)))
	(gdb-instance-enqueue-input
	 (list (concat "server delete display " number "\n")
	       'ignore))
	(if (not (display-graphic-p))
	    (kill-buffer (get-buffer (concat "*display " number "*")))
	  (catch 'frame-found

			       " 1 -T X"))))))

(defun gdb-delete-display ()
  "Delete displayed expression and its frame."
  (interactive)
  (gdb-instance-enqueue-input
   (list (concat "server delete display " gdb-display-number "\n")
	 'ignore))
  (kill-buffer nil)
  (delete-frame))