comparison lisp/progmodes/gdb-ui.el @ 69106:3f5044e40e3e

(gdb-signalled): New variable and function. (gdb-debug-log-ring): Rename from gdb-debug-log and make a ring. (gdb-send, gdb-send-item, gud-gdba-marker-filter): Use it. (gdb-debug-log-length): Customize it's length. (gud-watch, gdb-var-create-handler): Display function::var format but don't use to create variable object. (gdb-var-create-handler): Use message-box in place of message. (gdb-stopped): Call gdb-exited if signalled.

69105:f04b50463c62

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

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

69106:3f5044e40e3e

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-log-length 128
  "Length of `gdb-debug-log-ring'."
  :group 'gud
  :type 'integer
  :version "22.1")

(defvar gdb-debug-log-ring (make-ring gdb-debug-log-length)
  "Ring of commands sent to and replies received from GDB.
This variable is used to debug GDB-UI.  Just need most recent
messages and a ring limits the size.")

;;;###autoload
(defcustom gdb-enable-debug-log nil
  "Non-nil means record the process input and output in `gdb-debug-log-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-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-log-ring (make-ring gdb-debug-log-length)
	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)

  (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-log (push (cons 'send item) gdb-debug-log-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-log
      (ring-insert gdb-debug-log-ring (cons 'send-item item)))
  (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
    (if gdb-enable-debug-log
	(ring-insert gdb-debug-log-ring (cons 'recv string)))
    ;; 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 ""))
      ;;