source: project/release/4/remote-mailbox/tags/2.1.0/remote-mailbox-common.scm @ 33908

Last change on this file since 33908 was 33908, checked in by kon, 2 years ago

mv serialize to adapter module

File size: 1.6 KB
Line 
1;;;; remote-mailbox-common.scm
2;;;; Kon Lovett, Sep '09
3
4(module remote-mailbox-common
5
6(;export
7  ;;
8  mailbox-name?
9  tcp-port?
10  hostname?
11  error-mailbox-name
12  error-tcp-port
13  error-hostname
14  check-mailbox-name
15  check-tcp-port
16  check-hostname
17  ;;
18  default-remote-mailbox-tcp-port
19  default-remote-mailbox-hostname)
20
21(import scheme chicken)
22
23(import
24  (only srfi-13 string-null?)
25  (only miscmacros define-parameter)
26  (only type-errors warning-argument-type)
27  (only type-checks define-check+error-type))
28(require-library srfi-13 miscmacros type-errors type-checks)
29
30;;;
31
32(define-constant DEFAULT-TCP-PORT 63001)
33(define-constant DEFAULT-HOSTNAME "localhost")
34
35;;;
36
37(define mailbox-name? symbol?)
38
39(define (tcp-port? obj)
40  (and
41    (fixnum? obj)
42    (and (fx< 0 obj) (fx< obj 65536))) )
43
44(define (hostname? obj)
45  (and
46    (string? obj)
47    (not (string-null? obj))) )
48
49;;;
50
51(define-check+error-type mailbox-name)
52(define-check+error-type hostname)
53(define-check+error-type tcp-port)
54
55;;; Parameters
56
57(define-parameter default-remote-mailbox-tcp-port DEFAULT-TCP-PORT
58        (lambda (x)
59                (cond
60                  ((tcp-port? x)  x )
61                  ((not x)        DEFAULT-TCP-PORT )
62      (else
63        (warning-argument-type 'default-remote-mailbox-tcp-port x 'procedure)
64        (default-remote-mailbox-tcp-port) ) ) ) )
65
66(define-parameter default-remote-mailbox-hostname DEFAULT-HOSTNAME
67        (lambda (x)
68                (cond
69                  ((hostname? x)  x )
70                  ((not x)        DEFAULT-HOSTNAME )
71      (else
72        (warning-argument-type 'default-remote-mailbox-hostname x 'procedure)
73        (default-remote-mailbox-hostname) ) ) ) )
74
75) ;module remote-mailbox-common
76
Note: See TracBrowser for help on using the repository browser.