;;;ChangeLog:
;;;gsstark added completion based on zsend's completion (by gamadrid)
;;;gsstark added zsig randomizer
;;;gsstark added zwrite-reply-to-xzwgc kludge that takes username from my zwgc
;;;gsstark added zwrite-cancel 18/05/94
;;;[gsstark:19950209.2322EST] added let binding for default-directory around start-process

(provide 'zwrite)

(defvar zwrite-last-instance nil)
(defvar zwrite-last-recipient nil)
(defvar zwrite-last-class nil)
(defvar zwrite-last-class-instance nil)
(defvar zwrite-min-height 5)
(defvar zwrite-max-height 1000)
(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-bin nil)
(defvar zwrite-*completion-list* (list (list ))
  "completion list for zwrite.el, should be changed to used two lists, this one being set to the appropriate list for a particular call")

(defvar zwrite-reply-file "~/.zreplyuser")
(defvar zwrite-last-zgram nil "List of class, instance, recipient, body of last *sent* zephyrgram")
(defvar zwrite-opcode "")
(defvar zwrite-rndsigs-file "~/.rndsigs.el")
(defvar zwrite-rndsigs-vector nil)
					;(require 'zwrite-rndsigs zwrite-rndsigs-file)
(defvar zwrite-use-rndsigs nil)
(defvar zwrite-use-pty nil)
(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)
    (pop-to-buffer b)
    (if (< (window-height) zwrite-min-height)
	(enlarge-window (- zwrite-min-height (window-height))))
    (if (> (window-height) zwrite-max-height)
	(progn
	  (other-window -1) 
	  ;; note implied double negative 

	  (shrink-window (- zwrite-max-height (window-height)))
	  (other-window 1)
	  ))
    (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-x" 'zwrite-cancel)
    (local-set-key "\C-xk" 'zwrite-cancel) ;trying this out, it's a bit weird
    (local-set-key "\C-c\C-c" 'zwrite-send)
    (message "Press C-c C-c to send message, C-c C-x to cancel")
					;    (setq zwrite-current-zsig (zwrite-get-rndsig))
    (let ((process-connection-type zwrite-use-pty)
	  (default-directory (expand-file-name "~/")))
      (setq zwrite-process (start-process "Zwrite" 
					  b 
					  (or zwrite-bin
					      (concat zwrite-path "zwrite"))
					  "-l"
					  (if (equal recipient "*")
					      "-n" 
					    recipient)
					  "-d"
					  "-c" class 
					  "-i" instance
					  "-O" zwrite-opcode
					;					"-s" zwrite-current-zsig
					  ))
      )      
    (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 fo message\nRandom zsigs disabled"))
					;      (insert (format "Ready for message\n%s" 
					;		      zwrite-current-zsig ))
     ((string-match (regexp-quote "Not logged in") str)
      (insert "*** NO SUBSCRIBERS ***")
      (message "*** NO SUBSCRIBERS ***")
      (beep) (beep)
      (zwrite-cancel);; testing this, with my luck, it'll probably crash emacs
      )
     ((string-match (regexp-quote "Message sent") str)
      (insert "zwrite successful")
      (message "Message sent to %s" zwrite-target))
     (t
      (insert str)))))

(defun zwrite-do-eof (zwrite-process)
  (process-send-eof zwrite-process)
  (condition-case nil
      (process-send-string zwrite-process "\n\C-d")
    (error nil)))

(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))
    (search-forward "===")
    (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))))
    (zwrite-do-eof zwrite-process)
    )
  (if (fboundp 'zlog-add)
      (apply 'zlog-add zwrite-last-zgram))
  (zwrite-cancel t)
;;;  (bury-buffer (current-buffer))
;;;  (switch-to-buffer (other-buffer) t)
  )

;;; currently this function does a pretty good job of DTRT
;;; ideally zwrite-send would save the buffer you came from
;;; and this funtion would put you back there,
;;; but I expect that would be trickier to get right
;;; with regards to the window placements
(defun zwrite-cancel (&optional dont-kill-me-p)
  (interactive "P")
  (if dont-kill-me-p
      (bury-buffer (current-buffer))
    (kill-buffer (current-buffer)))
  (delete-window)
  (other-window -1)
  ;;hack to help emacs-zwgc users, 
  ;;should fix this by defining a function in emacs-zwgc that does this
					;  (if (string= (buffer-name) "*zwgc*")
					;      (other-window -1))
					;  (if (string= (buffer-name) "*zwgc*")
					;    (progn
					;      (split-window)
					;      (switch-to-buffer (other-buffer "*zwgc*"))
					;      (zwgc-current-notice))))
  )

(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)
    (zwrite-do-eof p))
  (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)
  (setq zwrite-opcode "")
  (let ((option (or specified
		    (let* ((minibuffer-local-completion-map
			    (append minibuffer-local-completion-map
				    '((15 . zwrite-set-opcode)) )) ;ctrl-o
			   (input (completing-read
				   (format "%s [%s]: " prompt last)
				   zwrite-*completion-list*
				   nil
				   nil)))
		      (if (equal input "") nil input))
		    last)))
    (zwrite-add-to-list zwrite-*completion-list* option)
    option))
       

(defun zwrite-set-opcode nil
  (interactive)
  (setq zwrite-opcode (completing-read
		       (format "%s []: " "What Opcode")
		       zwrite-*completion-list*
		       nil
		       nil))
  (zwrite-add-to-list zwrite-*completion-list* zwrite-opcode) )

(defun zwrite-add-to-list (which-list name)
  (if (not (assoc name which-list))
      (let ((new-entry (cons name nil))	; Create new list element for name
	    (new-cell (cons (car which-list) (cdr which-list)))
	    )
	(setcar which-list new-entry)
	(setcdr which-list new-cell))))

(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-class (&optional class inst)
  (interactive)
  (setq zwrite-last-class
	(zwrite-get-option "Write to class" 
			   class zwrite-last-class))
  (setq zwrite-last-class-instance
	(zwrite-get-option "And instance"
			   inst zwrite-last-class-instance))
  (zwrite-triple zwrite-last-class zwrite-last-class-instance "*"))

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

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

(defun zwrite-punt-instance (instance)
  (interactive "Instance to punt: ")
  (start-process (concat "punt-instance-" instance)
					;		 nil (concat zwrite-path "zctl")  "unsub" "message" instance "*"
		 nil "/afs/sipb.mit.edu/project/sipb/bin/zpunt" 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-faq ()
  (interactive)
  (zwrite-string-to-triple "help instance FAQ #1:
Q) anyone out there able to help me with foo?
A) don't know, ask the question and find out.
"
			   "message" "help" "*"))

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

(defun zwrite-reply-to-xzwgc-sender ()
  (interactive)
  (let (sender)
    (save-excursion
      (set-buffer (generate-new-buffer " *zwrite-xzwgc-sender*"))
      (insert-file-contents zwrite-reply-file)
      (setq sender (buffer-string))
      (kill-buffer (current-buffer)))
    (if sender
	(zwrite-personal sender))))

;;; 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-get-rndsig nil
  (let* ((max  (length zwrite-rndsigs-vector))
	 (signum (% (random) max))
	 (signum (if (natnump signum)
		     signum
		   (- signum)))
	 (sig (aref zwrite-rndsigs-vector signum)))
    sig))
	 

					;(defun zwrite-load-rndsigs (&optional given-file-name)
					;  (load-file (or given-file-name
					;		 zwrite-rndsigs-filename)))