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

s48 cavespider

This commit is contained in:
erana 2012-02-01 00:31:15 +09:00
parent e5ddf14c7d
commit 0e3287d63d
1 changed files with 45 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
s48/cavespider/string-util-alt.scm
View File

@ -29,70 +29,72 @@
(load "hash-util.scm") (load "hash-util.scm")
(load "html-util.scm") (load "html-util.scm")
(define (url->hostname url-list hostname-list) ;;(define (url->hostname url-list hostname-list)
(let ((file-contents (file-contents->url ))) ;; (let ((file-contents (file-contents->url )))
)) ;; ))
(define (tags filename) (define (tags filename)
(html-tags filename)) (html-tags filename))
(define (file-contents->url tags-of-file-contents-str) (define (file-contents->url tags-of-file-contents-str)
;;(display tags-of-file-contents-str)
(let ((s "") (let ((s "")
(ret '()) (ret '())
(http-prefix "http://")) (http-prefix "http://"))
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((>= i (string-length tags-of-file-contents-str)) ((>= i (string-length tags-of-file-contents-str))
#t) ret)
(cond ((eq? #\h (string-ref tags-of-file-contents-str i)) (cond ((not (eq? #\h (string-ref tags-of-file-contents-str i)))
(set! s "") (set! s ""))
(do ((j i (+ j 1))) ((eq? #\h (string-ref tags-of-file-contents-str i))
((cond ((string<=? s "http://")
(let ((s2 ""))
;; (display s)
(do ((k j (+ k 1)))
((cond ((>= k (string-length tags-of-file-contents-str))
(set! s "")(set! j k)(set! i k))
((eq? (string-ref tags-of-file-contents-str k)
#\/)
(set! ret (append ret (list s2)))
(set! s2 "")
(set! j k)(set! i k)
)))
(set! s2 (string-append (let ((s2 ""))
s2
(string (string-ref tags-of-file-contents-str k))))
(display "s2=")(display s)
(set! j k)
(set! i k);;FIXME
;;(set! j (+ j 1)) (do ((j i (+ j 1)))
;;(set! i (+ i 1)) ((cond ((string=? s2 http-prefix)
)))) (let ((s3 ""))
((>= j (+ (string-length tags-of-file-contents-str) 8)) (do ((k j (+ k 1)))
(display s)(set! i j)) ((cond ((eq? (string-ref tags-of-file-contents-str k)
;;(eq? (string-ref http-prefix j) #\")
;; (string-ref tags-of-file-contents-str i))) (display i)
(set! j k)(set! i k)(set! s2 ""))
((eq? (string-ref tags-of-file-contents-str k)
#\/)
(set! ret (append ret (list s3)))
(set! s3 "")
(set! j k)
(set! i k))
((>= k (string-length tags-of-file-contents-str));;FIXME prev
(set! s2 "")(set! i k)(set! j k))
))
(set! s3 (string-append
s3
(string (string-ref tags-of-file-contents-str k))))
)
;;(set! j k)
;;(set! i k)
))
((not (string<=? s2 http-prefix))
(set! s "")
) (set! i j))
(set! s (string-append s (string (string-ref tags-of-file-contents-str j)))) ))
(display s)
(set! i j) (set! s2 (string-append
))) s2
(string (string-ref tags-of-file-contents-str j))))
(display "s2=")(display s)
(set! i j)))))
(set! s (string-append s (string (string-ref tags-of-file-contents-str i)))) (set! s (string-append s (string (string-ref tags-of-file-contents-str i))))
;;(display "s=")(display (string-ref tags-of-file-contents-str i)) ;;(display "s=")(display (string-ref tags-of-file-contents-str i))
;;(set! i (+ i 1)))
) )
ret)) ret))
(display (display
(file-contents->url (tags "index.html")) (file-contents->url (html-dump "index.html"))
) )