suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fixed :: in doc.txt files

Browse Source 
svn: r5154

original commit: 5e2fb3605ccbb04eb89ba9b8c1d950cf6b845b2f
This commit is contained in:
Robby Findler 2006-12-21 15:39:38 +00:00
parent a523a718de
commit ae1bfa56c0
1 changed files with 79 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
collects/help/private/search.ss
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,71 +178,73 @@
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)
(cond (port-count-lines! p)
[(regexp-match re:keyword-line r) (let loop ()
(let/ec k (let ([m (regexp-match re:keyword-line p)])
(let* ([p (open-input-string (substring r 1 (string-length r)))] (cond
[entry (parameterize ([read-accept-bar-quote #f]) [m
(with-handlers ([exn:fail:read? (let/ec k
(lambda (x) (let* ([peek-port (peeking-input-port p)]
(k null))]) [entry (parameterize ([read-accept-bar-quote #f])
(read p)))] (with-handlers ([exn:fail:read?
[key (let loop ([l-entry entry]) (lambda (x)
(cond (fprintf (current-error-port)
[(symbol? l-entry) l-entry] "Found > line in ~s that did not parse properly: ~s\n"
[(pair? l-entry) (if (and (eq? (car l-entry) 'quote) (path->string (apply build-path doc))
(pair? (cdr l-entry))) (exn-message x))
(loop (cadr l-entry)) (k null))])
(loop (car l-entry)))] (read peek-port)))]
[else (error 'load-txt-keyworsd "bad entry in ~s: ~s" doc entry)]))] [key (let loop ([l-entry entry])
[content (if (symbol? entry) (cond
(with-handlers ([exn:fail:read? (lambda (x) #f)]) [(symbol? l-entry) l-entry]
(let ([s (read p)]) [(pair? l-entry) (if (and (eq? (car l-entry) 'quote)
(if (eq? s '::) (pair? (cdr l-entry)))
(read p) (loop (cadr l-entry))
#f))) (loop (car l-entry)))]
#f)]) [else (error 'load-txt-keyworsd "bad entry in ~s: ~s" doc entry)]))]
(list [content (if (symbol? entry)
; Make the keyword entry: (with-handlers ([exn:fail:read? (lambda (x) #f)])
(list (symbol->string key) ; the keyword name (let ([s (read peek-port)])
(let ([p (open-output-string)]) (if (eq? s '::)
(if content (format "~s ~s ~s" entry s (read peek-port))
(display content p) #f)))
(if (and (pair? entry) #f)]
(pair? (cdr entry)) [txt-to-display
(eq? (car entry) 'quote)) (let ([p (open-output-string)])
(fprintf p "'~s" (cadr entry)) (if content
(display entry p))) (display content p)
(get-output-string p)) ; the text to display (if (and (pair? entry)
(cadr doc) ; file (pair? (cdr entry))
start ; label (a position in this case) (eq? (car entry) 'quote))
"doc.txt"))))] ; title (fprintf p "'~s" (cadr entry))
[else #f])))) (display entry p)))
(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
(let-values ([(line col pos) (port-next-location p)])
(- pos 2)) ; label (a position in this case)
"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,20 +252,28 @@
(parse-txt-file (parse-txt-file
(apply build-path doc) (apply build-path doc)
text-indices text-indices
(lambda (r start) (λ (p)
(cond (let loop ([start 0])
[(regexp-match re:index-line r) (let* ([r (read-line p 'any)]
=> (lambda (m) [next (if (eof-object? r)
(let loop ([m m]) start
(let ([s (cadr m)]) (+ start (string-length r) 1))])
(cons (cond
; Make an index entry: [(eof-object? r) null]
(cons s start) [(regexp-match re:index-line r)
(let ([m (regexp-match re:index-line (caddr m))]) =>
(if m (lambda (m)
(loop m) (append (let loop ([m m])
null))))))] (let ([s (cadr m)])
[else #f])))) (cons
; Make an index entry:
(cons s start)
(let ([m (regexp-match re:index-line (caddr m))])
(if m
(loop m)
null)))))
(loop next)))]
[else (loop next)]))))))
(define re:splitter (regexp "^ *([^ ]+)(.*)")) (define re:splitter (regexp "^ *([^ ]+)(.*)"))
(define (split-words s) (define (split-words s)