Changeset 15965 in project
- Timestamp:
- 09/19/09 05:14:26 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/remote-mailbox/trunk/remote-mailbox-client.scm
r15964 r15965 44 44 remote-mailbox-common) 45 45 46 ;;; Support46 ;;; Utilities 47 47 48 48 (define (->boolean x) (and x #t)) 49 49 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 63 51 64 52 (define-record-type remote-mailbox … … 73 61 (output remote-mailbox-output-port remote-mailbox-output-port-set!) ) 74 62 75 ;; 63 (define (invalidate-remote-mailbox! rmb) (remote-mailbox-name-set! rmb #f)) 64 (define (valid-remote-mailbox? rmb) (->boolean (remote-mailbox-name rmb))) 76 65 77 (define -check+error-type remote-mailbox)66 (define (remote-mailbox-key rmb) (mutex-name (remote-mailbox-mutex rmb))) 78 67 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))) ) ) 80 80 81 81 (define (*remote-mailbox-connected? rmb) (->boolean (remote-mailbox-output-port rmb))) … … 104 104 (record/synch remote-mailbox rmb 105 105 (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) 107 109 108 110 ;;; Exported … … 130 132 (when tcp-port (check-tcp-port 'remote-mailbox tcp-port 'tcp-port)) 131 133 (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) ) 138 135 139 136 (define (remote-mailbox? obj) … … 145 142 146 143 (define (remote-mailboxes) 147 (dict-values/synch + fullname->remote-mailbox+) )144 (dict-values/synch +remote-mailbox-key->remote-mailbox+) ) 148 145 149 146 (define (drop-remote-mailbox! rmb)
Note: See TracChangeset
for help on using the changeset viewer.