;;;
;;; 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.mailbox
  (use srfi-1)
  (use file.util)
  (use gauche.parameter)
  (export <mailbox>
          make-scmail-mailbox
          scmail-mailbox-mail-list
          scmail-mailbox-make-folder
          scmail-mailbox-folder->path
          scmail-mailbox-add-type!
          ))

(select-module scmail.mailbox)

(define-class <mailbox> () 
  ((location :init-value #f
             :init-keyword :location)))

(define-method scmail-mailbox-mail-list ((mailbox <mailbox>) folder)
  (scmail-not-implemented-error mailbox 'scmail-mailbox-mail-list))

(define-method scmail-mailbox-make-folder ((mailbox <mailbox>) folder)
  (let1 dest-directory (scmail-mailbox-folder->path mailbox folder)
        (create-directory* dest-directory)
        dest-directory))

(define-method scmail-mailbox-folder->path ((mailbox <mailbox>) folder)
  (build-path (ref mailbox 'location) folder))

(define supported-mailbox-type-table (make-parameter '()))

(define (scmail-mailbox-add-type! name class)
  (supported-mailbox-type-table  (cons (cons name class)
                                       (supported-mailbox-type-table))))

(define (make-scmail-mailbox mailbox-type location)
  (let1 pair (assq mailbox-type (supported-mailbox-type-table))
        (if pair
            (make (cdr pair) :location location)
            (errorf "unsupported mailbox-type: ~a" mailbox-type))))
  
(provide "scmail/mailbox")


