;; workshop.el --- Allows for integration of workshop with emacs.

;;
;; Instructions:
;;
;; If you plan to launch emacs from workshop, then you do not need to
;; do anything unless you would like to customize the commands
;; or bindings (see Customizing below).
;;
;; In order to use invoke workshop from emacs, please add the following to
;; your .emacs file:
;;
;;   (setq load-path (append load-path '("/opt/SUNWspro/lib")))
;;   (load "workshop.el")
;;
;; Note that the path "/opt/SUNWspro/lib" is the path to the lib
;; directory of your workshop distribution.  
;;
;; Once your emacs comes up and you would like to launch workshop, simply
;; issue "M-x workshop-start" in the minibuffer.
;;
;; Function keys:
;;
;; When this file is loaded, the function keys are bound to workshop
;; commands.  If the user does not want workshop to bind the function
;; keys then, the variable eserve-bind-fkeys should be set to nil
;; before the load of the workshop file.  
;;
;; If the user would like to change the bindings, then this file
;; should be copied and edited as described below.
;;
;; Customizing: 
;;
;; In order to customize the behavior of the integration, the user
;; should copy the workshop.el file to the user's area and make the
;; desired edits to the copy of the file.  The lines pertaining
;; to workshop integration would look something like:
;;
;;   (setq load-path (append load-path '("/opt/SUNWspro/lib")))
;;   (load "/home/user1/elisp/workshop.el")
;;
;; where the "/home/user1/elisp" can be any location.  NOTE: the
;; setting of the load-path is still required in order for the
;; (require 'eserve) below to work.
;;

(require 'eserve)

(defvar workshop-process nil "process object for workshop process")
(defvar workshop-started nil "indicates whether workshop has been started/connected to")
(defvar workshop-path nil "indicates the path to the workshop binary, used to override use of PATH variable")

(defun workshop-check-connection ()
  "checks for connection between workshop and emacs, errors if no connection"
  (cond
   ((not workshop-started)
    (error "WorkShop is not connected to emacs, use M-x workshop-start to connect"))))
;;
;; command to launch workshop and connect emacs to it.
;; NOTE: workshop must be in the user's PATH variable.
;; 
(defun workshop-start ()
  "invokes workshop from emacs"
  (interactive)
  (cond
   ((or workshop-process workshop-started)
    (message "WorkShop has already been started - use M-x workshop-quit to bring it down")
    nil)
   (t
    (cond
     (workshop-path
      (cond 
       ((and (stringp workshop-path)
	     (file-executable-p workshop-path))
	(eserve-app-start workshop-path 'workshop-start-cb))
       (t
	(error "Cannot start WorkShop, bad value for workshop-path variable")
	nil)))
     (t
      (eserve-app-start "workshop" 'workshop-start-cb))))))

;;
;; command to quit workshop and disconnect from it.
;; 
(defun workshop-quit ()
  "quits workshop process from emacs"
  (interactive)
  (cond
   ((or workshop-process workshop-started)
    (workshop-exit-cleanup)
    (eserve-send-verb "workshop.quit" nil))
   (t
    (error "Cannot quit WorkShop, it has not been started.  Use M-x workshop-start"))))

;;
;; function to setup workshop function keys
;; NOTE: If the user would rather the fkeys be left alone,
;; then the variable eserve-bind-fkeys should be set to nil 
;; (before this file is loaded)
;;
(defun workshop-set-function-keys ()
  "sets up function key bindings to use for workshop functions"
  (global-set-key '[f3] 'workshop-build)
  (global-set-key '[f4] 'workshop-next-error)
  (global-set-key '[f5] 'workshop-next-match)
  (global-set-key '[f6] 'workshop-go)
  (global-set-key '[f7] 'workshop-step-over)
  (global-set-key '[f8] 'workshop-step-into)
  (global-set-key '[f9] 'workshop-up-stack)
  (cond
    (running-xemacs
     (global-set-key '[(shift f4)] 'workshop-prev-error)
     (global-set-key '[(shift f5)] 'workshop-prev-match)
     (global-set-key '[(shift f6)] 'workshop-restart)
     (global-set-key '[(shift f8)] 'workshop-step-out)
     (global-set-key '[(shift f9)] 'workshop-down-stack))
    (running-emacs
     (global-set-key '[S-f4] 'workshop-prev-error)
     (global-set-key '[S-f5] 'workshop-prev-match)
     (global-set-key '[S-f6] 'workshop-restart)
     (global-set-key '[S-f8] 'workshop-step-out)
     (global-set-key '[S-f9] 'workshop-down-stack))))

;;
;; Bind workshop fkeys if eserve-bind-fkeys is set
;;
(cond
 (eserve-bind-fkeys
  (workshop-set-function-keys)))

;;
;; User interactive commands
;;

(defun workshop-open-file ()
  "tells workshop to open a file on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "workshop.fileopen" nil))

(defun workshop-build ()
  "tells application to build the current target on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "build.build" nil))

(defun workshop-build-file ()
  "tells application to build the current file on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "build.build-file" nil))

(defun workshop-next-error ()
  "tells application to go to the next error in the error browser on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "build.next-error" nil))

(defun workshop-prev-error ()
  "tells application to go to the previous error in the error browser on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "build.prev-error" nil))

(defun workshop-next-match ()
  "tells application to go to the next match in the browser on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "browse.next-match" nil))

(defun workshop-prev-match ()
  "tells application to go to the previous match in the browser on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "browse.prev-match" nil))

(defun workshop-step-into ()
  "tells workshop to step into a function on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.step-into" nil))

(defun workshop-step-out ()
  "tells workshop to step out of a function on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.step-out" nil))

(defun workshop-step-over ()
  "tells workshop to step over an expression on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.step-over" nil))

(defun workshop-go ()
  "tells workshop to run/continue running the current program on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.go" nil))

(defun workshop-interrupt ()
  "tells workshop to stop running the current program on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.interrupt" nil))

(defun workshop-restart ()
  "tells workshop to restart the current program on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.restart" nil))

(defun workshop-up-stack ()
  "tells workshop to go to up one stack frame on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.up" nil))

(defun workshop-down-stack ()
  "tells workshop to go to down one stack frame on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.down" nil))

(defun workshop-pop-stack ()
  "tells workshop to pop one stack frame on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.pop" nil))

(defun workshop-pop2cur-stack ()
  "tells workshop to pop up to the current stack frame on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.pop-to-current" nil))

(defun workshop-stop-at ()
  "tells eserve to set a breakpoint on the current line on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (save-excursion
  (let ((file-name (buffer-file-name (current-buffer))))
    (cond
     (file-name
      (eserve-send-verb "debug.stop-at" t))
     (t 
      (error "Error: workshop-stop-at only works in buffers attached to files"))))))

(defun workshop-clear-at ()
  "tells eserve to clear the breakpoint on the current line on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (save-excursion
  (let ((file-name (buffer-file-name (current-buffer))))
    (cond
     (file-name
      (eserve-send-verb "debug.clear-at" t))
     (t 
      (error "Error: workshop-clear-at only works in buffers attached to files"))))))

(defun workshop-stop-in ()
  "tells eserve to set a breakpoint in function indicated in the current selection"
  (interactive)
  (workshop-check-connection)
  (let ((sel-text (eserve-current-selection))
	(sel-text-length 0)
	(message-string nil))
    (cond
     (sel-text
      (eserve-send-verb "debug.stop-in" t))
     (t 
      (error "Error: workshop-stop-in requires a selection")))))

(defun workshop-eval ()
  "tells eserve to evaluate the expression indicated in the current selection"
  (interactive)
  (workshop-check-connection)
  (save-excursion
  (let ((sel-text (eserve-current-selection)))
    (cond 
     (sel-text
      (eserve-send-verb "debug.evaluate-expr" t))
     (t 
      (error "Error: workshop-eval requires a selection"))))))

(defun workshop-eval-star ()
  "tells eserve to evaluate the expression (dereferenced) indicated in the current selection"
  (interactive)
  (workshop-check-connection)
  (save-excursion
  (let ((sel-text (eserve-current-selection)))
    (cond 
     (sel-text
      (eserve-send-verb "debug.evaluate-expr-star" t))
     (t 
      (error "Error: workshop-eval-star requires a selection"))))))

(defun workshop-browse-refs ()
  "tells workshop to find the browser references for the selection on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "browse.showrefs" t))

(defun workshop-browse-def ()
  "tells workshop to find the browser definition for the selection on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "browser.showdef" t))

(defun workshop-fix ()
  "tells workshop to fix the current file on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.fix" t))

(defun workshop-fix-all ()
  "tells workshop to fix all files on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.fix-all" nil))

(defun workshop-toggle-toolbar ()
  "toggles the state of the workshop toolbar"
  (interactive)
  (workshop-check-connection)
  (cond
   (running-xemacs
    (eserve-toggle-frame-toolbar (selected-frame)))
   (t
    (error "workshop-toggle-toolbar not available for GNU Emacs"))))

;;
;; Definitions for WorkShop menu
;;

(defvar workshop-menu-handle nil)
(defvar workshop-menu-object '[eservemenu "WorkShop" 0 nil nil])
(defvar workshop-start-button '[eservebutton "Start WorkShop"
					     "workshop.start"
					     nil
					     ""
					     nil
					     t
					     nil
					     nil
					     2
					     workshop-start])
(defvar workshop-quit-button '[eservebutton "Quit WorkShop"
					     "workshop.quit"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-quit])
(defvar workshop-build-button '[eservebutton "Current Target"
					     "build.build"
					     nil
					     ""
					     nil
					     t
					     nil
					     nil
					     2
					     workshop-build])
(defvar workshop-build-file-button '[eservebutton "Build This File"
					     "build.build-file"
					     t
					     ""
					     nil
					     t
					     nil
					     nil
					     2
					     workshop-build-file])
(defvar workshop-stop-at-button '[eservebutton "Stop At"
					     "debug.stop-at"
					     t
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-stop-at])
(defvar workshop-stop-in-button '[eservebutton "Stop In Selected"
					     "debug.stop-in"
					     t
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-stop-in])
(defvar workshop-clear-at-button '[eservebutton "Delete Breakpoint At"
					     "debug.clear-at"
					     t
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-clear-at])

(defvar workshop-prog-go-button '[eservebutton "Go"
					     "debug.go"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-go])
(defvar workshop-prog-interrupt-button '[eservebutton "Interrupt"
					     "debug.interrupt"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-interrupt])
(defvar workshop-prog-start-button '[eservebutton "Start"
					     "debug.restart"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-restart])
