;; eserve.el --- Implements Emacs side of EditServer-Emacs interface.

;; Copyright (C) 09/30/96  Sun Microsystems, Inc.

;; Created:     July 1994
;; Version:     1.109
;; Header:      @(#) eserve.el: v1.109 96/10/15 20:52:06

;; Keywords:    Edit Server GNU Emacs XEmacs integation

;;; To Do:

;;
;; User settable variables
;;

;; NOTE: If the user would rather the fkeys be left alone,
;; then the variable eserve-bind-fkeys should be set to nil (before
;; the application elisp files are loaded)
;;
(defvar eserve-bind-fkeys t "if t, add bindings for function keys")
(defvar eserve-path nil "indicates the path to the eserve binary, used to override use of PATH variable")

;;
;; %%%%%%%%%%%%%%%%%%%%%%% user section ends %%%%%%%%%%%%%%%%%%%
;;

(require 'cl)                           ;Common Lisp compatibility

;;
;; Global variables
;;
;; Create and initilaize global variables
;;
(defvar eserve-connection nil "eserve process object")
(defvar eserve-app-name nil "name of application attached to emacs")
(defvar eserve-app-cb nil "fn to call after application launched")
(defvar eserve-started-by-emacs nil "if t, eserve started from emacs")
(defvar eserve-protocol-version 2 "Version of the protocol to eserve")

;; Determine whether we are running GNU Emacs v19 or XEmacs.
(defvar running-xemacs nil "t if we're running XEmacs")
(defvar running-emacs  nil "t if we're running GNU Emacs 19")

(if (string-match "^\\(19\\|20\\)\..*\\(XEmacs\\|Lucid\\)" emacs-version)
    (setq running-xemacs t)
    (setq running-emacs  t))

;; We need to use prime numbers here (e.g. 127, 509, ...) to reduce the likeli-
;; hood of collisions.
(defvar eserve-buffers-marks-size 127 "Initial size of buffers-mark vectors list")
(defvar eserve-mark-vector-chunk  127 "Size of eserve-mark-vector chunk")
(defvar eserve-buffers-marks-list
  (make-hash-table :test 'eq :size eserve-buffers-marks-size) 
  "Hash table containing buffers and their associated mark vectors")

(defvar eserve-message-leftover nil "contains partial message saved across buffer sends from eserve")

(defvar eserve-mark-type-list nil "the list of mark types which describe the visible properties of a mark")

(defvar eserve-current-toolbar nil "The current ESERVE toolbar")
(defvar eserve-toolbar-icon-height 25 "height of toolbar icons")

(defvar eserve-frame-previous-toolbar-alist nil "list of frames and toolbar info")

(defvar eserve-toolbar-table nil 
"A vector of vectors which holds the descriptions of toolbar items.
Each toolbar items comprises

 0  file..........(string) the pixmap filename
 1  verb..........(string) the verb (action) to be performed
 2  help..........(string) the help text to display when over the icon
 3  needsFilePos..(boolean) indicates if file position should also be sent
                            with the verb 
 4  offset........(integer) the spacing (in pixels) to the previous icon
                            or edge.  This is treated as a hint by Emacs and
                            may be rounded up or down modulo
                            pixels/default-character-width.
 5  label.........(string) a label to use if an icon can't be created.")

(defvar eserve-startup-file nil "file contains code to connect app/emacs")
(defvar eserve-startup-envvar "SPRO_EDITOR_RENDEZVOUS_FILE" "env var whose value indicates the startup file")

(defvar eserve-menus nil "list of app-defined menus")
(defvar eserve-verb-hash-size 127 "initial size of eserve-verb-button-hash table")
(defvar eserve-verb-button-hash 
  (make-hash-table :test 'equal :size eserve-verb-hash-size) 
  "Hash table containing verb strings and their associated buttons")

(defvar eserve-save-verbs '("build.build" "build.build-file" 
			    "debug.fix" "debug.fix-all"))

;;
;; Debugging and tracing
;; 
(defvar eserve-log-buffer nil "log for eserve/emacs message traffic")
(cond 
 ((getenv "HB_DEBUG") 
  (setq debug-on-error t)
  (setq eserve-log-buffer (get-buffer-create " *eserve-log*"))))

(defun eserve-log-text (string)
  (cond 
   ((and eserve-log-buffer
	(buffer-name eserve-log-buffer))
    (save-excursion
      (set-buffer eserve-log-buffer) 
      (goto-char (point-max))
      (insert string)))))

;;
;; eserve initialization
;;
(defun eserve-init ()
  "Initializes Emacs for communication with ESERVE.  This function is called from
the command line which invokes Emacs."
  (eserve-log-text (format "%s started.\n" emacs-version))
  (eserve-log-text (format "%s\n" command-line-args))

  ;; GNU Emacs 19 - XEmacs compatibility
  (unless (fboundp 'raise-frame) (fset 'raise-frame 'raise-screen))
  (unless (fboundp 'window-frame) (fset 'window-frame 'window-screen))

  ;; Choose the correct overlay-or-extent creation & deletion functions.
  (when running-xemacs
    (defalias 'eserve-set-menus 'eserve-xemacs-set-menus)
    (defalias 'eserve-add-menu 'eserve-xemacs-add-menu)
    (defalias 'eserve-delete-menus 'eserve-xemacs-delete-menus)
    (defalias 'eserve-create-overlay-or-extent 'eserve-xemacs-create-extent)
    (defalias 'eserve-delete-overlay-or-extent 'eserve-xemacs-delete-extent)
    (defalias 'eserve-set-overlay-or-extent    'eserve-xemacs-set-extent)
    (setq find-file-compare-truenames t))
  (when running-emacs
    (defalias 'eserve-set-menus 'eserve-emacs-set-menus)
    (defalias 'eserve-add-menu 'eserve-emacs-add-menu)
    (defalias 'eserve-delete-menus 'eserve-emacs-delete-menus)
    (defalias 'eserve-create-overlay-or-extent 'eserve-emacs-create-overlay)
    (defalias 'eserve-delete-overlay-or-extent 'eserve-emacs-delete-overlay)
    (defalias 'eserve-set-overlay-or-extent    'eserve-emacs-set-overlay))

  ;; Create a new face with which to highlight errors, etc.
  (copy-face 'default 'eserve-highlight)

  (eserve-xpm-setup)
  (eserve-vc-setup)

;; load startup file if it exists
  (let ((startup-file nil))
    (cond
     ((setq eserve-startup-file (getenv eserve-startup-envvar))
      (eserve-load-startup-file)
      (setenv eserve-startup-envvar nil)))))
      
;;
;; eserve process communication functions
;;

(defun eserve-connection-filter (process output)
  "Handles output from eserve process."
  (if eserve-connection
      (set-process-filter eserve-connection t))
  (unwind-protect
      (condition-case err-msg
	  (progn
	    (eserve-log-text (format "%s" output))
	    (eserve-eval-cmds output))
	(error
	 (progn
	   (message (format "Error: %s - occurred during eserve msg evaluation" err-msg))
	   (eserve-log-text (format "Error: %s - occurred during eserve msg evaluation\n" err-msg)))))
    (if eserve-connection
	(set-process-filter eserve-connection 'eserve-connection-filter)))
  (if eserve-connection 
      (set-process-filter eserve-connection 'eserve-connection-filter)))

(defun eserve-connection-sentinel (process status)
  "Handles changes in status to ESERVE process."
  (cond
   ((memq (process-status process) '(signal exit closed))
    (message (format "Connection to edit server terminated"))
    (eserve-connection-cleanup)
    (eserve-cleanup))))

(defun eserve-connection-cleanup ()
  "Cleans up after ESERVE connection is broken"
  (setq eserve-connection nil))

(defun eserve-cleanup ()
  "Cleans up ESERVE related information"
  (eserve-clear-all-marks)
  (remove-hook 'kill-buffer-hook 'eserve-kill-buffer-hook)
  (remove-hook 'find-file-hooks 'eserve-find-file-hook)
  (remove-hook 'after-save-hook 'eserve-after-save-hook)
  (remove-hook 'first-change-hook 'eserve-first-change-hook)
  (cond 
   (running-xemacs
    (remove-hook 'after-change-functions 'eserve-xemacs-change-function)))
  (clrhash eserve-buffers-marks-list)
  (setq eserve-mark-type-list nil)
  (setq eserve-message-leftover nil)
  (setq eserve-app-name nil)
  (setq eserve-app-cb nil)
  (setq eserve-started-by-emacs nil)
  (eserve-delete-menus eserve-menus)
  (clrhash eserve-verb-button-hash)
  (eserve-xpm-cleanup)
  (eserve-toolbar-cleanup)
  (cond
   (running-emacs ;; menu removal bug
    (redraw-display))))

(defun eserve-quit ()
  "aborts currently launching application and disconnects from it"
  (interactive)
  (cond 
   ((not (or eserve-launch-timer-process
	     eserve-launch-process
	     eserve-connection))
    (error "Edit server has not been started, use M-x eserve-start to connect")))
  (cond 
   (eserve-launch-timer-process
    (eserve-launch-timer-reset)))
  (cond
   (eserve-launch-process
    (delete-process eserve-launch-process)
    (eserve-launch-process-cleanup)))
  (cond
   (eserve-connection
    (delete-process eserve-connection)
    (eserve-connection-cleanup)))
  (eserve-cleanup))

(defun eserve-xpm-setup ()
  "sets up the xpm-color-symbols list"
  (when running-xemacs
	(cond
	 ((not (assoc "FgColor" xpm-color-symbols))
	  (setq xpm-color-symbols
		(append (list
			 '("FgColor" (face-foreground 'default))
			 '("BgColor" (face-background 'default)))
			xpm-color-symbols))))))

(defun eserve-xpm-cleanup ()
  "restores the xpm-color-symbols list"
  (cond
   (running-xemacs
    (let ((bg-color-attr (assoc "BgColor" xpm-color-symbols))
	  (fg-color-attr (assoc "FgColor" xpm-color-symbols)))
      (cond
       (bg-color-attr
	(setq xpm-color-symbols (delq bg-color-attr xpm-color-symbols))))
      (cond
       (fg-color-attr
	(setq xpm-color-symbols (delq fg-color-attr xpm-color-symbols))))))))

(defun eserve-toolbar-cleanup ()
  "restores emacs to the pre-eserve-toolbar state"
  (cond
   (running-xemacs
      (mapcar '(lambda (tb-info) (eserve-restore-frame-toolbar tb-info))
	      eserve-frame-previous-toolbar-alist)
      (setq eserve-frame-previous-toolbar-alist nil)
      (setq eserve-current-toolbar nil)
      (setq eserve-toolbar-table nil))))

(defun eserve-eval-cmds (msgs)
  "reads and evaluates commands from eserve message stream"
  (let ((current-cmd-str nil)
        (current-cmd nil)
        (cmd-front 0)
        (index 0)
        (cmds nil)
        (cmds-len 0))
    (cond 
     (eserve-message-leftover
      (setq cmds (concat eserve-message-leftover msgs))
      (setq eserve-message-leftover nil))
     (t 
      (setq cmds (concat msgs))))
    (setq eserve-message-buffer nil)
    (setq cmds-len (length cmds))
    (while (< index cmds-len)
      ;; find a command
      (setq cmd-front index)
      (while (and (< index cmds-len) 
                  (not (char-equal (aref cmds index) ?\n)))
        (setq index (+ index 1)))
      ;; check for message been split across buffers
      (cond 
       ((and 
         (>= index cmds-len)
         (not (char-equal (aref cmds (- index 1)) ?\n)))
        (setq eserve-message-leftover (substring cmds cmd-front index)))
       (t 
        (setq current-cmd-str (substring cmds cmd-front index))
        (setq current-cmd (read-from-string current-cmd-str))
        (eval (car current-cmd))
        ;; go past newline
        (setq index (+ index 1))))))
)

(defun eserve-connect (eserve-portnum) 
  "Connects to the ESERVE process"
  (condition-case err-msg
      (progn
	(setq eserve-connection (open-network-stream "eserve connection"
                                               nil
                                               "localhost"
                                               eserve-portnum))
        (set-process-filter eserve-connection 'eserve-connection-filter)
        (set-process-sentinel eserve-connection 'eserve-connection-sentinel)
	(process-kill-without-query eserve-connection)
        (eserve-event-connected)
        (add-hook 'kill-buffer-hook 'eserve-kill-buffer-hook)
	(add-hook 'find-file-hooks 'eserve-find-file-hook)
        (add-hook 'after-save-hook 'eserve-after-save-hook)
        (add-hook 'first-change-hook 'eserve-first-change-hook)
	(cond 
	 (running-xemacs
	  (add-hook 'after-change-functions 'eserve-xemacs-change-function)))
	(cond
	 (eserve-app-name
	  (let ((app-process nil))
	    (setq app-process (eserve-launch-app eserve-app-name))
	    (cond
	     (eserve-app-cb
	      (funcall eserve-app-cb app-process)))
	    (setq eserve-app-name nil)
	    (setq eserve-app-cb nil)))))
    (error (message "%s: Could not connect to edit server."
                    err-msg))))

(defun eserve-load-startup-file ()
  "loads the file containing code to start the connection between eserve/emacs"
  (cond 
   ((and eserve-startup-file 
	 (stringp eserve-startup-file)
	 (> (length eserve-startup-file) 0))
    (cond
     ((file-exists-p eserve-startup-file)
      (load eserve-startup-file)
      (delete-file eserve-startup-file)))
    (setq eserve-startup-file nil))))

(defun eserve-process-send-string (process str)
  "send STR to the eserve process over the connection to eserve"
  (cond
   (process
      (process-send-string process str))))

(defun eserve-one-based (int)
  "take a lineno/column number, if it's -1 return -1, else make 1 based"
  (cond
   ((= int -1)
    -1)
   (t
    (+ int 1))))

(defun eserve-send-verb (verb needsFilePos)
  "send a tool verb to ESERVE"
  (cond 
   (eserve-connection
    (let ((file-name (buffer-file-name (current-buffer)))
	  (current-line (eserve-cursor-line))
	  (current-col (eserve-cursor-column))
	  (selection nil)
	  (sel-start-line -1)
	  (sel-start-col -1)
	  (sel-end-line -1)
	  (sel-end-col -1)
	  (message-str nil)
	  (reg-beg -1)
	  (reg-end -1))
      (cond
       (needsFilePos
	(cond 
	 ((and (x-selection-exists-p)
	       (x-selection-owner-p))
	  (setq selection (eserve-current-selection))
	  (save-excursion 
	    (progn 
	      (condition-case nil
		  (setq reg-beg (region-beginning))
		(error
		 (setq reg-beg -1)))
	      (cond
	       ((>= reg-beg 0)
		(goto-char (region-beginning))
		(setq sel-start-col (current-column))
		(beginning-of-line)
		(setq sel-start-line (count-lines 1 (point)))))))
	  (save-excursion 
	    (progn 
	      (condition-case nil
		  (setq reg-end (region-end))
		(error
		 (setq reg-end -1)))
	      (cond
	       ((>= reg-end 0)
		(goto-char reg-end)
		(setq sel-end-col (current-column))
		(beginning-of-line)
		(setq sel-end-line (count-lines 1 (point)))))))))))
      (if (not selection)
	  (setq selection ""))
      (if (not file-name)
	  (setq file-name "NULL"))
      (setq message-str 
	    (format "toolVerb %s %s %d,%d %d,%d %d,%d %d %s\n"
		    verb file-name 
		    (eserve-one-based current-line)
		    (eserve-one-based current-col)
		    (eserve-one-based sel-start-line)
		    (eserve-one-based sel-start-col)
		    (eserve-one-based sel-end-line)
		    (eserve-one-based sel-end-col)
		    (length selection) selection))
      (cond
       ((member verb eserve-save-verbs)
	(save-some-buffers t)))
      (eserve-log-text (format "(%s)\n" message-str))
      (eserve-process-send-string eserve-connection message-str)))))
  
(defun eserve-send-ack (ack-num)
  "send an ack to ESERVE"
  (let ((ack (format "ack %d\n" ack-num)))
    (eserve-log-text (format "(%s)\n" ack))
    (eserve-process-send-string eserve-connection ack)))

;;
;; functions to check on eserve status
;;

(defvar eserve-ping-timer-process nil)
(defvar eserve-ping-timer-max 8)
(defvar eserve-got-ping nil)
(defvar eserve-need-ping nil)

(defun eserve-ping (refnum)
  "received ping from edit server"
  (cond
   (eserve-need-ping
    (setq eserve-got-ping t)
    (eserve-ping-timer-timeout)
    (cond 
     (eserve-ping-timer-process
      (eserve-ping-timer-cleanup))))))

(defun eserve-ping-timer-sentinel (proc str)
  (let ((stat (process-status proc)))
    (cond
     ((memq stat '(exit signal))
      (setq eserve-ping-timer-process nil)
      (cond
       (eserve-need-ping
	(eserve-ping-timer-timeout)))))))

(defun eserve-ping-timer-cleanup ()
  (cond
   (eserve-ping-timer-process
    (delete-process eserve-ping-timer-process)
    (setq eserve-ping-timer-process nil))))

(defun eserve-start-ping-timer ()
  (cond
   (eserve-ping-timer-process
    (message "Edit serve ping in progress"))
   (t
    (let ((msg-str (format "ping %d" 1)))
      (setq eserve-need-ping t)
      ;; send eserve ack message
      (eserve-process-send-string eserve-connection msg-str)
      (setq eserve-ping-timer-process
	    (start-process "ping timer process" nil "sleep" 
			   (int-to-string eserve-ping-timer-max)))
      (set-process-sentinel eserve-ping-timer-process 
			    'eserve-ping-timer-sentinel)
      (message "Waiting for response from edit server...")))))

(defun eserve-ping-timer-timeout ()
    (cond
     ((and eserve-need-ping eserve-got-ping)
      (message "Received response from edit server, connection is up"))
     (eserve-need-ping
      (message (format "No response from edit server, use M-x eserve-quit to bring it down"))))
    (setq eserve-need-ping nil)
    (setq eserve-got-ping nil))

(defun eserve-status ()
  "find out if emacs is connected to eserve"
  (interactive)
  (cond
   (eserve-connection
    (eserve-start-ping-timer))
   (t
    (message "Edit server has not been started, use M-x eserve-start to connect"))))

;;
;; functions to invoke eserve from emacs
;; 

(defvar eserve-launch-process nil)
(defvar eserve-launch-timer-max 180)
(defvar eserve-launch-timer-increment 5)
(defvar eserve-launch-timer-process nil)
(defvar eserve-launch-current-time 0)
(defvar eserve-launch-abort nil)

(defun eserve-path-search (file path)
  ;; Search PATH, a list of directory names, for FILE.
  ;; Returns the element of PATH that contains FILE concatenated with
  ;; FILE, or nil if not found.
  (while (and path
	      (not (file-executable-p (expand-file-name file (car path)))))
    (setq path (cdr path)))
  (cond
   ((car path)
    (expand-file-name file (car path)))
   (t
    nil)))

(defun eserve-get-app-path (app-name)
  "returns the path to the application binary"
  (let ((app-path nil))
    (cond
     ((and app-name 
	   (equal (substring app-name 0 1) "/"))
      (setq app-path app-name))
     ((and running-xemacs (boundp 'sunpro-dir) sunpro-dir)
      (cond
       ((file-executable-p (concat sunpro-dir "WS4.0/bin/" app-name))
	(setq app-path (concat sunpro-dir "WS4.0/bin/" app-name)))
       ((file-executable-p (concat sunpro-dir "bin/" app-name))
	(setq app-path (concat sunpro-dir "bin/" app-name))))))
    (cond
     ((not app-path)
      (setq app-path (eserve-path-search app-name exec-path))))
    app-path))

(defun eserve-get-path-to-eserve ()
  "returns the path to the eserve binary"
  (let ((path-to-eserve nil))
    (cond
     (eserve-path
      (cond
       ((and (stringp eserve-path)
	     (file-executable-p eserve-path))
	(setq path-to-eserve eserve-path))
       (t
	(error "Error: bad value for eserve-path variable")
	nil)))
     ((and running-xemacs (boundp 'sunpro-dir) sunpro-dir
	   (file-executable-p (concat sunpro-dir "WS4.0/lib/eserve")))
      (setq path-to-eserve (concat sunpro-dir "WS4.0/lib/eserve")))
     (t
      (setq path-to-eserve (eserve-path-search "eserve" exec-path))))
    path-to-eserve))

(defun eserve-start ()
  "invokes edit server from emacs"
  (interactive)
  (cond
   ((not eserve-connection)
    (let ((path-to-eserve (eserve-get-path-to-eserve)))
      (cond 
       (path-to-eserve
	(eserve-init)
	(eserve-launch-server path-to-eserve)
	t)
       (t
	(error "Cannot find eserve in PATH environment variable")
	nil))))
   (t
    (error "Edit server connection exists - use M-x eserve-quit to bring it down")
    nil)))
 
(defun eserve-app-start (app-name started-cb)
  "invokes an application from emacs"
  (cond 
   ((not (stringp app-name))
    (message "No application name specified")
    nil)
   ((not eserve-connection)
    (let ((app-path (eserve-get-app-path app-name))
	  (path-to-eserve (eserve-get-path-to-eserve)))
      (cond 
       (app-path
	(cond 
	 (path-to-eserve
	  (setq eserve-app-name app-path)
	  (setq eserve-app-cb started-cb)
	  (eserve-init)
	  (eserve-launch-server path-to-eserve)
	  t)
	 (t 
	  (error (format "Cannot launch %s because eserve is not in PATH environment variable" app-name))
	  nil)))
	(t
	 (error (format "Cannot find %s in PATH environment variable" 
			 app-name))
	 nil))))
   (t
    (let ((app-process nil))
      (setq eserve-app-name app-name)
      (setq eserve-app-cb started-cb)
      (setq app-process (eserve-launch-app eserve-app-name))
      (cond
       (eserve-app-cb
	(funcall eserve-app-cb app-process)))
      (setq eserve-app-name nil)
      (setq eserve-app-cb nil))
    t)))
 
(defun eserve-launch-timer-sentinel (proc str)
  (let ((stat (process-status proc)))
    (cond
     ((memq stat '(exit signal))
      (setq eserve-launch-timer-process nil)
      (eserve-launch-timer-timeout)))))

(defun eserve-launch-timer-reset ()
  (setq eserve-launch-current-time 0)
  (cond 
   (eserve-launch-timer-process
    (setq eserve-launch-abort t)
    (eserve-kill-launch-timer))))

(defun eserve-kill-launch-timer ()
  (cond ((and eserve-launch-timer-process
	      (eq (process-status eserve-launch-timer-process) 'run))
	 (delete-process eserve-launch-timer-process)))
	 (setq eserve-launch-timer-process nil))

(defun eserve-setup-launch-timer ()
  (setq eserve-launch-timer-process
	(start-process "launch timer process" nil "sleep" 
		       (int-to-string eserve-launch-timer-increment)))
  (set-process-sentinel eserve-launch-timer-process 'eserve-launch-timer-sentinel))

(defun eserve-launch-timer-timeout ()
  (let ((startup-file-exists (file-readable-p eserve-startup-file)))
    (setq eserve-launch-current-time 
	  (+ eserve-launch-current-time eserve-launch-timer-increment))
    (cond
     (eserve-launch-abort
      (message "Connection aborted.")
      (setq eserve-launch-abort nil))
     (startup-file-exists
      (eserve-load-startup-file)
      (eserve-launch-timer-reset)
      (setq eserve-started-by-emacs t)
      (message (format "Connection to edit server established")))
     ((>= eserve-launch-current-time eserve-launch-timer-max)
      (eserve-launch-timer-reset)
      (cond 
       (eserve-launch-process
	(delete-process eserve-launch-process)))
      (eserve-launch-process-cleanup)
      (error "Error: Could not connect to edit server"))
     (t
      (message (format "Starting connection to edit server..."))
      (eserve-setup-launch-timer)))))

(defun eserve-launch-server (path-to-eserve)
  (setq eserve-startup-file (make-temp-name "/tmp/emacs"))
  (setenv "SPRO_EDITOR_RENDEZVOUS_FILE" eserve-startup-file)
  (condition-case err-msg
      (progn
	(setq eserve-launch-process (start-process "eserve launch" nil path-to-eserve))
	(message (format "Starting connection to edit server...")))

    (file-error 
       (message "Could not find eserve, please check your PATH variable")))
  (setenv "SPRO_EDITOR_RENDEZVOUS_FILE" nil)
  (cond
   (eserve-launch-process
    (eserve-setup-launch-timer)
    (set-process-sentinel eserve-launch-process 'eserve-launch-process-sentinel))))

(defun eserve-launch-app (app-name)
  (let ((app-process nil))
      (condition-case err-msg
	  (progn 
	    (setq app-process (start-process app-name nil app-name))
	    (message (format "%s started" app-name)))
	(file-error 
	 (error (format "Could not find %s, please check your PATH variable"
			app-name))))
      app-process))

(defun eserve-launch-process-cleanup ()
  "Cleans up after ESERVE process has terminated"
  (setq eserve-launch-process nil))

(defun eserve-launch-process-sentinel (process status)
  "Handles changes in status to ESERVE process."
  (cond 
   ((memq (process-status process) '(signal exit closed))
    (eserve-launch-process-cleanup))))

;;
;; eserve protocol functions for file and marker management
;;

(defun eserve-quit-emacs ()
  "brings down emacs on behalf of eserve"
  ;; reset filter to get around xemacs bug
  (set-process-filter eserve-connection 'eserve-connection-filter)
  ;; ask to save unsaved buffers and leave
  (save-buffers-kill-emacs))

(defun eserve-open-file (file-to-open)
  "opens a file into a buffer"
  (let ((file-buffer))
    (setq file-buffer (find-file file-to-open))
    file-buffer))

(defun eserve-load-file (file-to-load)
  "loads a file into a buffer on behalf of eserve"
  (let ((file-buffer (eserve-file-to-buffer file-to-load)))
    (cond 
      ((not file-buffer)
       (setq file-buffer (eserve-open-file file-to-load))))
    (message "")
    (eserve-show-buffer file-buffer)))

(defun eserve-reload-file (file-to-load)
  "reloads a file into a buffer on behalf of eserve"
  (let ((file-buffer (eserve-file-to-buffer file-to-load)))
    (cond 
      ((not file-buffer)
       (setq file-buffer (eserve-open-file file-to-load)))
      (t
       (save-excursion
	 (set-buffer file-buffer)
	 (cond
	  (running-xemacs
	   (revert-buffer t t))
	  (running-emacs
	   (revert-buffer nil t))))))
    (message "")
    (eserve-show-buffer file-buffer)))

(defun eserve-save-file (file-to-save)
  "saves a file on behalf of eserve"
  (let ((file-buffer (eserve-file-to-buffer file-to-save)))
    (cond 
      (file-buffer
       (save-excursion
	 (set-buffer file-buffer)
	 (save-buffer))
       (message "")))))

(defun eserve-front-file (file-to-front)
  "switches a buffer, and raises its window to the front on behalf of eserve"
  (let ((file-buffer (eserve-file-to-buffer file-to-front)))
    (cond
     (file-buffer
      (switch-to-buffer file-buffer)
      (eserve-raise-buffer file-buffer)))))

(defun eserve-show-file (file-to-show)
  "switches a buffer to the front on behalf of eserve"
  (let ((file-buffer (eserve-file-to-buffer file-to-show)))
    (eserve-show-buffer file-buffer)))

(defun eserve-minimize ()
  "iconifies all frames"
  (mapcar 'iconify-frame (frame-list)))

(defun eserve-maximize ()
  "iconifies all frames"
  (cond
   (running-xemacs
    (mapcar 'deiconify-frame (frame-list)))
    (t 
     (save-excursion
       (mapcar '(lambda (frame) 
		(select-frame frame)
		(iconify-or-deiconify-frame)) (frame-list))))))

(defun eserve-set-mark (file-name line-num mark-id mark-type)
  "creates a mark in file-name at line line-num of type mark-type"
  (let ((file-buffer (eserve-file-to-buffer-create file-name)))
    (if file-buffer
        (let ((eserve-mark (eserve-make-eserve-mark file-buffer line-num mark-id mark-type)))
          (eserve-add-mark eserve-mark)
          (if (/= mark-type 0)
              (eserve-mark-change-mark-type eserve-mark mark-type))))))

(defun eserve-delete-mark (file-name mark-id)
  "deletes a MARKID from FILENAME"
  (let ((file-buffer (eserve-file-to-buffer-create file-name)))
    (if file-buffer
          (eserve-remove-mark file-buffer mark-id))))

(defun eserve-goto-mark (file-name mark-id msg)
  "warps to the mark associated with MARKID in FILENAME showing MSG"
  (let ((file-buffer (eserve-file-to-buffer file-name)))
    (if file-buffer
        (let ((eserve-mark (eserve-get-mark file-buffer mark-id))
              (emark nil))
          (setq emark (eserve-mark-mark eserve-mark))
	  (cond
	   (running-xemacs
	      (x-disown-selection)))
          (goto-char (marker-position emark))
	  (switch-to-buffer file-buffer)
	  (cond 
	   ((> (length msg) 0)
	    (message (eserve-replace-in-string msg "
" "\\n"))))))))

(defun eserve-goto-line (file-name line-num)
  "warps to LINENUM in FILENAME"
  (let ((file-buffer (eserve-file-to-buffer file-name)))
    (if file-buffer
        (let ((pos (eserve-line-to-pos file-buffer line-num)))
	  (cond
	   (running-xemacs
	      (x-disown-selection)))
          (goto-char pos)
	  (switch-to-buffer file-buffer)))))

(defun eserve-get-mark-type (pos mark-type-list)
  ;; Return the mark-type in position POS in MARK-TYPE-LIST.
(aref mark-type-list pos))

(defun eserve-change-mark-type (file-name mark-id new-type)
  ;; Change in FILE NAME the type of mark MARK ID to NEW TYPE.
    (let
        ((eserve-mark (eserve-get-mark (eserve-file-to-buffer file-name) mark-id)))
      (eserve-mark-change-mark-type eserve-mark new-type)))

(defun eserve-set-mark-type-list (mark-type-list)
  ;; Set eserve-mark-type-list to MARK TYPE LIST and perform any needed
  ;; initializations.  Return TBD if successful or signal an error.
  (cond
   ;; Sanity checks ...
   ((not (vectorp mark-type-list)) (signal 'wrong-type-argument '()))
   ;; ... passed.
   (t
    (mapcar 'eserve-add-mark-type mark-type-list))))
 
(defun eserve-add-mark-type (mark-type)
  (cond
   ((eserve-mark-typep mark-type)
    (eserve-init-mark-type mark-type)
    (setq eserve-mark-type-list 
	  (vconcat eserve-mark-type-list (make-vector 1 mark-type))))))

(defun eserve-post-notification (msg severity)
  "post a message to the editor message area"
  (message (eserve-replace-in-string msg "
" "\\n")))

;;; 
;;; protocol support functions
;;;

(defun eserve-add-mark (eserve-mark)
  ;; Add a mark to the list of marks for the corresponding buffer.
  (let ((buff (eserve-mark-buffer eserve-mark))
        (mark-list nil)
        (mark-id (eserve-mark-id eserve-mark)))
    (setq mark-list (eserve-get-buffer-marks buff))
    (cond
     ((not mark-list) 
      (setq mark-list (eserve-create-buffer-marks buff))))
    (cond
     ((>= mark-id (length mark-list))
      (setq mark-list (eserve-grow-vector mark-list mark-id eserve-mark-vector-chunk))
      (eserve-set-buffer-marks buff mark-list)))
    ;; check for old mark not deleted
    (let ((old-mark (aref mark-list mark-id)))
      (cond 
       (old-mark
        (eserve-mark-clear-renderer old-mark))))
    (aset mark-list mark-id eserve-mark)))

(defun eserve-remove-mark (file-buffer mark-id)
  "removes mark corresponding to MARKID from FILEBUFFER's list of marks"
  (let ((mark-list (eserve-get-buffer-marks file-buffer)))
    (cond 
     (mark-list
      (let ((eserve-mark (aref mark-list mark-id)))
        (cond 
         (eserve-mark
          (eserve-mark-clear-renderer eserve-mark)
          (aset mark-list mark-id nil))))))))

(defun eserve-get-mark (file-buffer mark-id)
  "returns the eservemark associated with MARKID and BUFFER"
  (let ((mark-list (eserve-get-buffer-marks file-buffer))
        (list-size 0))
    (setq list-size (length mark-list))
    (cond
     ((< mark-id list-size)
      (aref mark-list mark-id))
     (t nil))))

(defun eserve-get-buffer-marks (file-buffer)
  "returns the marks associated with BUFFER"
  (cl-gethash file-buffer eserve-buffers-marks-list))

(defun eserve-set-buffer-marks (file-buffer mark-list)
  "associates MARKLIST with BUFFER"
  (cl-puthash file-buffer mark-list eserve-buffers-marks-list))

(defun eserve-delete-buffer-marks (file-buffer)
  "dis-associates MARKLIST with BUFFER, deletes buffer from list"
  (cl-remhash file-buffer eserve-buffers-marks-list))

(defun eserve-create-buffer-marks (file-buffer)
  "creates a marks list and associates it with BUFFER, RETURNS mark list"
  (let ((mark-list (make-vector eserve-mark-vector-chunk nil)))
    (eserve-set-buffer-marks file-buffer mark-list)
    mark-list))

(defun eserve-grow-vector (vector-to-grow max-index chunk-size)
  "extend LIST TO GROW to contain MAX INDEX, RETURN new VECTOR"
  (let ((new-size (* chunk-size
                    (+ (/ max-index chunk-size) 1)))
        (size-diff 0)
        (new-vector nil))
    (setq size-diff (- new-size (length vector-to-grow)))
    (setq new-vector (vconcat vector-to-grow (make-vector size-diff nil)))))

(defun eserve-mark-change-mark-type (eserve-mark mark-type-index)
  ;; Change ESERVE MARK to NEW MARK TYPE
  (save-excursion
    (set-buffer (eserve-mark-buffer eserve-mark))
    (goto-char (marker-position (eserve-mark-mark eserve-mark)))
    (let
        ((new-mark-type (eserve-get-mark-type mark-type-index eserve-mark-type-list))
         (beg-point (progn (beginning-of-line) (point)))
         (end-point (progn (end-of-line) (point))))
      ;; clear out old visual if it exists
      (eserve-mark-clear-renderer eserve-mark)
      (if (eserve-mark-type-face new-mark-type)
	  (eserve-set-mark-renderer
	   eserve-mark (eserve-create-overlay-or-extent
		     new-mark-type beg-point end-point))))))

(defun eserve-mark-clear-renderer (eserve-mark)
  ;; remove visual remains of ESERVE MARK
  (if eserve-mark
      (let ((old-renderer (eserve-mark-renderer eserve-mark)))
	(if old-renderer
	    (save-excursion
	      (set-buffer (eserve-mark-buffer eserve-mark))
	      (eserve-delete-overlay-or-extent old-renderer)
	      (eserve-set-mark-renderer eserve-mark nil))))))

(defun eserve-clear-buffer-marks (buff marks-list)
  "clears visuals for all ESERVE marks in the given buffer"
  (cond 
   ((and buff marks-list)
	(mapcar 'eserve-mark-clear-renderer marks-list))))

(defun eserve-clear-all-marks ()
 "removes visuals backing all ESERVE marks in all buffers"
 (cond
  (eserve-buffers-marks-list
   (maphash 'eserve-clear-buffer-marks eserve-buffers-marks-list))))

;;
;; editor state message functions
;; 

(defun eserve-get-cursor-row-text ()
  "Send the text of the line the cursor is on to ESERVE"
  (save-excursion
  (let ((beg (progn (beginning-of-line) (point)))
	(end (progn (end-of-line) (point)))
	(message-string nil)
	(row-text-str nil))
    (setq row-text-str (buffer-substring beg end))
    (setq message-string (format "cursorRowText %d %s\n" 
				 (length row-text-str)
				 row-text-str))
    (eserve-process-send-string eserve-connection message-string))))

(defun eserve-get-cursor-row ()
  "Send the row number of the line the cursor is on to ESERVE"
  (save-excursion
  (let ((row-num (eserve-cursor-line))
	(message-string nil))
    (setq message-string (format "cursorRow %d\n" row-num))
    (eserve-process-send-string eserve-connection message-string))))

(defun eserve-get-cursor-col ()
  "Send the column number of the cursor on the line the cursor is on to ESERVE"
  (save-excursion
  (let ((col-num (current-column))
	(message-string nil))
    (setq message-string (format "cursorCol %d\n" col-num))
    (eserve-process-send-string eserve-connection message-string))))

(defun eserve-get-selected-text ()
  "Send the text of the current selection on to ESERVE"
  (save-excursion
  (let ((sel-text (eserve-current-selection))
	(sel-text-length 0)
	(message-string nil))
    (if (not sel-text)
	(setq sel-text ""))
    (setq sel-text-length (length sel-text))
    (setq message-string (format "selectedText %d %s\n" 
				 sel-text-length sel-text))
    (eserve-process-send-string eserve-connection message-string))))

(defun eserve-get-current-file ()
  "Send the name of the file in the current buffer on to ESERVE"
  (save-excursion
  (let ((filename (buffer-file-name (current-buffer)))
	(filelen 0)
	(message-string nil))
    (cond
     (filename (setq filelen (length filename)))
     (t (setq filename "")))
    (setq message-string (format "currentFile %d %s\n" 
				 filelen filename))
    (eserve-process-send-string eserve-connection message-string))))

;;
;; eserve-mark object functions
;;

;;
;; an eservemark object has the form:
;;    [eservemark MARK-ID MARK-TYPE MARK RENDER]
;;
;;  'eservemark   : symbol, identifies this vector as an eserve-mark
;;   mark-id   : integer, used by ESERVE
;;   mark-type : integer, index into the vector eserve-mark-type-list
;;   mark      : mark, the mark itself
;;   renderer  : overlay or extent

(defun eserve-markp (x) 
  "returns t if x is an eservemark"
  (and (vectorp x) (= (length x) 5) (eq (aref x 0) 'eservemark)))

(defun eserve-mark-id (eservemark) 
  "returns the id of an eservemark"
  (aref eservemark 1))

(defun eserve-mark-type (eservemark) 
  "returns the type of an eservemark"
  (aref eservemark 2))

(defun eserve-mark-mark (eservemark) 
  "returns the emacs mark for an eservemark"
  (aref eservemark 3))

(defun eserve-mark-renderer (eservemark) 
  "returns the overlay or extent of an eservemark"
  (aref eservemark 4))

(defun eserve-mark-buffer (eservemark) 
  "returns the buffer of an eservemark"
  (marker-buffer (eserve-mark-mark eservemark)))

(defun eserve-set-mark-id (eservemark new-id) 
  "sets the id of an eservemark"
  (aset eservemark 1 new-id))

(defun eserve-set-mark-type (eservemark new-type) 
  "sets the type of an eservemark"
  (aset eservemark 2 new-type))

(defun eserve-set-mark-mark (eservemark new-mark) 
  "sets the emacs mark for an eservemark"
  (aset eservemark 3 new-mark))

(defun eserve-set-mark-renderer (eservemark new-renderer) 
  "sets the emacs overlay or extent for an eservemark"
  (aset eservemark 4 new-renderer))


(defun eserve-make-eserve-mark (file-buffer line-num mark-id mark-type)
  "creates an eservemark object at line line-num in buffer file-buffer"
  (let ((eservemark (make-vector 5 nil))
        (emark (make-marker))
        (buffpos (eserve-line-to-pos file-buffer line-num)))
    (aset eservemark 0 'eservemark)
    (eserve-set-mark-id eservemark mark-id)
    (eserve-set-mark-type eservemark mark-type)
    (eserve-set-mark-mark eservemark emark)
    (set-marker emark buffpos file-buffer)
    (eserve-set-mark-renderer eservemark nil)
    eservemark))

;;
;; eserve-mark-type object functions
;;

;;
;; an eserve-mark-type object has the form
;;    [fgColor bgColor glyphfile glyph face]
;;
;;   fgColor   : string  the foreground color of the mark
;;   bgColor   : string  the background color of the mark
;;   glyphFile : string  the pathname of the XPM/XBM glyph of this mark
;;   glyph     : gylph   the gylph itself
;;   face      : face    the face of the highlighted line
;;

(defsubst eserve-mark-type-fgColor (eserve-mark)
  ;; return the foreground color of MARK-TYPE
  (aref eserve-mark 0))

(defsubst eserve-mark-type-bgColor (eserve-mark)
  ;; return the background color of MARK-TYPE
  (aref eserve-mark 1))

(defsubst eserve-mark-type-glyphFile (eserve-mark)
  ;; return the glyph file name of MARK-TYPE
  (aref eserve-mark 2))

(defsubst eserve-mark-type-glyph (eserve-mark)
  ;; return the glyph itself of MARK-TYPE
  (aref eserve-mark 3))

(defsubst eserve-mark-type-face (eserve-mark)
  ;; return the face of MARK-TYPE
  (aref eserve-mark 4))

(defun eserve-mark-typep (x) 
  "returns t if x is an eserve-mark-type"
  (and (vectorp x) (= (length x) 5)))

(defun eserve-init-mark-type (mark-type)
  ;; Make a pixmap out of the glyphFile specified and store it in the glyph
  ;; object.  Create a new face and set its foreground and background
  ;; colors.  Then append the mark-type to the eserve-mark-type-list.  
  ;; TBD: file checks for glyphFile 
  ;; TBD: protect against errors in making the pixmap (incorrect format, etc.)

  ;; if there is not an existing face and either a foreground or background
  ;; color, then create a face and set its foreground and background colors
  (when (and (not (eserve-mark-type-face mark-type))
             (or (eserve-mark-type-fgColor mark-type)
                 (eserve-mark-type-bgColor mark-type)))
    (let
        ((fgColor (eserve-mark-type-fgColor mark-type))
         (bgColor (eserve-mark-type-bgColor mark-type))
         (face (aset mark-type 4 (copy-face 'eserve-highlight (gensym)))))
      (when fgColor (set-face-foreground face fgColor))
      (when bgColor (set-face-background face bgColor))))
  ;;
  ;; set up glyph (for xemacs) and create a face
  ;; for it so that we don't get color bleeding
  (when (and running-xemacs
	     (eserve-mark-type-glyphFile mark-type))
    (let ((glyph  (make-pixmap (eserve-mark-type-glyphFile mark-type)))
	  (g-face (copy-face 'eserve-highlight (gensym)))
	  (fgColor (eserve-mark-type-fgColor mark-type)))
      (when fgColor (set-face-foreground g-face fgColor))
      (set-glyph-face glyph g-face)
      (aset mark-type 3 glyph)
      (set-pixmap-contributes-to-line-height (aref mark-type 3) nil))))

;;
;; eserve-menu object functions
;;

;;
;; an eservemenu object has the form:
;;    [eservemenu LABEL NUMITEMS ITEMS HANDLE]
;;
;;  'eservemenu   : symbol, identifies this vector as an eserve-menu
;;   label     : string, displayed in menu bar
;;   numitems  : integer, number of menu items in items array
;;   items     : array of menu items
;;   handle    : editor specific handle to menu

(defun eserve-menup (x) 
  "returns t if x is an eservemenu"
  (and (vectorp x) (= (length x) 5) (eq (aref x 0) 'eservemenu)))

(defun eserve-menu-label (eservemenu) 
  "returns the label of an eservemenu"
  (aref eservemenu 1))

(defun eserve-menu-numitems (eservemenu) 
  "returns the number of menu items for an eservemenu"
  (aref eservemenu 2))

(defun eserve-menu-items (eservemenu) 
  "returns the array of menu items for an eservemenu"
  (aref eservemenu 3))

(defun eserve-menu-handle (eservemenu) 
  "returns the editor specific handle for an eservemenu"
  (aref eservemenu 4))

(defun eserve-set-menu-label (eservemenu newlabel) 
  "sets the label of an eservemenu"
  (aset eservemenu 1 newlabel))

(defun eserve-set-menu-numitems (eservemenu newnum) 
  "sets the number of menu items for an eservemenu"
  (aset eservemenu 2 newnum))

(defun eserve-set-menu-items (eservemenu newitems) 
  "sets the menu items for an eservemenu"
  (aset eservemenu 3 newitems))

(defun eserve-set-menu-handle (eservemenu newhandle) 
  "sets the editor specific handle for an eservemenu"
  (aset eservemenu 4 newhandle))

;;
;; eserve-button object functions
;;

;;
;; an eservebutton object has the form:
;;    [eservebutton LABEL VERB NEEDFILEPOS HELP SENSE ACCELERATOR]
;;
;;  'eservebutton : symbol, identifies this vector as an eserve-button
;;   label       : string, displayed in button
;;   verb        : string, verb (action) sent when button is selected
;;   needfilepos : bool, if t then send file position info with verb
;;   help        : string, documents button for user
;;   accelerator : string, key binding to invoke button
;;   sense       : bool, if t, button is enabled
;;   sensesym    : symbol, used to store sense value
;;   iconfile    : string, file containing icon definition
;;   offset      : integer, offset in pixels from previous button
;;   cmd         : function, function to call on button up if not nil

(defun eserve-buttonp (x) 
  "returns t if x is an eservebutton"
  (and (vectorp x) (= (length x) 11) (eq (aref x 0) 'eservebutton)))

(defun eserve-button-label (eservebutton) 
  "returns the label of an eservebutton"
  (aref eservebutton 1))

(defun eserve-button-verb (eservebutton) 
  "returns the verb of an eservebutton"
  (aref eservebutton 2))

(defun eserve-button-needfilepos (eservebutton) 
  "returns the needfilepos member of an eservebutton"
  (aref eservebutton 3))

(defun eserve-button-help (eservebutton) 
  "returns the help member of an eservebutton"
  (aref eservebutton 4))

(defun eserve-button-accelerator (eservebutton) 
  "returns the accelerator member of an eservebutton"
  (aref eservebutton 5))

(defun eserve-button-sense (eservebutton) 
  "returns the sense member of an eservebutton"
  (aref eservebutton 6))

(defun eserve-button-sensesym (eservebutton) 
  "returns the sensesym member of an eservebutton"
  (aref eservebutton 7))

(defun eserve-button-iconfile (eservebutton) 
  "returns the iconfile member of an eservebutton"
  (aref eservebutton 8))

(defun eserve-button-offset (eservebutton) 
  "returns the offset member of an eservebutton"
  (aref eservebutton 9))

(defun eserve-button-cmd (eservebutton) 
  "returns the command member of an eservebutton"
  (aref eservebutton 10))

(defun eserve-set-button-label (eservebutton newlabel) 
  "sets the label of an eservebutton"
  (aset eservebutton 1 newlabel))

(defun eserve-set-button-verb (eservebutton newverb) 
  "sets the verb member for an eservebutton"
  (aset eservebutton 2 newverb))

(defun eserve-set-button-needfilepos (eservebutton newneedfilepos) 
  "sets the needfilepos member an eservebutton"
  (aset eservebutton 3 newneedfilepos))

(defun eserve-set-button-help (eservebutton newhelp) 
  "sets the help member an eservebutton"
  (aset eservebutton 4 newhelp))

(defun eserve-set-button-accelerator (eservebutton newaccelerator) 
  "sets the accelerator member an eservebutton"
  (aset eservebutton 5 newaccelerator))

(defun eserve-set-button-sense (eservebutton newsense) 
  "sets the sense member an eservebutton"
  (aset eservebutton 6 newsense))

(defun eserve-set-button-sensesym (eservebutton newsensesym) 
  "sets the sensesym member an eservebutton"
  (aset eservebutton 7 newsensesym))

(defun eserve-set-button-iconfile (eservebutton newiconfile) 
  "sets the iconfile member an eservebutton"
  (aset eservebutton 8 newiconfile))

(defun eserve-set-button-offset (eservebutton newoffset) 
  "sets the offset member an eservebutton"
  (aset eservebutton 9 newoffset))

(defun eserve-set-button-cmd (eservebutton newcmd) 
  "sets the command member an eservebutton"
  (aset eservebutton 10 newcmd))

;;
;; button support functions
;;

(defun eserve-button-create-cmd (eservebutton name-prefix)
  "creates a command function to be invoked when the eservebutton is selected"
  (cond
   ((and name-prefix eservebutton)
    (let ((func-name (intern (concat name-prefix
				     (eserve-button-label eservebutton)))))
      (eval (` (defun (, func-name) ()
		 (interactive)
		 (eserve-send-verb (, (eserve-button-verb eservebutton))
				(, (eserve-button-needfilepos eservebutton))))))))))

(defun eserve-button-create-sensesym (eservebutton name-prefix)
  "creates the symbol which when evaluated determines button sense"
  (cond
   ((and name-prefix eservebutton)
    (intern (concat name-prefix "-" 
		    (eserve-button-label eservebutton) "-sense")))))

(defun eserve-register-button (button)
  "adds BUTTON to the verb button hash table"
  (let ((verb (eserve-button-verb button))
	(button-list nil))
    (cond
     (verb
      (setq button-list (cl-gethash verb eserve-verb-button-hash))
      (cl-puthash verb (cons button button-list) eserve-verb-button-hash)))))

(defun eserve-set-sensitivity (verb-sense)
  "sets the sensitivity of the buttons corresponding VERB-SENSE pair"
  (let ((verb (aref verb-sense 0))
	(sense (aref verb-sense 1))
	(sense-sym nil)
	(button-list nil))
    (setq button-list (cl-gethash verb eserve-verb-button-hash))
    (while button-list
      (set (eserve-button-sensesym (car button-list)) sense)
      (setq button-list (cdr button-list)))))

(defun eserve-set-sensitivities (verb-sense-array)
  "applies the sense values in VERB-SENSE-ARRAY to the existing eserve buttons"
  (mapcar 'eserve-set-sensitivity verb-sense-array)
  (cond
   (running-xemacs
    (eserve-update-frame-toolbars))))

;;
;; menu support functions
;;

(defun eserve-emacs-set-menus (menus)
  "adds menus from the MENUS list to the menu bar"
  (mapcar 'eserve-emacs-menu-create (reverse menus))
  (redraw-display))

(defun eserve-emacs-add-menu (menu)
  "addes MENU to the emacs menu bar"
  (eserve-emacs-menu-create menu)
  (setq eserve-menus 
	(append eserve-menus (list menu))))

(defun eserve-emacs-delete-menus (menus)
  "deletes menus from the MENUS list from the menu bar"
  (cond
   (menus
    (mapcar 'eserve-emacs-menu-delete menus)
    (setq eserve-menus nil)
    (redraw-display))))

(defun eserve-xemacs-set-menus (menus)
  "adds menus from the MENUS list to the menu bar"
  (mapcar 'eserve-xemacs-menu-create menus))

(defun eserve-xemacs-add-menu (menu)
  "adds MENU to the xemacs menu bar"
  (eserve-xemacs-menu-create menu)
  (setq eserve-menus 
	(append eserve-menus (list menu))))

(defun eserve-xemacs-delete-menus (menus)
  "deletes menus from the MENUS list from the menu bar"
  (cond
   (menus
    (mapcar 'eserve-xemacs-menu-delete menus)
    (setq eserve-menus nil))))

(defun eserve-xemacs-menu-create (eservemenu)
  "adds a ESERVEMENU to the xemacs menu bar"
  (cond
   ((and eservemenu (eserve-menup eservemenu))
    (let ((handle (` ( (, (eserve-menu-label eservemenu) ))))
	  (buttons nil)
	  (menulist nil)
	  (index 0)
	  (max-items (eserve-menu-numitems eservemenu)))
      (eserve-set-menu-handle eservemenu handle)
      (setq buttons (eserve-menu-items eservemenu))
      (while (< index max-items)
	(setq menulist (append menulist 
			       (list (eserve-xemacs-menuitem-create
				      eservemenu (aref buttons index)))))
	(setq index (+ index 1)))
      (add-menu nil (eserve-menu-label eservemenu) menulist)))))

(defun eserve-xemacs-menuitem-create (eservemenu eservebutton)
  "returns an xemacs menuitem from ESERVEBUTTON"
  (let ((menuitem (make-vector 4 nil)))
    (aset menuitem 0 (eserve-button-label eservebutton))
    (cond
     ((eserve-button-cmd eservebutton)
      (aset menuitem 1 (eserve-button-cmd eservebutton)))
     (t
      (aset menuitem 1 (eserve-button-create-cmd eservebutton (eserve-menu-label eservemenu)))))
    (eserve-set-button-sensesym eservebutton
     (eserve-button-create-sensesym eservebutton (eserve-menu-label eservemenu)))
    (set (eserve-button-sensesym eservebutton) 
	 (eserve-button-sense eservebutton))
    (aset menuitem 2 (eserve-button-sensesym eservebutton))
    (eserve-register-button eservebutton)
    menuitem))

(defun eserve-xemacs-menu-delete (eservemenu)
  "delete a ESERVEMENU from the xemacs menu bar"
  (cond
   ((and eservemenu (eserve-menup eservemenu))
    (delete-menu-item (eserve-menu-handle eservemenu)))))


(defun eserve-emacs-menuitem-create (eservemenu button kmap)
  "adds the button to ESERVEMENU"
  (let ((button-cmd nil))
    (cond
     ((eserve-button-verb button)
      (setq button-cmd (eserve-button-cmd button)))
     (t 
      (setq button-cmd (eserve-button-create-cmd button 
						 (eserve-menu-label eservemenu)))))
    (define-key kmap (` [ (, (intern (eserve-button-label button))) ])
      (` ( (, (eserve-button-label button)) 
	   (, (eserve-button-help button)) .
	   (, button-cmd))))
    (eserve-set-button-sensesym button
		(eserve-button-create-sensesym button 
					       (eserve-menu-label eservemenu)))
    (set (eserve-button-sensesym button) (eserve-button-sense button))
    (put button-cmd 'menu-enable (eserve-button-sensesym button))
    (eserve-register-button button)))


(defun eserve-emacs-menu-create (eservemenu)
  "adds a ESERVEMENU to the menu bar"
  (cond
   ((and eservemenu (eserve-menup eservemenu))
    (let ((handle (` [menu-bar (, (intern (eserve-menu-label eservemenu))) ]))
	  (kmap (make-sparse-keymap (eserve-menu-label eservemenu)))
	  (index (eserve-menu-numitems eservemenu))
	  (button nil))
      (define-key global-map handle (cons (eserve-menu-label eservemenu) kmap))
      (eserve-set-menu-handle eservemenu handle)
      (while (> index 0)
	(setq button (aref (eserve-menu-items eservemenu) (- index 1)))
	(eserve-emacs-menuitem-create eservemenu button kmap)
	(setq index (- index 1)))
      (setq menu-bar-final-items (append 
				  (list (intern (eserve-menu-label eservemenu)))
				  menu-bar-final-items))))))

(defun eserve-emacs-menu-delete (eservemenu)
  "delete a ESERVEMENU from the emacs menu bar"
  (cond
   ((and eservemenu (eserve-menup eservemenu))
    (global-unset-key (eserve-menu-handle eservemenu))
    (setq menu-bar-final-items 
	  (delete (intern (eserve-menu-label eservemenu)) 
		  menu-bar-final-items)))))

;;
;; version control support
;;
(defun eserve-vc-setup ()
  "sets up the VC menu"
  (require 'vc-hooks))

;;
;; file/buffer utility functions
;; 

(defun eserve-file-to-buffer (file-name)
  "Returns the buffer containing the contents of FILENAME or nil\n\
if no such buffer exists."
  (get-file-buffer (expand-file-name (abbreviate-file-name file-name))))

(defun eserve-file-to-buffer-create (file-name)
  "returns the buffer containing the contents of FILENAME (creates the buffer if not found)"
  (let ((full-file-name (abbreviate-file-name file-name))
        (file-buff nil))
    (setq file-buff (get-file-buffer full-file-name))
    (cond 
     (file-buff file-buff)
     (t (find-file-noselect full-file-name)))))

(defun eserve-line-to-pos (file-buffer line-no)
  "returns the character position of LINENO in BUFFER"
    (save-excursion
      (set-buffer file-buffer)
      (goto-char 1)
      (goto-line line-no)
      (point)))

(defun eserve-cursor-line ()
  (save-excursion
    (progn (beginning-of-line) (count-lines 1 (point)))))

(defun eserve-cursor-column ()
  (current-column))

(defun eserve-get-selection ()
  "return the text from the X primary clipboard"
  (x-get-selection-internal 'PRIMARY 'STRING))

(defun eserve-current-selection ()
  "return the text of the current selection"
  (save-excursion
  (let ((sel-text nil)
	(sel-exists (x-selection-exists-p 'PRIMARY))
	(own-text (x-selection-owner-p))
	(message-string nil))
    (cond 
    ((and sel-exists own-text)
      (setq sel-text (eserve-get-selection)))
     (t 
      nil)))))

(defun eserve-show-buffer (file-buffer)
  "switches current window to FILEBUFFER"
    (cond
     (file-buffer
      (switch-to-buffer file-buffer)
      (cond 
       ((not (eq (frame-visible-p (selected-frame)) t))
	(make-frame-visible))))))

(defun eserve-raise-buffer (file-buffer)
  "raises the X window containing FILEBUFFER"
  (cond 
   (file-buffer
    (raise-frame (window-frame (get-buffer-window file-buffer))))))

(defun eserve-add-to-path (dir)
  "adds DIR to the emacs LOAD-PATH"
  (cond
   ((and dir 
	 (stringp dir)
	 (not (member dir load-path)))
    (setq load-path
	  (append (list (expand-file-name dir)) load-path)))))

(defun eserve-write-to-buffer (buff string)
  "write STRING to buffer BUFF"
  (cond 
   ((and string (stringp string) buff
	(buffer-name buff))
    (save-excursion
      (set-buffer buff) 
      (goto-char (point-max))
      (insert string)))))

(defun eserve-write-buffer (buff filename)
  "write the contents of BUFF to FILENAME"
  (save-excursion
    (set-buffer buff)
    (write-file filename)))

(defun eserve-replace-in-string (str oldstr newstr)
  "returns a new string replacing occurrances of OLDSTR with NEWSTR using STR"
  (let ((rtn-str "")
	(start 0)
	(match nil)
	(prev-start 0))
    (while (setq match (string-match oldstr str start))
      (setq prev-start start)
      (setq start (+ match (length oldstr)))
      (setq rtn-str (concat rtn-str (substring str prev-start match) newstr)))
    (concat rtn-str (substring str start))))

;;
;; hook functions for editor events
;;

(defun eserve-find-file-hook ()
  "notifies client that new file has been loaded into emacs"
  (let ((file-name (buffer-file-name nil))
	(file-buffer nil))
    (cond
     (file-name
      (setq file-buffer (eserve-file-to-buffer file-name))
      (cond
       (file-buffer
	(eserve-event-loaded-file file-name)))))))

(defun eserve-first-change-hook ()
  "notifies client that file has been modified by emacs"
  (let ((file-name (buffer-file-name nil)))
    (cond
     (file-name
      (eserve-event-modified-file file-name)))))

(defun eserve-after-save-hook ()
  "notifies client that new file has been saved by emacs"
  (let ((file-name (buffer-file-name nil)))
    (cond
     (file-name
      (eserve-event-saved-file file-name)))))

(defun eserve-kill-buffer-hook ()
  "deletes buffer from eserve lists and informs eserve of event"
  (cond
   (buffer-file-name
    (let ((deleted-buffer (get-file-buffer buffer-file-name)))
      (eserve-log-text (format "eserve-kill-buffer hook -buffer name %s\n" buffer-file-name))
      (if (not deleted-buffer)
	  (eserve-log-text "eserve-kill-buffer hook -no deleted buffer\n"))
      (cond
       (deleted-buffer
	(eserve-event-deleted-file buffer-file-name)
        (cond
         ((eserve-get-buffer-marks deleted-buffer)
          (eserve-delete-buffer-marks deleted-buffer)))))))
   (t
    (eserve-log-text "eserve-kill-buffer hook - no buffer name\n"))))

;;
;; event functions - used to inform eserve of events occurring
;; in emacs 
;;
(defun eserve-event-deleted-file (deleted-file-name)
  "informs eserve that DELETEDFILENAME has been deleted"
  (let ((event-string (concat "deletedFile " deleted-file-name "\n")))
    (eserve-process-send-string eserve-connection event-string)
    (eserve-log-text (format "(%s)\n" event-string))))

(defun eserve-event-loaded-file (loaded-file-name )
  "informs eserve that LOADEDFILENAME has been loaded"
  (let ((event-string (concat "loadedFile " loaded-file-name " 0\n")))
    (eserve-process-send-string eserve-connection event-string)
    (eserve-log-text (format "(%s)\n" event-string))))

(defun eserve-event-modified-file (modified-file-name)
  "informs eserve that MODIFIEDFILENAME has been modified"
  (let ((event-string (concat "modifiedFile " modified-file-name "\n")))
    (eserve-process-send-string eserve-connection event-string)
    (eserve-log-text (format "(%s)\n" event-string))))

(defun eserve-event-saved-file (saved-file-name)
  "informs eserve that SAVEDFILENAME has been loaded"
  (let ((event-string (concat "savedFile " saved-file-name "\n")))
    (eserve-process-send-string eserve-connection event-string)
    (eserve-log-text (format "(%s)\n" event-string))))

(defun eserve-editor-version ()
  "returns a string containing the major/minor version number"
  (let ((version-end (string-match " " emacs-version))
	(editor-version emacs-version))
    (cond
     (version-end
      (setq editor-version (substring emacs-version 0 
				      version-end))))
    editor-version))

(defun eserve-event-connected ()
  "informs eserve that it is connected to emacs"
  (let ((event-string nil))
    (cond
     (running-xemacs
      (setq event-string (format "connected xemacs %d %s\n" 
				 eserve-protocol-version
				 (eserve-editor-version))))
     (t 
      (setq event-string (format "connected emacs %d %s\n" 
				 eserve-protocol-version
				 (eserve-editor-version)))))
    (eserve-process-send-string eserve-connection event-string)
    (eserve-log-text (format "(%s)\n" event-string))))

;;;
;;; Toolbar (aka buttonbar) functions
;;;

(defun eserve-toggle-frame-toolbar (frame)
  "toggles TOOLBAR for FRAME"
  (cond 
   ((equal eserve-current-toolbar
	   (specifier-instance top-toolbar frame))
    (eserve-deinstall-frame-toolbar frame))
   (t
    (eserve-install-frame-toolbar frame eserve-current-toolbar))))

(defun eserve-install-frame-toolbar (frame toolbar)
  "saves current toolbar info for FRAME and puts up TOOLBAR on FRAME"
  (eserve-save-frame-toolbar frame)
  (eserve-set-frame-toolbar frame toolbar))

(defun eserve-deinstall-frame-toolbar (frame)
  "takes down current toolbar on FRAME and puts up previous toolbar"
    (let ((toolbar-info (assoc frame eserve-frame-previous-toolbar-alist)))
      (cond
       (toolbar-info
	(eserve-restore-frame-toolbar toolbar-info)))))

(defun eserve-set-frame-toolbar (frame toolbar)
  "put TOOLBAR up on FRAME"
;;  (add-spec-to-specifier top-toolbar-height frame eserve-toolbar-icon-height)
  (add-spec-to-specifier top-toolbar toolbar frame))

(defun eserve-save-frame-toolbar (frame)
  "save current toolbar info for FRAME so we can restore it later"
  (let ((toolbar-info (assoc frame eserve-frame-previous-toolbar-alist)))
    (cond 
     (toolbar-info
      (setcdr toolbar-info (list (specifier-instance top-toolbar-height frame))))
     (t 
      (setq eserve-frame-previous-toolbar-alist
	    (append
	     (list (list frame (specifier-instance top-toolbar-height (selected-frame))))
	     eserve-frame-previous-toolbar-alist))))))

(defun eserve-restore-frame-toolbar (toolbar-info)
  "restore information from TOOLBAR-INFO"
  (let ((frame (nth 0 toolbar-info))
	(toolbar-height (nth 1 toolbar-info)))
    (cond
     ((frame-live-p frame)
	(remove-specifier top-toolbar frame)
;;      (add-spec-to-specifier top-toolbar-height toolbar-height frame)
      ))
    (setq eserve-frame-previous-toolbar-alist
	  (delq toolbar-info eserve-frame-previous-toolbar-alist))))

(defun eserve-update-frame-toolbars ()
  "update all eserve frame toolbars"
  (mapcar '(lambda (tb-info) 
	     (add-spec-to-specifier 
	       top-toolbar eserve-current-toolbar (nth 0 tb-info)))
	  eserve-frame-previous-toolbar-alist))

(defun eserve-add-toolbar-button (toolbar-button)
  "Adds toolbar-button to the current toolbar, performs all needed
  initializations and updates the toolbar."
  (cond
   ((and running-xemacs toolbar-button)
    (let ((old-tb-bg-attr (assoc "BgColor" xpm-color-symbols))
	  (new-tb-bg-color nil)
	  (new-tb-bg-attr nil)
	  (install-new-tb nil))

      ;; substitute toolbar background for icon bg color
      (setq new-tb-bg-color (cdr (assq 'background-toolbar-color 
				      (frame-parameters (selected-frame)))))
      (cond
       ((not new-tb-bg-color)
	    (setq new-tb-bg-color (face-background 'default))))
      (setq xpm-color-symbols (delete old-tb-bg-attr xpm-color-symbols))
      (setq xpm-color-symbols
		(append
		 (list
		  (` ("BgColor" (, new-tb-bg-color))))
		 xpm-color-symbols))

      ;; update eserve-toolbar-table 
      (cond
       ((not eserve-toolbar-table)
	(setq install-new-tb t)))
      (setq eserve-toolbar-table 
	    (vconcat eserve-toolbar-table 
		     (make-vector 1 toolbar-button))) 
      (eserve-init-toolbar-item toolbar-button)

      ;; substitute previous/saved bg color for icon bg color
      (setq new-tb-bg-attr (assoc "BgColor" xpm-color-symbols))
      (setq xpm-color-symbols (delq new-tb-bg-attr xpm-color-symbols))
      (setq xpm-color-symbols (append (list old-tb-bg-attr)
				       xpm-color-symbols))
      ;; create/update toolbar(s)
      (cond 
       (install-new-tb
	(eserve-install-frame-toolbar (selected-frame) eserve-current-toolbar))
       (t 
	(eserve-update-frame-toolbars)))))))

(defun eserve-set-toolbar-table (toolbar-table)
  "Sets eserve-toolbar-table to TOOLBAR-TABLE, performs all needed
  initializations and displays the toolbar.  [Returns TBD if successful, or TBD
  if a non-fatal error is raised.  Signals the error TBD otherwise.]"
  (cond
   (running-xemacs
    (let ((old-tb-bg-attr (assoc "BgColor" xpm-color-symbols))
	  (new-tb-bg-color nil)
	  (new-tb-bg-attr nil))
      (message "Initializing toolbar ...")
      ;; toolbar checks
      (when (not (vectorp toolbar-table)) 
	    (signal 'wrong-type-arg '(toolbar-table)))

      ;; substitute toolbar background for icon bg color
      (setq new-tb-bg-color (cdr (assq 'background-toolbar-color 
				      (frame-parameters (selected-frame)))))
      (cond
       ((not new-tb-bg-color)
	    (setq new-tb-bg-color (face-background 'default))))
      (setq xpm-color-symbols (delete old-tb-bg-attr xpm-color-symbols))
      (setq xpm-color-symbols
		(append
		 (list
		  (` ("BgColor" (, new-tb-bg-color))))
		 xpm-color-symbols))

      ;; create and install toolbar
      (setq eserve-toolbar-table toolbar-table) ; Save toolbar-table 
      (setq eserve-current-toolbar nil)	;delete any previous toolbars
      (mapcar 'eserve-init-toolbar-item toolbar-table)
      (eserve-install-frame-toolbar (selected-frame) eserve-current-toolbar)

      ;; substitute previous/saved bg color for icon bg color
      (setq new-tb-bg-attr (assoc "BgColor" xpm-color-symbols))
      (setq xpm-color-symbols (delq new-tb-bg-attr xpm-color-symbols))
      (setq xpm-color-symbols (append (list old-tb-bg-attr)
				       xpm-color-symbols))
      (message "")))))

(defun eserve-init-toolbar-item (toolbar-item)
  (let ((verb    (eserve-button-verb toolbar-item))
	(filePos (eserve-button-needfilepos toolbar-item))
	(button-cmd (eserve-button-create-cmd toolbar-item "eserve-toolbar"))
	(button-sense (eserve-button-sense toolbar-item))
	(button-sensesym (eserve-button-create-sensesym toolbar-item "eserve-toolbar"))
	(button-space (eserve-button-offset toolbar-item))
	(spacer nil)
	(normal-pixmap nil)
	(normal-iconfile (eserve-button-iconfile toolbar-item))
	(disabled-iconfile nil)
	(disabled-pixmap nil)
	(iconfile-dir nil)
	(iconfile-basename nil))
    (set button-sensesym button-sense)
    (eserve-set-button-sensesym toolbar-item button-sensesym)
    (eserve-register-button toolbar-item)
    (cond
     ((and (integerp button-space) (> button-space 0))
      (setq spacer (list (vector ':size button-space ':style '2d)))))
    (cond
     ((and normal-iconfile 
	   (file-readable-p normal-iconfile))
      (setq normal-pixmap (make-pixmap normal-iconfile))
      (setq iconfile-dir (file-name-directory normal-iconfile))
      (setq iconfile-basename (file-name-sans-extension
			       (file-name-nondirectory normal-iconfile)))
      (setq disabled-iconfile (concat iconfile-dir iconfile-basename "-xx.xpm"))
      (cond
       ((and disabled-iconfile
	    (file-readable-p disabled-iconfile))
	(setq disabled-pixmap (make-pixmap disabled-iconfile))))))
	
    (setq eserve-current-toolbar
	  (append 
	   eserve-current-toolbar
	   spacer
	   (list
	    (vector
	     (list
	      normal-pixmap
	      nil
	      disabled-pixmap)
	     button-cmd
	     button-sensesym
	     (eserve-button-help toolbar-item)))))))

(defun eserve-tool-flush (tool-name)
  "remove data related to tool TOOL-NAME"
)

;;;
;;; XEmacs-specific functions
;;;

(defun eserve-xemacs-create-extent (mark-type start end)
  ;; Create an extent in the current buffer with the properties of MARK-TYPE
  ;; and return it.  The function `eserve-create-overlay-or-extent' is aliased
  ;; to this one when running XEmacs.  Note, the arguments START and END are
  ;; not used and are present only because the corresponding function in GNU
  ;; Emacs `eserve-emacs-create-overlay' needs them.
  (when (or (eserve-mark-type-fgColor mark-type)
            (eserve-mark-type-bgColor mark-type)
            (eserve-mark-type-face    mark-type))
    (let 
        ((pixmap (eserve-mark-type-glyph mark-type))
         (face (eserve-mark-type-face mark-type))
         (extent (make-extent start end (current-buffer)))) ;no location!
      (if face
          (set-extent-face extent face)
        (set-extent-face extent 'eserve-highlight))
      (when pixmap
        (set-extent-begin-glyph extent pixmap 'outside-margin)
        (set-buffer-left-margin-width 3))
      extent)))                         ;return the newly created extent

(defun eserve-xemacs-change-function (start end old-length)
  ;; Called by `after-change-function' to see if a newline was inserted and
  ;; if so, to terminate the extent before that point.  TBD: the
  ;; corresponding operation of gluing two lines together to form a single
  ;; highlighted line.
  (save-excursion
    (goto-char start)
    (when (and (re-search-forward "\n" end t) ;return nil on failure
               (<= (point) end)
      (let
          ((extent (extent-at (point)))) ;returns smallest extent
        (if extent (set-extent-endpoints extent (extent-start-position extent)
                                     (point))))))))

(defun eserve-xemacs-delete-extent (extent)
    (when extent
      (delete-extent extent)
      (setq after-change-function nil)))

;;;
;;; GNU Emacs-specific functions 
;;;

(defun eserve-emacs-create-overlay (mark-type start end)
  ;; Create an overlay with the properties specified by MARK TYPE and return
  ;; it.  The function `eserve-create-overlay-or-extent' is aliased to this one
  ;; when running GNU Emacs v19.  N.B.  There are no pixmaps (i.e. true
  ;; glyphs) in GNU Emacs v19.  TBD: replace use of gensym.
  (let
      ((overlay (make-overlay start end))
       (face (eserve-mark-type-face mark-type)))
    (cond
     (face
	(overlay-put overlay 'face (face-name face))
	(overlay-put overlay 'modification-hooks
		     (list 'eserve-emacs-modification-function))
	overlay))))

(defun eserve-emacs-delete-overlay (overlay)
    (when overlay
      (delete-overlay overlay)))

(defun eserve-emacs-modification-function (&rest args)
  ;; Called by the modification hook in the overlay to see if a newline was
  ;; inserted and if so, to terminate the extent before that point.  TBD:
  ;; the corresponding operation of gluing two lines together to form a
  ;; single highlighted line.
  (let ((overlay nil)
	(after nil)
	(start nil)
	(end nil))
    (cond 
     ((= (length args) 3)
      (setq overlay (nth 0 args))
      (setq start (nth 1 args))
      (setq end (nth 2 args)))
     ((= (length args) 4)
      (setq overlay (nth 0 args))
      (setq after (nth 1 args))
      (setq start (nth 2 args))
      (setq end (nth 3 args))))
    (cond 
     (overlay
      (save-excursion
	(if (string-match "
" (this-command-keys))
	    (move-overlay overlay (overlay-start overlay) (point))))))))


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

;;; eserve.el ends here
