;;;
;;; scmail - a mail filter written in Scheme
;;;
;;; Copyright (C) 2002-2004 Satoru Takabayashi <satoru@namazu.org> 
;;;     All rights reserved.
;;;     This is free software with ABSOLUTELY NO WARRANTY.
;;;
;;; Permission to use, copy, modify, distribute this software and
;;; accompanying documentation for any purpose is hereby granted,
;;; provided that existing copyright notices are retained in all
;;; copies and that this notice is included verbatim in all
;;; distributions.
;;; This software is provided as is, without express or implied
;;; warranty.  In no circumstances the author(s) shall be liable
;;; for any damages arising out of the use of this software.
;;;

(define-module scmail.config
  (use file.util)
  (use gauche.parameter)
  (export <config>
          scmail-config-set-directory!
          scmail-config-default-file
          scmail-config-get-path
          scmail-config-make-directory
	  scmail-config-read
          scmail-config
          scmail-config-set-verbose-mode!
          scmail-config-verbose-mode?
	  ))
(select-module scmail.config)

(define scmail-config-directory (make-parameter (expand-path "~/.scmail")))

(define (scmail-config-set-directory! directory)
  (scmail-config-directory directory))

(define-class <config> ()
  ((mailbox :init-value "~/Mail"
	    :init-keyword :mailbox)
   (mailbox-type :init-value 'mh
                 :init-keyword :mailbox-type)
   (inbox :init-value "inbox"
	  :init-keyword :inbox)
   (spam  :init-value "spam"
	  :init-keyword :spam)
   (umask :init-value #o077
          :init-keyword :umask)
   (size-limit :init-value (* (* 1024 1024) 10) ; 10 MB
               :init-keyword :size-limit)
   (smtp-host :init-value "localhost"
	      :init-keyword :smtp-host)
   (log-file :init-value "log"
	     :init-keyword :log-file)
   (deliver-rules :init-value "deliver-rules"
                  :init-keyword :deliver-rules)
   (refile-rules :init-value "refile-rules"
                 :init-keyword :refile-rules)
   (token-table :init-value "token-table.dbm"
                :init-keyword :token-table)
   (digest :init-value "digest.dbm"
            :init-keyword :digest)
   (verbose-mode :init-value #f)

   ;; for backward compatibility
   (junk  :init-value #f
	  :init-keyword :junk)
   ))

(define (build-config-path path)
  (if (absolute-path? path)
      path
      (build-path (scmail-config-directory) path)))

(define-method initialize ((config <config>) initargs)
  (next-method)
  (if (not (or (eq? (ref config 'mailbox-type) 'mh)
               (eq? (ref config 'mailbox-type) 'maildir)))
      (errorf "unsupported mailbox-type: ~a" (ref config 'mailbox-type)))
  (if (ref config 'junk)
      (slot-set! config 'spam (ref config 'junk)))
  
  (for-each (lambda (slot)
              (slot-set! config slot (expand-path (ref config slot))))
            (list 'log-file 'refile-rules 'deliver-rules 'mailbox
                  'token-table 'digest))
)

(define (scmail-config-read config-file)
  (with-error-handler
   (lambda (e) (make <config>))
   (lambda ()
     (let ((options (call-with-input-file config-file
		      (lambda (port) (read port)))))
       (scmail-config (apply make <config> options))
       (scmail-config)))))

(define-method write-object ((config <config>) port)
  (format port "[config]"))

(define scmail-config (make-parameter (make <config>)))

(define (scmail-config-set-verbose-mode!) 
  (slot-set! (scmail-config) 'verbose-mode #t))

(define (scmail-config-verbose-mode?)
  (ref (scmail-config) 'verbose-mode))


;; Return an old path if it is existed for backward compatibility.
(define (choose path)
  (define table
    (map (lambda (pair) (cons (build-config-path (car pair))
                              (expand-path (cdr pair))))
         '(("config"          . "~/.scmailrc")
           ("refile-rules"    . "~/.scmailrc-refile")
           ("deliver-rules"   . "~/.scmailrc-deliver"))))
  (let* ((new-path (expand-path path))
         (old-path (let1 pair (assoc new-path table)
                        (if pair (expand-path (cdr pair)) #f))))
    (if (and old-path
             (not (file-exists? new-path))
             (file-exists? old-path))
        old-path
        new-path)))
  

(define (scmail-config-default-file)
  (choose (build-config-path  "config")))

(define (scmail-config-get-path slot)
  (choose (build-config-path (ref (scmail-config) slot))))

(define (scmail-config-make-directory)
  (let1 path (scmail-config-directory)
        (unless (file-exists? path)
                (with-error-handler
                 (lambda (e)
                   (scmail-eformat "~a" (ref e 'message)))
                 (lambda ()
                   (create-directory* path))))
        (if (file-exists? path)
            (begin 
              (unless (file-is-directory? path)
                      (scmail-eformat "~a is not a directory"))
              (unless (file-is-writable? path)
                      (scmail-eformat "~a is not writable"))))
        ))

(provide "scmail/config")
