comparison lisp/progmodes/gdb-ui.el @ 90317:34c8b755296d

Revision: [e-mail]/emacs--unicode--0--patch-23 Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 113-118) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 38-39) - Update from CVS

90316:458ed0c8c4c3

and #define directives otherwise.")
(defvar gdb-error "Non-nil when GDB is reporting an error.")
(defvar gdb-macro-info nil
  "Non-nil if GDB knows that the inferior includes preprocessor macro info.")
(defvar gdb-buffer-fringe-width nil)

(defvar gdb-buffer-type nil
  "One of the symbols bound in `gdb-buffer-rules'.")
(make-variable-buffer-local 'gdb-buffer-type)

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

(defvar gdb-debug-log nil)

;;;###autoload
(defcustom gdb-enable-debug-log nil
  "Non-nil means record the process input and output in `gdb-debug-log'."
  :type 'boolean
  :group 'gud
  :version "22.1")

(defcustom gdb-cpp-define-alist-program "gcc -E -dM -"

      (if (string-equal (nth 1 var1) (match-string 1 varno))
	  (setq expr (concat (car var1) "." (match-string 2 varno)))))
    expr))

(defun gdb-init-1 ()
  (setq gdb-debug-log nil)
  (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-match "Machine" mode-name))
			 (gud-call "break %f:%l" arg)

    'gdb-mouse-set-clear-breakpoint)
  (define-key gud-minor-mode-map [left-fringe mouse-1]
    'gdb-mouse-set-clear-breakpoint)
  (define-key gud-minor-mode-map [left-fringe mouse-2]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-margin mouse-2]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-margin mouse-3]
    'gdb-mouse-toggle-breakpoint-margin)
  (define-key gud-minor-mode-map [left-fringe mouse-3]
    'gdb-mouse-toggle-breakpoint-fringe)

  (setq comint-input-sender 'gdb-send)

	gdb-flush-pending-output nil
	gdb-location-alist nil
	gdb-source-file-list nil
	gdb-error nil
	gdb-macro-info nil
	gdb-buffer-fringe-width (car (window-fringes)))

  (setq gdb-buffer-type 'gdba)

  (if gdb-use-separate-io-buffer (gdb-clear-inferior-io))

  ;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4)
  (setq gdb-version nil)
  (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n"
			   'gdb-get-version)))

(defun gdb-init-2 ()
  (if (eq window-system 'w32)

      (setq gdb-version "pre-6.4")
    (setq gdb-version "6.4+"))
  (gdb-init-2))

(defun gdb-mouse-until (event)
  "Execute source lines by dragging the overlay arrow (fringe) with the mouse."
  (interactive "e")
  (if gud-overlay-arrow-position
      (let ((start (event-start event))
	    (end  (event-end event))
	    (buffer (marker-buffer gud-overlay-arrow-position)) (line))

		(save-excursion
		  (goto-line (line-number-at-pos (posn-point end)))
		  (forward-char 2)
		  (gud-call (concat "until *%a")))))))))

