comparison lisp/progmodes/gdb-ui.el @ 83473:428d132b4028

Merged from Patches applied: * [e-mail]/emacs--devo--0--patch-73 Merge from erc--emacs--0 * [e-mail]/emacs--devo--0--patch-74 Update from CVS * [e-mail]/emacs--devo--0--patch-75 Make ERC comply with the new copyright year guidelines. * [e-mail]/emacs--devo--0--patch-76 Update from CVS * [e-mail]/emacs--devo--0--patch-77 Update from CVS * [e-mail]/emacs--devo--0--patch-78 Update from CVS * [e-mail]/emacs--devo--0--patch-79 (rcirc-format-response-string): Fix small bugs * [e-mail]/emacs--devo--0--patch-80 Update from CVS * [e-mail]/emacs--devo--0--patch-81 Update from CVS * [e-mail]/emacs--devo--0--patch-82 Fix compiler error in erc-dcc.el. * [e-mail]/emacs--devo--0--patch-83 Update from CVS * [e-mail]/emacs--devo--0--patch-84 Update from CVS * [e-mail]/emacs--devo--0--patch-85 Update from CVS * [e-mail]/emacs--devo--0--patch-86 Update from CVS * [e-mail]/emacs--devo--0--patch-87 Update from CVS * [e-mail]/emacs--devo--0--patch-88 Merge from erc--emacs--0 * [e-mail]/emacs--devo--0--patch-89 Update from CVS * [e-mail]/emacs--devo--0--patch-90 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-513

83472:b8bd59a73456

      (3 font-lock-type-face))
    )
  "Font lock keywords used in `gdb-local-mode'.")

;; Variables for GDB 6.4+

(defvar gdb-register-names nil "List of register names.")
(defvar gdb-changed-registers nil
  "List of changed register numbers (strings).")

;;;###autoload

it starts with two windows: one displaying the GUD buffer and the
other with the source file with the main routine of the inferior.

If `gdb-many-windows' is t, regardless of the value of
`gdb-show-main', the layout below will appear unless
`gdb-use-inferior-io-buffer' is nil when the source buffer
occupies the full width of the frame.  Keybindings are given in
relevant buffer.

Watch expressions appear in the speedbar/slowbar.

Also display the main routine in the disassembly buffer if present."
  :type 'boolean
  :group 'gud
  :version "22.1")

(defcustom gdb-use-inferior-io-buffer nil
  "Non-nil means display output from the inferior in a separate buffer."
  :type 'boolean
  :group 'gud
  :version "22.1")

(defun gdb-use-inferior-io-buffer (arg)
  "Toggle separate IO for inferior.
With arg, use separate IO iff arg is positive."
  (interactive "P")
  (setq gdb-use-inferior-io-buffer
	(if (null arg)
	    (not gdb-use-inferior-io-buffer)
	  (> (prefix-numeric-value arg) 0)))
  (message (format "Separate inferior IO %sabled"
		   (if gdb-use-inferior-io-buffer "en" "dis")))
  (if (and gud-comint-buffer
	   (buffer-name gud-comint-buffer))
      (condition-case nil
	  (if gdb-use-inferior-io-buffer
	      (gdb-restore-windows)
	    (kill-buffer (gdb-inferior-io-name)))
	(error nil))))

(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")

	gdb-macro-info nil
	gdb-buffer-fringe-width (car (window-fringes)))

  (setq gdb-buffer-type 'gdba)

  (if gdb-use-inferior-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)))

	(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
	 (list
	  (if (eq gud-minor-mode 'gdba)
	      (concat "server interpreter mi \"-var-create - * "  expr "\"\n")
	    (concat"-var-create - * "  expr "\n"))
	  `(lambda () (gdb-var-create-handler ,expr))))))))

