suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues1 Pull Requests1 Actions Packages Projects Releases Wiki Activity

reformatted and a little improved code, use scheme/base

Browse Source 
svn: r9881

original commit: 8f8451dc4f17984156a5733c3e313f9b35de5ea1
This commit is contained in:
Eli Barzilay 2008-05-18 20:26:36 +00:00
parent 04e6d902c8
commit ae5f6458d8
2 changed files with 2596 additions and 2824 deletions
collects/scribble
decode.ssmanual.ss

66
collects/scribble/decode.ss
View File

@ -1,16 +1,16 @@
(module decode mzscheme
#lang scheme/base
(require "struct.ss"
"decode-struct.ss"
mzlib/contract
mzlib/class)
scheme/contract
scheme/class
scheme/list)
(provide decode
decode-part
decode-flow
decode-paragraph
decode-content
(rename decode-content decode-elements)
(rename-out [decode-content decode-elements])
decode-string
whitespace?)
@ -89,7 +89,8 @@
(cons (make-index-element
#f null (car tags)
(list (regexp-replace
#px"^\\s+(?:(?:A|An|The)\\s)?" (content->string title) ""))
#px"^\\s+(?:(?:A|An|The)\\s)?"
(content->string title) ""))
(list (make-element #f title))
(make-part-index-desc))
l)
@ -138,12 +139,11 @@
((part-start-depth (car l)) . <= . part-depth)))
(unless part-depth (error 'decode "misplaced part: ~e" (car l)))
(let ([s (car l)])
(let loop ([l (cdr l)]
[s-accum null])
(let loop ([l (cdr l)] [s-accum null])
(if (or (null? l)
(or (and (part-start? (car l))
(and (part-start? (car l))
((part-start-depth (car l)) . <= . part-depth))
(part? (car l))))
(part? (car l)))
(let ([para (decode-accum-para accum)]
[s (decode-styled-part (reverse s-accum)
(part-start-tag-prefix s)
@ -151,7 +151,8 @@
(part-start-style s)
(part-start-title s)
(add1 part-depth))]
[part (decode-flow* l keys colls tag-prefix tags vers style title part-depth)])
[part (decode-flow* l keys colls tag-prefix tags vers style
title part-depth)])
(make-versioned-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
@ -164,24 +165,35 @@
(loop (append (splice-run (car l)) (cdr l)) s-accum)
(loop (cdr l) (cons (car l) s-accum))))))]
[(splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) next? keys colls accum title tag-prefix tags vers style)]
[(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags vers style)]
(loop (append (splice-run (car l)) (cdr l))
next? keys colls accum title tag-prefix tags vers style)]
[(null? (cdr l))
(loop null #f keys colls (cons (car l) accum) title tag-prefix tags
vers style)]
[(part-index-decl? (car l))
(loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix tags vers style)]
(loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix
tags vers style)]
[(part-collect-decl? (car l))
(loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags vers style)]
(loop (cdr l) next? keys
(cons (part-collect-decl-element (car l)) colls)
accum title tag-prefix tags vers style)]
[(part-tag-decl? (car l))
(loop (cdr l) next? keys colls accum title tag-prefix (append tags (list (part-tag-decl-tag (car l)))) vers style)]
(loop (cdr l) next? keys colls accum title tag-prefix
(append tags (list (part-tag-decl-tag (car l))))
vers style)]
[(and (pair? (cdr l))
(splice? (cadr l)))
(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags vers style)]
(loop (cons (car l) (append (splice-run (cadr l)) (cddr l)))
next? keys colls accum title tag-prefix tags vers style)]
[(line-break? (car l))
(if next?
(loop (cdr l) #t keys colls accum title tag-prefix tags vers style)
(let ([m (match-newline-whitespace (cdr l))])
(if m
(let ([part (loop m #t keys colls null title tag-prefix tags vers style)])
(make-versioned-part (part-tag-prefix part)
(let ([part (loop m #t keys colls null title tag-prefix tags vers
style)])
(make-versioned-part
(part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
@ -190,8 +202,10 @@
(flow-paragraphs (part-flow part))))
(part-parts part)
(part-version part)))
(loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags vers style))))]
[else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags vers style)])))
(loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix
tags vers style))))]
[else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix
tags vers style)])))
(define (decode-part l tags title depth)
(decode-flow* l null null #f tags #f #f title depth))
@ -204,12 +218,10 @@
(define (match-newline-whitespace l)
(cond [(null? l) #f]
[(line-break? (car l))
(skip-whitespace l)]
[(line-break? (car l)) (skip-whitespace l)]
[(splice? (car l))
(match-newline-whitespace (append (splice-run (car l)) (cdr l)))]
[(whitespace? (car l))
(match-newline-whitespace (cdr l))]
[(whitespace? (car l)) (match-newline-whitespace (cdr l))]
[else #f]))
(define (skip-whitespace l)
@ -224,5 +236,5 @@
(make-paragraph (decode-content l)))
(define (decode-content l)
(apply append (map (lambda (s) (if (string? s) (decode-string s) (list s)))
(skip-whitespace l)))))
(append-map (lambda (s) (if (string? s) (decode-string s) (list s)))
(skip-whitespace l)))

1558
collects/scribble/manual.ss
View File

File diff suppressed because it is too large Load Diff