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

Added 'newline items, made index pages use them instead of

Browse Source 
table rows.  (And some reformatting, of course.)

svn: r8426

original commit: 642c0d60718d0d3daa5266f6402bea9957807aea
This commit is contained in:
Eli Barzilay 2008-01-26 19:31:32 +00:00
parent d2002d0a0d
commit 81179a7eea
3 changed files with 250 additions and 263 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
collects/scribble/basic.ss
View File

@ -1,5 +1,6 @@
(module basic scheme/base
#lang scheme/base
(require "decode.ss"
"struct.ss"
"config.ss"
@ -17,22 +18,18 @@
include-section)
(define (gen-tag content)
(regexp-replace* "[^-a-zA-Z0-9_=]"
(content->string content)
"_"))
(regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_"))
(define (prefix->string p)
(and p
(if (string? p)
p
(module-path-prefix->string p))))
(and p (if (string? p) p (module-path-prefix->string p))))
(define (convert-tag tag content)
(if (list? tag)
(apply append (map (lambda (t) (convert-tag t content)) tag))
`((part ,(or tag (gen-tag content))))))
(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] #:version [version #f] . str)
(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
#:version [version #f] . str)
(let ([content (decode-content str)])
(make-title-decl (prefix->string prefix)
(convert-tag tag content)
@ -40,14 +37,16 @@
style
content)))
(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
. str)
(let ([content (decode-content str)])
(make-part-start 0 (prefix->string prefix)
(convert-tag tag content)
style
content)))
(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
. str)
(let ([content (decode-content str)])
(make-part-start 1
(prefix->string prefix)
@ -55,7 +54,8 @@
style
content)))
(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f]
#:style [style #f] . str)
(let ([content (decode-content str)])
(make-part-start 2
(prefix->string prefix)
@ -124,24 +124,22 @@
(make-element 'bold (decode-content str)))
(define (tt . str)
(let ([l (decode-content str)])
(let ([l (let ([m (and (pair? l)
(let* ([l (decode-content str)]
[l (let ([m (and (pair? l)
(string? (car l))
(regexp-match-positions #rx"^ +" (car l)))])
(if m
(cons (hspace (- (cdar m) (caar m)))
(cons
(list* (hspace (- (cdar m) (caar m)))
(substring (car l) (cdar m))
(cdr l)))
(cdr l))
l))])
(if (andmap string? l)
(make-element 'tt l)
(make-element #f (map (lambda (s)
(if (or (string? s)
(symbol? s))
(if (or (string? s) (symbol? s))
(make-element 'tt (list s))
s))
l))))))
l)))))
(define (span-class classname . str)
(make-element classname (decode-content str)))
@ -160,8 +158,7 @@
(make-part-index-decl (map element->string elems) elems))
(define (record-index word-seq element-seq tag content)
(make-index-element
#f
(make-index-element #f
(list (make-target-element #f content `(idx ,tag)))
`(idx ,tag)
word-seq
@ -170,15 +167,10 @@
(define (index* word-seq content-seq . s)
(let ([key (make-generated-tag)])
(record-index word-seq
content-seq
key
(decode-content s))))
(record-index word-seq content-seq key (decode-content s))))
(define (index word-seq . s)
(let ([word-seq (if (string? word-seq)
(list word-seq)
word-seq)])
(let ([word-seq (if (string? word-seq) (list word-seq) word-seq)])
(apply index* word-seq word-seq s)))
(define (as-index . s)
@ -218,6 +210,11 @@
(lambda (renderer sec ri)
(define l null)
(define alpha-starts (make-hash-table))
(define (rows . rows)
(make-table 'index
(map (lambda (row)
(list (make-flow (list (make-paragraph row)))))
rows)))
(hash-table-for-each
(let ([parent (collected-info-parent (part-collected-info sec ri))])
(if parent
@ -227,52 +224,42 @@
(when (and (pair? k) (eq? 'index-entry (car k)))
(set! l (cons (cons (cadr k) v) l)))))
(set! l (sort l cadr-string-lists<?))
(make-table
'index
(list*
(list
(make-flow
(list
(make-paragraph
(rows
(let loop ([i l] [alpha alpha])
(define (add-letter letter l)
(list* (make-element "nonavigation" (list (string letter)))
" " l))
(define (add-letter let l)
(list* (make-element "nonavigation" (list (string let))) " " l))
(cond [(null? alpha) null]
[(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]
[else
(let* ([strs (cadr (car i))]
[letter (if (or (null? strs)
(string=? "" (car strs)))
[letter (if (or (null? strs) (string=? "" (car strs)))
#f
(string-ref (car strs) 0))])
(cond
[(not letter) (loop (cdr i) alpha)]
(char-upcase (string-ref (car strs) 0)))])
(cond [(not letter) (loop (cdr i) alpha)]
[(char-ci>? letter (car alpha))
(add-letter (car alpha) (loop i (cdr alpha)))]
[(char-ci=? letter (car alpha))
(hash-table-put! alpha-starts (car i) letter)
(list*
(make-element
(make-target-url
(format "#alpha:~a" (char-upcase letter))
(list* (make-element
(make-target-url (format "#alpha:~a" letter)
#f)
(list (string (car alpha))))
" "
(loop (cdr i) (cdr alpha)))]
[else (loop (cdr i) alpha)]))]))))))
(list (make-flow (list (make-paragraph (list 'nbsp)))))
[else (loop (cdr i) alpha)]))]))
(list 'nbsp)
(apply append
(map (lambda (i)
(let* ([e (make-link-element "indexlink"
(commas (caddr i))
(car i))]
[letter (hash-table-get alpha-starts i #f)]
[e (if letter
(define e (make-link-element
"indexlink" (commas (caddr i)) (car i)))
(list (cond [(hash-table-get alpha-starts i #f)
=> (lambda (let)
(make-element
(make-url-anchor (format "alpha:~a" letter))
(list e))
e)])
(list (make-flow (list (make-paragraph (list e)))))))
(make-url-anchor
(format "alpha:~a" (char-upcase let)))
(list e)))]
[else e])
'newline))
l))))))
(list contents))
@ -289,7 +276,4 @@
(define (local-table-of-contents)
(make-delayed-flow-element
(lambda (renderer part ri)
(send renderer local-table-of-contents part ri)))))
(send renderer local-table-of-contents part ri))))

6
collects/scribble/html-render.ss
View File

@ -581,14 +581,15 @@
(define/override (render-other i part ri)
(cond
[(string? i) (let ([m (and (extra-breaking?)
[(string? i)
(let ([m (and (extra-breaking?)
(regexp-match-positions #rx"[-:/]" i))])
(if m
(list* (substring i 0 (cdar m))
;; Most browsers wrap after a hyphen. The
;; one that doesn't, Firefox, pays attention
;; to wbr. Some browsers ignore wbr, but
;; at they don't do strange things with it.
;; at least they don't do strange things with it.
(if (equal? #\- (string-ref i (caar m)))
'(wbr)
`(span ((class "mywbr")) " "))
@ -596,6 +597,7 @@
(ascii-ize i)))]
[(eq? i 'mdash) `(" " ndash " ")]
[(eq? i 'hline) `((hr))]
[(eq? i 'newline) `((br))]
[(symbol? i) (list i)]
[else (list (format "~s" i))]))

1
collects/scribble/latex-render.ss
View File

@ -343,6 +343,7 @@
[(string? i) (display-protected i)]
[(symbol? i) (display
(case i
[(newline) "\\\\"]
[(nbsp) "~"]
[(mdash) "---"]
[(ndash) "--"]