;; 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 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 loading this 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 ()
  "Check for connection between workshop and emacs, error if no connection"
  (unless workshop-started
    (error "WorkShop is not connected to emacs, use M-x workshop-start to connect")))

;; Suppress compiler warnings
(eval-when-compile
  (require 'eserve)
  ;; GNU Emacs-specific variables
  (defvar menu-bar-final-items)
  (defvar menu-bar-tools-menu))

;;
;; command to launch workshop and connect emacs to it.
;; NOTE: workshop must be in the user's PATH variable.
;;
(defun workshop-start ()
  "Invoke workshop from emacs"
  (interactive)
  (when (or workshop-process workshop-started)
    (error "WorkShop has already been started - use M-x workshop-quit to bring it down"))
  (eserve-app-start
   (if (not workshop-path)
       "workshop"
     (if (and (stringp workshop-path) (file-executable-p workshop-path))
	 workshop-path
       (error "Cannot start WorkShop, bad value for workshop-path variable")))
   'workshop-start-cb))

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

;;
;; 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 ()
  "Set up function key bindings to use for workshop functions"
  (when eserve-bind-fkeys
    (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)))))
  
;;
;; User interactive commands
;;

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

(defun workshop-project-add-file ()
  "Tell WorkShop to add the current file to the project"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "workset.addfile" nil))

(defun workshop-project-remove-file ()
  "Tell WorkShop to remove the current file from the project"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "workset.removefile" nil))

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

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

(defun workshop-next-error ()
  "Tell WorkShop 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 ()
  "Tell WorkShop 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 ()
  "Tell WorkShop 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 ()
  "Tell WorkShop 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 ()
  "Tell 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 ()
  "Tell 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 ()
  "Tell WorkShop to step over an expression on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.step-over" nil))

(defun workshop-go ()
  "Tell 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 ()
  "Tell WorkShop to stop running the current program on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.interrupt" nil))

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

(defun workshop-up-stack ()
  "Tell 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 ()
  "Tell 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 ()
  "Tell WorkShop to pop one stack frame on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.pop" nil))

(defun workshop-pop2cur-stack ()
  "Tell 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 ()
  "Tell eserve to set a breakpoint on the current line on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.stop-at" t))

(defun workshop-clear-at ()
  "Tell eserve to clear the breakpoint on the current line on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.clear-at" t))

(defun workshop-stop-in ()
  "Tell eserve to set a breakpoint in function indicated in the current selection"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.stop-in" t))

(defun workshop-disable-at ()
  "Tell eserve to disable breakpoints on the current line on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.disable-at" t))

(defun workshop-enable-at ()
  "Tell eserve to enable breakpoints on the current line on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.enable-at" t))

