diff --git a/scsh/CSAN/CSAN-util.scm b/scsh/CSAN/CSAN-util.scm index 512345d..cd09ebc 100644 --- a/scsh/CSAN/CSAN-util.scm +++ b/scsh/CSAN/CSAN-util.scm @@ -28,17 +28,26 @@ (define (url-bite-off url) (let ((s "") - (do ((i 0 (+ i 1))) - ((or (>= i (string-length url)) - (eq? (string-ref url i) #\/) - (eq? (string-ref url i) #\\)) ;; needs scheme URL parsing (e.g. with regexps or other perl things - s) - (set! s (string-append s (string (string-ref url i)))) - (cond ((or (eq? s "http://")(eq? s "ftp://") - (eq? s " http://")(eq? s " ftp://")) - (set! s "")) - ))) - )) + (rets "") + (j 0)) + (do ((i 0 (+ i 1))) + ((or (string=? s "http://")(string=? s "ftp://") + (string=? s " http://")(string=? s " ftp://")) + (set! j i)) + (set! s (string-append s (string (string-ref url i)))) + ) + + + (do ((i j (+ i 1))) + ((or (>= i (string-length url)) + (eq? (string-ref url i) #\/) + (eq? (string-ref url i) #\\)) ;; needs scheme URL parsing (e.g. with regexps or other perl things + rets) + (set! rets (string-append rets (string (string-ref url i)))) + ))) + +;;test +;;(display (url-bite-off "http://soft/vub/")) (define CSAN-generators (make-table)) (table-set! CSAN-generators "helpfile" (lambda ()