scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

uncurry LOAD-SURFLET in GET-SURFLET-RT-STRUCTURE

This commit is contained in:
interp 2003-01-25 16:17:33 +00:00
parent 26fa1ca033
commit e934340fb5
1 changed files with 41 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
scheme/httpd/surflets/surflet-handler.scm
View File

@ -439,10 +439,9 @@
;; Returns SUrflet's RT-STRUCTURE indicated by SURFLET-NAME (a virtual ;; Returns SUrflet's RT-STRUCTURE indicated by SURFLET-NAME (a virtual
;; path string) while managing the SUrflet cache *SURFLET-TABLE* ;; path string) while managing the SUrflet cache *SURFLET-TABLE*
;; (locking). ;; (locking).
(define (get-surflet-rt-structure surflet-name directory) (define get-surflet-rt-structure
(let* ((full-surflet-name (absolute-file-name surflet-name directory)) (let ((load-surflet
(load-surflet (lambda (full-surflet-name cached?)
(lambda (cached?)
(with-fatal-handler* (with-fatal-handler*
(lambda (condition decline) (lambda (condition decline)
(if cached? (release-lock *surflet-table-lock*)) (if cached? (release-lock *surflet-table-lock*))
@ -462,6 +461,9 @@
;; only now the lock may be released ;; only now the lock may be released
(release-lock *surflet-table-lock*))) (release-lock *surflet-table-lock*)))
surflet-structure)))))) surflet-structure))))))
(lambda (surflet-name directory)
(let ((full-surflet-name (absolute-file-name surflet-name directory)))
(if (options-cache-surflets?) (if (options-cache-surflets?)
(begin (begin
;; The lock is only obtained and released, if surflets are ;; The lock is only obtained and released, if surflets are
@ -476,9 +478,9 @@
(begin (begin
(release-lock *surflet-table-lock*) (release-lock *surflet-table-lock*)
(car surflet)) (car surflet))
(load-surflet #t)) (load-surflet full-surflet-name #t))
(load-surflet #t)))) (load-surflet full-surflet-name #t))))
(load-surflet #f)))) (load-surflet full-surflet-name #f))))))
;;; GET-LOADED-SURFLETS ;;; GET-LOADED-SURFLETS
;; Returns list of all loaded surflets (real path strings). ;; Returns list of all loaded surflets (real path strings).