(defun workshop-eval ()
  "Tell eserve to evaluate the expression indicated in the current selection"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.evaluate-expr" t))

(defun workshop-eval-star ()
  "Tell eserve to evaluate the expression (dereferenced) indicated in the current selection"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.evaluate-expr-star" t))

(defun workshop-browse-refs ()
  "Tell WorkShop to find the browser references for the selection on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  ;; ### Should be checking for selection here and below. -- mrb
  (eserve-send-verb "browse.showrefs" t))

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

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

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

(defun workshop-reload ()
  "Tell eserve's debugger to terminate and reload the current program on behalf of emacs"
  (interactive)
  (workshop-check-connection)
  (eserve-send-verb "debug.reload" nil))

;;; Toolbar menu button support
(defun workshop-toolbar-invisible ()
  "Make the WorkShop toolbar invisible."
  (interactive)
  (setq eserve-toolbar-orientation nil)
  (eserve-set-toolbar-specifiers))

(defun workshop-toolbar-left ()
  "Place the WorkShop toolbar on the left edge of the frame."
  (interactive)
  (setq eserve-toolbar-orientation 'left)
  (eserve-set-toolbar-specifiers)
  (eserve-install-frame-toolbar (selected-frame)))

(defun workshop-toolbar-right ()
  "Place the WorkShop toolbar on the right edge of the frame."
  (interactive)
  (setq eserve-toolbar-orientation 'right)
  (eserve-set-toolbar-specifiers)
  (eserve-install-frame-toolbar (selected-frame)))

(defun workshop-toolbar-top ()
  "Place the WorkShop toolbar on the top edge of the frame."
  (interactive)
  (setq eserve-toolbar-orientation 'top)
  (eserve-set-toolbar-specifiers)
  (eserve-install-frame-toolbar (selected-frame)))

(defun workshop-toolbar-bottom ()
  "Place the WorkShop toolbar on the bottom edge of the frame."
  (interactive)
  (setq eserve-toolbar-orientation 'bottom)
  (eserve-set-toolbar-specifiers)
  (eserve-install-frame-toolbar (selected-frame)))

;;
;; Definitions for WorkShop menu
;;
;; See eserve.el for definition of the eserve-button vector type
;; The `sense' member in the following buttons is only the initial setting,
;; the setting is toggled from eserve `eserve-set-sensitivity'.
;; Note: there is duplicated code here.  Properties of workshop buttons are
;; defined here, in eserve.el, and in IPEEditorControl.cc.

(defvar workshop-menu-handle nil)
(defvar workshop-menu [eserve-menu "WorkShop" 0 nil nil])
(defvar workshop-start-button
  [eserve-button "Start WorkShop" "workshop.start"
		 nil "" nil t nil nil 2 workshop-start])
(defvar workshop-quit-button
  [eserve-button "Quit WorkShop" "workshop.quit"
		 nil "" nil nil nil nil 2 workshop-quit])
(defvar workshop-project-add-button
  [eserve-button "Add This File" "workset.addfile"
		 nil "" nil t nil nil 2 workshop-project-add-file])
(defvar workshop-project-remove-button
  [eserve-button "Remove This File" "workset.removefile"
		 t "" nil t nil nil 2 workshop-project-remove-file])
(defvar workshop-build-button
  [eserve-button "Current Target" "build.build"
		 nil "" nil t nil nil 2 workshop-build])
(defvar workshop-build-file-button
  [eserve-button "Build This File" "build.build-file"
		 t "" nil t nil nil 2 workshop-build-file])
(defvar workshop-stop-at-button
  [eserve-button "Stop At" "debug.stop-at"
		 t "" nil nil nil nil 2 workshop-stop-at])
(defvar workshop-stop-in-button
  [eserve-button "Stop In Selected" "debug.stop-in"
		 t "" nil nil nil nil 2 workshop-stop-in])
(defvar workshop-clear-at-button
  [eserve-button "Delete Breakpoint At" "debug.clear-at"
		 t "" nil nil nil nil 2 workshop-clear-at])
(defvar workshop-prog-go-button
  [eserve-button "Continue" "debug.go"
		 nil "" nil nil nil nil 2 workshop-go])
(defvar workshop-prog-interrupt-button
  [eserve-button "Interrupt" "debug.interrupt"
		 nil "" nil nil nil nil 2 workshop-interrupt])
(defvar workshop-prog-start-button
  [eserve-button "Start" "debug.restart"
		 nil "" nil nil nil nil 2 workshop-restart])
(defvar workshop-step-into-button
  [eserve-button "Into" "debug.step-into"
		 nil "" nil nil nil nil 2 workshop-step-into])
(defvar workshop-step-over-button
  [eserve-button "Over" "debug.step-over"
		 nil "" nil nil nil nil 2 workshop-step-over])
(defvar workshop-step-out-button
  [eserve-button "Out" "debug.step-out"
		 nil "" nil nil nil nil 2 workshop-step-out])
(defvar workshop-stack-up-button
  [eserve-button "Up" "debug.up"
		 nil "" nil nil nil nil 2 workshop-up-stack])
(defvar workshop-stack-down-button
  [eserve-button "Down" "debug.down"
		 nil "" nil nil nil nil 2 workshop-down-stack])
(defvar workshop-stack-pop-button
  [eserve-button "Pop" "debug.pop"
		 nil "" nil nil nil nil 2 workshop-pop-stack])
(defvar workshop-stack-pop2-button
  [eserve-button "Pop to Current Frame" "debug.pop-to-current"
		 nil "" nil nil nil nil 2 workshop-pop2cur-stack])
(defvar workshop-eval-button
  [eserve-button "Selected" "debug.evaluate-expr"
		 t "" nil nil nil nil 2 workshop-eval])
(defvar workshop-eval-star-button
  [eserve-button "As Pointer" "debug.evaluate-expr-star"
		 t "" nil nil nil nil 2 workshop-eval-star])
(defvar workshop-browse-refs-button
  [eserve-button "References to Selected" "browse.showrefs"
		 t "" nil t nil nil 2 workshop-browse-refs])
(defvar workshop-browse-def-button
  [eserve-button "Definition of Selected" "browse.showdef"
		 t "" nil nil nil nil 2 workshop-browse-def])
(defvar workshop-prog-fix-button
  [eserve-button "File" "debug.fix"
		 t "" nil nil nil nil 2 workshop-fix])
(defvar workshop-prog-fix-all-button
  [eserve-button "Program" "debug.fix-all"
		 nil "" nil nil nil nil 2 workshop-fix-all])
(defvar workshop-toolbar-invisible-button
  [eserve-button "Invisible" "toolbar.invisible"
		 nil "" nil t nil nil 2 workshop-toolbar-invisible])
(defvar workshop-toolbar-left-button
  [eserve-button "Left" "toolbar.left"
		 nil "" nil t nil nil 2 workshop-toolbar-left])
(defvar workshop-toolbar-top-button
  [eserve-button "Top" "toolbar.top"
		 nil "" nil t nil nil 2 workshop-toolbar-top])
(defvar workshop-toolbar-right-button
  [eserve-button "Right" "toolbar.right"
		 nil "" nil t nil nil 2 workshop-toolbar-right])
(defvar workshop-toolbar-bottom-button
  [eserve-button "Bottom" "toolbar.bottom"
		 nil "" nil t nil nil 2 workshop-toolbar-bottom])

(defvar workshop-menu-kmap nil)
(defvar workshop-menu-project-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 ()
  "Add the workshop menu to the emacs menu bar"
  (let ((handle `[menu-bar ,(intern (eserve-menu-label workshop-menu)) ]))
    (setq workshop-menu-kmap (make-sparse-keymap
			      (eserve-menu-label workshop-menu)))
    (define-key global-map handle
      (cons (eserve-menu-label
	     workshop-menu) workshop-menu-kmap))
    (setq workshop-menu-handle handle)

    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-prog-fix-all-button
				  workshop-menu-fix-kmap)

    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-browse-def-button
				  workshop-menu-browse-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-eval-star-button
				  workshop-menu-eval-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-stack-down-button
				  workshop-menu-stack-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-stack-up-button
				  workshop-menu-stack-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-stack-pop-button
				  workshop-menu-stack-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-step-out-button
				  workshop-menu-step-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-step-over-button
				  workshop-menu-step-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-prog-interrupt-button
				  workshop-menu-program-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-prog-go-button
				  workshop-menu-program-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-clear-at-button
				  workshop-menu-breakpts-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-stop-in-button
				  workshop-menu-breakpts-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  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
				  workshop-build-file-button
				  workshop-menu-build-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-build-button
				  workshop-menu-build-kmap)

    (setq workshop-menu-project-kmap (make-sparse-keymap "WorkShop Project"))
    (fset 'workshop-menu-project-kmap
	  (symbol-value 'workshop-menu-project-kmap))
    (define-key workshop-menu-kmap [project]
      '("Project" . workshop-menu-project-kmap))
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-project-add-button
				  workshop-menu-project-kmap)
    (eserve-emacs-menuitem-create workshop-menu
				  workshop-project-remove-button
				  workshop-menu-project-kmap)

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

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

(defun workshop-emacs-add-start-menuitem ()
  "Add the start workshop menu item to the tools menu"
  (when (boundp 'menu-bar-tools-menu)
    (define-key menu-bar-tools-menu
      (vector (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)))

    (setf (eserve-button-sensesym workshop-start-button)
	  (eserve-button-create-sensesym
	   workshop-start-button (eserve-menu-label workshop-menu)))
    (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-submenu (&rest buttons)
  (mapcar #'(lambda (button)
	      (eserve-xemacs-menuitem-create workshop-menu button))
	  buttons))

(defun workshop-xemacs-menu-create ()
  "Add the workshop menu to the emacs menu bar"
  (let ((menulist
	 `(("Project"
	    ,@(workshop-xemacs-submenu
	       workshop-project-add-button
	       workshop-project-remove-button))
	   ("Build"
	    ,@(workshop-xemacs-submenu
	       workshop-build-button
	       workshop-build-file-button))
	   ("Breakpoints"
	    ,@(workshop-xemacs-submenu
	       workshop-stop-at-button
	       workshop-stop-in-button
	       workshop-clear-at-button))
	   ("Program"
	    ,@(workshop-xemacs-submenu
	       workshop-prog-start-button
	       workshop-prog-go-button
	       workshop-prog-interrupt-button))
	   ("Step"
	    ,@(workshop-xemacs-submenu
	       workshop-step-into-button
	       workshop-step-over-button
	       workshop-step-out-button))
	   ("Stack"
	    ,@(workshop-xemacs-submenu
	       workshop-stack-up-button
	       workshop-stack-down-button
	       workshop-stack-pop-button
	       workshop-stack-pop2-button))
	   ("Evaluate"
	    ,@(workshop-xemacs-submenu
	       workshop-eval-button
	       workshop-eval-star-button))
	   ("Browse"
	    ,@(workshop-xemacs-submenu
	       workshop-browse-refs-button
	       workshop-browse-def-button))
	   ("Fix"
	    ,@(workshop-xemacs-submenu
	       workshop-prog-fix-button
	       workshop-prog-fix-all-button))
;;; To disable the `Toolbar' menu, comment out the following form:
	   ,@(if (featurep 'toolbar)
		 `(("Toolbar"
		    ,@(workshop-xemacs-submenu
		       workshop-toolbar-left-button
		       workshop-toolbar-top-button
		       workshop-toolbar-right-button
		       workshop-toolbar-bottom-button
		       workshop-toolbar-invisible-button))))
	   "----"
	   ,(eserve-xemacs-menuitem-create workshop-menu
					   workshop-quit-button))))

    (setq workshop-menu-handle (list (eserve-menu-label workshop-menu)))

    (save-excursion
      (dolist (buffer (buffer-list))
	(set-buffer buffer)
	(add-submenu
	 nil
	 (cons (eserve-menu-label workshop-menu) menulist))))))

(defun workshop-xemacs-menu-remove ()
  "Remove the workshop menu from the xemacs menu bar"
  (when (car (find-menu-item current-menubar
			     (list (eserve-menu-label workshop-menu))))
    (save-excursion
      (dolist (buffer (buffer-list))
	(set-buffer buffer)
	(delete-menu-item workshop-menu-handle)))))

(defun workshop-xemacs-add-start-menuitem ()
  "Add the start workshop menu item to the tools menu"
  (eserve-xemacs-menuitem-create workshop-menu 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)
  "Handle changes in STATUS to workshop PROCESS."
  (when (memq (process-status process) '(signal exit closed))
    (workshop-exit-cleanup)
    (setq workshop-process nil)
    (message "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
  (when (eserve-button-sensesym workshop-start-button)
    (set (eserve-button-sensesym workshop-start-button) nil))
  (when (eserve-button-sensesym workshop-quit-button)
    (set (eserve-button-sensesym workshop-quit-button) t))
  (when 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
  (when (eserve-button-sensesym workshop-start-button)
    (set (eserve-button-sensesym workshop-start-button) t))
  (when (eserve-button-sensesym workshop-quit-button)
    (set (eserve-button-sensesym workshop-quit-button) nil))
  (when 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 the `Start WorkShop' button."
  (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"))))
    ;; Remove the (non-WorkShop) debug and compile button from the toolbar
    (let ((buttons (specifier-instance default-toolbar)))
      (setq buttons
	    (delete-if
	     (lambda (button)
	       (memq (aref button 1) '(toolbar-debug toolbar-compile)))
	     buttons))

      ;; Add workshop button, if not already there
      (unless (find-if (lambda (button) (eq (aref button 1) 'workshop-start))
		       buttons)
	(setq buttons
	      (append buttons
		      `([toolbar-workshop-icon
			 workshop-start
			 ,(eserve-button-sensesym workshop-start-button)
			 "Start Sun WorkShop"]))))

      (set-specifier default-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