(require 'zwrite)
(require 'zwgc)
(provide 'znol)

(defvar zwgc-got-notice-hook nil)	;Just in case not bound yet

(defvar znol-watch nil)			;List of people to especially watch for
					;(i.e., beep a lot when they log in or out)

(defvar zwgc-ding nil)

(defconst znol-buffer-name "*Znol*" 
  "Znol buffer name")

(defvar znol-buffer (get-buffer-create znol-buffer-name)
  "Znol buffer")

(defvar znol-process nil 
  "Znol process")

(defvar znol-retries nil
  "Number of times we've tried restarting znol")

(defvar znol-command-line '("/usr/athena/znol")
  "List: znol executable and command-line arguments")

(defvar znol-process-babble ""
  "Incomplete line from znol process (just in case)")

(defvar znol-regexp "\\([^:]*\\): \\([^\t]*\\)\t"
  "Regular expression to parse znol output into username and machine")

(defvar znol-class-login-regexp "^[ \t]*\\([^ \t\n]+\\) logged \\([^ \t\n]+\\)")

(defvar znol-class-login-machine-regexp "^on \\([^ \t]+\\) on")

(defun znol-start ()
  (interactive)
  (if (not znol-retries)
      (setq znol-retries 0))
  (save-excursion 
    (setq znol-buffer (get-buffer-create znol-buffer-name))
    (set-buffer znol-buffer)
    (fundamental-mode)
    (use-local-map (make-sparse-keymap))
    (define-key (current-local-map) "\C-?" (function
					     (lambda nil 
					       (interactive)
					       (let ((b (current-buffer)))
						 (switch-to-buffer (other-buffer))
						 (bury-buffer b)))))
    (define-key (current-local-map) "q" 'delete-window)
    (define-key (current-local-map) "\er" 'znol-start)
    (delete-region (point-min) (point-max))
    (insert "*** Znol process still running ***\n")
    (if znol-process
	(condition-case error (kill-process znol-process)
	  (error)))
    (setq znol-process (apply 'start-process 
			      (append (list "*znol*" znol-buffer)
				      znol-command-line)))
    (set-process-filter znol-process 'znol-filter)
    (set-process-sentinel znol-process 'znol-sentinel))
  (or (memq 'znol-parse-zephyrgram zwgc-got-notice-hook)
      (setq zwgc-got-notice-hook (cons 'znol-parse-zephyrgram zwgc-got-notice-hook))))

(defun znol-sentinel (proc str)
  (setq znol-retries nil)
  (save-excursion
    (set-buffer znol-buffer)
    (goto-char (point-min))
    (forward-line 1)
    (delete-region (point-min) (point))
    (zwrite-string-to-triple 
     (buffer-substring (point-min) (point-max))
     "message" "personal" (getenv "USER"))))

(defun eval-after-sleeping (secs form)
  (set-process-sentinel
   (start-process (format "Sleep %s before %s" secs form) nil "/bin/sleep" (format "%s" secs))
   (list 'lambda '(_process _status) form)))

(defun znol-sentinel-restart (proc str)
  (if (eq znol-retries 4)
      (message "znol: too many failures ... giving up")
    (setq znol-retries (1+ znol-retries))
    (message "znol process failed --- restarting")
    (eval-after-sleeping 15 '(znol-start))))

(defun znol-filter (proc str)
  (setq str (concat znol-process-babble str))
  (let (nl line)
    (while (setq nl (string-match "\n" str))
      (setq line (substring str 0 (1- nl)))
      (setq str (substring str (1+ nl)))
      (if (string-match (regexp-quote "getting WindowGram p") line)
	  (set-process-sentinel znol-process 'znol-sentinel-restart)
	(string-match znol-regexp line)
	(znol-login (substring line (match-beginning 1) (match-end 1))
		    (substring line (match-beginning 2) (match-end 2)))))))

(defun znol-find-line (name machine)
  (goto-char (point-min))
  (let ((case-fold-search t))
    (re-search-forward (concat "^" (regexp-quote name) "[ \t]+" (regexp-quote machine) "$")
		       (point-max) t)))

(defun znol-login (name machine)
  (save-excursion 
    (set-buffer znol-buffer)
    (goto-char (point-min))
    (or (znol-find-line name machine)
	(progn
	  (goto-char (point-max))
	  (insert name)
	  (indent-to-column 15)
	  (insert (concat machine "\n"))))))


(defun znol-logout (name machine)
  (save-excursion 
    (set-buffer znol-buffer)
    (goto-char (point-min))
    (if (znol-find-line name machine)
	(progn
	  (beginning-of-line)
	  (let ((p (point)))
	    (forward-line 1)
	    (delete-region p (point)))))))

(defun znol-show ()
  (interactive)
  (pop-to-buffer znol-buffer)
  (select-window (previous-window (selected-window))))

(defun znol-parse-zephyrgram ()
  (if zwgc-ding
      (beep))
  (let ((zgram (buffer-substring (point-min) (point-max))))
    (if (string-match znol-class-login-regexp zgram)
	(let ((name (substring zgram (match-beginning 1) (match-end 1)))
	      (inout (substring zgram (match-beginning 2) (match-end 2))))
	  (if (string-match znol-class-login-machine-regexp zgram)
	      (progn
		(funcall
		 (if (equal inout "in") 'znol-login 'znol-logout)
		 name
		 (substring zgram (match-beginning 1) (match-end 1)))
		(znol-maybe-alert name)))))))

(defun znol-maybe-alert (name)
  (let ((people znol-watch))
    (while people
      (if (string-equal name (car people))
	  (progn 
	    (message "%s just logged in" name)
	    (let ((n 3))
	      (while (> n 0)
		(beep)
		(setq n (1- n))))))
      (setq people (cdr people)))))


(defun znol-watch (who)
  (interactive "sUser name to look out for: ")
  (if (> (length who) 0) 
      (setq znol-watch (cons who znol-watch)))
  (message (format "Now watching for: %s" znol-watch)))