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

78
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 "")) (let ((s2 ""))
;; (display s)
(do ((j i (+ j 1)))
((cond ((string=? s2 http-prefix)
(let ((s3 ""))
(do ((k j (+ k 1))) (do ((k j (+ k 1)))
((cond ((>= k (string-length tags-of-file-contents-str)) ((cond ((eq? (string-ref tags-of-file-contents-str k)
(set! s "")(set! j k)(set! i k)) #\")
(display i)
(set! j k)(set! i k)(set! s2 ""))
((eq? (string-ref tags-of-file-contents-str k) ((eq? (string-ref tags-of-file-contents-str k)
#\/) #\/)
(set! ret (append ret (list s2))) (set! ret (append ret (list s3)))
(set! s2 "") (set! s3 "")
(set! j k)(set! i k) (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! s2 (string-append (set! s2 (string-append
s2 s2
(string (string-ref tags-of-file-contents-str k)))) (string (string-ref tags-of-file-contents-str j))))
(display "s2=")(display s) (display "s2=")(display s)
(set! j k)
(set! i k);;FIXME
;;(set! j (+ j 1)) (set! i j)))))
;;(set! i (+ i 1))
))))
((>= j (+ (string-length tags-of-file-contents-str) 8))
(display s)(set! i j))
;;(eq? (string-ref http-prefix j)
;; (string-ref tags-of-file-contents-str i)))
)
(set! s (string-append s (string (string-ref tags-of-file-contents-str j))))
(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"))
) )