comparison lisp/gdb-ui.el @ 48515:3216cd45d6d2

Major re-organisation. Simplify legacy gdba code to allow only one gdb process.

48514:f2d41568620b

  "If t, using gdba, start gdb with ancillary buffers visible.
Use `toggle-gdb-windows' to change this value during a gdb session"
  :type 'boolean
  :group 'gud)

(defvar gdb-main-file nil "Source file from which program execution begins.")
(defvar gdb-cdir nil "Compilation directory.")
(defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.")
(defvar gdb-prev-main-or-pc nil)
(defvar gdb-current-address nil)
(defvar gdb-current-frame nil)
(defvar gdb-display-in-progress nil)
(defvar gdb-dive nil)
(defvar gdb-first-time nil)
(defvar breakpoint-enabled-icon 
  "Icon for enabled breakpoint in display margin")
(defvar breakpoint-disabled-icon 
  "Icon for disabled breakpoint in display margin")
(defvar gdb-nesting-level)
(defvar gdb-expression-buffer-name)
(defvar gdb-expression)
(defvar gdb-point)
(defvar gdb-annotation-arg)
(defvar gdb-array-start)
(defvar gdb-array-stop)
(defvar gdb-display-number)
(defvar gdb-dive-display-number)
(defvar gdb-dive-map nil)
(defvar gdb-display-string)
(defvar gdb-values)
(defvar gdb-array-size)
(defvar gdb-array-slice-map nil)
(defvar gdb-buffer-instance nil)
(defvar gdb-source-window nil)
(defvar gdb-target-name "--unknown--"
  "The apparent name of the program being debugged in a gud buffer.")

(defun gdba (command-line)
  "Run gdb on program FILE in buffer *gdb-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.

  (gdba-common-init command-line nil
		   'gdba-marker-filter 'gud-gdb-find-file)

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

;  (gud-def gud-break  "break %f:%l"  "\C-b" "Set breakpoint at current line.")
  (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
;  (gud-def gud-remove "clear %f:%l"  "\C-d" "Remove breakpoint at current line")
  (gud-def gud-run    "run"	     nil    "Run the program.")
  (gud-def gud-stepi  "stepi %p"     "\C-i" "Step one instruction with display.")
  (gud-def gud-step   "step %p"      "\C-s" "Step one source line with display.")
  (gud-def gud-next   "next %p"      "\C-n" "Step one line (skip functions).")
  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")

  (setq gdb-display-in-progress nil)
  (setq gdb-dive nil)
  (setq gud-last-last-frame nil)

  (run-hooks 'gdb-mode-hook)
  (let ((instance
	 (make-gdb-instance (get-buffer-process (current-buffer)))))
    (if gdb-first-time (gdb-clear-inferior-io instance))

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

(defun gud-break (arg)
  "Set breakpoint at current line or address."
  (interactive "p")
  (if (not (string-equal mode-name "Assembler"))

  "Display (possibly dereferenced) C expression at point."
  (interactive)
  (save-excursion
    (let ((expr (gud-find-c-expr)))
      (gdb-instance-enqueue-idle-input
       gdb-buffer-instance
       (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
	 gdb-buffer-instance
	 (list (concat "server display* " expr "\n")
	       '(lambda () nil)))
;else
      (gdb-instance-enqueue-idle-input
       gdb-buffer-instance
       (list (concat "server display " expr "\n")
	     '(lambda () nil)))))


;; The completion process filter is installed temporarily to slurp the
;; output of GDB up to the next prompt and build the completion list.
;; It must also handle annotations.
(defun gdba-complete-filter (string)
  (gdb-output-burst gdb-buffer-instance string)
  (while (string-match "\n\032\032\\(.*\\)\n" string)
    (setq string (concat (substring string 0 (match-beginning 0))
			 (substring string (match-end 0)))))
  (setq string (concat gud-gdb-complete-string string))
  (while (string-match "\n" string)

	string)
    (progn
      (setq gud-gdb-complete-string string)
      "")))


(defun gdba-common-init (command-line massage-args marker-filter &optional find-file)

  (let* ((words (split-string command-line))
	 (program (car words))

    (let ((w args))
      (while (and w (not (eq (car w) t)))
	(setq w (cdr w)))
      (if w
	  (setcar w file)))
    (let ((old-instance gdb-buffer-instance))
      (apply 'make-comint (concat "gdb-" filepart) program nil args)
      (gud-mode)
      (make-variable-buffer-local 'old-gdb-buffer-instance)
      (setq old-gdb-buffer-instance old-instance))
    (setq gdb-target-name filepart))
  (make-local-variable 'gud-marker-filter)
  (setq gud-marker-filter marker-filter)
  (if find-file (set (make-local-variable 'gud-find-file) find-file))

;;
;; gdb-instance objects
;;

(defun make-gdb-instance (proc)
  "Create a gdb instance object from a gdb process."
  (let ((instance (cons 'gdb-instance proc)))
    (with-current-buffer (process-buffer proc)
      (setq gdb-buffer-instance instance)
      (progn
	(mapc 'make-local-variable gdb-instance-variables)
	(setq gdb-buffer-type 'gdba)
	;; If we're taking over the buffer of another process,
	;; take over it's ancillary buffers as well.
	;;
	(let ((dead old-gdb-buffer-instance))
	  (dolist (b (buffer-list))
		(set-buffer b)
		(if (eq dead gdb-buffer-instance)
		(setq gdb-buffer-instance instance))))))
    instance))

(defun gdb-instance-process (inst) (cdr inst))

;;; The list of instance variables is built up by the expansions of
;;; DEF-GDB-VARIABLE
;;;
(defvar gdb-instance-variables '()
  "A list of variables that are local to the GUD buffer associated
with a gdb instance.")

(defmacro def-gdb-variable (name accessor setter &optional default doc)
  `(progn
     (defvar ,name ,default ,(or doc "undocumented"))
     (if (not (memq ',name gdb-instance-variables))
	 (setq gdb-instance-variables
	       (cons ',name gdb-instance-variables)))
     ,(and accessor
	     `(defun ,accessor (instance)
		(let
		    ((buffer (gdb-get-instance-buffer instance 'gdba)))
		  (and buffer
		       (save-excursion
			 (set-buffer buffer)
			 ,name)))))
     ,(and setter
	     `(defun ,setter (instance val)
		(let
		    ((buffer (gdb-get-instance-buffer instance 'gdba)))
		  (and buffer
		       (save-excursion
			 (set-buffer buffer)
			 (setq ,name val))))))))

(defmacro def-gdb-var (root-symbol &optional default doc)
  (let* ((root (symbol-name root-symbol))
	 (accessor (intern (concat "gdb-instance-" root)))
	 (setter (intern (concat "set-gdb-instance-" root)))
	 (var-name (intern (concat "gdb-" root))))
    `(def-gdb-variable
	 ,var-name ,accessor ,setter
	 ,default ,doc)))

(def-gdb-var buffer-instance nil
  "In an instance buffer, the buffer's instance.")

(def-gdb-var buffer-type nil
  "One of the symbols bound in gdb-instance-buffer-rules")

(def-gdb-var burst ""

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

(defun in-gdb-instance-context (instance form)
  "Funcall FORM in the GUD buffer of INSTANCE."
  (save-excursion
    (set-buffer (gdb-get-instance-buffer instance 'gdba))
    (funcall form)))

;; end of instance vars

;;
;; finding instances
;;

(defun gdb-proc->instance (proc)
  (save-excursion
    (set-buffer (process-buffer proc))
    gdb-buffer-instance))

(defun gdb-mru-instance-buffer ()
  "Return the most recently used (non-auxiliary) GUD buffer."
  (save-excursion
    (gdb-goto-first-gdb-instance (buffer-list))))

(defun gdb-goto-first-gdb-instance (blist)
  "Use gdb-mru-instance-buffer -- not this."
  (and blist
       (progn
	 (set-buffer (car blist))
	 (or (and gdb-buffer-instance
		  (eq gdb-buffer-type 'gdba)
		  (car blist))
	     (gdb-goto-first-gdb-instance (cdr blist))))))

(defun buffer-gdb-instance (buf)
  (save-excursion
    (set-buffer buf)
    gdb-buffer-instance))

(defun gdb-needed-default-instance ()
  "Return the most recently used gdb instance or signal an error."
  (let ((buffer (gdb-mru-instance-buffer)))
    (or (and buffer (buffer-gdb-instance buffer))
	(error "No instance of gdb found"))))

(defun gdb-instance-target-string (instance)
  "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
   instance
   (function (lambda () gdb-target-name))))



;;
;; Instance Buffers.
;;

;; is constructed specially.
;;
;; Others are constructed by gdb-get-create-instance-buffer and
;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc

(defun gdb-get-instance-buffer (instance key)
  "Return the instance buffer for INSTANCE tagged with type KEY.
The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
  (save-excursion
    (gdb-look-for-tagged-buffer instance key (buffer-list))))

(defun gdb-get-create-instance-buffer (instance key)
  "Create a new gdb instance buffer of the type specified by KEY.
The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
  (or (gdb-get-instance-buffer instance key)
      (let* ((rules (assoc key gdb-instance-buffer-rules-assoc))
	     (name (funcall (gdb-rules-name-maker rules) instance))
	     (new (get-buffer-create name)))
	(save-excursion
	  (set-buffer new)
	  (make-variable-buffer-local 'gdb-buffer-type)
	  (setq gdb-buffer-type key)
	  (make-variable-buffer-local 'gdb-buffer-instance)
	  (setq gdb-buffer-instance instance)
	  (if (cdr (cdr rules))
	      (funcall (car (cdr (cdr rules)))))
	  new))))

(defun gdb-rules-name-maker (rules) (car (cdr rules)))

(defun gdb-look-for-tagged-buffer (instance key bufs)
  (let ((retval nil))
    (while (and (not retval) bufs)
      (set-buffer (car bufs))
      (if (and (eq gdb-buffer-instance instance)
	       (eq gdb-buffer-type key))
	  (setq retval (car bufs)))
      (setq bufs (cdr bufs)))
    retval))

(defun gdb-instance-buffer-p (buf)
  (save-excursion
    (set-buffer buf)
    (and gdb-buffer-type
	 (not (eq gdb-buffer-type 'gdba)))))

;;
;; This assoc maps buffer type symbols to rules.  Each rule is a list of
;; at least one and possible more functions.  The functions have these
;; roles in defining a buffer type:
;;

;; The remaining function(s) are optional:
;;
;;     MODE - called in new new buffer with no arguments, should establish
;;	      the proper mode for the buffer.
;;

(defvar gdb-instance-buffer-rules-assoc '())

(defun gdb-set-instance-buffer-rules (buffer-type &rest rules)
  (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc)))
    (if binding
	(setcdr binding rules)

;;

(gdb-set-instance-buffer-rules 'gdb-partial-output-buffer
			       'gdb-partial-output-name)

(defun gdb-partial-output-name (instance)
  (concat "*partial-output-"
	  (gdb-instance-target-string instance)
	  "*"))


(gdb-set-instance-buffer-rules 'gdb-inferior-io
			       'gdb-inferior-io-name
			       'gdb-inferior-io-mode)

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

(defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map))
(define-key comint-mode-map "\C-c\C-c" 'gdb-inferior-io-interrupt)
(define-key comint-mode-map "\C-c\C-z" 'gdb-inferior-io-stop)

  (setq comint-input-sender 'gdb-inferior-io-sender))

(defun gdb-inferior-io-sender (proc string)
  (save-excursion
    (set-buffer (process-buffer proc))
    (let ((instance gdb-buffer-instance))
      (set-buffer (gdb-get-instance-buffer instance 'gdba))
      (let ((gdb-proc (get-buffer-process (current-buffer))))
	(process-send-string gdb-proc string)
	(process-send-string gdb-proc "\n")))))

(defun gdb-inferior-io-interrupt (instance)
  "Interrupt the program being debugged."
  (interactive (list (gdb-needed-default-instance)))
  (interrupt-process
   (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp))

(defun gdb-inferior-io-quit (instance)
  "Send quit signal to the program being debugged."
  (interactive (list (gdb-needed-default-instance)))
  (quit-process
   (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp))

(defun gdb-inferior-io-stop (instance)
  "Stop the program being debugged."
  (interactive (list (gdb-needed-default-instance)))
  (stop-process
   (get-buffer-process (gdb-get-instance-buffer instance 'gdba)) comint-ptyp))

(defun gdb-inferior-io-eof (instance)
  "Send end-of-file to the program being debugged."
  (interactive (list (gdb-needed-default-instance)))
  (process-send-eof
   (get-buffer-process (gdb-get-instance-buffer instance 'gdba))))


;;
;; gdb communications
;;

;;

(defun gdb-send (proc string)
  "A comint send filter for gdb.
This filter may simply queue output for a later time."
  (let ((instance (gdb-proc->instance proc)))
    (gdb-instance-enqueue-input instance (concat string "\n"))))

;; Note: Stuff enqueued here will be sent to the next prompt, even if it
;; is a query, or other non-top-level prompt.  To guarantee stuff will get
;; sent to the top-level prompt, currently it must be put in the idle queue.
;;				 ^^^^^^^^^
;; [This should encourage gdb extensions that invoke gdb commands to let
;;  the user go first; it is not a bug.     -t]
;;

(defun gdb-instance-enqueue-input (instance item)
  (if (gdb-instance-prompting instance)
      (progn
	(gdb-send-item instance item)
	(set-gdb-instance-prompting instance nil))
    (set-gdb-instance-input-queue
     instance
     (cons item (gdb-instance-input-queue instance)))))

(defun gdb-instance-dequeue-input (instance)
  (let ((queue (gdb-instance-input-queue instance)))
    (and queue
       (if (not (cdr queue))
	   (let ((answer (car queue)))
	     (set-gdb-instance-input-queue instance '())
	     answer)
	 (gdb-take-last-elt queue)))))

(defun gdb-instance-enqueue-idle-input (instance item)
  (if (and (gdb-instance-prompting instance)
	   (not (gdb-instance-input-queue instance)))
      (progn
	(gdb-send-item instance item)
	(set-gdb-instance-prompting instance nil))
    (set-gdb-instance-idle-input-queue
     instance
     (cons item (gdb-instance-idle-input-queue instance)))))

(defun gdb-instance-dequeue-idle-input (instance)
  (let ((queue (gdb-instance-idle-input-queue instance)))
    (and queue
       (if (not (cdr queue))
	   (let ((answer (car queue)))
	     (set-gdb-instance-idle-input-queue instance '())
	     answer)
	 (gdb-take-last-elt queue)))))

; Don't use this in general.
(defun gdb-take-last-elt (l)

   :group 'gud)

(defun gdba-marker-filter (string)
  "A gud marker filter for gdb."
  ;; Bogons don't tell us the process except through scoping crud.
  (let ((instance (gdb-proc->instance proc)))
    (gdb-output-burst instance string)))

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

;    ("elt" gdb-elt)
    ("field-begin" gdb-field-begin)
    ("field-end" gdb-field-end)
    ) "An assoc mapping annotation tags to functions which process them.")

(defun gdb-ignore-annotation (instance args)
  nil)

(defconst gdb-source-spec-regexp
  "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")

;; Do not use this except as an annotation handler."
(defun gdb-source (instance args)
  (string-match gdb-source-spec-regexp args)
  ;; Extract the frame position from the marker.
  (setq gud-last-frame
	(cons
	 (substring args (match-beginning 1) (match-end 1))

				   (match-end 2)))))
  (setq gdb-current-address (substring args (match-beginning 3)
				       (match-end 3)))
  (setq gdb-main-or-pc gdb-current-address)
;update with new frame for machine code if necessary
  (gdb-invalidate-assembler instance))

;; An annotation handler for `prompt'.
;; This sends the next command (if any) to gdb.
(defun gdb-prompt (instance ignored)
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'user) t)
     ((eq sink 'post-emacs)
      (set-gdb-instance-output-sink instance 'user))
     (t
      (set-gdb-instance-output-sink instance 'user)
      (error "Phase error in gdb-prompt (got %s)" sink))))
  (let ((highest (gdb-instance-dequeue-input instance)))
    (if highest
	(gdb-send-item instance highest)
      (let ((lowest (gdb-instance-dequeue-idle-input instance)))
	(if lowest
	    (gdb-send-item instance lowest)
	  (progn
	    (set-gdb-instance-prompting instance t)
	    (gud-display-frame)))))))

;; An annotation handler for non-top-level prompts.
(defun gdb-subprompt (instance ignored)
  (let ((highest (gdb-instance-dequeue-input instance)))
    (if highest
	(gdb-send-item instance highest)
      (set-gdb-instance-prompting instance t))))

(defun gdb-send-item (instance item)
  (set-gdb-instance-current-item instance item)
  (if (stringp item)
      (progn
	(set-gdb-instance-output-sink instance 'user)
	(process-send-string (gdb-instance-process instance)
			     item))
    (progn
      (gdb-clear-partial-output instance)
      (set-gdb-instance-output-sink instance 'pre-emacs)
      (process-send-string (gdb-instance-process instance)
			   (car item)))))

;; An annotation handler for `pre-prompt'.
;; This terminates the collection of output from a previous
;; command if that happens to be in effect.
(defun gdb-pre-prompt (instance ignored)
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'user) t)
     ((eq sink 'emacs)
      (set-gdb-instance-output-sink instance 'post-emacs)
      (let ((handler
	     (car (cdr (gdb-instance-current-item instance)))))
	(save-excursion
	  (set-buffer (gdb-get-create-instance-buffer
		       instance 'gdb-partial-output-buffer))
	  (funcall handler))))
     (t
      (set-gdb-instance-output-sink instance 'user)
      (error "Output sink phase error 1")))))

;; An annotation handler for `starting'.  This says that I/O for the subprocess
;; is now the program being debugged, not GDB.
(defun gdb-starting (instance ignored)
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'user)
      (set-gdb-instance-output-sink instance 'inferior))
     (t (error "Unexpected `starting' annotation")))))

;; An annotation handler for `exited' and other annotations which say that
;; I/O for the subprocess is now GDB, not the program being debugged.
(defun gdb-stopping (instance ignored)
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'inferior)
      (set-gdb-instance-output-sink instance 'user))
     (t (error "Unexpected stopping annotation")))))

;; 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.
(defun gdb-stopped (instance ignored)
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'inferior)
      (set-gdb-instance-output-sink instance 'user))
     ((eq sink 'user) t)
     (t (error "Unexpected stopped annotation")))))

(defun gdb-frame-begin (instance ignored)
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'inferior)
      (set-gdb-instance-output-sink instance 'user))
     ((eq sink 'user) t)
     ((eq sink 'emacs) t)
     (t (error "Unexpected frame-begin annotation (%S)" sink)))))

;; An annotation handler for `post-prompt'.
;; This begins the collection of output from the current
;; command if that happens to be appropriate."
(defun gdb-post-prompt (instance ignored)
  (if (not (gdb-instance-pending-triggers instance))
      (progn
	(gdb-invalidate-registers instance ignored)
	(gdb-invalidate-locals instance ignored)
	(gdb-invalidate-display instance ignored)))
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'user) t)
     ((eq sink 'pre-emacs)
      (set-gdb-instance-output-sink instance 'emacs))

     (t
      (set-gdb-instance-output-sink instance 'user)
      (error "Output sink phase error 3")))))

;; If we get an error whilst evaluating one of the expressions
;; we won't get the display-end annotation. Set the sink back to
;; user to make sure that the error message is seen

(defun gdb-error-begin (instance ignored)
  (set-gdb-instance-output-sink instance 'user))

(defun gdb-display-begin (instance ignored)
  (if (gdb-get-instance-buffer instance 'gdb-display-buffer)
      (progn
	(set-gdb-instance-output-sink instance 'emacs)
	(gdb-clear-partial-output instance)
	(setq gdb-display-in-progress t))
    (set-gdb-instance-output-sink instance 'user)))

(defun gdb-display-number-end (instance ignored)
  (set-buffer (gdb-get-instance-buffer
	       instance 'gdb-partial-output-buffer))
  (setq gdb-display-number (buffer-string))
  (setq gdb-expression-buffer-name
	(concat "*display " gdb-display-number "*"))
  (save-excursion
    (if (progn

		    (gdb-expressions-mode)
		    (make-frame '((height . 20) (width . 40)
				  (tool-bar-lines . nil)
				  (menu-bar-lines . nil)
				  (minibuffer . nil))))))))))
  (set-buffer (gdb-get-instance-buffer
	       instance 'gdb-partial-output-buffer))
  (setq gdb-dive nil))

(defun gdb-display-end (instance ignored)
  (set-buffer (gdb-get-instance-buffer instance 'gdb-partial-output-buffer))
  (goto-char (point-min))
  (search-forward ": ")
  (looking-at "\\(.*?\\) =")
  (let ((char "")
	(gdb-temp-value (buffer-substring (match-beginning 1)

      (progn
	(save-excursion
	  (set-buffer gdb-expression-buffer-name)
	  (setq buffer-read-only nil)
	  (delete-region (point-min) (point-max))
	  (insert-buffer (gdb-get-instance-buffer
			  instance 'gdb-partial-output-buffer))
	  (setq buffer-read-only t)))
; else
; display expression name...
    (goto-char (point-min))
    (let ((start (progn (point)))

      (save-excursion
	(set-buffer gdb-expression-buffer-name)
	(setq buffer-read-only nil)
	(delete-region (point-min) (point-max))
	(insert-buffer-substring (gdb-get-instance-buffer
				  gdb-buffer-instance
				  'gdb-partial-output-buffer)
				 start end)
	(insert "\n")))

    (goto-char (point-min))

	(setq buffer-read-only nil)
	(goto-char (point-max))
	(insert "\n")
	(insert-text-button "[back]" 'type 'gdb-display-back)
	(setq buffer-read-only t))))
  (gdb-clear-partial-output instance)
  (set-gdb-instance-output-sink instance 'user)
  (setq gdb-display-in-progress nil))

(define-button-type 'gdb-display-back
  'help-echo (purecopy "mouse-2, RET: go back to previous display buffer")
  '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
     gdb-buffer-instance
     (list (concat "server delete display " number "\n")
	   '(lambda () nil)))
    (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
; in gdb-partial-output-buffer (to allow recursion).

; array-section flags are just removed again but after counting. They
; might also be useful for arrays of structures and structures with arrays.
(defun gdb-array-section-begin (instance args)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer
	       instance 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert (concat "\n##array-section-begin " args "\n"))))))

(defun gdb-array-section-end (instance ignored)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer
	       instance 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert "\n##array-section-end\n")))))

(defun gdb-field-begin (instance args)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer
	       instance 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert (concat "\n##field-begin " args "\n"))))))

(defun gdb-field-end (instance ignored)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer
	       instance 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert "\n##field-end\n")))))

(defun gdb-elt (instance ignored)
  (if gdb-display-in-progress
      (progn
	(goto-char (point-max))
	(insert "\n##elt\n"))))

; get rid of ##field-end and `,' or `}'
  (gdb-delete-line)
  (gdb-delete-line)
  (setq gdb-nesting-level (- gdb-nesting-level 1)))

(defun gdb-insert-field ()
  (let ((start (progn (point)))
	(end (progn (next-line) (point)))
	(num 0))
    (save-excursion

      (if (string-equal gdb-annotation-arg "\*") (insert "\*"))
      (while (<= num gdb-nesting-level)
	(insert "\t")
	(setq num (+ num 1)))
      (insert-buffer-substring (gdb-get-instance-buffer
				gdb-buffer-instance
				'gdb-partial-output-buffer)
			       start end)
      (put-text-property (- (point) (- end start)) (- (point) 1)
			 'mouse-face 'highlight)
      (put-text-property (- (point) (- end start)) (- (point) 1)
                         'local-map gdb-dive-map)
      (setq buffer-read-only t))
    (delete-region start end)))

(defun gdb-array-format ()
  (while (re-search-forward "##" nil t)
; keep making recursive calls...
    (if (looking-at "array-section-begin")

		  (gdb-array-format1))))
;else get rid of ##array-section-end etc
	  (gdb-delete-line)
	  (setq gdb-nesting-level (- gdb-nesting-level 1))
	  (gdb-array-format)))))

(defun gdb-array-format1 ()
  (setq gdb-display-string "")
  (setq buffer-read-only nil)
  (delete-region (point-min) (point-max))

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

(setq gdb-dive-map (make-keymap))
(define-key gdb-dive-map [mouse-2] 'gdb-dive)
(define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame)

(defun gdb-dive (event)
  "Dive into structure."
  (interactive "e")
  (setq gdb-dive t)
  (gdb-dive-new-frame event))

(defun gdb-dive-new-frame (event)
  "Dive into structure and display in a new frame."
  (interactive "e")
  (save-excursion
    (mouse-set-point event)
    (let ((point (point)) (gdb-full-expression gdb-expression)
	  (end (progn (end-of-line) (point)))
	  (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil))
      (beginning-of-line)
      (if (looking-at "\*") (setq gdb-display-char "*"))
      (re-search-forward "\\(\\S-+\\) = " end t)
      (setq gdb-last-field (buffer-substring-no-properties
			    (match-beginning 1)
			    (match-end 1)))
      (goto-char (match-beginning 1))
      (let ((last-column (current-column)))
	(while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t)
	  (goto-char (match-beginning 1))
	  (if (and (< (current-column) last-column)
		   (> (count-lines 1 (point)) 1))
	      (progn
		(setq gdb-part-expression
		      (concat "." (buffer-substring-no-properties
				   (match-beginning 1)
				   (match-end 1)) gdb-part-expression))
		(setq last-column (current-column))))))
; * 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 gdb-buffer-instance
				       (list
					(concat "server display" gdb-display-char
						" " gdb-full-expression "\n")
			      '(lambda () nil))))))

;; 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.

(defun gdb-output-burst (instance 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 instance) string))
	  ;; Start accumulating output for the GUD buffer
	  (output ""))

      ;; Process all the complete markers in this chunk.

	  ;; Stuff prior to the match is just ordinary output.
	  ;; It is either concatenated to OUTPUT or directed
	  ;; elsewhere.
	  (setq output
		(gdb-concat-output
		 instance
		 output
		 (substring burst 0 (match-beginning 0))))

	  ;; Take that stuff off the burst.
	  (setq burst (substring burst (match-end 0)))

		 (annotation-rule (assoc annotation-type
					 gdb-annotation-rules)))
	    ;; Call the handler for this annotation.
	    (if annotation-rule
		(funcall (car (cdr annotation-rule))
			 instance
			 annotation-arguments)
	      ;; Else the annotation is not recognized.  Ignore it silently,
	      ;; so that GDB can add new annotations without causing
	      ;; us to blow up.
	      ))))

      (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
			burst)
	  (progn
	    ;; Everything before the potential marker start can be output.
	    (setq output
		  (gdb-concat-output
		   instance
		   output
		   (substring burst 0 (match-beginning 0))))

	    ;; Everything after, we save, to combine with later input.
	    (setq burst (substring burst (match-beginning 0))))

	;; In case we know the burst contains no partial annotations:
	(progn
	  (setq output (gdb-concat-output instance output burst))
	  (setq burst "")))

      ;; Save the remaining burst for the next call to this function.
      (set-gdb-instance-burst instance burst)
      output)))

(defun gdb-concat-output (instance so-far new)
  (let ((sink (gdb-instance-output-sink instance)))
    (cond
     ((eq sink 'user) (concat so-far new))
     ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
     ((eq sink 'emacs)
      (gdb-append-to-partial-output instance new)
      so-far)
     ((eq sink 'inferior)
      (gdb-append-to-inferior-io instance new)
      so-far)
     (t (error "Bogon output sink %S" sink)))))

(defun gdb-append-to-partial-output (instance string)
  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer
      instance 'gdb-partial-output-buffer))
    (goto-char (point-max))
    (insert string)))

(defun gdb-clear-partial-output (instance)
  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer
      instance 'gdb-partial-output-buffer))
    (delete-region (point-min) (point-max))))

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

(defun gdb-clear-inferior-io (instance)
  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer
      instance 'gdb-inferior-io))
    (delete-region (point-min) (point-max))))



;; One trick is to have a command who's output is always available in

;; There are two aspects to this: gdb has to tell us when the output
;; for that command might have changed, and we have to be able to run
;; the command behind the user's back.
;;
;; The idle input queue and the output phasing associated with
;; the instance variable `(gdb-instance-output-sink instance)' help
;; us to run commands behind the user's back.
;;
;; Below is the code for specificly managing buffers of output from one
;; command.
;;

;;
;; NAME is the function name.  DEMAND-PREDICATE tests if output is really needed.
;; GDB-COMMAND is a string of such.  OUTPUT-HANDLER is the function bound to the
;; input in the input queue (see comment about ``gdb communications'' above).
(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler)
  `(defun ,name (instance &optional ignored)
     (if (and (,demand-predicate instance)
	      (not (member ',name
			   (gdb-instance-pending-triggers instance))))
	 (progn
	   (gdb-instance-enqueue-idle-input
	    instance
	    (list ,gdb-command ',output-handler))
	   (set-gdb-instance-pending-triggers
	    instance
	    (cons ',name
		  (gdb-instance-pending-triggers instance)))))))

(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
  `(defun ,name ()
     (set-gdb-instance-pending-triggers
      instance
      (delq ',trigger
	    (gdb-instance-pending-triggers instance)))
     (let ((buf (gdb-get-instance-buffer instance
					  ',buf-key)))
       (and buf
	    (save-excursion
	      (set-buffer buf)
	      (let ((p (point))
		    (buffer-read-only nil))
		(delete-region (point-min) (point-max))
		(insert-buffer (gdb-get-create-instance-buffer
				instance
				'gdb-partial-output-buffer))
		(goto-char p)))))
; put customisation here
     (,custom-defun)))

(defmacro def-gdb-auto-updated-buffer
  (buffer-key trigger-name gdb-command output-handler-name custom-defun)
   `(progn
     (def-gdb-auto-update-trigger ,trigger-name
       ;; The demand predicate:
       (lambda (instance)
	 (gdb-get-instance-buffer instance ',buffer-key))
       ,gdb-command
       ,output-handler-name)
     (def-gdb-auto-update-handler ,output-handler-name
       ,trigger-name ,buffer-key ,custom-defun)))

  ;; from the command above.  That function will copy the output into
  ;; the appropriately typed buffer.  That function will be called:
  gdb-info-breakpoints-handler
;; buffer specific functions
  gdb-info-breakpoints-custom)

;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
(defun gdb-info-breakpoints-custom ()
  (let ((flag)(address))

		  (remove-images (point-min) (point-max))
		(remove-strings (point-min) (point-max))))
	  (setq buffers (cdr buffers)))))

    (save-excursion
      (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer))
      (save-excursion
	(goto-char (point-min))
	(while (< (point) (- (point-max) 1))
	  (forward-line 1)
	  (if (looking-at "[^\t].*breakpoint")

		    (with-current-buffer (current-buffer)
		      (progn
			(set (make-local-variable 'gud-minor-mode) 'gdba)
			(set (make-local-variable 'tool-bar-map)
			     gud-tool-bar-map)
			(set (make-variable-buffer-local 'left-margin-width) 2)
			(if (get-buffer-window (current-buffer))
			    (set-window-margins (get-buffer-window
						 (current-buffer))
						left-margin-width
						right-margin-width))))

					  'left-margin)
			    (put-string "b" (point) "disabled"
					'left-margin)))))))))
	  (end-of-line))))))

(defun gdb-breakpoints-buffer-name (instance)
  (save-excursion
    (set-buffer (process-buffer (gdb-instance-process instance)))
    (concat "*breakpoints of " (gdb-instance-target-string instance) "*")))

(defun gdb-display-breakpoints-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance
				    'gdb-breakpoints-buffer)))

(defun gdb-frame-breakpoints-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance
				    'gdb-breakpoints-buffer)))

(defvar gdb-breakpoints-mode-map nil)
(setq gdb-breakpoints-mode-map (make-keymap))
(suppress-keymap gdb-breakpoints-mode-map)

  (setq mode-name "Breakpoints")
  (use-local-map gdb-breakpoints-mode-map)
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (gdb-invalidate-breakpoints gdb-buffer-instance))

(defun gdb-toggle-bp-this-line ()
  (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
       gdb-buffer-instance
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable "
	   "server enable ")

  (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
       gdb-buffer-instance
       (list
	(concat
	 "server delete "
	 (buffer-substring (match-beginning 0)
			   (match-end 1))
	 "\n")
	'(lambda () nil)))))

(defun gdb-goto-bp-this-line ()
"Display the file at the breakpoint specified."
  (interactive)
  (save-excursion

  gdb-info-frames-handler
  gdb-info-frames-custom)

(defun gdb-info-frames-custom ()
  (save-excursion
    (set-buffer (gdb-get-instance-buffer instance 'gdb-stack-buffer))
    (let ((buffer-read-only nil))
      (goto-char (point-min))
      (looking-at "\\S-*\\s-*\\(\\S-*\\)")
      (setq gdb-current-frame (buffer-substring (match-beginning 1) (match-end 1)))
      (while (< (point) (point-max))
	(put-text-property (progn (beginning-of-line) (point))
			   (progn (end-of-line) (point))
			   'mouse-face 'highlight)
	(forward-line 1)))))

(defun gdb-stack-buffer-name (instance)
  (save-excursion
    (set-buffer (process-buffer (gdb-instance-process instance)))
    (concat "*stack frames of "
	    (gdb-instance-target-string instance) "*")))

(defun gdb-display-stack-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance
				   'gdb-stack-buffer)))

(defun gdb-frame-stack-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance
				   'gdb-stack-buffer)))

(defvar gdb-frames-mode-map nil)
(setq gdb-frames-mode-map (make-keymap))
(suppress-keymap gdb-frames-mode-map)
(define-key gdb-frames-mode-map [mouse-2]

  (setq mode-name "Frames")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-frames-mode-map)
  (gdb-invalidate-frames gdb-buffer-instance))

(defun gdb-get-frame-number ()
  (save-excursion
    (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
	   (n (or (and pos

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

  (setq mode-name "Registers")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-registers-mode-map)
  (gdb-invalidate-registers gdb-buffer-instance))

(defun gdb-registers-buffer-name (instance)
  (save-excursion
    (set-buffer (process-buffer (gdb-instance-process instance)))
    (concat "*registers of " (gdb-instance-target-string instance) "*")))

(defun gdb-display-registers-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance
				   'gdb-registers-buffer)))

(defun gdb-frame-registers-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance
				   'gdb-registers-buffer)))

;;
;; Locals buffers
;;

  gdb-info-locals-custom)


;Abbreviate for arrays and structures. These can be expanded using gud-display
(defun gdb-info-locals-handler nil
  (set-gdb-instance-pending-triggers
   instance (delq (quote gdb-invalidate-locals)
		  (gdb-instance-pending-triggers instance)))
  (let ((buf (gdb-get-instance-buffer instance
				      (quote gdb-partial-output-buffer))))
    (save-excursion
      (set-buffer buf)
      (goto-char (point-min))
      (replace-regexp "^ .*\n" "")
      (goto-char (point-min))
      (replace-regexp "{[-0-9, {}\]*\n" "(array);\n")))
      (goto-char (point-min))
      (replace-regexp "{.*=.*\n" "(structure);\n")
  (let ((buf (gdb-get-instance-buffer instance (quote gdb-locals-buffer))))
    (and buf (save-excursion
	       (set-buffer buf)
	       (let ((p (point))
		     (buffer-read-only nil))
		 (delete-region (point-min) (point-max))
		 (insert-buffer (gdb-get-create-instance-buffer
				 instance
				 (quote gdb-partial-output-buffer)))
		 (goto-char p)))))
  (run-hooks (quote gdb-info-locals-hook)))

(defun gdb-info-locals-custom ()

  (setq mode-name "Locals")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-locals-mode-map)
  (gdb-invalidate-locals gdb-buffer-instance))

(defun gdb-locals-buffer-name (instance)
  (save-excursion
    (set-buffer (process-buffer (gdb-instance-process instance)))
    (concat "*locals of " (gdb-instance-target-string instance) "*")))

(defun gdb-display-locals-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance
				   'gdb-locals-buffer)))

(defun gdb-frame-locals-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance
				   'gdb-locals-buffer)))
;;
;; Display expression buffers (just allow one to start with)
;;
(gdb-set-instance-buffer-rules 'gdb-display-buffer
			       'gdb-display-buffer-name

  (setq mode-name "Display")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-display-mode-map)
  (gdb-invalidate-display gdb-buffer-instance))

(defun gdb-display-buffer-name (instance)
  (save-excursion
    (set-buffer (process-buffer (gdb-instance-process instance)))
    (concat "*Displayed expressions of " (gdb-instance-target-string instance) "*")))

(defun gdb-display-display-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance
				   'gdb-display-buffer)))

(defun gdb-frame-display-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance
				   'gdb-display-buffer)))

(defun gdb-toggle-disp-this-line ()
  (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
       gdb-buffer-instance
       (list
	(concat
	 (if (eq ?y (char-after (match-beginning 2)))
	     "server disable display "
	   "server enable display ")

(defun gdb-delete-disp-this-line ()
  (interactive)
  (save-excursion
    (set-buffer
     (gdb-get-instance-buffer gdb-buffer-instance 'gdb-display-buffer))
    (beginning-of-line 1)
    (if (not (looking-at "\\([0-9]+\\):   \\([ny]\\)"))
	(error "No expression on this line")
      (let ((number (buffer-substring (match-beginning 0)
				      (match-end 1))))
	(gdb-instance-enqueue-idle-input
	 gdb-buffer-instance
	 (list (concat "server delete display " number "\n")
	       '(lambda () nil)))
	(if (not (display-graphic-p))
	    (kill-buffer (get-buffer (concat "*display " number "*")))
	  ;else

  (setq buffer-read-only t))


;;;; Window management

;;; FIXME: This should only return true for buffers in the current instance
(defun gdb-protected-buffer-p (buffer)
  "Is BUFFER a buffer which we want to leave displayed?"
  (save-excursion
    (set-buffer buffer)
    (or gdb-buffer-type

  (set-window-buffer gdb-source-window buffer))


;;; Shared keymap initialization:

(defun gdb-display-gdb-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance 'gdba)))

(defun gdb-make-windows-menu (map)
  ;; FIXME: This adds to the DBX, PerlDB, ... menu as well :-(
  ;; Probably we should create gdb-many-windows-map and put those menus
  ;; on that map.

(define-key gud-minor-mode-map "\C-c\M-\C-f" 'gdb-display-stack-buffer)
(define-key gud-minor-mode-map "\C-c\M-\C-b" 'gdb-display-breakpoints-buffer)

(gdb-make-windows-menu gud-minor-mode-map)

(defun gdb-frame-gdb-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance 'gdba)))

(defun gdb-make-frames-menu (map)
  (define-key map [menu-bar frames]
    (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames")))
  (define-key map [menu-bar frames gdb]

    '("Assembler" . gdb-frame-assembler-buffer)))

(if (display-graphic-p)
    (gdb-make-frames-menu gud-minor-mode-map))

(defun gdb-proc-died (proc)
  ;; Stop displaying an arrow in a source file.
  (setq overlay-arrow-position nil)

  ;; Kill the dummy process, so that C-x C-c won't worry about it.
  (save-excursion
    (set-buffer (process-buffer proc))
    (kill-process
     (get-buffer-process
      (gdb-get-instance-buffer gdb-buffer-instance 'gdb-inferior-io)))))
;; end of functions from gdba.el

;; new functions for gdb-ui.el
;; layout for all the windows
(defun gdb-setup-windows (instance)
  (gdb-display-locals-buffer instance)
  (gdb-display-stack-buffer instance)
  (delete-other-windows)
  (gdb-display-breakpoints-buffer instance)
  (gdb-display-display-buffer instance)
  (delete-other-windows)
  (split-window nil ( / ( * (window-height) 3) 4))
  (split-window nil ( / (window-height) 3))
  (split-window-horizontally)
  (other-window 1)
  (switch-to-buffer (gdb-locals-buffer-name instance))
  (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)))
  (setq gdb-source-window (get-buffer-window (current-buffer)))
  (split-window-horizontally)
  (other-window 1)
  (switch-to-buffer (gdb-inferior-io-name instance))
  (other-window 1)
  (switch-to-buffer (gdb-stack-buffer-name instance))
  (split-window-horizontally)
  (other-window 1)
  (switch-to-buffer (gdb-breakpoints-buffer-name instance))
  (other-window 1))

(defun gdb-restore-windows ()
  "Restore the basic arrangement of windows used by gdba.
This arrangement depends on the value of `gdb-many-windows'."
  (interactive)
  (if gdb-many-windows
      (progn
	(switch-to-buffer gud-comint-buffer)
	(delete-other-windows)
	(gdb-setup-windows gdb-buffer-instance))
;else
    (switch-to-buffer gud-comint-buffer)
    (delete-other-windows)
    (split-window)
    (other-window 1)

	(other-window 1)
	(setq gdb-many-windows nil))
;else
    (switch-to-buffer gud-comint-buffer)
    (delete-other-windows)
    (gdb-setup-windows gdb-buffer-instance)
    (setq gdb-many-windows t)))

(defconst breakpoint-xpm-data "/* XPM */
static char *magick[] = {
/* columns rows colors chars-per-pixel */

  ;; all other windows.
  (if (eq (selected-window) (minibuffer-window))
      (other-window 1))
  (delete-other-windows)
  (if gdb-many-windows
      (gdb-setup-windows gdb-buffer-instance)
;else
    (gdb-display-breakpoints-buffer gdb-buffer-instance)
    (gdb-display-display-buffer instance)
    (gdb-display-stack-buffer instance)
    (delete-other-windows)
    (split-window)
    (other-window 1)
    (switch-to-buffer (gud-find-file gdb-main-file))
    (other-window 1)

    (while overlays
      (let ((overlay (car overlays)))
	(when (string-equal (overlay-get overlay 'before-string) "gdb-arrow")
	  (delete-overlay overlay)))
      (setq overlays (cdr overlays)))))

(defvar gdb-array-slice-map nil)
(setq gdb-array-slice-map (make-keymap))
(define-key gdb-array-slice-map [mouse-2] 'gdb-array-slice)

(defun gdb-array-slice (event)
  "Select an array slice to display."
  (interactive "e")
  (mouse-set-point event)
  (save-excursion
    (let ((n -1) (stop 0) (start 0) (point (point)))
      (beginning-of-line)
      (while (search-forward "[" point t)
	(setq n (+ n 1)))
      (setq start (string-to-int (read-string "Start index: ")))
      (aset gdb-array-start n start)
      (setq stop (string-to-int (read-string "Stop index: ")))
      (aset gdb-array-stop n stop)))
  (gdb-array-format1))

(defun gdb-array-visualise ()
  "Visualise arrays and slices using graph program from plotutils."
  (interactive)
  (if (and (display-graphic-p) gdb-display-string)

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

  (concat "server disassemble " gdb-main-or-pc "\n")
  gdb-assembler-handler
  gdb-assembler-custom)

(defun gdb-assembler-custom ()
  (let ((buffer (gdb-get-instance-buffer gdb-buffer-instance
					 'gdb-assembler-buffer))
	(gdb-arrow-position) (address) (flag))
    (if gdb-current-address
	(progn
	  (save-excursion
	    (set-buffer buffer)

      (set-buffer buffer)
      (if (display-graphic-p)
	  (remove-images (point-min) (point-max))
	(remove-strings (point-min) (point-max))))
    (save-excursion
      (set-buffer (gdb-get-instance-buffer instance 'gdb-breakpoints-buffer))
      (goto-char (point-min))
      (while (< (point) (- (point-max) 1))
	(forward-line 1)
	(if (looking-at "[^\t].*breakpoint")
	    (progn

\\{gdb-assembler-mode-map}"
  (setq major-mode 'gdb-assembler-mode)
  (setq mode-name "Assembler")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (set (make-variable-buffer-local 'left-margin-width) 2)
  (setq buffer-read-only t)
  (use-local-map gdb-assembler-mode-map)
  (gdb-invalidate-assembler gdb-buffer-instance)
  (gdb-invalidate-breakpoints gdb-buffer-instance))

(defun gdb-assembler-buffer-name (instance)
  (save-excursion
    (set-buffer (process-buffer (gdb-instance-process instance)))
    (concat "*Machine Code " (gdb-instance-target-string instance) "*")))

(defun gdb-display-assembler-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer instance
				   'gdb-assembler-buffer)))

(defun gdb-frame-assembler-buffer (instance)
  (interactive (list (gdb-needed-default-instance)))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer instance
				   'gdb-assembler-buffer)))

(defun gdb-invalidate-frame-and-assembler (instance &optional ignored)
  (gdb-invalidate-frames instance)
  (gdb-invalidate-assembler instance))

(defun gdb-invalidate-breakpoints-and-assembler (instance &optional ignored)
  (gdb-invalidate-breakpoints instance)
  (gdb-invalidate-assembler instance))

; modified because if gdb-main-or-pc has changed value a new command
; must be enqueued to update the buffer with the new output
(defun gdb-invalidate-assembler (instance &optional ignored)
  (if (and ((lambda (instance)
	      (gdb-get-instance-buffer instance
				       (quote gdb-assembler-buffer))) instance)
	   (or (not (member (quote gdb-invalidate-assembler)
			(gdb-instance-pending-triggers instance)))
	   (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc))))
      (progn

        ; take previous disassemble command off the queue
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer instance 'gdba))
	   (let ((queue gdb-idle-input-queue) (item))
	     (while queue
	       (setq item (car queue))
	       (if (equal (cdr item) '(gdb-assembler-handler))
		   (delete item gdb-idle-input-queue))
		 (setq queue (cdr queue)))))

	(gdb-instance-enqueue-idle-input
	      instance (list (concat "server disassemble " gdb-main-or-pc "\n")
			     (quote gdb-assembler-handler)))
	     (set-gdb-instance-pending-triggers
	      instance (cons (quote gdb-invalidate-assembler)
			     (gdb-instance-pending-triggers instance)))
	     (setq gdb-prev-main-or-pc gdb-main-or-pc))))

(defun gdb-delete-line ()
"Delete current line."
(interactive)

48515:3216cd45d6d2

  "If t, using gdba, start gdb with ancillary buffers visible.
Use `toggle-gdb-windows' to change this value during a gdb session"
  :type 'boolean
  :group 'gud)

(defvar gdb-main-or-pc nil "Initialisation for Assembler buffer.")
(defvar gdb-current-address nil)
(defvar gdb-display-in-progress nil)
(defvar gdb-dive nil)
(defvar gdb-first-time nil)
(defvar gdb-proc nil "The process associated with gdb.")

;;;###autoload
(defun gdba (command-line)
  "Run gdb on program FILE in buffer *gdb-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.

  (gdba-common-init command-line nil
		   'gdba-marker-filter 'gud-gdb-find-file)

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

  (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
  (gud-def gud-run    "run"	     nil    "Run the program.")
  (gud-def gud-stepi  "stepi %p"     "\C-i" "Step one instruction with display.")
  (gud-def gud-step   "step %p"      "\C-s" "Step one source line with display.")
  (gud-def gud-next   "next %p"      "\C-n" "Step one line (skip functions).")
  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")

  (setq gdb-display-in-progress nil)
  (setq gdb-dive nil)
  (setq gud-last-last-frame nil)

  (run-hooks 'gdb-mode-hook)
  (setq gdb-proc (get-buffer-process (current-buffer)))
  (gdb-make-instance)
  (if gdb-first-time (gdb-clear-inferior-io))

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

(defun gud-break (arg)
  "Set breakpoint at current line or address."
  (interactive "p")
  (if (not (string-equal mode-name "Assembler"))

  "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")
	       '(lambda () nil)))
;else
      (gdb-instance-enqueue-idle-input
       (list (concat "server display " expr "\n")
	     '(lambda () nil)))))


;; The completion process filter is installed temporarily to slurp the
;; output of GDB up to the next prompt and build the completion list.
;; It must also handle annotations.
(defun gdba-complete-filter (string)
  (gdb-output-burst string)
  (while (string-match "\n\032\032\\(.*\\)\n" string)
    (setq string (concat (substring string 0 (match-beginning 0))
			 (substring string (match-end 0)))))
  (setq string (concat gud-gdb-complete-string string))
  (while (string-match "\n" string)

	string)
    (progn
      (setq gud-gdb-complete-string string)
      "")))

(defvar gdb-target-name "--unknown--"
  "The apparent name of the program being debugged in a gud buffer.")

(defun gdba-common-init (command-line massage-args marker-filter &optional find-file)

  (let* ((words (split-string command-line))
	 (program (car words))

    (let ((w args))
      (while (and w (not (eq (car w) t)))
	(setq w (cdr w)))
      (if w
	  (setcar w file)))
    (apply 'make-comint (concat "gdb-" filepart) program nil args)
    (gud-mode)
    (setq gdb-target-name filepart))
  (make-local-variable 'gud-marker-filter)
  (setq gud-marker-filter marker-filter)
  (if find-file (set (make-local-variable 'gud-find-file) find-file))

;;
;; gdb-instance objects
;;

(defvar gdb-instance-variables '()
  "A list of variables that are local to the GUD buffer associated
with a gdb instance.")

;;; The list of instance variables is built up by the expansions of
;;; DEF-GDB-VARIABLE
;;;

(defmacro def-gdb-variable (name accessor setter &optional default doc)
  `(progn
     (defvar ,name ,default ,doc)
     (if (not (memq ',name gdb-instance-variables))
	 (push ',name gdb-instance-variables))
     ,(and accessor
	     `(defun ,accessor ()
		(let ((buffer (gdb-get-instance-buffer 'gdba)))
		  (and buffer (save-excursion
				(set-buffer buffer)
				,name)))))
     ,(and setter
	     `(defun ,setter (val)
		(let ((buffer (gdb-get-instance-buffer 'gdba)))
		  (and buffer (save-excursion
				(set-buffer buffer)
				(setq ,name val))))))))

(defmacro def-gdb-var (root-symbol &optional default doc)
  (let* ((root (symbol-name root-symbol))
	 (accessor (intern (concat "gdb-instance-" root)))
	 (setter (intern (concat "set-gdb-instance-" root)))
	 (var-name (intern (concat "gdb-" root))))
    `(def-gdb-variable
	 ,var-name ,accessor ,setter
	 ,default ,doc)))

(def-gdb-var buffer-type nil
  "One of the symbols bound in gdb-instance-buffer-rules")

(def-gdb-var burst ""

(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."
  (save-excursion
    (set-buffer (gdb-get-instance-buffer 'gdba))
    (funcall form)))

;; end of instance vars

(defun gdb-make-instance ()
  "Create a gdb instance object from a gdb process."
  (with-current-buffer (process-buffer gdb-proc)
    (progn
      (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
   (function (lambda () gdb-target-name))))


;;
;; Instance Buffers.
;;

;; is constructed specially.
;;
;; Others are constructed by gdb-get-create-instance-buffer and
;; named according to the rules set forth in the gdb-instance-buffer-rules-assoc

(defvar gdb-instance-buffer-rules-assoc '())

(defun gdb-get-instance-buffer (key)
  "Return the instance buffer tagged with type KEY.
The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
  (save-excursion
    (gdb-look-for-tagged-buffer key (buffer-list))))

(defun gdb-get-create-instance-buffer (key)
  "Create a new gdb instance buffer of the type specified by KEY.
The key should be one of the cars in `gdb-instance-buffer-rules-assoc'."
  (or (gdb-get-instance-buffer key)
      (let* ((rules (assoc key gdb-instance-buffer-rules-assoc))
	     (name (funcall (gdb-rules-name-maker rules)))
	     (new (get-buffer-create name)))
	(save-excursion
	  (set-buffer new)
	  (make-variable-buffer-local 'gdb-buffer-type)
	  (setq gdb-buffer-type key)
	  (if (cdr (cdr rules))
	      (funcall (car (cdr (cdr rules)))))
	  new))))

(defun gdb-rules-name-maker (rules) (car (cdr rules)))

(defun gdb-look-for-tagged-buffer (key bufs)
  (let ((retval nil))
    (while (and (not retval) bufs)
      (set-buffer (car bufs))
      (if (eq gdb-buffer-type key)
	  (setq retval (car bufs)))
      (setq bufs (cdr bufs)))
    retval))

;;
;; This assoc maps buffer type symbols to rules.  Each rule is a list of
;; at least one and possible more functions.  The functions have these
;; roles in defining a buffer type:
;;

;; The remaining function(s) are optional:
;;
;;     MODE - called in new new buffer with no arguments, should establish
;;	      the proper mode for the buffer.
;;

(defun gdb-set-instance-buffer-rules (buffer-type &rest rules)
  (let ((binding (assoc buffer-type gdb-instance-buffer-rules-assoc)))
    (if binding
	(setcdr binding rules)

;;

(gdb-set-instance-buffer-rules 'gdb-partial-output-buffer
			       'gdb-partial-output-name)

(defun gdb-partial-output-name ()
  (concat "*partial-output-"
	  (gdb-instance-target-string)
	  "*"))


(gdb-set-instance-buffer-rules 'gdb-inferior-io
			       'gdb-inferior-io-name
			       'gdb-inferior-io-mode)

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

(defvar gdb-inferior-io-mode-map (copy-keymap comint-mode-map))
(define-key comint-mode-map "\C-c\C-c" 'gdb-inferior-io-interrupt)
(define-key comint-mode-map "\C-c\C-z" 'gdb-inferior-io-stop)

  (setq comint-input-sender 'gdb-inferior-io-sender))

(defun gdb-inferior-io-sender (proc string)
  (save-excursion
    (set-buffer (process-buffer proc))
      (set-buffer (gdb-get-instance-buffer 'gdba))
	(process-send-string gdb-proc string)
	(process-send-string gdb-proc "\n")))

(defun gdb-inferior-io-interrupt ()
  "Interrupt the program being debugged."
  (interactive (list gdb-proc))
  (interrupt-process
   (get-buffer-process (gdb-get-instance-buffer 'gdba)) comint-ptyp))

(defun gdb-inferior-io-quit ()
  "Send quit signal to the program being debugged."
  (interactive (list gdb-proc))
  (quit-process
   (get-buffer-process (gdb-get-instance-buffer 'gdba)) comint-ptyp))

(defun gdb-inferior-io-stop ()
  "Stop the program being debugged."
  (interactive (list gdb-proc))
  (stop-process
   (get-buffer-process (gdb-get-instance-buffer 'gdba)) comint-ptyp))

(defun gdb-inferior-io-eof ()
  "Send end-of-file to the program being debugged."
  (interactive (list gdb-proc))
  (process-send-eof
   (get-buffer-process (gdb-get-instance-buffer 'gdba))))


;;
;; gdb communications
;;

;;

(defun gdb-send (proc string)
  "A comint send filter for gdb.
This filter may simply queue output for a later time."
    (gdb-instance-enqueue-input (concat string "\n")))

;; Note: Stuff enqueued here will be sent to the next prompt, even if it
;; is a query, or other non-top-level prompt.  To guarantee stuff will get
;; sent to the top-level prompt, currently it must be put in the idle queue.
;;				 ^^^^^^^^^
;; [This should encourage gdb extensions that invoke gdb commands to let
;;  the user go first; it is not a bug.     -t]
;;

(defun gdb-instance-enqueue-input (item)
  (if (gdb-instance-prompting)
      (progn
	(gdb-send-item item)
	(set-gdb-instance-prompting nil))
    (set-gdb-instance-input-queue
     (cons item (gdb-instance-input-queue)))))

(defun gdb-instance-dequeue-input ()
  (let ((queue (gdb-instance-input-queue)))
    (and queue
       (if (not (cdr queue))
	   (let ((answer (car queue)))
	     (set-gdb-instance-input-queue '())
	     answer)
	 (gdb-take-last-elt queue)))))

(defun gdb-instance-enqueue-idle-input (item)
  (if (and (gdb-instance-prompting)
	   (not (gdb-instance-input-queue)))
      (progn
	(gdb-send-item item)
	(set-gdb-instance-prompting nil))
    (set-gdb-instance-idle-input-queue
     (cons item (gdb-instance-idle-input-queue)))))

(defun gdb-instance-dequeue-idle-input ()
  (let ((queue (gdb-instance-idle-input-queue)))
    (and queue
       (if (not (cdr queue))
	   (let ((answer (car queue)))
	     (set-gdb-instance-idle-input-queue '())
	     answer)
	 (gdb-take-last-elt queue)))))

; Don't use this in general.
(defun gdb-take-last-elt (l)

   :group 'gud)

(defun gdba-marker-filter (string)
  "A gud marker filter for gdb."
  ;; Bogons don't tell us the process except through scoping crud.
  (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)

;    ("elt" gdb-elt)
    ("field-begin" gdb-field-begin)
    ("field-end" gdb-field-end)
    ) "An assoc mapping annotation tags to functions which process them.")

(defun gdb-ignore-annotation (args)
  nil)

(defconst gdb-source-spec-regexp
  "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")

;; Do not use this except as an annotation handler."
(defun gdb-source (args)
  (string-match gdb-source-spec-regexp args)
  ;; Extract the frame position from the marker.
  (setq gud-last-frame
	(cons
	 (substring args (match-beginning 1) (match-end 1))

				   (match-end 2)))))
  (setq gdb-current-address (substring args (match-beginning 3)
				       (match-end 3)))
  (setq gdb-main-or-pc gdb-current-address)
;update with new frame for machine code if necessary
  (gdb-invalidate-assembler))

;; An annotation handler for `prompt'.
;; This sends the next command (if any) to gdb.
(defun gdb-prompt (ignored)
  (let ((sink (gdb-instance-output-sink)))
    (cond
     ((eq sink 'user) t)
     ((eq sink 'post-emacs)
      (set-gdb-instance-output-sink 'user))
     (t
      (set-gdb-instance-output-sink 'user)
      (error "Phase error in gdb-prompt (got %s)" sink))))
  (let ((highest (gdb-instance-dequeue-input)))
    (if highest
	(gdb-send-item highest)
      (let ((lowest (gdb-instance-dequeue-idle-input)))
	(if lowest
	    (gdb-send-item lowest)
	  (progn
	    (set-gdb-instance-prompting t)
	    (gud-display-frame)))))))

;; An annotation handler for non-top-level prompts.
(defun gdb-subprompt (ignored)
  (let ((highest (gdb-instance-dequeue-input)))
    (if highest
	(gdb-send-item highest)
      (set-gdb-instance-prompting t))))

(defun gdb-send-item (item)
  (set-gdb-instance-current-item item)
  (if (stringp item)
      (progn
	(set-gdb-instance-output-sink 'user)
	(process-send-string gdb-proc item))
    (progn
      (gdb-clear-partial-output)
      (set-gdb-instance-output-sink 'pre-emacs)
      (process-send-string gdb-proc (car item)))))

;; An annotation handler for `pre-prompt'.
;; This terminates the collection of output from a previous
;; command if that happens to be in effect.
(defun gdb-pre-prompt (ignored)
  (let ((sink (gdb-instance-output-sink)))
    (cond
     ((eq sink 'user) t)
     ((eq sink 'emacs)
      (set-gdb-instance-output-sink 'post-emacs)
      (let ((handler
	     (car (cdr (gdb-instance-current-item)))))
	(save-excursion
	  (set-buffer (gdb-get-create-instance-buffer 
		       'gdb-partial-output-buffer))
	  (funcall handler))))
     (t
      (set-gdb-instance-output-sink 'user)
      (error "Output sink phase error 1")))))

;; An annotation handler for `starting'.  This says that I/O for the subprocess
;; is now the program being debugged, not GDB.
(defun gdb-starting (ignored)
  (let ((sink (gdb-instance-output-sink)))
    (cond
     ((eq sink 'user)
      (set-gdb-instance-output-sink 'inferior))
     (t (error "Unexpected `starting' annotation")))))

;; An annotation handler for `exited' and other annotations which say that
;; I/O for the subprocess is now GDB, not the program being debugged.
(defun gdb-stopping (ignored)
  (let ((sink (gdb-instance-output-sink)))
    (cond
     ((eq sink 'inferior)
      (set-gdb-instance-output-sink 'user))
     (t (error "Unexpected stopping annotation")))))

;; 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.
(defun gdb-stopped (ignored)
  (let ((sink (gdb-instance-output-sink)))
    (cond
     ((eq sink 'inferior)
      (set-gdb-instance-output-sink 'user))
     ((eq sink 'user) t)
     (t (error "Unexpected stopped annotation")))))

(defun gdb-frame-begin (ignored)
  (let ((sink (gdb-instance-output-sink)))
    (cond
     ((eq sink 'inferior)
      (set-gdb-instance-output-sink 'user))
     ((eq sink 'user) t)
     ((eq sink 'emacs) t)
     (t (error "Unexpected frame-begin annotation (%S)" sink)))))

;; An annotation handler for `post-prompt'.
;; This begins the collection of output from the current
;; command if that happens to be appropriate."
(defun gdb-post-prompt (ignored)
  (if (not (gdb-instance-pending-triggers))
      (progn
	(gdb-invalidate-registers ignored)
	(gdb-invalidate-locals ignored)
	(gdb-invalidate-display ignored)))
  (let ((sink (gdb-instance-output-sink)))
    (cond
     ((eq sink 'user) t)
     ((eq sink 'pre-emacs)
      (set-gdb-instance-output-sink 'emacs))

     (t
      (set-gdb-instance-output-sink 'user)
      (error "Output sink phase error 3")))))

;; If we get an error whilst evaluating one of the expressions
;; we won't get the display-end annotation. Set the sink back to
;; user to make sure that the error message is seen

(defun gdb-error-begin (ignored)
  (set-gdb-instance-output-sink 'user))

(defun gdb-display-begin (ignored)
  (if (gdb-get-instance-buffer 'gdb-display-buffer)
      (progn
	(set-gdb-instance-output-sink 'emacs)
	(gdb-clear-partial-output)
	(setq gdb-display-in-progress t))
    (set-gdb-instance-output-sink 'user)))

(defvar gdb-expression-buffer-name)
(defvar gdb-display-number)
(defvar gdb-dive-display-number)

(defun gdb-display-number-end (ignored)
  (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
  (setq gdb-display-number (buffer-string))
  (setq gdb-expression-buffer-name
	(concat "*display " gdb-display-number "*"))
  (save-excursion
    (if (progn

		    (gdb-expressions-mode)
		    (make-frame '((height . 20) (width . 40)
				  (tool-bar-lines . nil)
				  (menu-bar-lines . nil)
				  (minibuffer . nil))))))))))
  (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
  (setq gdb-dive nil))

(defvar gdb-current-frame nil)
(defvar gdb-nesting-level)
(defvar gdb-expression)
(defvar gdb-point)
(defvar gdb-annotation-arg)

(defun gdb-display-end (ignored)
  (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
  (goto-char (point-min))
  (search-forward ": ")
  (looking-at "\\(.*?\\) =")
  (let ((char "")
	(gdb-temp-value (buffer-substring (match-beginning 1)

      (progn
	(save-excursion
	  (set-buffer gdb-expression-buffer-name)
	  (setq buffer-read-only nil)
	  (delete-region (point-min) (point-max))
	  (insert-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
	  (setq buffer-read-only t)))
; else
; display expression name...
    (goto-char (point-min))
    (let ((start (progn (point)))

      (save-excursion
	(set-buffer gdb-expression-buffer-name)
	(setq buffer-read-only nil)
	(delete-region (point-min) (point-max))
	(insert-buffer-substring (gdb-get-instance-buffer
				  'gdb-partial-output-buffer)
				 start end)
	(insert "\n")))

    (goto-char (point-min))

	(setq buffer-read-only nil)
	(goto-char (point-max))
	(insert "\n")
	(insert-text-button "[back]" 'type 'gdb-display-back)
	(setq buffer-read-only t))))
  (gdb-clear-partial-output)
  (set-gdb-instance-output-sink 'user)
  (setq gdb-display-in-progress nil))

(define-button-type 'gdb-display-back
  'help-echo (purecopy "mouse-2, RET: go back to previous display buffer")
  '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")
	   '(lambda () nil)))
    (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
; in gdb-partial-output-buffer (to allow recursion).

; array-section flags are just removed again but after counting. They
; might also be useful for arrays of structures and structures with arrays.
(defun gdb-array-section-begin (args)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert (concat "\n##array-section-begin " args "\n"))))))

(defun gdb-array-section-end (ignored)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert "\n##array-section-end\n")))))

(defun gdb-field-begin (args)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert (concat "\n##field-begin " args "\n"))))))

(defun gdb-field-end (ignored)
  (if gdb-display-in-progress
      (progn
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer 'gdb-partial-output-buffer))
	  (goto-char (point-max))
	  (insert "\n##field-end\n")))))

(defun gdb-elt (ignored)
  (if gdb-display-in-progress
      (progn
	(goto-char (point-max))
	(insert "\n##elt\n"))))

; get rid of ##field-end and `,' or `}'
  (gdb-delete-line)
  (gdb-delete-line)
  (setq gdb-nesting-level (- gdb-nesting-level 1)))

(defvar gdb-dive-map nil)

(setq gdb-dive-map (make-keymap))
(define-key gdb-dive-map [mouse-2] 'gdb-dive)
(define-key gdb-dive-map [S-mouse-2] 'gdb-dive-new-frame)

(defun gdb-dive (event)
  "Dive into structure."
  (interactive "e")
  (setq gdb-dive t)
  (gdb-dive-new-frame event))

(defun gdb-dive-new-frame (event)
  "Dive into structure and display in a new frame."
  (interactive "e")
  (save-excursion
    (mouse-set-point event)
    (let ((point (point)) (gdb-full-expression gdb-expression)
	  (end (progn (end-of-line) (point)))
	  (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil))
      (beginning-of-line)
      (if (looking-at "\*") (setq gdb-display-char "*"))
      (re-search-forward "\\(\\S-+\\) = " end t)
      (setq gdb-last-field (buffer-substring-no-properties
			    (match-beginning 1)
			    (match-end 1)))
      (goto-char (match-beginning 1))
      (let ((last-column (current-column)))
	(while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t)
	  (goto-char (match-beginning 1))
	  (if (and (< (current-column) last-column)
		   (> (count-lines 1 (point)) 1))
	      (progn
		(setq gdb-part-expression
		      (concat "." (buffer-substring-no-properties
				   (match-beginning 1)
				   (match-end 1)) gdb-part-expression))
		(setq last-column (current-column))))))
; * 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")
			      '(lambda () nil))))))

(defun gdb-insert-field ()
  (let ((start (progn (point)))
	(end (progn (next-line) (point)))
	(num 0))
    (save-excursion

      (if (string-equal gdb-annotation-arg "\*") (insert "\*"))
      (while (<= num gdb-nesting-level)
	(insert "\t")
	(setq num (+ num 1)))
      (insert-buffer-substring (gdb-get-instance-buffer
				'gdb-partial-output-buffer)
			       start end)
      (put-text-property (- (point) (- end start)) (- (point) 1)
			 'mouse-face 'highlight)
      (put-text-property (- (point) (- end start)) (- (point) 1)
                         'local-map gdb-dive-map)
      (setq buffer-read-only t))
    (delete-region start end)))

(defvar gdb-values)

(defun gdb-array-format ()
  (while (re-search-forward "##" nil t)
; keep making recursive calls...
    (if (looking-at "array-section-begin")

		  (gdb-array-format1))))
;else get rid of ##array-section-end etc
	  (gdb-delete-line)
	  (setq gdb-nesting-level (- gdb-nesting-level 1))
	  (gdb-array-format)))))

(defvar gdb-array-start)
(defvar gdb-array-stop)

(defvar gdb-array-slice-map nil)
(setq gdb-array-slice-map (make-keymap))
(define-key gdb-array-slice-map [mouse-2] 'gdb-array-slice)

(defun gdb-array-slice (event)
  "Select an array slice to display."
  (interactive "e")
  (mouse-set-point event)
  (save-excursion
    (let ((n -1) (stop 0) (start 0) (point (point)))
      (beginning-of-line)
      (while (search-forward "[" point t)
	(setq n (+ n 1)))
      (setq start (string-to-int (read-string "Start index: ")))
      (aset gdb-array-start n start)
      (setq stop (string-to-int (read-string "Stop index: ")))
      (aset gdb-array-stop n stop)))
  (gdb-array-format1))

(defvar gdb-display-string)
(defvar gdb-array-size)

(defun gdb-array-format1 ()
  (setq gdb-display-string "")
  (setq buffer-read-only nil)
  (delete-region (point-min) (point-max))

	(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 insterted 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
	  (output ""))

      ;; Process all the complete markers in this chunk.

	  ;; Stuff prior to the match is just ordinary output.
	  ;; It is either concatenated to OUTPUT or directed
	  ;; elsewhere.
	  (setq output
		(gdb-concat-output output
		 (substring burst 0 (match-beginning 0))))

	  ;; Take that stuff off the burst.
	  (setq burst (substring burst (match-end 0)))

		 (annotation-rule (assoc annotation-type
					 gdb-annotation-rules)))
	    ;; Call the handler for this annotation.
	    (if annotation-rule
		(funcall (car (cdr annotation-rule))
			 annotation-arguments)
	      ;; Else the annotation is not recognized.  Ignore it silently,
	      ;; so that GDB can add new annotations without causing
	      ;; us to blow up.
	      ))))

      (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
			burst)
	  (progn
	    ;; Everything before the potential marker start can be output.
	    (setq output
		  (gdb-concat-output output
		   (substring burst 0 (match-beginning 0))))

	    ;; Everything after, we save, to combine with later input.
	    (setq burst (substring burst (match-beginning 0))))

	;; In case we know the burst contains no partial annotations:
	(progn
	  (setq output (gdb-concat-output output burst))
	  (setq burst "")))

      ;; Save the remaining burst for the next call to this function.
      (set-gdb-instance-burst burst)
      output)))

(defun gdb-concat-output (so-far new)
  (let ((sink (gdb-instance-output-sink )))
    (cond
     ((eq sink 'user) (concat so-far new))
     ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
     ((eq sink 'emacs)
      (gdb-append-to-partial-output new)
      so-far)
     ((eq sink 'inferior)
      (gdb-append-to-inferior-io new)
      so-far)
     (t (error "Bogon output sink %S" sink)))))

(defun gdb-append-to-partial-output (string)
  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer 'gdb-partial-output-buffer))
    (goto-char (point-max))
    (insert string)))

(defun gdb-clear-partial-output ()
  (save-excursion
    (set-buffer
     (gdb-get-create-instance-buffer 'gdb-partial-output-buffer))
    (delete-region (point-min) (point-max))))

(defun gdb-append-to-inferior-io (string)
  (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))
    (delete-region (point-min) (point-max))))



;; One trick is to have a command who's output is always available in

;; There are two aspects to this: gdb has to tell us when the output
;; for that command might have changed, and we have to be able to run
;; the command behind the user's back.
;;
;; The idle input queue and the output phasing associated with
;; the instance variable `(gdb-instance-output-sink)' help
;; us to run commands behind the user's back.
;;
;; Below is the code for specificly managing buffers of output from one
;; command.
;;

;;
;; NAME is the function name.  DEMAND-PREDICATE tests if output is really needed.
;; GDB-COMMAND is a string of such.  OUTPUT-HANDLER is the function bound to the
;; input in the input queue (see comment about ``gdb communications'' above).
(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler)
  `(defun ,name (&optional ignored)
     (if (and (,demand-predicate)
	      (not (member ',name
			   (gdb-instance-pending-triggers))))
	 (progn
	   (gdb-instance-enqueue-idle-input
	    (list ,gdb-command ',output-handler))
	   (set-gdb-instance-pending-triggers
	    (cons ',name
		  (gdb-instance-pending-triggers)))))))

(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
  `(defun ,name ()
     (set-gdb-instance-pending-triggers
      (delq ',trigger
	    (gdb-instance-pending-triggers)))
     (let ((buf (gdb-get-instance-buffer ',buf-key)))
       (and buf
	    (save-excursion
	      (set-buffer buf)
	      (let ((p (point))
		    (buffer-read-only nil))
		(delete-region (point-min) (point-max))
		(insert-buffer (gdb-get-create-instance-buffer
				'gdb-partial-output-buffer))
		(goto-char p)))))
; put customisation here
     (,custom-defun)))

(defmacro def-gdb-auto-updated-buffer
  (buffer-key trigger-name gdb-command output-handler-name custom-defun)
   `(progn
     (def-gdb-auto-update-trigger ,trigger-name
       ;; The demand predicate:
       (lambda ()
	 (gdb-get-instance-buffer ',buffer-key))
       ,gdb-command
       ,output-handler-name)
     (def-gdb-auto-update-handler ,output-handler-name
       ,trigger-name ,buffer-key ,custom-defun)))

  ;; from the command above.  That function will copy the output into
  ;; the appropriately typed buffer.  That function will be called:
  gdb-info-breakpoints-handler
;; buffer specific functions
  gdb-info-breakpoints-custom)

(defvar gdb-cdir nil "Compilation directory.")
(defvar breakpoint-enabled-icon 
  "Icon for enabled breakpoint in display margin")
(defvar breakpoint-disabled-icon 
  "Icon for disabled breakpoint in display margin")

;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
(defun gdb-info-breakpoints-custom ()
  (let ((flag)(address))

		  (remove-images (point-min) (point-max))
		(remove-strings (point-min) (point-max))))
	  (setq buffers (cdr buffers)))))

    (save-excursion
      (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer))
      (save-excursion
	(goto-char (point-min))
	(while (< (point) (- (point-max) 1))
	  (forward-line 1)
	  (if (looking-at "[^\t].*breakpoint")

		    (with-current-buffer (current-buffer)
		      (progn
			(set (make-local-variable 'gud-minor-mode) 'gdba)
			(set (make-local-variable 'tool-bar-map)
			     gud-tool-bar-map)
			(setq left-margin-width 2)
			(if (get-buffer-window (current-buffer))
			    (set-window-margins (get-buffer-window
						 (current-buffer))
						left-margin-width
						right-margin-width))))

					  'left-margin)
			    (put-string "b" (point) "disabled"
					'left-margin)))))))))
	  (end-of-line))))))

(defun gdb-breakpoints-buffer-name ()
  (save-excursion
    (set-buffer (process-buffer gdb-proc))
    (concat "*breakpoints of " (gdb-instance-target-string) "*")))

(defun gdb-display-breakpoints-buffer ()
  (interactive (list gdb-proc))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer)))

(defun gdb-frame-breakpoints-buffer ()
  (interactive (list gdb-proc))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer 'gdb-breakpoints-buffer)))

(defvar gdb-breakpoints-mode-map nil)
(setq gdb-breakpoints-mode-map (make-keymap))
(suppress-keymap gdb-breakpoints-mode-map)

  (setq mode-name "Breakpoints")
  (use-local-map gdb-breakpoints-mode-map)
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (gdb-invalidate-breakpoints))

(defun gdb-toggle-bp-this-line ()
  (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 ")

  (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 "
	 (buffer-substring (match-beginning 0)
			   (match-end 1))
	 "\n")
	'(lambda () nil)))))

(defvar gdb-source-window nil)

(defun gdb-goto-bp-this-line ()
"Display the file at the breakpoint specified."
  (interactive)
  (save-excursion

  gdb-info-frames-handler
  gdb-info-frames-custom)

(defun gdb-info-frames-custom ()
  (save-excursion
    (set-buffer (gdb-get-instance-buffer 'gdb-stack-buffer))
    (let ((buffer-read-only nil))
      (goto-char (point-min))
      (looking-at "\\S-*\\s-*\\(\\S-*\\)")
      (setq gdb-current-frame (buffer-substring (match-beginning 1) (match-end 1)))
      (while (< (point) (point-max))
	(put-text-property (progn (beginning-of-line) (point))
			   (progn (end-of-line) (point))
			   'mouse-face 'highlight)
	(forward-line 1)))))

(defun gdb-stack-buffer-name ()
  (save-excursion
    (set-buffer (process-buffer gdb-proc))
    (concat "*stack frames of "
	    (gdb-instance-target-string) "*")))

(defun gdb-display-stack-buffer ()
  (interactive (list gdb-proc))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdb-stack-buffer)))

(defun gdb-frame-stack-buffer ()
  (interactive (list gdb-proc))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer 'gdb-stack-buffer)))

(defvar gdb-frames-mode-map nil)
(setq gdb-frames-mode-map (make-keymap))
(suppress-keymap gdb-frames-mode-map)
(define-key gdb-frames-mode-map [mouse-2]

  (setq mode-name "Frames")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-frames-mode-map)
  (gdb-invalidate-frames))

(defun gdb-get-frame-number ()
  (save-excursion
    (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
	   (n (or (and pos

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

  (setq mode-name "Registers")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-registers-mode-map)
  (gdb-invalidate-registers))

(defun gdb-registers-buffer-name ()
  (save-excursion
    (set-buffer (process-buffer gdb-proc))
    (concat "*registers of " (gdb-instance-target-string) "*")))

(defun gdb-display-registers-buffer ()
  (interactive (list gdb-proc))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdb-registers-buffer)))

(defun gdb-frame-registers-buffer ()
  (interactive (list gdb-proc))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer 'gdb-registers-buffer)))

;;
;; Locals buffers
;;

  gdb-info-locals-custom)


;Abbreviate for arrays and structures. These can be expanded using gud-display
(defun gdb-info-locals-handler nil
  (set-gdb-instance-pending-triggers (delq (quote gdb-invalidate-locals)
					   (gdb-instance-pending-triggers)))
  (let ((buf (gdb-get-instance-buffer (quote gdb-partial-output-buffer))))
    (save-excursion
      (set-buffer buf)
      (goto-char (point-min))
      (replace-regexp "^ .*\n" "")
      (goto-char (point-min))
      (replace-regexp "{[-0-9, {}\]*\n" "(array);\n")))
      (goto-char (point-min))
      (replace-regexp "{.*=.*\n" "(structure);\n")
  (let ((buf (gdb-get-instance-buffer (quote gdb-locals-buffer))))
    (and buf (save-excursion
	       (set-buffer buf)
	       (let ((p (point))
		     (buffer-read-only nil))
		 (delete-region (point-min) (point-max))
		 (insert-buffer (gdb-get-create-instance-buffer
				 (quote gdb-partial-output-buffer)))
		 (goto-char p)))))
  (run-hooks (quote gdb-info-locals-hook)))

(defun gdb-info-locals-custom ()

  (setq mode-name "Locals")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-locals-mode-map)
  (gdb-invalidate-locals))

(defun gdb-locals-buffer-name ()
  (save-excursion
    (set-buffer (process-buffer gdb-proc))
    (concat "*locals of " (gdb-instance-target-string) "*")))

(defun gdb-display-locals-buffer ()
  (interactive (list gdb-proc))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdb-locals-buffer)))

(defun gdb-frame-locals-buffer ()
  (interactive (list gdb-proc))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer 'gdb-locals-buffer)))
;;
;; Display expression buffers (just allow one to start with)
;;
(gdb-set-instance-buffer-rules 'gdb-display-buffer
			       'gdb-display-buffer-name

  (setq mode-name "Display")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq buffer-read-only t)
  (use-local-map gdb-display-mode-map)
  (gdb-invalidate-display))

(defun gdb-display-buffer-name ()
  (save-excursion
    (set-buffer (process-buffer gdb-proc))
    (concat "*Displayed expressions of " (gdb-instance-target-string) "*")))

(defun gdb-display-display-buffer ()
  (interactive (list gdb-proc))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdb-display-buffer)))

(defun gdb-frame-display-buffer ()
  (interactive (list gdb-proc))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer 'gdb-display-buffer)))

(defun gdb-toggle-disp-this-line ()
  (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 ")

(defun gdb-delete-disp-this-line ()
  (interactive)
  (save-excursion
    (set-buffer
     (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 (buffer-substring (match-beginning 0)
				      (match-end 1))))
	(gdb-instance-enqueue-idle-input
	 (list (concat "server delete display " number "\n")
	       '(lambda () nil)))
	(if (not (display-graphic-p))
	    (kill-buffer (get-buffer (concat "*display " number "*")))
	  ;else

  (setq buffer-read-only t))


;;;; Window management

;;; FIXME: This should only return true for buffers in the current gdb-proc
(defun gdb-protected-buffer-p (buffer)
  "Is BUFFER a buffer which we want to leave displayed?"
  (save-excursion
    (set-buffer buffer)
    (or gdb-buffer-type

  (set-window-buffer gdb-source-window buffer))


;;; Shared keymap initialization:

(defun gdb-display-gdb-buffer ()
  (interactive (list gdb-proc))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdba)))

(defun gdb-make-windows-menu (map)
  ;; FIXME: This adds to the DBX, PerlDB, ... menu as well :-(
  ;; Probably we should create gdb-many-windows-map and put those menus
  ;; on that map.

(define-key gud-minor-mode-map "\C-c\M-\C-f" 'gdb-display-stack-buffer)
(define-key gud-minor-mode-map "\C-c\M-\C-b" 'gdb-display-breakpoints-buffer)

(gdb-make-windows-menu gud-minor-mode-map)

(defun gdb-frame-gdb-buffer ()
  (interactive (list gdb-proc))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer 'gdba)))

(defun gdb-make-frames-menu (map)
  (define-key map [menu-bar frames]
    (cons "GDB-Frames" (make-sparse-keymap "GDB-Frames")))
  (define-key map [menu-bar frames gdb]

    '("Assembler" . gdb-frame-assembler-buffer)))

(if (display-graphic-p)
    (gdb-make-frames-menu gud-minor-mode-map))

;; end of functions from gdba.el

;; new functions for gdb-ui.el

(defvar gdb-main-file nil "Source file from which program execution begins.")

;; layout for all the windows
(defun gdb-setup-windows ()
  (gdb-display-locals-buffer)
  (gdb-display-stack-buffer)
  (delete-other-windows)
  (gdb-display-breakpoints-buffer)
  (gdb-display-display-buffer)
  (delete-other-windows)
  (split-window nil ( / ( * (window-height) 3) 4))
  (split-window nil ( / (window-height) 3))
  (split-window-horizontally)
  (other-window 1)
  (switch-to-buffer (gdb-locals-buffer-name))
  (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)))
  (setq gdb-source-window (get-buffer-window (current-buffer)))
  (split-window-horizontally)
  (other-window 1)
  (switch-to-buffer (gdb-inferior-io-name))
  (other-window 1)
  (switch-to-buffer (gdb-stack-buffer-name))
  (split-window-horizontally)
  (other-window 1)
  (switch-to-buffer (gdb-breakpoints-buffer-name))
  (other-window 1))

(defun gdb-restore-windows ()
  "Restore the basic arrangement of windows used by gdba.
This arrangement depends on the value of `gdb-many-windows'."
  (interactive)
  (if gdb-many-windows
      (progn
	(switch-to-buffer gud-comint-buffer)
	(delete-other-windows)
	(gdb-setup-windows))
;else
    (switch-to-buffer gud-comint-buffer)
    (delete-other-windows)
    (split-window)
    (other-window 1)

	(other-window 1)
	(setq gdb-many-windows nil))
;else
    (switch-to-buffer gud-comint-buffer)
    (delete-other-windows)
    (gdb-setup-windows)
    (setq gdb-many-windows t)))

(defconst breakpoint-xpm-data "/* XPM */
static char *magick[] = {
/* columns rows colors chars-per-pixel */

  ;; all other windows.
  (if (eq (selected-window) (minibuffer-window))
      (other-window 1))
  (delete-other-windows)
  (if gdb-many-windows
      (gdb-setup-windows)
;else
    (gdb-display-breakpoints-buffer)
    (gdb-display-display-buffer)
    (gdb-display-stack-buffer)
    (delete-other-windows)
    (split-window)
    (other-window 1)
    (switch-to-buffer (gud-find-file gdb-main-file))
    (other-window 1)

    (while overlays
      (let ((overlay (car overlays)))
	(when (string-equal (overlay-get overlay 'before-string) "gdb-arrow")
	  (delete-overlay overlay)))
      (setq overlays (cdr overlays)))))

(defun gdb-array-visualise ()
  "Visualise arrays and slices using graph program from plotutils."
  (interactive)
  (if (and (display-graphic-p) gdb-display-string)

(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")
	 '(lambda () nil)))
  (kill-buffer nil)
  (delete-frame))

  (concat "server disassemble " gdb-main-or-pc "\n")
  gdb-assembler-handler
  gdb-assembler-custom)

(defun gdb-assembler-custom ()
  (let ((buffer (gdb-get-instance-buffer 'gdb-assembler-buffer))
	(gdb-arrow-position) (address) (flag))
    (if gdb-current-address
	(progn
	  (save-excursion
	    (set-buffer buffer)

      (set-buffer buffer)
      (if (display-graphic-p)
	  (remove-images (point-min) (point-max))
	(remove-strings (point-min) (point-max))))
    (save-excursion
      (set-buffer (gdb-get-instance-buffer 'gdb-breakpoints-buffer))
      (goto-char (point-min))
      (while (< (point) (- (point-max) 1))
	(forward-line 1)
	(if (looking-at "[^\t].*breakpoint")
	    (progn

\\{gdb-assembler-mode-map}"
  (setq major-mode 'gdb-assembler-mode)
  (setq mode-name "Assembler")
  (set (make-local-variable 'gud-minor-mode) 'gdba)
  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
  (setq left-margin-width 2)
  (setq buffer-read-only t)
  (use-local-map gdb-assembler-mode-map)
  (gdb-invalidate-assembler)
  (gdb-invalidate-breakpoints))

(defun gdb-assembler-buffer-name ()
  (save-excursion
    (set-buffer (process-buffer gdb-proc))
    (concat "*Machine Code " (gdb-instance-target-string) "*")))

(defun gdb-display-assembler-buffer ()
  (interactive (list gdb-proc))
  (gdb-display-buffer
   (gdb-get-create-instance-buffer 'gdb-assembler-buffer)))

(defun gdb-frame-assembler-buffer ()
  (interactive (list gdb-proc))
  (switch-to-buffer-other-frame
   (gdb-get-create-instance-buffer 'gdb-assembler-buffer)))

(defun gdb-invalidate-frame-and-assembler (&optional ignored)
  (gdb-invalidate-frames)
  (gdb-invalidate-assembler))

(defun gdb-invalidate-breakpoints-and-assembler (&optional ignored)
  (gdb-invalidate-breakpoints)
  (gdb-invalidate-assembler))

(defvar gdb-prev-main-or-pc nil)

; modified because if gdb-main-or-pc has changed value a new command
; must be enqueued to update the buffer with the new output
(defun gdb-invalidate-assembler (&optional ignored)
  (if (and ((lambda ()
	      (gdb-get-instance-buffer (quote gdb-assembler-buffer))))
	   (or (not (member (quote gdb-invalidate-assembler)
			(gdb-instance-pending-triggers)))
	   (not (string-equal gdb-main-or-pc gdb-prev-main-or-pc))))
      (progn

        ; take previous disassemble command off the queue
	(save-excursion
	  (set-buffer (gdb-get-instance-buffer 'gdba))
	   (let ((queue gdb-idle-input-queue) (item))
	     (while queue
	       (setq item (car queue))
	       (if (equal (cdr item) '(gdb-assembler-handler))
		   (delete item gdb-idle-input-queue))
		 (setq queue (cdr queue)))))

	(gdb-instance-enqueue-idle-input
	 (list (concat "server disassemble " gdb-main-or-pc "\n")
			     (quote gdb-assembler-handler)))
	     (set-gdb-instance-pending-triggers
	      (cons (quote gdb-invalidate-assembler)
			     (gdb-instance-pending-triggers)))
	     (setq gdb-prev-main-or-pc gdb-main-or-pc))))

(defun gdb-delete-line ()
"Delete current line."
(interactive)