;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:ZL -*-
;;
;;; Utility for automatically generating ZMail.init file
;;; containing bug report filters for organizing incoming mail.
;;;
;;; -dg 2/28/86
;;;

(defconst *default-bug-filter-list*
	  '(
	    bug-lispm
	    bug-local-file
	    bug-file-server
	    bug-object-lisp
	    bug-site-editor
	    bug-gateway
	    bug-tape
	    bug-tiger
	    bug-lambda-diag
	    bug-kermit
	    bug-tcp
	    bug-unix-interface
	    bug-zmail
	    bug-window-maker
	    bug-zwei
	    bug-unix
	    software-testers
	    software-release
	    ))

(defun write-filter-file (&key
			  (bug-filter-list *default-bug-filter-list*)
			  other-filters
			  (load t))
  (let ((init-filename (send (fs:user-homedir) :new-pathname
			     :name "ZMail-filters"
			     :canonical-type :lisp))
	filter-move-list
	other-mail-list
	(filter-list (append bug-filter-list other-filters)))
    (unless (and (probef init-filename)
		 (not (yes-or-no-p "Filter Init file already exists... clobber it?")))
      (with-open-file (f init-filename :direction :output)
	;;; write the header
	(format f ";;; Automatically generated ZMail init file ~
                   -*- Mode:Lisp; Package:ZWEI; Readtable:ZL; Base:10 -*-~2%")
	;;; Assess mail files and filter associations for filters
	(dolist (filter filter-list)
	  (let ((filter-filename (format nil "~A:////lmi////~A////mail////~A"
				      fs:user-login-machine
				      fs:user-id
				      (string-downcase filter))))
	    (push (cons filter filter-filename) filter-move-list)
	    (push (fs:parse-pathname filter-filename) other-mail-list)))
	;;; output mail file list
	(pprint `(setq *other-mail-file-names* ',other-mail-list) f)
	(format f "~2%")
	;;; output filter associations
	(pprint `(setq *filter-move-mail-file-alist* ',filter-move-list) f)
	(format f "~2%")
	;;; write filter definitions
	(dolist (filter filter-list)
	  (pprint
	    `(DEFINE-FILTER ,filter (MSG)
	       (msg-header-recipient-search *recipient-type-headers*
					    ,(format nil "~c~A~c"
						     #/top-j
						     (string-downcase filter)
						     #/top-k)))
		  f)
	  (format f "~2%")))
      (when load
	(load init-filename)))))