source: project/release/4/remote-mailbox/trunk/remote-mailbox-common.scm @ 35329

Last change on this file since 35329 was 35329, checked in by kon, 13 months ago

add types, deprecate '/' style identifiers, use moremacros define-warning-parameter, reflow

File size: 3.0 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? check-mailbox-name error-mailbox-name
9  tcp-port-no? check-tcp-port-no error-tcp-port-no
10  hostname? check-hostname error-hostname
11  ;;
12  default-remote-mailbox-tcp-port-no
13  default-remote-mailbox-hostname
14  ;DEPRECATED
15  default-remote-mailbox-tcp-port
16  tcp-port? check-tcp-port error-tcp-port)
17
18(import scheme chicken)
19(use
20  (only srfi-13 string-null?)
21  (only moremacros define-warning-parameter)
22  (only type-errors warning-argument-type)
23  (only type-checks define-check+error-type))
24
25;;;
26
27(define-constant DEFAULT-TCP-PORT-NO 63001)
28(define-constant DEFAULT-HOSTNAME "localhost")
29
30(define *environment-variable-tcp-port-no* (get-environment-variable "REMOTE-MAILBOX-TCP-PORT"))
31(define *environment-variable-hostname* (get-environment-variable "REMOTE-MAILBOX-HOSTNAME"))
32
33(define *tcp-port-no* (or *environment-variable-tcp-port-no* DEFAULT-TCP-PORT-NO))
34(define *hostname* (or *environment-variable-hostname* DEFAULT-HOSTNAME))
35
36;;;
37
38(define-type mailbox-name symbol)
39(define-type tcp-port-no fixnum)
40(define-type hostname string)
41
42(: mailbox-name? (* -> boolean : mailbox-name))
43;
44(define mailbox-name? symbol?)
45
46(: tcp-port-no? (* -> boolean : tcp-port-no))
47;
48(define (tcp-port-no? obj)
49  (and
50    (fixnum? obj)
51    (and (fx< 0 obj) (fx<= obj 65535))) )
52
53(: hostname? (* -> boolean : hostname))
54;
55(define (hostname? obj)
56  (and
57    (string? obj)
58    (not (string-null? obj))) )
59
60;;;
61
62(define-check+error-type mailbox-name)
63(define-check+error-type tcp-port-no)
64(define-check+error-type hostname)
65
66;;; Parameters
67
68(define (remote-mailbox-tcp-port-no? x)
69  (or (not x) (tcp-port-no? x)) )
70
71(: default-remote-mailbox-tcp-port-no (#!optional (or boolean fixnum) -> fixnum))
72;
73(define-warning-parameter default-remote-mailbox-tcp-port-no *tcp-port-no* remote-mailbox-tcp-port-no
74  ;ugh, automagic identifier injection
75  (unless obj (set! obj *tcp-port-no*)) )
76
77(define (remote-mailbox-hostname? x)
78  (or (not x) (hostname? x)) )
79
80(: default-remote-mailbox-hostname (#!optional (or boolean string) -> string))
81;
82(define-warning-parameter default-remote-mailbox-hostname *hostname* remote-mailbox-hostname
83  ;ugh, automagic identifier injection
84  (unless obj (set! obj *hostname*)) )
85
86;;DEPRECATED
87
88(: default-remote-mailbox-tcp-port (deprecated default-remote-mailbox-tcp-port-no))
89(define default-remote-mailbox-tcp-port default-remote-mailbox-tcp-port-no)
90
91(: tcp-port? (deprecated tcp-port-no?))
92(define tcp-port? tcp-port-no?)
93
94(: check-tcp-port (deprecated check-tcp-port-no))
95(: error-tcp-port (deprecated error-tcp-port-no))
96#|
97Warning: in toplevel procedure `remote-mailbox-common#check-tcp-port':
98  use of deprecated `remote-mailbox-common#tcp-port?' - consider `tcp-port-no?'
99
100Warning: in toplevel procedure `remote-mailbox-common#check-tcp-port':
101  use of deprecated `remote-mailbox-common#error-tcp-port' - consider `error-tcp-port-no'
102|#
103(define-check+error-type tcp-port)
104
105) ;module remote-mailbox-common
106
Note: See TracBrowser for help on using the repository browser.