(defcustom gdb-speedbar-auto-raise nil
  "If non-nil raise speedbar every time display of watch expressions is\
 updated."
  :type 'boolean
  :group 'gud

  (interactive (list last-input-event))
  (if event (posn-set-point (event-end event)))
  (require 'tooltip)
  (save-selected-window
    (let ((expr (tooltip-identifier-from-point (point))))
      (if (and (string-equal gdb-current-language "c")
	       gdb-use-colon-colon-notation gdb-selected-frame)
	  (setq expr (concat gdb-selected-frame "::" expr)))
      (catch 'already-watched
	(dolist (var gdb-var-list)
	  (if (string-equal expr (car var)) (throw 'already-watched nil)))
	(set-text-properties 0 (length expr) nil expr)
	(gdb-enqueue-input

  "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")

(defun gdb-var-create-handler (expr)
  (goto-char (point-min))
  (if (re-search-forward gdb-var-create-regexp nil t)
      (let ((var (list expr
		       (match-string 1)
		       (match-string 2)
		       (match-string 3)
		       nil nil)))
	(push var gdb-var-list)
	(speedbar 1)
	(unless (string-equal
		 speedbar-initial-expansion-list-name "GUD")
	  (speedbar-change-initial-expansion-list "GUD"))

	    (concat "-var-evaluate-expression " (nth 1 var) "\n"))
	  `(lambda () (gdb-var-evaluate-expression-handler
		       ,(nth 1 var) nil)))))
    (if (search-forward "Undefined command" nil t)
	(message-box "Watching expressions requires gdb 6.0 onwards")
      (message "No symbol \"%s\" in current context." expr))))

(defun gdb-var-evaluate-expression-handler (varnum changed)
  (goto-char (point-min))
  (re-search-forward ".*value=\\(\".*\"\\)" nil t)
  (catch 'var-found

  (concat "*input/output of "
	  (gdb-get-target-string)
	  "*"))

(defun gdb-display-separate-io-buffer ()
  "Display IO of inferior in a separate window."
  (interactive)
  (if gdb-use-separate-io-buffer
      (gdb-display-buffer
       (gdb-get-create-buffer 'gdb-inferior-io))))

    (let ((inhibit-read-only t))
      (remove-text-properties (point-min) (point-max) '(face))))
  (let ((item (concat string "\n")))
    (if gud-running
      (progn
	(if gdb-enable-debug-log (push (cons 'send item) gdb-debug-log))
	(process-send-string proc item))
      (gdb-enqueue-input item))))

;; Note: Stuff enqueued here will be sent to the next prompt, even if it
;; is a query, or other non-top-level prompt.

	   (unless (nbutlast queue) (setq gdb-input-queue '()))
	   last))))

(defun gdb-send-item (item)
  (setq gdb-flush-pending-output nil)
  (if gdb-enable-debug-log (push (cons 'send-item item) gdb-debug-log))
  (setq gdb-current-item item)
  (let ((process (get-buffer-process gud-comint-buffer)))
    (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	(if (stringp item)
	    (progn

    ("prompt-for-continue" gdb-subprompt)
    ("post-prompt" gdb-post-prompt)
    ("source" gdb-source)
    ("starting" gdb-starting)
    ("exited" gdb-exited)
    ("signalled" gdb-exited)
    ("signal" gdb-stopping)
    ("breakpoint" gdb-stopping)
    ("watchpoint" gdb-stopping)
    ("frame-begin" gdb-frame-begin)
    ("stopped" gdb-stopped)

  (setq gdb-active-process nil)
  (setq gud-overlay-arrow-position nil)
  (setq gdb-overlay-arrow-position nil)
  (gdb-stopping ignored))

(defun gdb-frame-begin (ignored)
  (let ((sink gdb-output-sink))
    (cond
     ((eq sink 'inferior)
      (setq gdb-output-sink 'user))

(defun gdb-stopped (ignored)
  "An annotation handler for `stopped'.
It is just like `gdb-stopping', except that if we already set the output
sink to `user' in `gdb-stopping', that is fine."
  (setq gud-running nil)
  (setq gdb-active-process t)
  (let ((sink gdb-output-sink))
    (cond
     ((eq sink 'inferior)
      (setq gdb-output-sink 'user))
     ((eq sink 'user) t)
     (t
      (gdb-resync)
      (error "Unexpected stopped annotation")))))

(defun gdb-error (ignored)
  (setq gdb-error (not gdb-error)))

(defun gdb-post-prompt (ignored)

(defun gud-gdba-marker-filter (string)
  "A gud marker filter for gdb.  Handle a burst of output from GDB."
  (if gdb-flush-pending-output
      nil
    (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
    ;; Recall the left over gud-marker-acc from last time.
    (setq gud-marker-acc (concat gud-marker-acc string))
    ;; Start accumulating output for the GUD buffer.
    (let ((output ""))
      ;;

90317:34c8b755296d

and #define directives otherwise.")
(defvar gdb-error "Non-nil when GDB is reporting an error.")
(defvar gdb-macro-info nil
  "Non-nil if GDB knows that the inferior includes preprocessor macro info.")
(defvar gdb-buffer-fringe-width nil)
(defvar gdb-signalled nil)

(defvar gdb-buffer-type nil
  "One of the symbols bound in `gdb-buffer-rules'.")
(make-variable-buffer-local 'gdb-buffer-type)

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

(defcustom gdb-debug-ring-max 128
  "Maximum size of `gdb-debug-ring'."
  :group 'gud
  :type 'integer
  :version "22.1")

(defvar gdb-debug-ring nil
  "List of commands, most recent first, sent to and replies received from GDB.
This variable is used to debug GDB-UI.")

;;;###autoload
(defcustom gdb-enable-debug nil
  "Non-nil means record the process input and output in `gdb-debug-ring'."
  :type 'boolean
  :group 'gud
  :version "22.1")

(defcustom gdb-cpp-define-alist-program "gcc -E -dM -"

      (if (string-equal (nth 1 var1) (match-string 1 varno))
	  (setq expr (concat (car var1) "." (match-string 2 varno)))))
    expr))

(defun gdb-init-1 ()
  (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-match "Machine" mode-name))
			 (gud-call "break %f:%l" arg)

    'gdb-mouse-set-clear-breakpoint)
  (define-key gud-minor-mode-map [left-fringe mouse-1]
    'gdb-mouse-set-clear-breakpoint)
  (define-key gud-minor-mode-map [left-fringe mouse-2]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-margin drag-mouse-1]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-margin mouse-2]
    'gdb-mouse-until)
  (define-key gud-minor-mode-map [left-margin C-drag-mouse-1]
    'gdb-mouse-jump)
  (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1]
    'gdb-mouse-jump)
  (define-key gud-minor-mode-map [left-fringe C-mouse-2]
    'gdb-mouse-jump)
  (define-key gud-minor-mode-map [left-margin C-mouse-2]
    'gdb-mouse-jump)
   (define-key gud-minor-mode-map [left-margin mouse-3]
    'gdb-mouse-toggle-breakpoint-margin)
  (define-key gud-minor-mode-map [left-fringe mouse-3]
    'gdb-mouse-toggle-breakpoint-fringe)

  (setq comint-input-sender 'gdb-send)

	gdb-flush-pending-output nil
	gdb-location-alist nil
	gdb-source-file-list nil
	gdb-error nil
	gdb-macro-info nil
	gdb-buffer-fringe-width (car (window-fringes))
	gdb-debug-ring nil
	gdb-signalled nil)

  (setq gdb-buffer-type 'gdba)

  (if gdb-use-separate-io-buffer (gdb-clear-inferior-io))

  ;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4)
  (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n"
			   'gdb-get-version)))

(defun gdb-init-2 ()
  (if (eq window-system 'w32)

      (setq gdb-version "pre-6.4")
    (setq gdb-version "6.4+"))
  (gdb-init-2))

(defun gdb-mouse-until (event)
  "Continue running until a source line past the current line.
The destination source line can be selected either by clicking with mouse-2
on the fringe/margin or dragging the arrow with mouse-1 (default bindings)."
  (interactive "e")
  (if gud-overlay-arrow-position
      (let ((start (event-start event))
	    (end  (event-end event))
	    (buffer (marker-buffer gud-overlay-arrow-position)) (line))

		(save-excursion
		  (goto-line (line-number-at-pos (posn-point end)))
		  (forward-char 2)
		  (gud-call (concat "until *%a")))))))))

(defun gdb-mouse-jump (event)
  "Set execution address/line.
The destination source line can be selected either by clicking with mouse-2
on the fringe/margin or dragging the arrow with mouse-1 (default bindings).
Unlike gdb-mouse-until the destination address can be before the current
line, and no execution takes place."
  (interactive "e")
  (if gud-overlay-arrow-position
      (let ((start (event-start event))
	    (end  (event-end event))
	    (buffer (marker-buffer gud-overlay-arrow-position)) (line))
	(if (not (string-match "Machine" mode-name))
	    (if (equal buffer (window-buffer (posn-window end)))
		(with-current-buffer buffer
		  (when (or (equal start end)
			    (equal (posn-point start)
				   (marker-position
				    gud-overlay-arrow-position)))
		    (setq line (line-number-at-pos (posn-point end)))
	   (progn (gud-call (concat "tbreak " (number-to-string line)))
		  (gud-call (concat "jump " (number-to-string line)))))))
	  (if (equal (marker-buffer gdb-overlay-arrow-position)
		     (window-buffer (posn-window end)))
	      (when (or (equal start end)
			(equal (posn-point start)
			       (marker-position
				gdb-overlay-arrow-position)))
		(save-excursion
		  (goto-line (line-number-at-pos (posn-point end)))
		  (forward-char 2)
		  (progn
		    (gud-call (concat "tbreak *%a"))
		    (gud-call (concat "jump *%a"))))))))))

(defcustom gdb-speedbar-auto-raise nil
  "If non-nil raise speedbar every time display of watch expressions is\
 updated."
  :type 'boolean
  :group 'gud

  (interactive (list last-input-event))
  (if event (posn-set-point (event-end event)))
  (require 'tooltip)
  (save-selected-window
    (let ((expr (tooltip-identifier-from-point (point))))
      (catch 'already-watched
	(dolist (var gdb-var-list)
	  (if (string-equal expr (car var)) (throw 'already-watched nil)))
	(set-text-properties 0 (length expr) nil expr)
	(gdb-enqueue-input

  "name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")

(defun gdb-var-create-handler (expr)
  (goto-char (point-min))
  (if (re-search-forward gdb-var-create-regexp nil t)
      (let ((var (list
		  (if (and (string-equal gdb-current-language "c")
			   gdb-use-colon-colon-notation gdb-selected-frame)
		      (setq expr (concat gdb-selected-frame "::" expr))
		    expr)
		  (match-string 1)
		  (match-string 2)
		  (match-string 3)
		  nil nil)))
	(push var gdb-var-list)
	(speedbar 1)
	(unless (string-equal
		 speedbar-initial-expansion-list-name "GUD")
	  (speedbar-change-initial-expansion-list "GUD"))

	    (concat "-var-evaluate-expression " (nth 1 var) "\n"))
	  `(lambda () (gdb-var-evaluate-expression-handler
		       ,(nth 1 var) nil)))))
    (if (search-forward "Undefined command" nil t)
	(message-box "Watching expressions requires gdb 6.0 onwards")
      (message-box "No symbol \"%s\" in current context." expr))))

(defun gdb-var-evaluate-expression-handler (varnum changed)
  (goto-char (point-min))
  (re-search-forward ".*value=\\(\".*\"\\)" nil t)
  (catch 'var-found

  (concat "*input/output of "
	  (gdb-get-target-string)
	  "*"))

(defun gdb-display-separate-io-buffer ()
  "Display IO of debugged program in a separate window."
  (interactive)
  (if gdb-use-separate-io-buffer
      (gdb-display-buffer
       (gdb-get-create-buffer 'gdb-inferior-io))))

    (let ((inhibit-read-only t))
      (remove-text-properties (point-min) (point-max) '(face))))
  (let ((item (concat string "\n")))
    (if gud-running
      (progn
	(if gdb-enable-debug (push (cons 'send item) gdb-debug-ring))
	(process-send-string proc item))
      (gdb-enqueue-input item))))

;; Note: Stuff enqueued here will be sent to the next prompt, even if it
;; is a query, or other non-top-level prompt.

	   (unless (nbutlast queue) (setq gdb-input-queue '()))
	   last))))

(defun gdb-send-item (item)
  (setq gdb-flush-pending-output nil)
  (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-ring))
  (setq gdb-current-item item)
  (let ((process (get-buffer-process gud-comint-buffer)))
    (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	(if (stringp item)
	    (progn

    ("prompt-for-continue" gdb-subprompt)
    ("post-prompt" gdb-post-prompt)
    ("source" gdb-source)
    ("starting" gdb-starting)
    ("exited" gdb-exited)
    ("signalled" gdb-signalled)
    ("signal" gdb-stopping)
    ("breakpoint" gdb-stopping)
    ("watchpoint" gdb-stopping)
    ("frame-begin" gdb-frame-begin)
    ("stopped" gdb-stopped)

  (setq gdb-active-process nil)
  (setq gud-overlay-arrow-position nil)
  (setq gdb-overlay-arrow-position nil)
  (gdb-stopping ignored))

(defun gdb-signalled (ignored)
  (setq gdb-signalled t))

(defun gdb-frame-begin (ignored)
  (let ((sink gdb-output-sink))
    (cond
     ((eq sink 'inferior)
      (setq gdb-output-sink 'user))

(defun gdb-stopped (ignored)
  "An annotation handler for `stopped'.
It is just like `gdb-stopping', except that if we already set the output
sink to `user' in `gdb-stopping', that is fine."
  (setq gud-running nil)
  (let ((sink gdb-output-sink))
    (cond
     ((eq sink 'inferior)
      (setq gdb-output-sink 'user))
     ((eq sink 'user) t)
     (t
      (gdb-resync)
      (error "Unexpected stopped annotation"))))
  (if gdb-signalled (gdb-exited ignored)))

(defun gdb-error (ignored)
  (setq gdb-error (not gdb-error)))

(defun gdb-post-prompt (ignored)

(defun gud-gdba-marker-filter (string)
  "A gud marker filter for gdb.  Handle a burst of output from GDB."
  (if gdb-flush-pending-output
      nil
    (when gdb-enable-debug
	(push (cons 'recv string) gdb-debug-ring)
	(if (> (length gdb-debug-ring) gdb-debug-ring-max)
	  (setcdr (nthcdr (1- gdb-debug-ring-max) gdb-debug-ring) nil)))
    ;; Recall the left over gud-marker-acc from last time.
    (setq gud-marker-acc (concat gud-marker-acc string))
    ;; Start accumulating output for the GUD buffer.
    (let ((output ""))
      ;;