(defvar workshop-step-into-button '[eservebutton "Into"
					     "debug.step-into"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-step-into])
(defvar workshop-step-over-button '[eservebutton "Over"
					     "debug.step-over"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-step-over])
(defvar workshop-step-out-button '[eservebutton "Out"
					     "debug.step-out"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-step-out])
(defvar workshop-stack-up-button '[eservebutton "Up"
					     "debug.up"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-up-stack])
(defvar workshop-stack-down-button '[eservebutton "Down"
					     "debug.down"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-down-stack])
(defvar workshop-stack-pop-button '[eservebutton "Pop"
					     "debug.pop"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-pop-stack])
(defvar workshop-stack-pop2-button '[eservebutton "Pop to Current Frame"
					     "debug.pop-to-current"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-pop2cur-stack])
(defvar workshop-eval-button '[eservebutton "Selected"
					     "debug.evaluate-expr"
					     t
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-eval])
(defvar workshop-eval-star-button '[eservebutton "As Pointer"
					     "debug.evaluate-expr-star"
					     t
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-eval-star])
(defvar workshop-browse-refs-button '[eservebutton "References to Selected"
					     "browse.showrefs"
					     t
					     ""
					     nil
					     t
					     nil
					     nil
					     2
					     workshop-browse-refs])

(defvar workshop-browse-def-button '[eservebutton "Definition of Selected"
					     "browser.showdef"
					     t
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-browse-def])
(defvar workshop-prog-fix-button '[eservebutton "File"
					     "debug.fix"
					     t
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-fix])

