(require 'zephyr)

(defun zephyr-no-buffer (name default filters)
  (setq zephyr-initial-history (list default))
  (zephyr-new-buffer name)
  (setq zephyr-filters
	(append zephyr-filters
		filters
		'((nil))))
  (beginning-of-line))

(defun classes-no-filters (classes value)
  (mapcar (lambda (class)
	    (list (cons 'class (concat "^" class "\\(\.d\\)*$")) value))
	  classes))

(defun instances-no-filters (class instances value)
  (mapcar (lambda (instance)
	    (list (cons 'class (concat "^" class "\\(\.d\\)*$")) 
		  (cons 'instance (concat "^" instance "\\(\.d\\)*$")) value))
	  instances))

(defun class-defaultify (class)
  (concat "(" class ":personal)"))

(defun zephyr-class (class)
  (interactive "sClass: ")
  (zephyr-no-buffer class
		    (class-defaultify class)
		    (classes-no-filters (list class) t)))

(defun zephyr-my-banner (msg)
  (let 
      ((auth (cdr (assq 'auth msg)))
       (signature (assq 'signature msg))
       (opcode (assq 'opcode msg))
       (time (assq 'time msg))
       (class (assq 'class msg))
       (fromhost (assq 'fromhost msg)))
    (cons (cons 'banner
		(concat 
		 (cond (time (substring (cdr time) 11 16)) (t ""))
		 " "
		 (zephyr-fromline msg)
		 (cond ((and opcode (cdr opcode))
			(concat "[" (symbol-name (cdr opcode)) "]")) (t ""))
		 (cond ((eq auth 'yes) "")
		       ((eq auth 'failed) "?")
		       ((eq auth 'no) "*"))
		 zephyr-receive-divider
		 (if (and signature
			  (not (and class 
				    (string-match "noc" 
						  (symbol-name (cdr class))))))
		     (concat (cdr signature) "\n")
		   "")
		 ))
	  msg)))


(defun zephyr-ensure-final-newline (msg)
  (let ((print-as (assq 'print-as msg)))
    (if print-as
	(if (not (equal "\n" (substring (cdr print-as) -1 'nil)))
	    (setcdr print-as (concat (cdr print-as) "\n")))))
  msg)

; colorizing code liberally lifted from mark eichin 2/19/99
(setq zephyr-face-list 
      '(fg:yellow fg:orange fg:red fg:blue fg:magenta fg:cyan fg:green
        bg:red4 bg:blue
	bg:grey24))
(require 'facemenu)
(mapcar (lambda (x) (facemenu-get-face x)) zephyr-face-list)

(make-face 'blood-on-concrete)
(if (and window-system 
	 (x-color-defined-p "red")
	 (x-color-defined-p "grey24"))
    (progn
      (set-face-foreground 'blood-on-concrete "red")
      (set-face-background 'blood-on-concrete "grey24")))
   

(defun zephyr-colorize (msg)
  (let ((bannertext (assq 'banner msg))
	(bodytext (assq 'print-as msg))
	(recipient (assq 'recipient msg))
	(opcode (assq 'opcode msg))
	(class (assq 'class msg))
	(instance (assq 'instance msg))
	(msgface nil))
    (if class
	(let ((classname (downcase (symbol-name (cdr class)))))
	  (if (equal classname "noc")
	      (setq msgface 'blood-on-concrete))
	  (if (equal classname "ops")
	      (setq msgface 'bg:red4))
	  (if (equal classname "athena-sluts")
	      (setq msgface 'fg:green))
	  (if (equal classname "blood")
	      (setq msgface 'fg:magenta))
	  (if (equal classname "message")
	      (if (and instance (string-match "^weather\\(\.d\\)*$" 
					      (cdr instance)))
		  (setq msgface 'blood-on-concrete)
		(setq msgface 'fg:orange)))
	  ))
    (if (and opcode (equal (downcase (symbol-name (cdr opcode))) "auto"))
	(setq msgface 'blood-on-concrete))
    (if (and recipient (equal (user-login-name) (cdr recipient)))
	(setq msgface 'bg:blue))
    (if bannertext
	(set-text-properties 0
			     (length (cdr bannertext))
			     (list 'face (or msgface 'default))
			     (cdr bannertext)))
    (if bodytext
	(set-text-properties 0
			     (length (cdr bodytext))
			     (list 'face (or msgface 'default))
			     (cdr bodytext)))
    )
  msg)

(defun zephyr-reparse-noc-messages (msg)
  (let ((class (assq 'class msg))
	(instance (assq 'instance msg))
	(opcode (assq 'opcode msg))
	(time (assq 'time msg))
	(banner (assq 'banner msg))
	(print-as (assq 'print-as msg))
	(auth (cdr (assq 'auth msg)))
	(fields (cdr (assq 'message msg))))
    (if (and class
	     (string-match "noc" (symbol-name (cdr class)))
	     (equal (length fields) 4)
	     (eq auth 'yes))
	(progn
	  (setcdr banner (concat
			  (if time (substring (cdr time 11 16)) "")
			  " "
			  (if instance (cdr instance) "")
			  zephyr-receive-divider
			  (if (and opcode (cdr opcode))
			      (concat (symbol-name (cdr opcode))
				      " service "))
			  (nth fields 2)))
	  (setcdr print-as (nth fields 3)))))
  msg)

(setq zephyr-hook-list '(zephyr-parse 
			 zephyr-dispatch
			 zephyr-parse-fields
			 zephyr-my-banner
			 zephyr-reparse-noc-messages
			 zephyr-ensure-final-newline
			 zephyr-colorize
			 zephyr-insert))

(setq zephyr-insert-hook-list '(zephyr-ping-notify
				zephyr-insert-message
				zephyr-make-message-extents
				zephyr-touch
;				zephyr-notify-with-message
;				zephyr-notify-with-deiconify
;				zephyr-notify-with-beep
				))

(setq zephyr-extra-subscriptions '(
				   ("message" "urgent" "%me%")
				   ("sipb" "*" "*")
				   ("noc" "*" "*")
				   ("ops" "*" "*")
				   ("filsrv" "*" "*")
				   ("message" "*" "*")
				   ("afsadm" "*" "*")
				   ("moira" "*" "*")
				   ("sms" "*" "*")
				   ("zone-cell" "*" "*")
				   ("zone" "*" "*")
				   ("netbsd" "*" "*")
				   ("kcr" "*" "*")
				   ("zsex" "*" "*")
				   ("mail" "pop" "%me%")
				   ("syslog" "*" "%me%")
				   ("jhawk" "*" "*")
				   ("geek" "*" "*")
				   ("blood" "*" "*")
				   ("consult" "*" "*")
				   ("sipb.phone" "*" "*")
				   ("n42" "*" "*")
				   ("athena-sluts" "*" "*")
				   ("athena-prudes" "*" "*")
				   ("spo" "*" "*")
				   ("tofkas" "*" "*")
				   ("anonymous" "*" "*")
				   ("anonzsex" "*" "*")
				   ("wsmonitor" "*" "*")
				   ("olc" "*" "*")
				   ("olta" "*" "*")
				   ("owl" "*" "*")
				   ("message.d" "*" "*")
				   ("discuss" "*" "%me")
				   ("security" "*" "*")
				   ))

;(setq zephyr-filters 
;      '(((opcode . "PING") nil)
;	((class . "^MESSAGE$") (instance . "^6") nil)
;	((class . "^MESSAGE$") (instance . "^AHOOY\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^CGK\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^PROVERB\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^APO\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^ORFF\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^STUDS\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^WHITE-MAGIC\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^TMBG\\(\.D\\)*$") nil)
;	((class . "^MESSAGE$") (instance . "^SUN-TZU\\(\.D\\)*$") nil)
;	))

(setq zephyr-log-buffer-limit 2097152)
(setq zephyr-bufffer-limit 2097152)

; summarily punt these instances
(setq zephyr-filters (instances-no-filters "message"
					   '("ahooy" "cgk" "proverb" "apo"
					      "studs") nil))

(setq normal-instances '("kcr" "consult" "printadm" "watchmaker" "weather" 
			 "fortune" "b5-quotes" "network" "test"))
(setq normal-classes '("ops" "afsadm" "wsmonitor" "moira" "sms" "zone"
		       "zone-cell" "consult" "geek" "netbsd" "security" 
		       "blood" "athena-sluts" "olc" "noc" "filsrv" "syslog"
		       "mail" "login" ))
(setq sipb-instances '("sipb"))
(setq sipb-classes '("sipb" "sipb.phone"))
(setq chatty-instances '("help" "b5"))
(setq chatty-classes '("anonymous" "anonzsex"))


(setq scroll-step 4)

(setq zephyr-receive-program (list "tzc" "-e" "OPSTAFF" "-l" "*zephyr*"
				   ))

(setq zephyr-signature "never again")

(setq normal-filters (append
		      (list (list (cons 'recipient (user-login-name)) t))
		      (instances-no-filters "message" normal-instances t)
		      (classes-no-filters normal-classes t)))
(setq sipb-filters (append
		    (instances-no-filters "message" sipb-instances t)
		    (classes-no-filters sipb-classes t)))
(setq chatty-filters (append
		    (instances-no-filters "message" chatty-instances t)
		    (classes-no-filters chatty-classes t)))
(setq trash-filters (append
		     (list (list (cons 'recipient (user-login-name)) nil))
		     (instances-no-filters "message" normal-instances nil)
		     (classes-no-filters normal-classes nil)
		     (instances-no-filters "message" sipb-instances nil)
		     (classes-no-filters sipb-classes nil)
		     (instances-no-filters "message" chatty-instances nil)
		     (classes-no-filters chatty-classes nil)))


(defun zephyr-normal ()
  (interactive)
  (zephyr-no-buffer "normal" "kcr" normal-filters))
(defun zephyr-sipb ()
  (interactive)
  (zephyr-no-buffer "sipb" "(sipb:misc)" sipb-filters))
(defun zephyr-chatty ()
  (interactive)
  (zephyr-no-buffer "chatty" "(zsex:angst)" chatty-filters))
(defun zephyr-trash ()
  (interactive)
  (Zephyr-no-buffer "trash" "(lllllllllllll)" trash-filters))
(defun zephyr-tower ()
  (interactive)
  (zephyr-no-buffer "tower" "kcr" (append normal-filters
					  sipb-filters)))
(defun zephyr-loud ()
  (interactive)
  (zephyr-no-buffer "loud" "kcr" (append normal-filters
					 sipb-filters
					 chatty-filters)))
(defun zephyr-noise ()
  (interactive)
  (zephyr-no-buffer "noise" "(sipb:misc)" (append chatty-filters
						  sipb-filters)))
		     
(defun old-zephyr-normal ()
  (interactive)
  (zephyr-no-buffer "normal" "kcr" 
		    (append
		     (instances-no-filters "message" normal-instances t)
		     (classes-no-filters normal-classes t)
		     (list (list (cons 'recipient (user-login-name)) t))
		     )))