Changeset 15965 in project


Ignore:
Timestamp:
09/19/09 05:14:26 (10 years ago)
Author:
Kon Lovett
Message:

minor re-factor

File:
1 edited

Legend:

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

    r15964 r15965  
    4444                   remote-mailbox-common)
    4545
    46 ;;; Support
     46;;; Utilities
    4747
    4848(define (->boolean x) (and x #t))
    4949
    50 (define (invalidate-remote-mailbox! rmb) (remote-mailbox-name-set! rmb #f))
    51 (define (valid-remote-mailbox? rmb) (->boolean (remote-mailbox-name rmb)))
    52 
    53 (define (remote-mailbox-key rmb) (mutex-name (remote-mailbox-mutex rmb)))
    54 
    55 (define (make-remote-mailbox-mutex) (make-dict/synch 'fullname->remote-mailbox))
    56 
    57 (define +fullname->remote-mailbox+ (make-remote-mailbox-mutex))
    58 
    59 (define (make-remote-mailbox-key name hostname tcp-port)
    60         (conc name #\@ hostname (if tcp-port (conc #\: tcp-port) "")) )
    61 
    62 ;;
     50;;; Support
    6351
    6452(define-record-type remote-mailbox
     
    7361        (output remote-mailbox-output-port remote-mailbox-output-port-set!) )
    7462
    75 ;;
     63(define (invalidate-remote-mailbox! rmb) (remote-mailbox-name-set! rmb #f))
     64(define (valid-remote-mailbox? rmb) (->boolean (remote-mailbox-name rmb)))
    7665
    77 (define-check+error-type remote-mailbox)
     66(define (remote-mailbox-key rmb) (mutex-name (remote-mailbox-mutex rmb)))
    7867
    79 ;;
     68(define +remote-mailbox-key->remote-mailbox+ (make-dict/synch '+remote-mailbox-key->remote-mailbox))
     69
     70(define (make-remote-mailbox-key name hostname tcp-port)
     71        (conc name #\@ hostname (if tcp-port (conc #\: tcp-port) "")) )
     72
     73(define (*remote-mailbox name hostname tcp-port connect)
     74  (let ((key (make-remote-mailbox-key name hostname tcp-port)))
     75    (dict-indempotent-ref!/synch
     76      +remote-mailbox-key->remote-mailbox+
     77      key
     78      (lambda (def)
     79        (*make-remote-mailbox name hostname tcp-port connect (make-mutex key) #f #f))) ) )
    8080
    8181(define (*remote-mailbox-connected? rmb) (->boolean (remote-mailbox-output-port rmb)))
     
    104104        (record/synch remote-mailbox rmb
    105105    (close-remote-mailbox-connection! rmb)
    106     (dict-delete!/synch +fullname->remote-mailbox+ (remote-mailbox-key rmb)) ) )
     106    (dict-delete!/synch +remote-mailbox-key->remote-mailbox+ (remote-mailbox-key rmb)) ) )
     107
     108(define-check+error-type remote-mailbox)
    107109
    108110;;; Exported
     
    130132        (when tcp-port (check-tcp-port 'remote-mailbox tcp-port 'tcp-port))
    131133        (check-procedure 'remote-mailbox connect 'connect)
    132         (let ((key (make-remote-mailbox-key name hostname tcp-port)))
    133           (dict-indempotent-ref!/synch
    134             +fullname->remote-mailbox+
    135             key
    136             (lambda (def)
    137               (*make-remote-mailbox name hostname tcp-port connect (make-mutex key) #f #f))) ) )
     134        (*remote-mailbox name hostname tcp-port connect) )
    138135
    139136(define (remote-mailbox? obj)
     
    145142
    146143(define (remote-mailboxes)
    147         (dict-values/synch +fullname->remote-mailbox+) )
     144        (dict-values/synch +remote-mailbox-key->remote-mailbox+) )
    148145
    149146(define (drop-remote-mailbox! rmb)
Note: See TracChangeset for help on using the changeset viewer.