(defvar workshop-prog-fix-all-button '[eservebutton "Program"
					     "debug.fix-all"
					     nil
					     ""
					     nil
					     nil
					     nil
					     nil
					     2
					     workshop-fix-all])

(defvar workshop-menu-kmap nil)
(defvar workshop-menu-build-kmap nil)
(defvar workshop-menu-fix-kmap nil)
(defvar workshop-menu-breakpts-kmap nil)
(defvar workshop-menu-program-kmap nil)
(defvar workshop-menu-step-kmap nil)
(defvar workshop-menu-stack-kmap nil)
(defvar workshop-menu-eval-kmap nil)
(defvar workshop-menu-browse-kmap nil)

;;
;; WorkShop menu creation functions
;;

(defun workshop-emacs-menu-create ()
  "adds the workshop menu to the emacs menu bar"
  (let ((quit-cmd nil)
	(handle (` [menu-bar (, (intern (eserve-menu-label workshop-menu-object))) ])))
    (setq workshop-menu-kmap (make-sparse-keymap 
			      (eserve-menu-label workshop-menu-object)))
    (define-key global-map handle 
      (cons (eserve-menu-label 
	     workshop-menu-object) workshop-menu-kmap))
    (setq workshop-menu-handle handle)

    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-quit-button 
				  workshop-menu-kmap)

    (define-key workshop-menu-kmap [separator1]
      '("----" . nil))

    (setq workshop-menu-fix-kmap (make-sparse-keymap "WorkShop Fix"))
    (fset 'workshop-menu-fix-kmap
	  (symbol-value 'workshop-menu-fix-kmap))
    (define-key workshop-menu-kmap [fix]
      '("Fix" . workshop-menu-fix-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-prog-fix-all-button 
				  workshop-menu-fix-kmap)

    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-prog-fix-button 
				  workshop-menu-fix-kmap)

    (setq workshop-menu-browse-kmap (make-sparse-keymap "WorkShop Browse"))
    (fset 'workshop-menu-browse-kmap
	  (symbol-value 'workshop-menu-browse-kmap))
    (define-key workshop-menu-kmap [browse]
      '("Browse" . workshop-menu-browse-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-browse-def-button 
				  workshop-menu-browse-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-browse-refs-button 
				  workshop-menu-browse-kmap)

    (setq workshop-menu-eval-kmap (make-sparse-keymap "WorkShop Eval"))
    (fset 'workshop-menu-eval-kmap
	  (symbol-value 'workshop-menu-eval-kmap))
    (define-key workshop-menu-kmap [eval]
      '("Eval" . workshop-menu-eval-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-eval-star-button 
				  workshop-menu-eval-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-eval-button 
				  workshop-menu-eval-kmap)

    (setq workshop-menu-stack-kmap (make-sparse-keymap "WorkShop Stack"))
    (fset 'workshop-menu-stack-kmap
	  (symbol-value 'workshop-menu-stack-kmap))
    (define-key workshop-menu-kmap [stack]
      '("Stack" . workshop-menu-stack-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-stack-down-button 
				  workshop-menu-stack-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-stack-up-button 
				  workshop-menu-stack-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-stack-pop-button 
				  workshop-menu-stack-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-stack-pop2-button 
				  workshop-menu-stack-kmap)

    (setq workshop-menu-step-kmap (make-sparse-keymap "WorkShop Step"))
    (fset 'workshop-menu-step-kmap
	  (symbol-value 'workshop-menu-step-kmap))
    (define-key workshop-menu-kmap [step]
      '("Step" . workshop-menu-step-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-step-out-button 
				  workshop-menu-step-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-step-over-button 
				  workshop-menu-step-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-step-into-button 
				  workshop-menu-step-kmap)

    (setq workshop-menu-program-kmap (make-sparse-keymap "WorkShop Program"))
    (fset 'workshop-menu-program-kmap
	  (symbol-value 'workshop-menu-program-kmap))
    (define-key workshop-menu-kmap [program]
      '("Program" . workshop-menu-program-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-prog-interrupt-button 
				  workshop-menu-program-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-prog-go-button 
				  workshop-menu-program-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-prog-start-button 
				  workshop-menu-program-kmap)

    (setq workshop-menu-breakpts-kmap 
	  (make-sparse-keymap "WorkShop Breakpoints"))
    (fset 'workshop-menu-breakpts-kmap
	  (symbol-value 'workshop-menu-breakpts-kmap))
    (define-key workshop-menu-kmap [breakpoints]
      '("Breakpoints" . workshop-menu-breakpts-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-clear-at-button 
				  workshop-menu-breakpts-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-stop-in-button 
				  workshop-menu-breakpts-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-stop-at-button 
				  workshop-menu-breakpts-kmap)

    (setq workshop-menu-build-kmap (make-sparse-keymap "WorkShop Build"))
    (fset 'workshop-menu-build-kmap
	  (symbol-value 'workshop-menu-build-kmap))
    (define-key workshop-menu-kmap [build]
      '("Build" . workshop-menu-build-kmap))
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-build-file-button 
				  workshop-menu-build-kmap)
    (eserve-emacs-menuitem-create workshop-menu-object
				  workshop-build-button 
				  workshop-menu-build-kmap)

    ;; create workshop start menu item by hand
    (setq menu-bar-final-items (append 
				(list 
				 (intern 
				  (eserve-menu-label workshop-menu-object)))
				menu-bar-final-items))))

(defun workshop-emacs-menu-remove ()
  "removes the workshop menu from the emacs menu bar"
  (cond
   (workshop-menu-kmap
    (global-unset-key workshop-menu-handle)
    (setq menu-bar-final-items 
	  (delete (intern (eserve-menu-label workshop-menu-object))
		  menu-bar-final-items)))))

(defun workshop-emacs-add-start-menuitem ()
  "adds the start workshop menu item to the tools menu"
  (cond 
   ((boundp 'menu-bar-tools-menu)
    (define-key menu-bar-tools-menu (` [ (, (intern (eserve-button-label workshop-start-button))) ])
      (` ( (, (eserve-button-label workshop-start-button)) 
	   (, (eserve-button-help workshop-start-button)) .
	   (, (eserve-button-cmd workshop-start-button)))))

    (eserve-set-button-sensesym workshop-start-button
	    (eserve-button-create-sensesym workshop-start-button 
				 (eserve-menu-label workshop-menu-object)))
    (set (eserve-button-sensesym workshop-start-button) 
       (eserve-button-sense workshop-start-button))
    (put  (eserve-button-cmd workshop-start-button)
	'menu-enable (eserve-button-sensesym workshop-start-button)))))

(defun workshop-xemacs-menu-create ()
  "adds the workshop menu to the emacs menu bar"
  (let ((handle (list (eserve-menu-label workshop-menu-object)))
	(menulist nil)
	(buildlist nil)
	(steplist nil)
	(breaklist nil)
	(proglist nil)
	(stacklist nil)
	(evallist nil)
	(browselist nil)
	(fixlist nil)
	(start-item nil)
	(quit-item nil))

    (setq workshop-menu-handle handle)

    (setq buildlist (list 
		     "Build"
		     (eserve-xemacs-menuitem-create workshop-menu-object
						    workshop-build-button)
		     (eserve-xemacs-menuitem-create workshop-menu-object
						    workshop-build-file-button) ))
    (setq breaklist (list 
		     "Breakpoints"
		     (eserve-xemacs-menuitem-create workshop-menu-object
						    workshop-stop-at-button)
		     (eserve-xemacs-menuitem-create workshop-menu-object
						    workshop-stop-in-button)
		     (eserve-xemacs-menuitem-create workshop-menu-object
						    workshop-clear-at-button)))
    (setq proglist (list 
		    "Program"
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-prog-start-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-prog-go-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-prog-interrupt-button)))
    (setq steplist (list 
		    "Step"
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-step-into-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-step-over-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-step-out-button)))

    (setq stacklist (list 
		    "Stack"
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-stack-up-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-stack-down-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-stack-pop-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-stack-pop2-button)))

    (setq evallist (list 
		    "Evaluate"
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-eval-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-eval-star-button)))
    (setq browselist (list 
		    "Browse"
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-browse-refs-button)
		    (eserve-xemacs-menuitem-create workshop-menu-object
						   workshop-browse-def-button)))

    (setq fixlist (list
		   "Fix"
		   (eserve-xemacs-menuitem-create workshop-menu-object
						  workshop-prog-fix-button)
		   (eserve-xemacs-menuitem-create workshop-menu-object
						  workshop-prog-fix-all-button)))

    (setq quit-item (eserve-xemacs-menuitem-create workshop-menu-object
						 workshop-quit-button))

    (setq menulist (list buildlist breaklist proglist
			 steplist stacklist evallist browselist fixlist
			 "----" quit-item))

    (mapcar '(lambda (buff) 
	       (save-excursion
		 (set-buffer buff)
		 (add-submenu 
		  nil
		  (cons (eserve-menu-label workshop-menu-object) menulist))))
	    (buffer-list))))

(defun workshop-xemacs-menu-remove ()
  "removes the workshop menu from the xemacs menu bar"
  (cond
   ((car (find-menu-item current-menubar
			 (list (eserve-menu-label workshop-menu-object))))
    (mapcar '(lambda (buff)
	       (save-excursion
		 (set-buffer buff)
		 (delete-menu-item workshop-menu-handle)))
	    (buffer-list)))))

(defun workshop-xemacs-add-start-menuitem ()
  "adds the start workshop menu item to the tools menu"

  (eserve-xemacs-menuitem-create workshop-menu-object
				 workshop-start-button)
  (add-menu-button
   '("Tools")
   (vector
    "Start WorkShop" 'workshop-start
    (eserve-button-sensesym workshop-start-button) nil) 
   "Grep..."))

;;
;; WorkShop process functions
;;


(defun workshop-process-sentinel (process status)
  "Handles changes in status to WORKSHOP process."
  (cond
   ((memq (process-status process) '(signal exit closed))
    (workshop-exit-cleanup)
    (setq workshop-process nil)
    (message (format "Connection to workshop terminated")))))

(defun workshop-start-cb (proc)
  "callback for start of workshop process"
  (workshop-startup-init)
  (setq workshop-process proc)
  (set-process-sentinel workshop-process 'workshop-process-sentinel))

(defun workshop-startup-init ()
  "setup emacs after workshop starts it"
  (setq workshop-started t)
  ;; add workshop menu
  (workshop-menu-create)
  ;; enable workshop-quit, disable workshop-start
  (cond 
   ((eserve-button-sensesym workshop-start-button)
    (set (eserve-button-sensesym workshop-start-button) nil)))
  (cond 
   ((eserve-button-sensesym workshop-quit-button)
    (set (eserve-button-sensesym workshop-quit-button) t)))
  (cond 
   (running-xemacs
    (workshop-update-default-toolbar))))

(defun workshop-exit-cleanup ()
  "cleanup after workshop exit"
  (setq workshop-started nil)
  ;; remove workshop menu
  (workshop-menu-remove)
  ;; enable workshop-start, disable workshop-quit
  (cond 
   ((eserve-button-sensesym workshop-start-button)
    (set (eserve-button-sensesym workshop-start-button) t)))
  (cond
   ((eserve-button-sensesym workshop-quit-button)
    (set (eserve-button-sensesym workshop-quit-button) nil)))
  (cond 
   (running-xemacs
    (workshop-update-default-toolbar))))

(defvar toolbar-workshop-icon nil "A `workshop' icon set.")

(defun workshop-update-default-toolbar ()
  "update the default toolbar with changes to workshop buttons"
   (set-specifier default-toolbar  (specifier-instance default-toolbar)))

(defun workshop-frob-toolbar ()
  "Replace Debug and Compile toolbar buttons with WorkShop buttons"
  (when (and (featurep 'xpm) 
	     (featurep 'toolbar)
	     (consp (specifier-instance default-toolbar)))
    (let ((prefix (expand-file-name "workshop" toolbar-icon-directory)))
      (setq toolbar-workshop-icon
            (toolbar-make-button-list
             (concat prefix "-up.xpm")
             nil
             (concat prefix "-xx.xpm")
             (concat prefix "-cap-up.xpm")
             nil
             (concat prefix "-cap-xx.xpm"))))
    ;; Destructively alter the default toolbar to:
    ;; - remove the debug and compile button
    ;; - add the workshop button, preferably before info.
    (let* ((toolbar-buttons (specifier-instance default-toolbar))
           (buttons toolbar-buttons)
	   (workshop-button
	    (vector
	     'toolbar-workshop-icon
	     'workshop-start
	     (eserve-button-sensesym workshop-start-button)
	     "Start Sunsoft WorkShop"))
           (added-p nil)
           fun)
      ;; Remove obsolete buttons
      (while buttons
        (setq fun (aref (car buttons) 1))
        (if (eq fun 'workshop-start)
            (setq added-p t))
        (if  (or (eq fun 'toolbar-debug)
                 (eq fun 'toolbar-compile))
            (progn
              (setcar buttons (car-safe (cdr buttons)))
              (setcdr buttons (cdr-safe (cdr buttons))))
          (setq buttons (cdr buttons))))

      ;; Add workshop button, if not already there
      (when (null added-p)
        (setq buttons toolbar-buttons)
        (while (not (or (eq (aref (car buttons) 1) 'toolbar-info)
                        (null (cdr buttons))))
          (setq buttons (cdr buttons)))
        ;; insert workshop button
        (setcdr buttons (cons (car buttons) (cdr buttons)))
        (setcar buttons workshop-button))
      
      (set-specifier default-toolbar toolbar-buttons))))

(cond
 (running-emacs
  (workshop-emacs-add-start-menuitem)
  (defalias 'workshop-menu-create 'workshop-emacs-menu-create)
  (defalias 'workshop-menu-remove 'workshop-emacs-menu-remove))
 (running-xemacs 
  (workshop-xemacs-add-start-menuitem)
  (workshop-frob-toolbar)
  (defalias 'workshop-menu-create 'workshop-xemacs-menu-create)
  (defalias 'workshop-menu-remove 'workshop-xemacs-menu-remove)))

(provide 'workshop)  ;Announce that we're providing the package 'workshop'.

;;; workshop.el ends here
