--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/eos/sun-eos-debugger-extra.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,854 @@
+;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks Debugger interface
+
+;; Copyright (C) Sun Microsystems, Inc.
+
+;; Maintainer:	Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
+;; Author:      Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
+
+;; Keywords:	SPARCworks EOS Era on SPARCworks Debugger dbx
+
+;;; Commentary:
+;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
+
+;;; Code:
+
+;; debugger buffer
+
+(require 'eos-common   "sun-eos-common")
+(require 'eos-debugger "sun-eos-debugger")
+(require 'eos-menubar  "sun-eos-menubar")
+
+(defvar eos::debugger-buffer "*Eos Debugger Log*"
+  "name of buffer where to log debugger activity; see eos::use-debugger-buffer")
+(defvar eos::dbx-buffer nil)
+(defvar eos::key-mode 'none "Style of key mode interaction for Eos")
+
+(defun eos::ensure-debugger-buffer ()
+  ;; will ensure a debugger buffer, with the proper major mode
+  (let ((buf (get-buffer eos::debugger-buffer)))
+    (if buf
+	(switch-to-buffer buf)
+      (setq buf (get-buffer-create eos::debugger-buffer))
+      (set-buffer buf)
+      (eos::debugger-mode)
+      (toggle-read-only -1)		; writeable
+      (eos::insert-string-as-extent "[Debugger] " t (get-face 'bold))
+      (toggle-read-only 1)		; read-only
+      )))
+
+(defun eos::synchronize-debugger-buffer ()
+  ;; ensure all views of this buffer are at the end
+  (eos::ensure-debugger-buffer)
+  (let ((x (point-max)))
+    (goto-char x)
+    (mapcar (function
+	     (lambda (win)
+	       (set-window-point win x)))
+	    (get-buffer-window-list eos::debugger-buffer))
+    ))
+
+(defvar eos::debugger-mode-map nil)
+
+(if eos::debugger-mode-map
+    nil
+  (progn
+    (setq eos::debugger-mode-map (make-keymap))
+    (set-keymap-name eos::debugger-mode-map 'eos::debugger-mode-map)
+    (define-key eos::debugger-mode-map [(meta p)] 'eos::debugger-previous-cmd)
+    (define-key eos::debugger-mode-map [(meta n)] 'eos::debugger-next-cmd)
+    (define-key eos::debugger-mode-map [return] 'eos::debugger-send-cmd)
+    ))
+
+(defun eos::debugger-mode ()
+  (interactive)
+  "local mode"
+  (kill-all-local-variables)    
+  (setq major-mode 'eos::debugger-mode)
+  (setq mode-name "eos::debugger")
+  (setq truncate-lines t)
+  (set-syntax-table emacs-lisp-mode-syntax-table)
+  (use-local-map eos::debugger-mode-map))
+
+
+;; Handling of command lists
+
+(defvar eos::current-command nil "Current command navigated; as an extent")
+(defvar eos::last-command nil "last command sent to debugger, as an extent")
+
+(defun eos::debugger-previous-cmd ()
+  ;; present the previous command
+  (interactive)
+  (save-excursion
+    (let ((xt nil))
+      (if (null eos::current-command)
+	  (setq xt eos::last-command)
+	(setq xt (extent-property 
+		  eos::current-command
+		  'previous-command)))
+      (if xt
+	  (progn
+	    (eos::debugger-delete-last-cmd-line)
+	    (goto-char (point-max))
+	    (insert (buffer-substring
+		     (extent-start-position xt)
+		     (1- (extent-end-position xt)) ; remove <CR>
+		     ))
+	    (setq eos::current-command xt))
+	(error "no previous command")
+	))
+    ))
+
+(defun eos::debugger-next-cmd ()
+  ;; present the next command
+  (interactive)
+  (save-excursion
+    (let ((xt nil))
+      (if (null eos::current-command)
+	  (error "no next command")
+	(setq xt (extent-property 
+		  eos::current-command
+		  'next-command)))
+      (eos::debugger-delete-last-cmd-line)
+      (if xt
+	  (progn
+	    (goto-char (point-max))
+	    (insert (buffer-substring
+		     (extent-start-position xt)
+		     (1- (extent-end-position xt)) ; remove <CR>
+		     ))
+	    (setq eos::current-command xt))
+	(setq eos::current-command nil)
+	))
+    ))
+
+(defun eos::debugger-delete-last-cmd-line ()
+  ;; delete the last command line, not yet inputed, returns that cmd line
+  (goto-char (point-max))
+  (let ((e (point)))
+    (beginning-of-line)
+    (let* ((xt (extent-at (point)))
+	   (p (extent-end-position xt))
+	   (str (buffer-substring p e))
+	   )
+      (delete-region p e)
+      str
+      )))
+
+(defun eos::debugger-send-cmd ()
+  ;; send the message in the current line
+  (interactive)
+  (end-of-line)
+  (let ((e (point)))
+    (beginning-of-line)
+    (let* ((xt (extent-at (point)))
+	   (p (extent-end-position xt))
+	   (str (buffer-substring p e))
+	   )
+      (delete-region p e)
+      (eos::send-spider-current-do-msg (concat str "\n"))
+      (goto-char (point-max))
+      (setq eos::current-command nil)
+      )))
+
+;; client
+;;
+
+(defun get-buffer-window-list (buffer)
+  ;; like get-buffer-window except that will generate a list of windows
+  ;; instead of just the first one"
+  (let* ((buf (get-buffer buffer))
+	 (win1 (next-window nil 'foo t t))
+	 (win win1)
+	 (first t)
+	 (ret nil)
+	 )
+    (if (null buf)
+	nil
+      (while (or
+	      (and first win)
+	      (not (or first (equal win win1)))
+	      )
+	(setq first nil)
+	(if (equal
+	     buf
+	     (window-buffer win))
+	    (setq ret (cons win ret)))
+	(setq win (next-window win t t t))
+	)
+      ret)))
+
+(defun eos::dbx-process ()
+  ;; Returns nil, or the corresponding process where to insert
+  (let ((pl (process-list))
+	(found-proc nil)
+	)
+    (while (and pl (null found-proc))
+      (let* ((proc (car pl))
+	     (name (process-name proc))
+	     )
+	(if (and (>= (length name) 3)
+		 (equal (substring name 0 3) "Eos"))
+	    (setq found-proc proc)
+	  (setq pl (cdr pl))
+	  )
+	))
+    found-proc
+    ))
+
+(defun eos::insert-echo (process string)
+  (if (null process)
+      nil
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (goto-char (point-max))
+;;      (let ((beg (point)))
+;;	(insert-before-markers string))
+      (insert-before-markers string)
+      (if (process-mark process)
+	  (set-marker (process-mark process) (point-max))))
+    (if (eq (process-buffer process)
+	    (current-buffer))
+	(goto-char (point-max)))
+    ))
+
+
+(defun eos::insert-on-debugger-buffer (msg rdonly face &optional previous-command)
+  ;; will insert MSG at end of debugger buffer with RDONLY property and with FACE. 
+  ;; If PREVIOUS-COMMAND is given, the newly created extent will be doubly linked into this one
+  ;; using 'previous-command and 'next-command properties
+  (save-window-excursion
+  (let ((fr (selected-frame))
+	(buf (current-buffer))
+	(xt nil))
+    (eos::ensure-debugger-buffer)
+    (toggle-read-only -1)		; not read-only 
+    (eos::insert-echo (eos::dbx-process) msg)
+    (setq xt (eos::insert-string-as-extent msg rdonly face))
+    (if previous-command
+	(progn
+	  (set-extent-property xt 'previous-command previous-command)
+	  (set-extent-property previous-command 'next-command xt)
+	  ))
+    (toggle-read-only 1)		; now read-only 
+    (switch-to-buffer buf)
+    (select-frame fr)
+    xt
+  ))
+  )
+
+(defun eos::insert-string-as-extent (msg rdonly face)
+  ;; insert MSG as a extent with RDONLY and FACE.  Returns the extent
+  (let ((here nil)
+	(xt nil))
+    (goto-char (point-max))
+    (setq here (point))
+    (insert msg)
+    (setq xt (make-extent here (point) nil))
+    (if rdonly
+	(progn
+	  (set-extent-property xt 'read-only t)
+	  (set-extent-property xt 'duplicable nil)
+	  ))
+    (set-extent-face xt face)
+    (eos::synchronize-debugger-buffer)
+    xt
+    ))
+
+
+(require 'comint)
+
+(defvar eos::dbx-program "dbx")
+(defvar eos::dbx-switches (list "-editor"))
+
+(defun eos::expand-file-name (file)
+  ;; expand file name depending on first character
+  (cond
+   ((null file)
+    nil)
+   ((eq (elt file 0) ?~)
+    (expand-file-name file))
+   ((eq (elt file 0) ?$)
+    (substitute-in-file-name file))
+   (t file)))
+
+(defun eos::read-dbx-request (program switches)
+  ;; will prompt to the user with PROGRAM and SWITCHES, let her modify this
+  ;; and then will read the result and split it into program and switches.
+  (let* ((prompt
+	  (concat program " " (mapconcat 'identity switches " ")))
+	 (ret (read-from-minibuffer "Run dbx as: " prompt))
+	 (ret2 (split-string ret " ")))
+    ;; some testing
+    (cons (car ret2) (cdr ret2))
+  ))
+
+(defun eos::dbx ()
+;; Run an inferior dbx -editor process, with I/O through buffer *Eos Dbx*.
+;; If buffer exists but dbx process is not running, make new dbx.
+;; If buffer exists and dbx process is running, 
+;; just switch to buffer `*Eos Dbx*'.
+  (let ((buffer "*Eos Dbx*")
+	(buffer-name "Eos Dbx")
+	(input nil))
+    (cond ((not (comint-check-proc buffer))
+	   (setq input (eos::read-dbx-request eos::dbx-program
+					      eos::dbx-switches))
+	   (setq eos::dbx-program (car input))
+	   (setq eos::dbx-switches (cdr input))
+	   (message "Starting Dbx subprocess")
+	   (setq buffer
+		 (set-buffer
+		  (apply 'make-comint 
+			 buffer-name
+			 (eos::expand-file-name eos::dbx-program)
+			 nil
+			 (mapcar 'eos::expand-file-name eos::dbx-switches))))
+	   (comint-mode)
+	   (if (and (eq (device-type (frame-device (selected-frame))) 'tty)
+		    (eq eos::key-mode 'none)
+		    (yes-or-no-p 
+		     "Do you want the prefix map activated?"))
+	       (eos::set-key-mode 'prefix))
+	   (setq eos::dbx-or-debugger 'dbx)
+	   (setq eos::dbx-buffer (current-buffer))
+	   (make-local-variable 'kill-buffer-hook)
+	   (setq kill-buffer-hook
+		 (list (function (lambda ()
+				   (cond
+				    ((null (eos::dbx-process)) t)
+				    ((not (eq (process-status (eos::dbx-process)) 'run)) t)
+				    ((yes-or-no-p
+					  "Warning! Killing this buffer will kill a dbx process, proceed? ")
+				     (eos::internal-clear-annotations t t t t))
+				    (t (error "kill-buffer aborted!")))
+				   ))))
+	   )
+	  (t
+	   (message "Reusing existing dbx buffer and dbx process")))
+    (switch-to-buffer buffer)
+  ))
+
+
+;; Actions to start a debugger in the background.
+
+(defvar eos::debugger-process nil
+  "Debugger process for the background.  Only one per XEmacs")
+
+(defvar eos::dbx-or-debugger nil)
+
+(defun eos::start-debugger ()
+  "Start an \"debugger -editor\" in the background. Will ask for confirmation if
+XEmacs somehow believes there is already one running"
+  (interactive)
+  (if (and (or (not (processp eos::debugger-process))
+	       (not (eq (process-status eos::debugger-process) 'run))
+	       (yes-or-no-p
+		"Warning! XEmacs believes there already is a debugger -editor, proceed? "))
+	   (or (not (eos::dbx-process))
+	       (not (eq (process-status (eos::dbx-process)) 'run))
+	       (yes-or-no-p
+		"Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
+      (progn
+	(setq eos::debugger-process
+	      (start-process "*eos debugger*" nil "debugger" "-editor"))
+	(message "Starting Debugger subprocess")
+	(eos::select-debugger-frame (selected-frame))
+	(setq eos::dbx-or-debugger 'debugger)
+	)))
+
+;; Ditto for dbx.
+
+(defun eos::start-dbx ()
+  "Start an \"dbx -editor\" as a subprocess. Will ask for confirmation if
+XEmacs somehow believes there is already one running"
+  (interactive)
+  (if (and (or (not (processp eos::debugger-process))
+	       (not (eq (process-status eos::debugger-process) 'run))
+	       (yes-or-no-p
+		"Warning! XEmacs believes there already is a debugger -editor, proceed? "))
+	   (or (not (eos::dbx-process))
+	       (not (eq (process-status (eos::dbx-process)) 'run))
+	       (yes-or-no-p
+		"Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
+      (progn
+	(eos::select-debugger-frame (selected-frame))
+	(eos::dbx)
+	)))
+
+
+;;
+;; Communication commands
+;;
+
+(defun eos::spider-do-callback (msg pat)
+  ;; Callback after processing a spider_do request
+  (eos::insert-on-debugger-buffer
+   (format "%s" (get-tooltalk-message-attribute msg 'arg_val 2))
+   t
+   (get-face 'bold))
+  (destroy-tooltalk-message msg)
+  )
+
+(defvar eos::last-command-was-print nil "(eos:: internal)")
+
+(defun eos::spro_spider_output (msg pat)
+  ;; For spider output
+  (let ((s (get-tooltalk-message-attribute msg 'arg_val 1))
+	(err (get-tooltalk-message-attribute msg 'arg_val 2))
+	)
+    (message (format "%s" s))
+    (eos::insert-on-debugger-buffer (format "%s" s)
+				    t
+				    (get-face 'default))
+    (if (and err (not (string-equal err "")))
+	(eos::insert-on-debugger-buffer
+	 (insert (format "STDERR> %s" err))
+	 t
+	 (get-face 'default))
+      )
+    (destroy-tooltalk-message msg)))
+
+(defun eos::spro_spider_output-common (msg pat)
+  ;; For spider output
+  (if eos::last-command-was-print
+      (eos::spro_spider_print_output msg pat)
+    (eos::spro_spider_output msg pat)))
+
+(defmacro eos::spider-tt-args (cmd spider-id clique-id)
+  (` (list
+      'class TT_REQUEST
+      'address TT_HANDLER
+      'scope TT_SESSION
+      'handler (, spider-id)
+      'op "SPRO_SPIDER_DO"
+      'callback 'eos::spider-do-callback
+      'args (list
+	     (list 'TT_IN (, clique-id) "Context_ID")
+	     (list 'TT_IN (, cmd) "string")
+	     (list 'TT_OUT))
+      )))
+
+(defun eos::send-spider-do-msg (cmd spider-id clique-id)
+  ;; Send CMD, a string, to SPIDER-ID, using CLIQUE-ID
+  (let ((msg (make-tooltalk-message
+	      (eos::spider-tt-args cmd spider-id clique-id))))
+    (setq eos::last-command
+	  (eos::insert-on-debugger-buffer
+	   cmd
+	   t
+	   (get-face 'italic)
+	   eos::last-command))
+    (setq eos::current-command eos::last-command)
+    (send-tooltalk-message msg)
+    (destroy-tooltalk-message msg)
+    ))
+
+(defvar eos::no-connection-box
+      '("XEmacs does not know the ID of a debugger to connect to.
+You may need to reissue a debug or attach command from the debugger.
+Consult the introduction to Eos (Help->SPARCworks...) for more details."
+	       ["Dismiss" (message "Command aborted") t]))
+
+(defun eos::send-spider-current-do-msg (cmd)
+  ;; Send CMD to the current dbx engine using the current debugger clique;
+  ;;The cmd ends in a new-line.
+  (if (null eos::current-debugger-clique-id)
+      (popup-dialog-box eos::no-connection-box)
+    (eos::send-spider-do-msg cmd
+			     eos::current-dbx-proc-id
+			     eos::current-debugger-clique-id)))
+
+(defun eos::dbx-cmd (arg) 
+  "Send CMD to the current dbx engine using the current debugger clique;
+The cmd does not end in a new-line; a new-line will be added"
+  (interactive "sDbx cmd: ")
+  (eos::send-spider-current-do-msg (concat arg "\n")))
+
+
+;;
+;; Extra patterns
+
+(defvar eos::dbx-extra-pattern-list nil)
+
+(defun eos::debugger-extra-startup ()
+  ;; Actions to do at startup for eos-debugger-extra.el
+    (setq eos::dbx-extra-pattern-list	; list of extra TT patterns
+	  (eos::create-debugger-extra-patterns))
+    (eos::ensure-available-print-frame)
+    (eos::define-prefix-map)		; initialize keymap
+  )
+
+(defun eos::create-debugger-extra-patterns ()
+  ;; returns a list of patterns
+  (list
+   (make-an-observer "SPRO_SPIDER_OUTPUT" 'eos::spro_spider_output-common)
+   ))
+
+(defun eos::register-debugger-extra-patterns ()
+  ;; register additional dbx patterns
+    (mapcar 'register-tooltalk-pattern eos::dbx-extra-pattern-list))
+
+(defun eos::unregister-debugger-extra-patterns ()
+  ;; unregister additional dbx patterns
+  (mapcar 'unregister-tooltalk-pattern eos::dbx-extra-pattern-list))
+
+;;
+;; Common commands
+;;
+
+
+(defun eos::type () (interactive)
+  (if (eq eos::dbx-or-debugger 'debugger)
+      (call-interactively 'eos::dbx-cmd)
+    (if (buffer-live-p eos::dbx-buffer)
+	(switch-to-buffer eos::dbx-buffer)
+      (message "no dbx subprocess buffer known"))))
+
+(defun eos::run () (interactive) (eos::dbx-cmd "run"))
+(defun eos::fix () (interactive) (eos::dbx-cmd "fix"))
+(defun eos::build () (interactive) (eos::dbx-cmd "make"))
+
+(defun eos::cont () (interactive) (eos::dbx-cmd "cont"))
+(defun eos::cont-and-dismiss () (interactive)
+  (eos::dismiss-print-frame) (eos::cont))
+(defun eos::clear-all () (interactive) (eos::dbx-cmd "clear"))
+(defun eos::next () (interactive) (eos::dbx-cmd "next"))
+(defun eos::next-and-dismiss () (interactive)
+  (eos::dismiss-print-frame) (eos::next))
+(defun eos::step () (interactive) (eos::dbx-cmd "step"))
+(defun eos::step-and-dismiss () (interactive)
+  (eos::dismiss-print-frame) (eos::step))
+(defun eos::step-up () (interactive) (eos::dbx-cmd "step up"))
+
+(defun eos::up () (interactive)  (eos::dbx-cmd "up" ))
+(defun eos::down () (interactive) (eos::dbx-cmd "down"))
+(defun eos::pop () (interactive) (eos::dbx-cmd "pop"))
+
+
+(defun eos::stop-at ()
+  (interactive)
+  (let ((name (buffer-file-name)))
+    (if (null name) (error "Buffer has no associated file"))
+    (eos::dbx-cmd
+     (format "stop at \"%s\":%d" name (eos::line-at (point))))
+    ))
+
+(defun eos::clear-at ()
+  (interactive)
+  (let ((name (buffer-file-name)))
+    (if (null name) (error "Buffer has no associated file"))
+    (eos::dbx-cmd
+     (format "clear \"%s\":%d" name (eos::line-at (point))))
+	 ))
+
+(defun eos::stop-in ()
+  (interactive)
+  (eos::dbx-cmd
+   (format "stop in %s"
+	   (if (eq 'x (device-type (selected-device)))
+	       (x-get-selection)
+	     (buffer-substring (point) (mark)))
+	   ))
+   (setq zmacs-region-stays t))
+
+(defun eos::func ()
+  (interactive)
+  (eos::dbx-cmd
+   (format "func %s"
+	   (if (eq 'x (device-type (selected-device)))
+	       (x-get-selection)
+	     (buffer-substring (point) (mark)))
+	   ))
+  (setq zmacs-region-stays t))
+
+(defun eos::cont-to ()
+  (interactive)
+  (let ((name (buffer-file-name)))
+    (if (null name) (error "Buffer has no associated file"))
+    (eos::dbx-cmd
+     (format "stop at \"%s\":%d -temp; cont" name (eos::line-at (point))))
+    ))
+
+(defun eos::print-normal ()
+  (interactive)
+  (eos::dbx-cmd
+   (format "print  %s"
+	   (if (eq 'x (device-type (selected-device)))
+	       (x-get-selection)
+	     (buffer-substring (point) (mark)))
+	   ))
+  (setq zmacs-region-stays t))
+
+(defun eos::print*-normal ()
+  (interactive)
+  (eos::dbx-cmd
+   (format "print  *(%s)"
+	   (if (eq 'x (device-type (selected-device)))
+	       (x-get-selection)
+	     (buffer-substring (point) (mark)))
+	   ))
+  (setq zmacs-region-stays t))
+
+;; specialization for print commands
+
+(defun eos::send-spider-print-msg (expr)
+  ;; Print EXPR using separate frame
+  (setq eos::last-command-was-print t)
+  (eos::dbx-cmd (format "print %s" expr)))
+
+(defun eos::send-spider-print*-msg (expr)
+  ;; Send *EXPR using separate frame
+  (setq eos::last-command-was-print t)
+  (eos::dbx-cmd (format "print *(%s)" expr)))
+
+(defun eos::print () (interactive)
+ (eos::send-spider-print-msg
+  (if (eq 'x (device-type (selected-device)))
+      (x-get-selection)
+    (buffer-substring (point) (mark)))
+  )
+ (setq zmacs-region-stays t))
+
+(defun eos::print* () (interactive)
+ (eos::send-spider-print*-msg
+  (if (eq 'x (device-type (selected-device)))
+      (x-get-selection)
+    (buffer-substring (point) (mark)))
+  )
+ (setq zmacs-region-stays t))
+
+
+;;
+;;
+;; Print on separate frame
+
+
+(defun eos::buffer-line-size (buffer)
+  (interactive)
+  (or (bufferp buffer)
+      (setq buffer (current-buffer)))
+  (save-excursion
+    (switch-to-buffer buffer)
+    (eos::line-at (point-max))))
+
+;;
+;; Handling of a collection of print frames
+;; (currently only one)
+
+(defvar eos::print-frame nil "Frame for prints")
+(defvar eos::print-buffer " *Eos Print Output*" "Buffer for prints")
+
+(defun eos::new-available-print-frame()
+  ;; returns an available print frame
+  ;; currently just returns the one frame
+  (require 'eos-toolbar  "sun-eos-toolbar")
+  (let ((scr (selected-frame))
+	(buf (current-buffer)))
+
+    ;; create frames
+    (if (and 
+	 (frame-live-p eos::print-frame)
+	 (or (not (frame-live-p eos::debugger-frame))
+	     (not (eq eos::print-frame
+		      eos::debugger-frame))))
+	(progn
+	  (make-frame-visible eos::print-frame)
+	  eos::print-frame)
+      (setq eos::print-frame (make-frame))
+      ;; no modeline visible...
+      (set-face-background 'modeline 
+			   (face-background (get-face 'default))
+			   eos::print-frame)
+      (set-face-foreground 'modeline 
+			   (face-background (get-face 'default))
+			   eos::print-frame)
+      ;; there is redundancy below.
+      (select-frame eos::print-frame)
+      (switch-to-buffer eos::print-buffer)
+      (set-buffer-menubar nil)
+      (add-spec-to-specifier (eos::toolbar-position) eos::print-toolbar (selected-frame))
+      (add-spec-to-specifier has-modeline-p nil (selected-frame))
+      (select-frame scr)
+      (switch-to-buffer buf)
+      eos::print-frame
+      )))
+
+;; set delete-frame-hook and check for this frame... then do 
+
+
+
+(defun eos::ensure-available-print-frame ()
+  ;; ensures that there is at least one available print frame
+  t)
+
+(defun eos::show-print-frame ()
+  (interactive)
+  (setq eos::print-frame (eos::new-available-print-frame))
+  (select-frame eos::print-frame)
+  (switch-to-buffer eos::print-buffer)
+  (set-frame-height eos::print-frame
+		     (+ 1 (eos::buffer-line-size eos::print-buffer)))
+  (goto-char (point-min))
+    )
+
+(defun eos::dismiss-print-frame ()
+  (interactive)
+  (if (frame-live-p eos::print-frame)
+      (progn
+	(make-frame-invisible eos::print-frame)
+	(select-frame (car (visible-frame-list))))))
+;;
+;; print output
+;;
+
+(defun eos::spro_spider_print_output (msg pat)
+  ;; For spider print output (switched with spro_spider_output
+  (let ((buf (current-buffer))
+	(scr (selected-frame)))
+    (save-excursion			; does not work in callbacks?
+      (switch-to-buffer eos::print-buffer)
+      (delete-region (point-min) (point-max))
+      (goto-char (point-max))
+      (insert (format "%s" (get-tooltalk-message-attribute msg
+							   'arg_val 1)))
+      (let ((err (get-tooltalk-message-attribute msg
+						 'arg_val 2)))
+	(if (and err (not (string-equal err "")))
+	    (insert (format "STDERR> %s" err))))
+      (eos::show-print-frame)
+      (select-frame scr)
+      (switch-to-buffer buf)
+      )
+    (destroy-tooltalk-message msg)
+    (setq eos::last-command-was-print nil)
+    ))
+
+
+;; User interface
+
+(defvar eos::prefix-map (make-keymap))
+
+(defun eos::define-prefix-map ()
+
+  (define-key eos::prefix-map "%" 'eos::dbx-cmd)
+  (define-key eos::prefix-map "r" 'eos::run)
+  (define-key eos::prefix-map "f" 'eos::fix)
+
+  (define-key eos::prefix-map "p" 'eos::print)
+  (define-key eos::prefix-map "\C-p" 'eos::print*)
+
+  (define-key eos::prefix-map "c" 'eos::cont)
+  (define-key eos::prefix-map "b" 'eos::stop-at)
+  (define-key eos::prefix-map "\C-b" 'eos::clear-at)
+
+  (define-key eos::prefix-map "n" 'eos::next)
+  (define-key eos::prefix-map "s" 'eos::step)
+  (define-key eos::prefix-map "\C-s" 'eos::step-up)
+
+  (define-key eos::prefix-map "u" 'eos::up)
+  (define-key eos::prefix-map "d" 'eos::down)
+
+)
+
+(defun eos::set-key-mode (mode)
+  ;; Set the key MODE to either 'none, 'prefix, or 'function
+  (setq eos::key-mode mode)
+  (cond
+   ((eq eos::key-mode 'none)
+    (define-key global-map "\C-cd" nil)
+    (eos::remove-function-keys)
+    (add-submenu nil (append '("SPARCworks") eos::short-menu))
+    )
+   ((eq eos::key-mode 'prefix)
+    (define-key global-map "\C-cd" eos::prefix-map)
+    (eos::remove-function-keys)
+    (add-submenu nil (append '("SPARCworks") eos::long-menu))
+    )
+   ((eq eos::key-mode 'function)
+    (define-key global-map "\C-cd" nil)
+    (eos::add-function-keys)
+    (add-submenu nil (append '("SPARCworks") eos::long-menu))
+    )
+   (t
+    (error "unimplemented")
+    )))
+
+(defun eos::add-function-keys ()
+  (interactive)
+
+  ;;
+  (global-set-key [f6] 'eos::dbx-cmd)
+  (global-set-key [(control f6)] 'eos::run)
+  (global-set-key [(shift f6)] 'eos::fix)
+  ;;
+  (global-set-key [f7] 'eos::print)
+  (global-set-key [(control f7)] 'eos::print*)
+  (global-set-key [(shift f7)] 'eos::dismiss-print-frame)
+  ;;
+  (global-set-key [f8] 'eos::cont)
+  (global-set-key [(control f8)] 'eos::stop-at)
+  (global-set-key [(shift f8)] 'eos::clear-at)
+  ;;
+  (global-set-key [f9] 'eos::next)
+  (global-set-key [(control f9)] 'eos::step)
+  (global-set-key [(shift f9)] 'eos::step-up)
+  ;;
+  )
+
+(defun eos::remove-function-keys ()
+  (interactive)
+
+  ;;
+  (global-set-key [f6] nil)
+  (global-set-key [(control f6)] nil)
+  (global-set-key [(shift f6)] nil)
+  ;;
+  (global-set-key [f7] nil)
+  (global-set-key [(control f7)] nil)
+  (global-set-key [(shift f7)] nil)
+  ;;
+  (global-set-key [f8] nil)
+  (global-set-key [(control f8)] nil)
+  (global-set-key [(shift f8)] nil)
+  ;;
+  (global-set-key [f9] nil)
+  (global-set-key [(control f9)] nil)
+  (global-set-key [(shift f9)] nil)
+  ;;
+  )
+
+;; Provides popup access
+
+(defvar eos::popup-mode nil)
+(defvar eos::saved-global-popup-menu nil)
+
+(defun eos::toggle-popup-menu ()
+  ;; Toggle whether to use or not popup menus for SPARCworks
+  (interactive)
+  (if eos::popup-mode
+      (setq global-popup-menu eos::saved-global-popup-menu)
+    (eos::push-popup-menu))
+  (setq eos::popup-mode (null eos::popup-mode))
+  )
+
+(defun eos::push-popup-menu ()
+  (setq eos::saved-global-popup-menu global-popup-menu)
+  (setq global-popup-menu
+	(append
+	 '("SPARCworks Command"
+	   ["Stop At" eos::stop-at t]
+	   ["Clear At" eos::clear-at t]
+	   ["Stop In" eos::stop-in t]
+	   ["Cont To" eos::cont-to t]
+	   ["Print" eos::print t]
+	   ["Print*" eos::print* t]
+	   "---"
+	   ["Read a Dbx Command" eos::dbx-cmd t]
+	   "---")
+	 (list
+	  eos::saved-global-popup-menu))
+	))
+
+(provide 'eos-debugger)
+
+;;; sun-eos-debugger.el ends here