;;;; remote-mailbox-common.scm
;;;; Kon Lovett, Sep '09

(module remote-mailbox-common

(;export
  ;;
  mailbox-name?
  tcp-port?
  hostname?
  error-mailbox-name
  error-tcp-port
  error-hostname
  check-mailbox-name
  check-tcp-port
  check-hostname
  ;;
  default-remote-mailbox-tcp-port
  default-remote-mailbox-hostname)

(import scheme chicken)

(import
  (only srfi-13 string-null?)
  (only miscmacros define-parameter)
  (only type-errors warning-argument-type)
  (only type-checks define-check+error-type))
(require-library srfi-13 miscmacros type-errors type-checks)

;;;

(define-constant DEFAULT-TCP-PORT 63001)
(define-constant DEFAULT-HOSTNAME "localhost")

;;;

(define mailbox-name? symbol?)

(define (tcp-port? obj)
  (and
    (fixnum? obj)
    (and (fx< 0 obj) (fx< obj 65536))) )

(define (hostname? obj)
  (and
    (string? obj)
    (not (string-null? obj))) )

;;;

(define-check+error-type mailbox-name)
(define-check+error-type hostname)
(define-check+error-type tcp-port)

;;; Parameters

(define-parameter default-remote-mailbox-tcp-port DEFAULT-TCP-PORT
	(lambda (x)
		(cond
		  ((tcp-port? x)  x )
		  ((not x)        DEFAULT-TCP-PORT )
      (else
        (warning-argument-type 'default-remote-mailbox-tcp-port x 'procedure)
        (default-remote-mailbox-tcp-port) ) ) ) )

(define-parameter default-remote-mailbox-hostname DEFAULT-HOSTNAME
	(lambda (x)
		(cond
		  ((hostname? x)  x )
		  ((not x)        DEFAULT-HOSTNAME )
      (else
        (warning-argument-type 'default-remote-mailbox-hostname x 'procedure)
        (default-remote-mailbox-hostname) ) ) ) )

) ;module remote-mailbox-common