(provide 'zwrite)
(require 'zsigs)
(zsigs-init)

(defvar zwrite-last-instance nil)
(defvar zwrite-last-recipient nil)
(defvar zwrite-last-class 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")

; Alists have the form (("name") ("anothername") ("foo"))
(defvar zwrite-recipient-list (list (list (user-login-name))))
(defvar zwrite-instance-list (list (list )))
(defvar zwrite-class-list (list (list )))

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

(defun zwrite-triple (class instance recipient &optional
			    generic-buffer-name save-pair)
  "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)
    (make-local-variable 'zwrite-save-pair)
    (make-local-variable 'zwrite-sig)
    (setq zwrite-target (list class instance recipient))
    (setq zwrite-save-pair save-pair)
    (setq zwrite-sig (zsigs 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)
			 "-s" zwrite-sig
			 "-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")
      (if zwrite-save-pair
	  (zwrite-add-to-list (cdr zwrite-save-pair) (car zwrite-save-pair)))
      (message "%s: %s" (nth 2 zwrite-target) zwrite-sig))
     (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 list)
  (or specified
      (let ( (input (completing-read (format "%s [%s]: " prompt last) list)) )
	(if (equal input "") (eq 1 0) input))
      last))

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

(defun zwrite-instance (&optional inst)
  (interactive)
  (setq zwrite-last-instance  
	(zwrite-get-option "Write to instance" 
			   inst zwrite-last-instance
			   zwrite-instance-list))
  (zwrite-triple "message" zwrite-last-instance "*" nil 
		 (cons zwrite-last-instance zwrite-instance-list)))
  
(defun zwrite-class (&optional class)
  (interactive)
  (setq zwrite-last-class
	(zwrite-get-option "Write to class(instance)"
			   class zwrite-last-class
			   zwrite-class-list))
  (string-match "\\(.*\\)(\\(.*\\))" zwrite-last-class)
  (zwrite-triple (substring zwrite-last-class (match-beginning 1) (match-end 1))
		 (substring zwrite-last-class (match-beginning 2) (match-end 2))
		 "*" nil (cons zwrite-last-class zwrite-class-list)))

(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))))))


(defun zwrite-add-to-list (list name)
  "Make a new entry at the beginning of LIST which contains NAME as
it's car.  Creates a list suitable for use as an alist."
  (if (not (assoc name list))
      (let ((new-entry (cons name nil))
	    (new-cell (cons (car list) (cdr list))))
	(setcar list new-entry)
	(setcdr list new-cell)
	list)))