(defconst gdb-var-create-regexp

	(unless (string-equal
		 speedbar-initial-expansion-list-name "GUD")
	  (speedbar-change-initial-expansion-list "GUD"))
	(gdb-enqueue-input
	 (list
	  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
		  'gdba)
	      (concat "server interpreter mi \"-var-evaluate-expression "
		      (nth 1 var) "\"\n")
	    (concat "-var-evaluate-expression " (nth 1 var) "\n"))
	  `(lambda () (gdb-var-evaluate-expression-handler
		       ,(nth 1 var) nil))))

  "Expand the node the user clicked on.
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node.
INDENT is the current indentation depth."
  (cond ((string-match "+" text)        ;expand this node
	 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	     (if (string-equal gdb-version "pre-6.4")
		 (gdb-var-list-children token)
	       (gdb-var-list-children-1 token))
	   (progn
	     (gdbmi-var-update)
	     (gdbmi-var-list-children token))))
	((string-match "-" text)	;contract this node
	 (dolist (var gdb-var-list)
	   (if (string-match (concat token "\\.") (nth 1 var))
	       (setq gdb-var-list (delq var gdb-var-list))))
	 (setq gdb-var-changed t)

(defun gdb-inferior-io-name ()
  (concat "*input/output of "
	  (gdb-get-target-string)
	  "*"))

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

(defconst gdb-frame-parameters
  '((height . 14) (width . 80)
    (unsplittable . t)
    (tool-bar-lines . nil)
    (menu-bar-lines . nil)
    (minibuffer . nil)))

(defun gdb-frame-inferior-io-buffer ()
  "Display IO of inferior in a new frame."
  (interactive)
  (if gdb-use-inferior-io-buffer
      (let ((special-display-regexps (append special-display-regexps '(".*")))
	    (special-display-frame-alist gdb-frame-parameters))
	(display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))))

(defvar gdb-inferior-io-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt)
    (define-key map "\C-c\C-z" 'gdb-inferior-io-stop)
    (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit)
    (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
    (define-key map "\C-d" 'gdb-inferior-io-eof)
    map))

(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
  "Major mode for gdb inferior-io."
  :syntax-table nil :abbrev-table nil

  (with-current-buffer (process-buffer proc)
    (setq proc (get-buffer-process gud-comint-buffer))
    (process-send-string proc string)
    (process-send-string proc "\n")))

(defun gdb-inferior-io-interrupt ()
  "Interrupt the program being debugged."
  (interactive)
  (interrupt-process
   (get-buffer-process gud-comint-buffer) comint-ptyp))

(defun gdb-inferior-io-quit ()
  "Send quit signal to the program being debugged."
  (interactive)
  (quit-process
   (get-buffer-process gud-comint-buffer) comint-ptyp))

(defun gdb-inferior-io-stop ()
  "Stop the program being debugged."
  (interactive)
  (stop-process
   (get-buffer-process gud-comint-buffer) comint-ptyp))

(defun gdb-inferior-io-eof ()
  "Send end-of-file to the program being debugged."
  (interactive)
  (process-send-eof
   (get-buffer-process gud-comint-buffer)))


  (let ((sink gdb-output-sink))
    (cond
     ((eq sink 'user)
      (progn
	(setq gud-running t)
	(if gdb-use-inferior-io-buffer
	    (setq gdb-output-sink 'inferior))))
     (t
      (gdb-resync)
      (error "Unexpected `starting' annotation")))))

(defun gdb-stopping (ignored)
  "An annotation handler for `breakpoint' and other annotations.
They say that I/O for the subprocess is now GDB, not the program
being debugged."
  (if gdb-use-inferior-io-buffer
      (let ((sink gdb-output-sink))
	(cond
	 ((eq sink 'inferior)
	  (setq gdb-output-sink 'user))
	 (t

    ;; so gdb-frame-address is updated.
    ;; (gdb-invalidate-assembler)

    (if (string-equal gdb-version "pre-6.4")
	(gdb-invalidate-registers)
      (if (gdb-get-buffer 'gdb-registers-buffer) (gdb-get-changed-registers))
      (gdb-invalidate-registers-1))

    (gdb-invalidate-memory)
    (if (string-equal gdb-version "pre-6.4")
	(gdb-invalidate-locals)

(defun gdb-info-breakpoints-custom ()
  (let ((flag) (bptno))
    ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
	(if (and (eq gud-minor-mode 'gdba)
		 (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
	    (gdb-remove-breakpoint-icons (point-min) (point-max)))))
    (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
      (save-excursion
	(goto-char (point-min))

    (display-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer))))

(defvar gdb-breakpoints-mode-map
  (let ((map (make-sparse-keymap))
	(menu (make-sparse-keymap "Breakpoints")))
    (define-key menu [quit] '("Quit"   . kill-this-buffer))
    (define-key menu [goto] '("Goto"   . gdb-goto-breakpoint))
    (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
    (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
    (suppress-keymap map)
    (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))

  (run-mode-hooks 'gdb-breakpoints-mode-hook)
  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
      'gdb-invalidate-breakpoints
    'gdbmi-invalidate-breakpoints))

(defun gdb-toggle-breakpoint ()
  "Enable/disable breakpoint at current line."
  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	    (looking-at "\\([0-9]+\\).*?point\\s-+\\S-+\\s-+\\(.\\)\\s-+")
	  (looking-at
     "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+\\S-+\\s-+\\S-+:[0-9]+"))
	(gdb-enqueue-input
	 (list
	  (concat gdb-server-prefix
		  (if (eq ?y (char-after (match-beginning 2)))
		      "disable "

(defun gdb-delete-breakpoint ()
  "Delete the breakpoint at current line."
  (interactive)
  (beginning-of-line 1)
  (if (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	  (looking-at "\\([0-9]+\\).*?point\\s-+\\S-+\\s-+\\(.\\)")
	(looking-at
	 "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\s-+\\S-+\\s-+\\S-+:[0-9]+"))
      (gdb-enqueue-input
       (list
	(concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore))
    (error "Not recognized as break/watchpoint line")))

  ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
  (let ((window (get-buffer-window gud-comint-buffer)))
    (if window (save-selected-window  (select-window window))))
  (save-excursion
    (beginning-of-line 1)
    (if (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	    (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)")
	  (looking-at
	   "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+.\\s-+\\S-+\\s-+\
\\(\\S-+\\):\\([0-9]+\\)"))
	(let ((bptno (match-string 1))
	      (file  (match-string 2))
	      (line  (match-string 3)))
	  (save-selected-window
	    (let* ((buf (find-file-noselect

			   (cdr (assoc bptno gdb-location-alist)))))
		   (window (display-buffer buf)))
	      (with-current-buffer buf
		(goto-line (string-to-number line))
		(set-window-point window (point))))))
      (error "Not recognized as break/watchpoint line"))))


;; Frames buffer.  This displays a perpetually correct bactracktrace
;; (from the command `where').
;;

  (setq buffer-read-only t)
  (use-local-map gdb-locals-mode-map)
  (set (make-local-variable 'font-lock-defaults)
       '(gdb-locals-font-lock-keywords))
  (run-mode-hooks 'gdb-locals-mode-hook)
  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
      (if (string-equal gdb-version "pre-6.4")
	  'gdb-invalidate-locals
	'gdb-invalidate-locals-1)
    'gdbmi-invalidate-locals))

(defun gdb-locals-buffer-name ()
  (with-current-buffer gud-comint-buffer
    (concat "*locals of " (gdb-get-target-string) "*")))

  (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
  (define-key menu [disassembly]
    '("Disassembly" . gdb-display-assembler-buffer))
  (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
  (define-key menu [inferior]
    '(menu-item "Inferior IO" gdb-display-inferior-io-buffer
		:enable gdb-use-inferior-io-buffer))
  (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
  (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
  (define-key menu [breakpoints]
    '("Breakpoints" . gdb-display-breakpoints-buffer)))

  (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
  (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
  (define-key menu [disassembly] '("Disassembiy" . gdb-frame-assembler-buffer))
  (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
  (define-key menu [inferior]
    '(menu-item "Inferior IO" gdb-frame-inferior-io-buffer
		:enable gdb-use-inferior-io-buffer))
  (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
  (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
  (define-key menu [breakpoints]
    '("Breakpoints" . gdb-frame-breakpoints-buffer)))

(let ((menu (make-sparse-keymap "GDB-UI/MI")))
  (define-key gud-menu-map [ui]
    `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI")
		,menu :visible (memq gud-minor-mode '(gdbmi gdba))))
  (define-key menu [gdb-use-inferior-io]
  '(menu-item "Separate inferior IO" gdb-use-inferior-io-buffer
	      :visible (eq gud-minor-mode 'gdba)
	      :help "Toggle separate IO for inferior."
	      :button (:toggle . gdb-use-inferior-io-buffer)))
  (define-key menu [gdb-many-windows]
  '(menu-item "Display Other Windows" gdb-many-windows
	      :help "Toggle display of locals, stack and breakpoint information"
	      :button (:toggle . gdb-many-windows)))
  (define-key menu [gdb-restore-windows]

  (other-window 1)
  (switch-to-buffer
       (if gud-last-last-frame
	   (gud-find-file (car gud-last-last-frame))
	 (gud-find-file gdb-main-file)))
  (when gdb-use-inferior-io-buffer
    (split-window-horizontally)
    (other-window 1)
    (gdb-set-window-buffer
     (gdb-get-create-buffer 'gdb-inferior-io)))
  (other-window 1)

  "Set up buffer for debugging if file is part of the source code
of the current session."
  (if (and (buffer-name gud-comint-buffer)
	   ;; in case gud or gdb-ui is just loaded
	   gud-comint-buffer
	   (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
	       'gdba))
      (if (member buffer-file-name gdb-source-file-list)
	  (with-current-buffer (find-buffer-visiting buffer-file-name)
	    (set (make-local-variable 'gud-minor-mode) 'gdba)
	    (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)))))

;;from put-image
(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
  "Put string PUTSTRING in front of POS in the current buffer.

	(setq gdb-frame-address (match-string 1))))
  (goto-char (point-min))
  (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
      (setq gdb-current-language (match-string 1)))
  (gdb-invalidate-assembler))


;; For debugging Emacs only (assumes that usual stack buffer already exists).
(defun gdb-xbacktrace ()
  "Generate a full lisp level backtrace with arguments."
  (interactive)
  (setq my-frames nil)
  (with-current-buffer (get-buffer-create "xbacktrace")
    (erase-buffer))
  (let (frame-number gdb-frame-number)
    (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
      (save-excursion
	(goto-char (point-min))
	(while (search-forward "in Ffuncall " nil t)
	  (goto-char (line-beginning-position))
	  (looking-at "^#\\([0-9]+\\)")
	  (push (match-string-no-properties 1) my-frames)
	  (forward-line 1))))
    (dolist (frame my-frames)
      (gdb-enqueue-input (list (concat "server frame " frame "\n")
			       'ignore))
;    (gdb-enqueue-input (list "server ppargs\n" 'gdb-get-arguments))
      (gud-basic-call "server ppargs")
)
    (gdb-enqueue-input (list (concat "server frame " frame-number "\n")
			     'ignore))))
    
(defun gdb-get-arguments ()
  (with-current-buffer "xbacktrace"
    (insert-buffer-substring (gdb-get-buffer 'gdb-partial-output-buffer))))

;; Code specific to GDB 6.4
(defconst gdb-source-file-regexp-1 "fullname=\"\\(.*?\\)\"")

(defun gdb-set-gud-minor-mode-existing-buffers-1 ()
  "Create list of source files for current GDB session."
  (goto-char (point-min))
  (while (re-search-forward gdb-source-file-regexp-1 nil t)
    (push (match-string 1) gdb-source-file-list))
  (dolist (buffer (buffer-list))
    (with-current-buffer buffer
      (when (member buffer-file-name gdb-source-file-list)
	(set (make-local-variable 'gud-minor-mode) 'gdba)
	(set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
	(when gud-tooltip-mode
	  (make-local-variable 'gdb-define-alist)
	  (gdb-create-define-alist)
	  (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))

; Uses "-var-list-children --all-values".  Needs GDB 6.1 onwards.
(defun gdb-var-list-children-1 (varnum)
  (gdb-enqueue-input
   (list (concat "server interpreter mi \"-var-update " varnum "\"\n")
	 'ignore))
  (gdb-enqueue-input
   (list (concat "server interpreter mi \"-var-list-children --all-values "  
		 varnum "\"\n")
	     `(lambda () (gdb-var-list-children-handler-1 ,varnum)))))

(defconst gdb-var-list-children-regexp-1
  "name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\
value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")

(defun gdb-var-update-1 ()
  (if (not (member 'gdb-var-update gdb-pending-triggers))
      (progn
	(gdb-enqueue-input
	 (list
	  (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
	      "server interpreter mi \"-var-update --all-values *\"\n"
	    "-var-update --all-values *\n")
				 'gdb-var-update-handler-1))
	(push 'gdb-var-update gdb-pending-triggers))))

(defconst gdb-var-update-regexp-1 "name=\"\\(.*?\\)\",value=\\(\".*?\"\\),")

(defun gdb-var-update-handler-1 ()

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

(def-gdb-auto-update-trigger gdb-invalidate-registers-1
  (gdb-get-buffer 'gdb-registers-buffer)
  (if (eq gud-minor-mode 'gdba)
      "server interpreter mi \"-data-list-register-values x\"\n"
    "-data-list-register-values x\n")
    gdb-data-list-register-values-handler)

(defconst gdb-data-list-register-values-regexp

				     mouse-face highlight))))
	  (forward-line 1))))))

;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
  (if (not (member 'gdb-get-changed-registers gdb-pending-triggers))
      (progn
	(gdb-enqueue-input
	 (list
	  (if (eq gud-minor-mode 'gdba)
	      "server interpreter mi -data-list-changed-registers\n"
	    "-data-list-changed-registers\n")
	       'gdb-get-changed-registers-handler))
	(push 'gdb-get-changed-registers gdb-pending-triggers))))

(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")

(defun gdb-get-changed-registers-handler ()

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

(def-gdb-auto-update-trigger gdb-invalidate-locals-1
  (gdb-get-buffer 'gdb-locals-buffer)
  "server interpreter mi -\"stack-list-locals --simple-values\"\n"
  gdb-stack-list-locals-handler)

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

83473:428d132b4028

      (3 font-lock-type-face))
    )
  "Font lock keywords used in `gdb-local-mode'.")

;; Variables for GDB 6.4+
(defvar gdb-register-names nil "List of register names.")
(defvar gdb-changed-registers nil
  "List of changed register numbers (strings).")

;;;###autoload

it starts with two windows: one displaying the GUD buffer and the
other with the source file with the main routine of the inferior.

If `gdb-many-windows' is t, regardless of the value of
`gdb-show-main', the layout below will appear unless
`gdb-use-separate-io-buffer' is nil when the source buffer
occupies the full width of the frame.  Keybindings are given in
relevant buffer.

Watch expressions appear in the speedbar/slowbar.

Also display the main routine in the disassembly buffer if present."
  :type 'boolean
  :group 'gud
  :version "22.1")

(defcustom gdb-use-separate-io-buffer nil
  "Non-nil means display output from the inferior in a separate buffer."
  :type 'boolean
  :group 'gud
  :version "22.1")

(defun gdb-use-separate-io-buffer (arg)
  "Toggle separate IO for inferior.
With arg, use separate IO iff arg is positive."
  (interactive "P")
  (setq gdb-use-separate-io-buffer
	(if (null arg)
	    (not gdb-use-separate-io-buffer)
	  (> (prefix-numeric-value arg) 0)))
  (message (format "Separate inferior IO %sabled"
		   (if gdb-use-separate-io-buffer "en" "dis")))
  (if (and gud-comint-buffer
	   (buffer-name gud-comint-buffer))
      (condition-case nil
	  (if gdb-use-separate-io-buffer
	      (gdb-restore-windows)
	    (kill-buffer (gdb-inferior-io-name)))
	(error nil))))

(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")

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

	(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
	 (list
	  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	      (concat "server interpreter mi \"-var-create - * "  expr "\"\n")
	    (concat"-var-create - * "  expr "\n"))
	  `(lambda () (gdb-var-create-handler ,expr))))))))

(defconst gdb-var-create-regexp

	(unless (string-equal
		 speedbar-initial-expansion-list-name "GUD")
	  (speedbar-change-initial-expansion-list "GUD"))
	(gdb-enqueue-input
	 (list
	  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	      (concat "server interpreter mi \"-var-evaluate-expression "
		      (nth 1 var) "\"\n")
	    (concat "-var-evaluate-expression " (nth 1 var) "\n"))
	  `(lambda () (gdb-var-evaluate-expression-handler
		       ,(nth 1 var) nil))))

  "Expand the node the user clicked on.
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node.
INDENT is the current indentation depth."
  (cond ((string-match "+" text)        ;expand this node
	 (if (and
	      (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	      (string-equal gdb-version "pre-6.4"))
	     (gdb-var-list-children token)
	   (gdb-var-list-children-1 token)))
	((string-match "-" text)	;contract this node
	 (dolist (var gdb-var-list)
	   (if (string-match (concat token "\\.") (nth 1 var))
	       (setq gdb-var-list (delq var gdb-var-list))))
	 (setq gdb-var-changed t)

(defun gdb-inferior-io-name ()
  (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))))

(defconst gdb-frame-parameters
  '((height . 14) (width . 80)
    (unsplittable . t)
    (tool-bar-lines . nil)
    (menu-bar-lines . nil)
    (minibuffer . nil)))

(defun gdb-frame-separate-io-buffer ()
  "Display IO of inferior in a new frame."
  (interactive)
  (if gdb-use-separate-io-buffer
      (let ((special-display-regexps (append special-display-regexps '(".*")))
	    (special-display-frame-alist gdb-frame-parameters))
	(display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))))

(defvar gdb-inferior-io-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt)
    (define-key map "\C-c\C-z" 'gdb-separate-io-stop)
    (define-key map "\C-c\C-\\" 'gdb-separate-io-quit)
    (define-key map "\C-c\C-d" 'gdb-separate-io-eof)
    (define-key map "\C-d" 'gdb-separate-io-eof)
    map))

(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
  "Major mode for gdb inferior-io."
  :syntax-table nil :abbrev-table nil

  (with-current-buffer (process-buffer proc)
    (setq proc (get-buffer-process gud-comint-buffer))
    (process-send-string proc string)
    (process-send-string proc "\n")))

(defun gdb-separate-io-interrupt ()
  "Interrupt the program being debugged."
  (interactive)
  (interrupt-process
   (get-buffer-process gud-comint-buffer) comint-ptyp))

(defun gdb-separate-io-quit ()
  "Send quit signal to the program being debugged."
  (interactive)
  (quit-process
   (get-buffer-process gud-comint-buffer) comint-ptyp))

(defun gdb-separate-io-stop ()
  "Stop the program being debugged."
  (interactive)
  (stop-process
   (get-buffer-process gud-comint-buffer) comint-ptyp))

(defun gdb-separate-io-eof ()
  "Send end-of-file to the program being debugged."
  (interactive)
  (process-send-eof
   (get-buffer-process gud-comint-buffer)))


  (let ((sink gdb-output-sink))
    (cond
     ((eq sink 'user)
      (progn
	(setq gud-running t)
	(if gdb-use-separate-io-buffer
	    (setq gdb-output-sink 'inferior))))
     (t
      (gdb-resync)
      (error "Unexpected `starting' annotation")))))

(defun gdb-stopping (ignored)
  "An annotation handler for `breakpoint' and other annotations.
They say that I/O for the subprocess is now GDB, not the program
being debugged."
  (if gdb-use-separate-io-buffer
      (let ((sink gdb-output-sink))
	(cond
	 ((eq sink 'inferior)
	  (setq gdb-output-sink 'user))
	 (t

    ;; so gdb-frame-address is updated.
    ;; (gdb-invalidate-assembler)

    (if (string-equal gdb-version "pre-6.4")
	(gdb-invalidate-registers)
      (gdb-get-changed-registers)
      (gdb-invalidate-registers-1))

    (gdb-invalidate-memory)
    (if (string-equal gdb-version "pre-6.4")
	(gdb-invalidate-locals)

(defun gdb-info-breakpoints-custom ()
  (let ((flag) (bptno))
    ;; Remove all breakpoint-icons in source buffers but not assembler buffer.
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
	(if (and (memq gud-minor-mode '(gdba gdbmi))
		 (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
	    (gdb-remove-breakpoint-icons (point-min) (point-max)))))
    (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
      (save-excursion
	(goto-char (point-min))

    (display-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer))))

(defvar gdb-breakpoints-mode-map
  (let ((map (make-sparse-keymap))
	(menu (make-sparse-keymap "Breakpoints")))
    (define-key menu [quit] '("Quit"   . gdb-delete-frame-or-window))
    (define-key menu [goto] '("Goto"   . gdb-goto-breakpoint))
    (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
    (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
    (suppress-keymap map)
    (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))

  (run-mode-hooks 'gdb-breakpoints-mode-hook)
  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
      'gdb-invalidate-breakpoints
    'gdbmi-invalidate-breakpoints))

(defconst gdb-breakpoint-regexp
  "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+")

(defun gdb-toggle-breakpoint ()
  "Enable/disable breakpoint at current line."
  (interactive)
  (save-excursion
    (beginning-of-line 1)
    (if (looking-at gdb-breakpoint-regexp)
	(gdb-enqueue-input
	 (list
	  (concat gdb-server-prefix
		  (if (eq ?y (char-after (match-beginning 2)))
		      "disable "

(defun gdb-delete-breakpoint ()
  "Delete the breakpoint at current line."
  (interactive)
  (beginning-of-line 1)
  (if (looking-at gdb-breakpoint-regexp)
      (gdb-enqueue-input
       (list
	(concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore))
    (error "Not recognized as break/watchpoint line")))

  ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
  (let ((window (get-buffer-window gud-comint-buffer)))
    (if window (save-selected-window  (select-window window))))
  (save-excursion
    (beginning-of-line 1)
    (if (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)")
	(let ((bptno (match-string 1))
	      (file  (match-string 2))
	      (line  (match-string 3)))
	  (save-selected-window
	    (let* ((buf (find-file-noselect

			   (cdr (assoc bptno gdb-location-alist)))))
		   (window (display-buffer buf)))
	      (with-current-buffer buf
		(goto-line (string-to-number line))
		(set-window-point window (point))))))
      (error "No location specified."))))


;; Frames buffer.  This displays a perpetually correct bactracktrace
;; (from the command `where').
;;

  (setq buffer-read-only t)
  (use-local-map gdb-locals-mode-map)
  (set (make-local-variable 'font-lock-defaults)
       '(gdb-locals-font-lock-keywords))
  (run-mode-hooks 'gdb-locals-mode-hook)
  (if (and (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	   (string-equal gdb-version "pre-6.4"))
      'gdb-invalidate-locals
    'gdb-invalidate-locals-1))

(defun gdb-locals-buffer-name ()
  (with-current-buffer gud-comint-buffer
    (concat "*locals of " (gdb-get-target-string) "*")))

  (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
  (define-key menu [disassembly]
    '("Disassembly" . gdb-display-assembler-buffer))
  (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
  (define-key menu [inferior]
    '(menu-item "Inferior IO" gdb-display-separate-io-buffer
		:enable gdb-use-separate-io-buffer))
  (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
  (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
  (define-key menu [breakpoints]
    '("Breakpoints" . gdb-display-breakpoints-buffer)))

  (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
  (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
  (define-key menu [disassembly] '("Disassembiy" . gdb-frame-assembler-buffer))
  (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
  (define-key menu [inferior]
    '(menu-item "Inferior IO" gdb-frame-separate-io-buffer
		:enable gdb-use-separate-io-buffer))
  (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
  (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
  (define-key menu [breakpoints]
    '("Breakpoints" . gdb-frame-breakpoints-buffer)))

(let ((menu (make-sparse-keymap "GDB-UI/MI")))
  (define-key gud-menu-map [ui]
    `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI")
		,menu :visible (memq gud-minor-mode '(gdbmi gdba))))
  (define-key menu [gdb-use-separate-io]
  '(menu-item "Separate inferior IO" gdb-use-separate-io-buffer
	      :visible (eq gud-minor-mode 'gdba)
	      :help "Toggle separate IO for inferior."
	      :button (:toggle . gdb-use-separate-io-buffer)))
  (define-key menu [gdb-many-windows]
  '(menu-item "Display Other Windows" gdb-many-windows
	      :help "Toggle display of locals, stack and breakpoint information"
	      :button (:toggle . gdb-many-windows)))
  (define-key menu [gdb-restore-windows]

  (other-window 1)
  (switch-to-buffer
       (if gud-last-last-frame
	   (gud-find-file (car gud-last-last-frame))
	 (gud-find-file gdb-main-file)))
  (when gdb-use-separate-io-buffer
    (split-window-horizontally)
    (other-window 1)
    (gdb-set-window-buffer
     (gdb-get-create-buffer 'gdb-inferior-io)))
  (other-window 1)

  "Set up buffer for debugging if file is part of the source code
of the current session."
  (if (and (buffer-name gud-comint-buffer)
	   ;; in case gud or gdb-ui is just loaded
	   gud-comint-buffer
	   (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
	       '(gdba gdbmi)))
      (if (member buffer-file-name gdb-source-file-list)
	  (with-current-buffer (find-buffer-visiting buffer-file-name)
	    (set (make-local-variable 'gud-minor-mode)
		 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
	    (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)))))

;;from put-image
(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
  "Put string PUTSTRING in front of POS in the current buffer.

	(setq gdb-frame-address (match-string 1))))
  (goto-char (point-min))
  (if (re-search-forward " source language \\(\\S-*\\)\." nil t)
      (setq gdb-current-language (match-string 1)))
  (gdb-invalidate-assembler))


;; Code specific to GDB 6.4
(defconst gdb-source-file-regexp-1 "fullname=\"\\(.*?\\)\"")

(defun gdb-set-gud-minor-mode-existing-buffers-1 ()
  "Create list of source files for current GDB session.
If buffers already exist for any of these files, gud-minor-mode
is set in them."
  (goto-char (point-min))
  (while (re-search-forward gdb-source-file-regexp-1 nil t)
    (push (match-string 1) gdb-source-file-list))
  (dolist (buffer (buffer-list))
    (with-current-buffer buffer
      (when (member buffer-file-name gdb-source-file-list)
	(set (make-local-variable 'gud-minor-mode)
	     (buffer-local-value 'gud-minor-mode gud-comint-buffer))
	(set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
	(when gud-tooltip-mode
	  (make-local-variable 'gdb-define-alist)
	  (gdb-create-define-alist)
	  (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))

; Uses "-var-list-children --all-values".  Needs GDB 6.1 onwards.
(defun gdb-var-list-children-1 (varnum)
  (gdb-enqueue-input
   (list
    (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	(concat "server interpreter mi \"-var-list-children --all-values "  
		varnum "\"\n")
      (concat "-var-list-children --all-values " varnum "\n"))
    `(lambda () (gdb-var-list-children-handler-1 ,varnum)))))

(defconst gdb-var-list-children-regexp-1
  "name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\
value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")

(defun gdb-var-update-1 ()
  (if (not (member 'gdb-var-update gdb-pending-triggers))
      (progn
	(gdb-enqueue-input
	 (list
	  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	      "server interpreter mi \"-var-update --all-values *\"\n"
	    "-var-update --all-values *\n")
	  'gdb-var-update-handler-1))
	(push 'gdb-var-update gdb-pending-triggers))))

(defconst gdb-var-update-regexp-1 "name=\"\\(.*?\\)\",value=\\(\".*?\"\\),")

(defun gdb-var-update-handler-1 ()

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

(def-gdb-auto-update-trigger gdb-invalidate-registers-1
  (gdb-get-buffer 'gdb-registers-buffer)
  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
      "server interpreter mi \"-data-list-register-values x\"\n"
    "-data-list-register-values x\n")
    gdb-data-list-register-values-handler)

(defconst gdb-data-list-register-values-regexp

				     mouse-face highlight))))
	  (forward-line 1))))))

;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
  (if (and (gdb-get-buffer 'gdb-registers-buffer)
	   (not (member 'gdb-get-changed-registers gdb-pending-triggers)))
      (progn
	(gdb-enqueue-input
	 (list
	  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
	      "server interpreter mi -data-list-changed-registers\n"
	    "-data-list-changed-registers\n")
	  'gdb-get-changed-registers-handler))
	(push 'gdb-get-changed-registers gdb-pending-triggers))))

(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")

(defun gdb-get-changed-registers-handler ()

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

(def-gdb-auto-update-trigger gdb-invalidate-locals-1
  (gdb-get-buffer 'gdb-locals-buffer)
  (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
      "server interpreter mi -\"stack-list-locals --simple-values\"\n"
    "-stack-list-locals --simple-values\n")
  gdb-stack-list-locals-handler)

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