Changeset 15340 in project
- Timestamp:
- 08/06/09 20:40:50 (12 years ago)
- Location:
- release/4/uri-dispatch/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/uri-dispatch/trunk/tests/run.scm
r15221 r15340 8 8 ;; Version: $Id$ 9 9 ;; Version: 10 ;; Last-Updated: Mi Jul 15 20:52:052009 (CEST)10 ;; Last-Updated: Do Aug 6 20:49:24 2009 (CEST) 11 11 ;; By: David Krentzlin <david@lisp-unleashed.de> 12 ;; Update #: 3 312 ;; Update #: 35 13 13 ;; URL: 14 14 ;; Keywords: … … 68 68 (define (test3 . args) #t) 69 69 (define (echo2 . args) args) 70 71 (enable-checks #f) 70 72 71 73 -
release/4/uri-dispatch/trunk/uri-dispatch.scm
r15224 r15340 8 8 ;; Version: $Id$ 9 9 ;; Version: 10 ;; Last-Updated: Mi Jul 15 21:49:20 2009 (CEST)10 ;; Last-Updated: Do Aug 6 20:57:50 2009 (CEST) 11 11 ;; By: David Krentzlin <david@lisp-unleashed.de> 12 ;; Update #: 9612 ;; Update #: 117 13 13 ;; URL: 14 14 ;; Keywords: … … 61 61 dispatch-uri) 62 62 (import scheme chicken) 63 (require-library uri-common environments srfi-13) 64 (import (only uri-common uri-reference? uri-path) 63 (require-library uri-common environments srfi-13 extras) 64 (import extras 65 (only uri-common uri-reference? uri-path) 65 66 (only srfi-13 string-append) 66 67 (only environments environment-ref environment-has-binding?)) … … 70 71 (define module-whitelist (list)) 71 72 (define dispatch-environment interaction-environment) 72 (define enable-checks (make-parameter # f))73 (define enable-checks (make-parameter #t)) 73 74 (define default-dispatch-target (make-parameter (lambda args #f))) 74 75 75 76 (define (dispatch-uri uri) 76 77 (unless (uri-reference? uri) 77 (error "Supplied argument ismust be an uri"))78 (error "Supplied argument must be an uri")) 78 79 (let ((path (cdr (uri-path uri)))) 79 80 (cond … … 81 82 (apply (or (default-dispatch-target) 82 83 (dispatch-error)) '())) 83 (( = 1 (lengthpath))84 ((null? (cdr path)) 84 85 (if (equal? (car path) "") 85 86 (apply (or (default-dispatch-target) (dispatch-error)) '()) 86 87 (let ((handler (handler-ref (string->symbol (car path))))) 87 88 (if handler 88 ( handler (cdr path)))89 (apply (dispatch-error) path)))) 89 (apply handler (cdr path)) 90 (apply (dispatch-error) path))))) 90 91 (else 91 92 (let ((mod/proc (handler-ref (string->symbol (string-append (car path) "#" (cadr path))) (string->symbol (car path))))) … … 94 95 (let ((handler (handler-ref (string->symbol (car path))))) 95 96 (if handler 96 ( handler (cdr path))97 (apply handler (cdr path)) 97 98 (apply (dispatch-error) path))))))))) 98 99
Note: See TracChangeset
for help on using the changeset viewer.