Changeset 15965 in project

Timestamp:

09/19/09 05:14:26 (10 years ago)

Author:

Kon Lovett

Message:

minor re-factor

File:

• release/4/remote-mailbox/trunk/remote-mailbox-client.scm (modified) (5 diffs)

release/4/remote-mailbox/trunk/remote-mailbox-client.scm

@@ -44 +44 @@
                    remote-mailbox-common)
 
-;;; Support
+;;; Utilities
 
 (define (->boolean x) (and x #t))
 
-(define (invalidate-remote-mailbox! rmb) (remote-mailbox-name-set! rmb #f))
-(define (valid-remote-mailbox? rmb) (->boolean (remote-mailbox-name rmb)))
-
-(define (remote-mailbox-key rmb) (mutex-name (remote-mailbox-mutex rmb)))
-
-(define (make-remote-mailbox-mutex) (make-dict/synch 'fullname->remote-mailbox))
-
-(define +fullname->remote-mailbox+ (make-remote-mailbox-mutex))
-
-(define (make-remote-mailbox-key name hostname tcp-port)
-        (conc name #\@ hostname (if tcp-port (conc #\: tcp-port) "")) )
-
-;;
+;;; Support
 
 (define-record-type remote-mailbox
@@ -73 +61 @@
         (output remote-mailbox-output-port remote-mailbox-output-port-set!) )
 
-;;
+(define (invalidate-remote-mailbox! rmb) (remote-mailbox-name-set! rmb #f))
+(define (valid-remote-mailbox? rmb) (->boolean (remote-mailbox-name rmb)))
 
-(define-check+error-type remote-mailbox)
+(define (remote-mailbox-key rmb) (mutex-name (remote-mailbox-mutex rmb)))
 
-;;
+(define +remote-mailbox-key->remote-mailbox+ (make-dict/synch '+remote-mailbox-key->remote-mailbox))
+
+(define (make-remote-mailbox-key name hostname tcp-port)
+        (conc name #\@ hostname (if tcp-port (conc #\: tcp-port) "")) )
+
+(define (*remote-mailbox name hostname tcp-port connect)
+  (let ((key (make-remote-mailbox-key name hostname tcp-port)))
+    (dict-indempotent-ref!/synch
+      +remote-mailbox-key->remote-mailbox+
+      key
+      (lambda (def)
+        (*make-remote-mailbox name hostname tcp-port connect (make-mutex key) #f #f))) ) )
 
 (define (*remote-mailbox-connected? rmb) (->boolean (remote-mailbox-output-port rmb)))
@@ -104 +104 @@
         (record/synch remote-mailbox rmb
     (close-remote-mailbox-connection! rmb)
-    (dict-delete!/synch +fullname->remote-mailbox+ (remote-mailbox-key rmb)) ) )
+    (dict-delete!/synch +remote-mailbox-key->remote-mailbox+ (remote-mailbox-key rmb)) ) )
+
+(define-check+error-type remote-mailbox)
 
 ;;; Exported
@@ -130 +132 @@
         (when tcp-port (check-tcp-port 'remote-mailbox tcp-port 'tcp-port))
         (check-procedure 'remote-mailbox connect 'connect)
-        (let ((key (make-remote-mailbox-key name hostname tcp-port)))
-          (dict-indempotent-ref!/synch
-            +fullname->remote-mailbox+
-            key
-            (lambda (def)
-              (*make-remote-mailbox name hostname tcp-port connect (make-mutex key) #f #f))) ) )
+        (*remote-mailbox name hostname tcp-port connect) )
 
 (define (remote-mailbox? obj)
@@ -145 +142 @@
 
 (define (remote-mailboxes)
-        (dict-values/synch +fullname->remote-mailbox+) )
+        (dict-values/synch +remote-mailbox-key->remote-mailbox+) )
 
 (define (drop-remote-mailbox! rmb)