original commit: f13c702a5b40d4210e67ac8a0acc4a8e10e58abd
This commit is contained in:
Robby Findler 2003-07-31 19:54:45 +00:00
parent 0cabae7acd
commit 5b73d23f27

View File

@ -180,37 +180,43 @@
(lambda (r start) (lambda (r start)
(cond (cond
[(regexp-match re:keyword-line r) [(regexp-match re:keyword-line r)
(let* ([p (open-input-string (substring r 1 (string-length r)))] (let/ec k
[entry (parameterize ([read-accept-bar-quote #f]) (let* ([p (open-input-string (substring r 1 (string-length r)))]
(read p))] [entry (parameterize ([read-accept-bar-quote #f])
[key (let loop ([entry entry]) (with-handlers ([not-break-exn?
(cond (lambda (x)
[(symbol? entry) entry] (k null))])
[(pair? entry) (if (eq? (car entry) 'quote) (read p)))]
(loop (cadr entry)) [key (let loop ([entry entry])
(loop (car entry)))] (cond
[else (error "bad entry")]))] [(symbol? entry) entry]
[content (if (symbol? entry) [(pair? entry) (if (and (eq? (car entry) 'quote)
(with-handlers ([not-break-exn? (lambda (x) #f)]) (pair? (cdr entry)))
(let ([s (read p)]) (loop (cadr entry))
(if (eq? s '::) (loop (car entry)))]
(read p) [else (error "bad entry")]))]
#f))) [content (if (symbol? entry)
#f)]) (with-handlers ([not-break-exn? (lambda (x) #f)])
(list (let ([s (read p)])
; Make the keyword entry: (if (eq? s '::)
(list (symbol->string key) ; the keyword name (read p)
(let ([p (open-output-string)]) #f)))
(if content #f)])
(display content p) (list
(if (and (pair? entry) ; Make the keyword entry:
(eq? (car entry) 'quote)) (list (symbol->string key) ; the keyword name
(fprintf p "'~s" (cadr entry)) (let ([p (open-output-string)])
(display entry p))) (if content
(get-output-string p)) ; the text to display (display content p)
(cadr doc) ; file (if (and (pair? entry)
start ; label (a position in this case) (pair? (cdr entry))
"doc.txt")))] ; title (eq? (car entry) 'quote))
(fprintf p "'~s" (cadr entry))
(display entry p)))
(get-output-string p)) ; the text to display
(cadr doc) ; file
start ; label (a position in this case)
"doc.txt"))))] ; title
[else #f])))) [else #f]))))
(define re:index-line (regexp "_([^_]*)_(.*)")) (define re:index-line (regexp "_([^_]*)_(.*)"))