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

More restructuring.

This commit is contained in:
interp 2003-01-19 10:31:16 +00:00
parent 7c33c9ba08
commit bee74b3867
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
scheme/httpd/surflets/web-server/root/surflets/news.scm
View File

@ -7,17 +7,19 @@
(define (read-data) (define (read-data)
(let ((news-input (open-input-file "news.txt"))) (let ((news-input (open-input-file "news.txt")))
(do ((next-line (read-line news-input) (do ((next-line (read-line news-input)
(read-line news-input))) (read-line news-input))
((eof-object? next-line) (close news-input)) (data '() (cons next-line data)))
(set! *data* (cons next-line *data*))))) ((eof-object? next-line)
(close news-input)
data))))
(define (main req) (define (main req)
(if (null? *data*) (read-data)) (if (null? *data*) (set! *data* (read-data)))
(let loop ((count (- (length *data*) 1))) (let loop ((count (- (length *data*) 1)))
(if (< count 0) (if (< count 0)
(show-final-page) (show-final-page)
(begin (begin
(show-news-page count) (show-news-page (list-ref *data* count))
(loop (- count 1)))))) (loop (- count 1))))))
(define (show-final-page) (define (show-final-page)
@ -28,10 +30,10 @@
(p (URL "news.scm" "See news again.") (br) (p (URL "news.scm" "See news again.") (br)
(URL "/" "Return to main menu.")))))) (URL "/" "Return to main menu."))))))
(define (show-news-page count) (define (show-news-page news)
(send-html/suspend (send-html/suspend
(lambda (next-url) (lambda (next-url)
`(html (body (p (h1 ,(list-ref *data* count))) `(html (body (p (h1 ,news))
(a (@ href ,next-url) "read more...") (a (@ href ,next-url) "read more...")
(hr) (hr)
(p (URL "news.scm" "See news again from beginning.") (br) (p (URL "news.scm" "See news again from beginning.") (br)