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

html util

This commit is contained in:
erana 2012-01-30 08:05:42 +09:00
parent 26c55e8730
commit 4c3310938c
1 changed files with 20 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
scsh/CSAN/CSAN-util.scm
View File

@ -28,17 +28,26 @@
(define (url-bite-off url) (define (url-bite-off url)
(let ((s "") (let ((s "")
(do ((i 0 (+ i 1))) (rets "")
((or (>= i (string-length url)) (j 0))
(eq? (string-ref url i) #\/) (do ((i 0 (+ i 1)))
(eq? (string-ref url i) #\\)) ;; needs scheme URL parsing (e.g. with regexps or other perl things ((or (string=? s "http://")(string=? s "ftp://")
s) (string=? s " http://")(string=? s " ftp://"))
(set! s (string-append s (string (string-ref url i)))) (set! j i))
(cond ((or (eq? s "http://")(eq? s "ftp://") (set! s (string-append s (string (string-ref url i))))
(eq? s " http://")(eq? s " ftp://")) )
(set! s ""))
)))
)) (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)) (define CSAN-generators (make-table))
(table-set! CSAN-generators "helpfile" (lambda () (table-set! CSAN-generators "helpfile" (lambda ()