(provide 'zwrite)

(defvar zwrite-last-instance nil)
(defvar zwrite-last-recipient nil)
(defvar zwrite-min-height 15)
(defvar zwrite-hook nil "Hooks run when zwrite is entered.")
(defvar zwrite-send-hook nil "Hooks run when a zgram is sent.")
(defvar zwrite-path "/usr/athena/bin/" "Path to zephyr programs")

(defvar zwrite-last-zgram nil "List of class, instance, recipient, body of last *sent* zephyrgram")

(define-abbrev-table 'zwrite-abbrev-table '())

(defun zwrite-triple (class instance recipient &optional generic-buffer-name)
  "Start a zwrite process to the given triple.  Allow the
user to enter a message.  Run zwrite-hook."
  (if (string-equal instance "")
      (error "Ken you're being lame."))
  (let ((b (generate-new-buffer 
	    (if generic-buffer-name
		"*Zwrite*"
	      (format "*Zwrite to <%s,%s,%s>*" class instance recipient)))))
    (switch-to-buffer b)
    (if (< (window-height) zwrite-min-height)
	(enlarge-window (- zwrite-min-height (window-height))))
    (indented-text-mode)
    (insert "*** Zwrite process status: checking for subscribers\n\n")
    (setq local-abbrev-table zwrite-abbrev-table)
    (setq abbrev-mode t)
    (setq major-mode 'zwrite-mode)
    (setq mode-name "Zwrite")
    (make-local-variable 'zwrite-target)
    (make-local-variable 'zwrite-process)
    (setq zwrite-target (list class instance recipient))
    (use-local-map (make-sparse-keymap))
    (local-set-key "\C-c\C-c" 'zwrite-send)
    (message "Press C-c C-c to send message")
    (setq zwrite-process (start-process "Zwrite" b (concat zwrite-path "zwrite")
			   (if (equal recipient "*")
			       "-n"
			     recipient)
			   "-c" class "-i" instance))
    (set-process-sentinel zwrite-process 'zwrite-sentinel)
    (set-process-filter zwrite-process 'zwrite-filter)
    (run-hooks 'zwrite-hook)))

(defun zwrite-filter (proc str)
  (save-excursion
    (set-buffer (process-buffer proc))
    (goto-char (point-min))
    (search-forward ": ")
    (let ((start (point)))
      (end-of-line)
      (delete-region start (point)))
    (cond
     ((string-match (regexp-quote "Type your message now") str)
      (insert "Ready for message"))
     ((string-match (regexp-quote "Not logged in") str)
      (insert "*** NO SUBSCRIBERS ***"))
     ((string-match (regexp-quote "Message sent") str)
      (insert "zwrite successful")
      (message "Message sent to %s" zwrite-target))
     (t
      (insert str)))))

(defun zwrite-send ()
  (interactive)
  (run-hooks 'zwrite-send-hook)
  (message (format "Sending message to %s" zwrite-target))
  (save-excursion
    (goto-char (point-max))
    (if (not (bolp)) (insert "\n"))
    (goto-char (point-min))
    (forward-line 1)
    (if (eolp) (forward-line 1))
    (let ((text (buffer-substring (point) (point-max))))
      (process-send-string zwrite-process text)
      (setq zwrite-last-zgram (append zwrite-target (list text))))
    (process-send-string zwrite-process "\C-d"))
  (if (fboundp 'zlog-add)
      (apply 'zlog-add zwrite-last-zgram))
  (bury-buffer (current-buffer))
  (switch-to-buffer (other-buffer) t))

(defun zwrite-resend ()
  (interactive)
  (if zwrite-last-zgram
      (progn
	(zwrite-triple (nth 0 zwrite-last-zgram)
		       (nth 1 zwrite-last-zgram)
		       (nth 2 zwrite-last-zgram))
	(insert (nth 3 zwrite-last-zgram)))
    (error "No last zephyrgram")))
	
(defun zwrite-string-to-triple (msg class inst recip)
  (let ((p (apply 'start-process
		  (append
		   (list "Zwrite" nil (concat zwrite-path "zwrite"))
		   (if (equal recip "*") nil (list recip))
		   (list "-n" "-c" class "-i" inst)))))
    (process-send-string p msg)
    (process-send-string p "\n\C-d"))
  (if (fboundp 'zlog-add)
      (zlog-add class inst recip msg)))

    
(defun zwrite-sentinel (proc str)
  (kill-buffer (process-buffer proc)))

(defun zwrite-get-option (prompt specified last)
  (or specified
      (let ((input (read-from-minibuffer
		    (format "%s [%s]: " prompt
			    last))))
	(if (equal input "") nil input))
      last))

(defun zwrite-personal (&optional recip)
  (interactive)
  (setq zwrite-last-recipient  
	(zwrite-get-option "Send personal message to" 
			   recip zwrite-last-recipient))
  (zwrite-triple "message" "personal" zwrite-last-recipient))

(defun zwrite-instance (&optional inst)
  (interactive)
  (setq zwrite-last-instance  
	(zwrite-get-option "Write to instance" 
			   inst zwrite-last-instance))
  (zwrite-triple "message" zwrite-last-instance "*"))
  
(defun zwrite-i-help ()
  (interactive)
  (zwrite-instance "help"))

(defun zwrite-i-sipb ()
  (interactive)
  (zwrite-instance "sipb"))

(defun zwrite-punt-instance (instance)
  (interactive "sInstance to punt: ")
  (start-process (concat "punt-instance-" instance)
		 nil (concat zwrite-path "zctl")  "unsub" "message" instance "*"))

(defun zwrite-punt-all ()
  (interactive)
  (call-process (concat zwrite-path "zctl") nil nil nil "cancel")
  (start-process  "resubscribe-personal" nil (concat zwrite-path "zctl") "sub" "message" "personal" "*"))

(defun zwrite-help-rtfm ()
  (interactive)
  (zwrite-string-to-triple "rtfm..."
			   "message" "help" "*"))

(defun zwrite-help-tryit ()
  (interactive)
  (zwrite-string-to-triple "try it..."
			   "message" "help" "*"))
  

;;; Yes, the following three functions are almost identical
;;; and should use a common core, like zwgc-apply-cell.

(defun zwrite-reply-to-sender ()
  (interactive)
  (let (sender)
    (save-excursion
      (set-buffer (get-buffer "*zwgc*"))
      (goto-char (point-min))
      (if (re-search-forward "From \\(.*\\) on" nil t)
	  (setq sender (buffer-substring (nth 2 (match-data)) (nth 3 (match-data))))))
    (if sender
	(zwrite-personal sender))))

(defun zwrite-reply-to-instance ()
  (interactive)
  (let (instance)
    (save-excursion
      (set-buffer (get-buffer "*zwgc*"))
      (goto-char (point-min))
      (if (re-search-forward " *\\([^ \n]*\\)")
	  (setq instance (buffer-substring (nth 2 (match-data)) (nth 3 (match-data))))))
    (if instance
	(zwrite-instance instance))))


(defun zwrite-reply-to-instance-unless-personal ()
  (interactive)
  (let (instance)
    (save-excursion
      (set-buffer (get-buffer "*zwgc*"))
      (goto-char (point-min))
      (if (re-search-forward " *\\([^ \n]*\\)")
	  (setq instance (buffer-substring (nth 2 (match-data)) (nth 3 (match-data))))))
    (if instance
	(cond
	 ((string-equal (downcase instance) "personal")
	  (zwrite-reply-to-sender))
	 ((string-equal (downcase instance) "looney")
	  (zwrite-triple "looney" "reply" "*"))
	 (t
	  (zwrite-instance instance))))))