fixed :: in doc.txt files

svn: r5154

original commit: 5e2fb3605ccbb04eb89ba9b8c1d950cf6b845b2f
This commit is contained in:
Robby Findler 2006-12-21 15:39:38 +00:00
parent a523a718de
commit ae1bfa56c0

View File

@ -3,6 +3,7 @@
"colldocs.ss" "colldocs.ss"
"path.ss" "path.ss"
"manuals.ss" "manuals.ss"
(lib "port.ss")
(lib "getinfo.ss" "setup") (lib "getinfo.ss" "setup")
(lib "list.ss") (lib "list.ss")
(lib "plt-match.ss") (lib "plt-match.ss")
@ -177,40 +178,38 @@
l) l)
l))))) l)))))
(define (parse-txt-file doc ht handle-one) (define (parse-txt-file doc ht handle-parsing)
(with-hash-table (with-hash-table
ht ht
doc doc
(lambda () (lambda ()
(with-handlers ([exn:fail:filesystem? (lambda (x) null)]) (with-handlers ([exn:fail:filesystem? (lambda (x) null)])
(with-input-from-file doc (call-with-input-file doc
(lambda () handle-parsing)))))
(let loop ([start 0])
(let* ([r (read-line (current-input-port) 'any)]
[next (if (eof-object? r)
start
(+ start (string-length r) 1))])
(cond
[(eof-object? r) null]
[(handle-one r start) => (lambda (vs) (append vs (loop next)))]
[else (loop next)])))))))))
(define re:keyword-line (regexp "^>")) (define re:keyword-line (regexp "\n>"))
(define text-keywords (make-hash-table 'equal)) (define text-keywords (make-hash-table 'equal))
(define (load-txt-keywords doc) (define (load-txt-keywords doc)
(parse-txt-file (parse-txt-file
(apply build-path doc) (apply build-path doc)
text-keywords text-keywords
(lambda (r start) (λ (p)
(port-count-lines! p)
(let loop ()
(let ([m (regexp-match re:keyword-line p)])
(cond (cond
[(regexp-match re:keyword-line r) [m
(let/ec k (let/ec k
(let* ([p (open-input-string (substring r 1 (string-length r)))] (let* ([peek-port (peeking-input-port p)]
[entry (parameterize ([read-accept-bar-quote #f]) [entry (parameterize ([read-accept-bar-quote #f])
(with-handlers ([exn:fail:read? (with-handlers ([exn:fail:read?
(lambda (x) (lambda (x)
(fprintf (current-error-port)
"Found > line in ~s that did not parse properly: ~s\n"
(path->string (apply build-path doc))
(exn-message x))
(k null))]) (k null))])
(read p)))] (read peek-port)))]
[key (let loop ([l-entry entry]) [key (let loop ([l-entry entry])
(cond (cond
[(symbol? l-entry) l-entry] [(symbol? l-entry) l-entry]
@ -221,14 +220,12 @@
[else (error 'load-txt-keyworsd "bad entry in ~s: ~s" doc entry)]))] [else (error 'load-txt-keyworsd "bad entry in ~s: ~s" doc entry)]))]
[content (if (symbol? entry) [content (if (symbol? entry)
(with-handlers ([exn:fail:read? (lambda (x) #f)]) (with-handlers ([exn:fail:read? (lambda (x) #f)])
(let ([s (read p)]) (let ([s (read peek-port)])
(if (eq? s '::) (if (eq? s '::)
(read p) (format "~s ~s ~s" entry s (read peek-port))
#f))) #f)))
#f)]) #f)]
(list [txt-to-display
; Make the keyword entry:
(list (symbol->string key) ; the keyword name
(let ([p (open-output-string)]) (let ([p (open-output-string)])
(if content (if content
(display content p) (display content p)
@ -237,11 +234,17 @@
(eq? (car entry) 'quote)) (eq? (car entry) 'quote))
(fprintf p "'~s" (cadr entry)) (fprintf p "'~s" (cadr entry))
(display entry p))) (display entry p)))
(get-output-string p)) ; the text to display (get-output-string p))]
[kwd-entry
; Make the keyword entry:
(list (symbol->string key) ; the keyword name
txt-to-display ; the text to display
(cadr doc) ; file (cadr doc) ; file
start ; label (a position in this case) (let-values ([(line col pos) (port-next-location p)])
"doc.txt"))))] ; title (- pos 2)) ; label (a position in this case)
[else #f])))) "doc.txt")])
(cons kwd-entry (loop))))] ; title
[else null]))))))
(define re:index-line (regexp "_([^_]*)_(.*)")) (define re:index-line (regexp "_([^_]*)_(.*)"))
(define text-indices (make-hash-table 'equal)) (define text-indices (make-hash-table 'equal))
@ -249,11 +252,18 @@
(parse-txt-file (parse-txt-file
(apply build-path doc) (apply build-path doc)
text-indices text-indices
(lambda (r start) (λ (p)
(let loop ([start 0])
(let* ([r (read-line p 'any)]
[next (if (eof-object? r)
start
(+ start (string-length r) 1))])
(cond (cond
[(eof-object? r) null]
[(regexp-match re:index-line r) [(regexp-match re:index-line r)
=> (lambda (m) =>
(let loop ([m m]) (lambda (m)
(append (let loop ([m m])
(let ([s (cadr m)]) (let ([s (cadr m)])
(cons (cons
; Make an index entry: ; Make an index entry:
@ -261,8 +271,9 @@
(let ([m (regexp-match re:index-line (caddr m))]) (let ([m (regexp-match re:index-line (caddr m))])
(if m (if m
(loop m) (loop m)
null))))))] null)))))
[else #f])))) (loop next)))]
[else (loop next)]))))))
(define re:splitter (regexp "^ *([^ ]+)(.*)")) (define re:splitter (regexp "^ *([^ ]+)(.*)"))
(define (split-words s) (define (split-words s)