Ignore:
Timestamp:
03/25/17 21:46:49 (2 years ago)
Author:
kon
Message:

mv serialize to adapter module

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/remote-mailbox/trunk/remote-mailbox-common.scm

    r19860 r33908  
    44(module remote-mailbox-common
    55
    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     make-remote-mailbox-packet
    19     remote-mailbox-packet?
    20     remote-mailbox-packet-key
    21     remote-mailbox-packet-value
    22     ;;
    23     default-remote-mailbox-tcp-port
    24     default-remote-mailbox-hostname)
     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)
    2520
    26   (import
    27     scheme
    28     chicken
    29     (only srfi-13 string-null?)
    30     (only miscmacros define-parameter)
    31     (only type-checks define-check+error-type))
     21(import scheme chicken)
    3222
    33   (require-library srfi-13 miscmacros type-checks)
     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")
    3434
    3535;;;
     
    3737(define mailbox-name? symbol?)
    3838
    39 (define (tcp-port? obj) (and (fixnum? obj) (and (fx< 0 obj) (fx< obj 65536))))
     39(define (tcp-port? obj)
     40  (and
     41    (fixnum? obj)
     42    (and (fx< 0 obj) (fx< obj 65536))) )
    4043
    41 (define (hostname? obj) (and (string? obj) (not (string-null? obj))))
     44(define (hostname? obj)
     45  (and
     46    (string? obj)
     47    (not (string-null? obj))) )
    4248
    4349;;;
     
    4753(define-check+error-type tcp-port)
    4854
    49 ;;; Remote Mailbox Packet
    50 
    51 (define +remote-mailbox-tag+ 'rmbtag)
    52 
    53 (define (make-remote-mailbox-packet key val) (vector +remote-mailbox-tag+ key val))
    54 
    55 (define (remote-mailbox-packet? obj)
    56         (and (vector? obj)
    57                          (= 3 (vector-length obj))
    58                          (eq? +remote-mailbox-tag+ (vector-ref obj 0))) )
    59 
    60 (define (remote-mailbox-packet-key rmp) (vector-ref rmp 1))
    61 
    62 (define (remote-mailbox-packet-value rmp) (vector-ref rmp 2))
    63 
    6455;;; Parameters
    6556
    66 (define-parameter default-remote-mailbox-tcp-port 63001
     57(define-parameter default-remote-mailbox-tcp-port DEFAULT-TCP-PORT
    6758        (lambda (x)
    68                 (cond ((tcp-port? x) x)
    69           (else (default-remote-mailbox-tcp-port) ) ) ) )
     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) ) ) ) )
    7065
    71 (define-parameter default-remote-mailbox-hostname "localhost"
     66(define-parameter default-remote-mailbox-hostname DEFAULT-HOSTNAME
    7267        (lambda (x)
    73                 (cond ((hostname? x) x)
    74           (else (default-remote-mailbox-hostname) ) ) ) )
     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) ) ) ) )
    7574
    7675) ;module remote-mailbox-common
Note: See TracChangeset for help on using the changeset viewer.