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

Some racketization (and outdent).

Browse Source 
original commit: 34ec39119442c4202e3779a929b8406aee58e524
This commit is contained in:
Eli Barzilay 2012-05-06 06:29:18 -04:00
parent c3d02f1416
commit 6bec5dbd28
1 changed files with 186 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
collects/scribble/text-render.rkt
View File

@ -1,7 +1,8 @@
(module text-render racket/base #lang racket/base
(require "core.rkt" (require "core.rkt"
racket/class racket/class
racket/port) racket/port
racket/list)
(provide render-mixin) (provide render-mixin)
(define current-preserve-spaces (make-parameter #f)) (define current-preserve-spaces (make-parameter #f))
@ -10,9 +11,8 @@
(define (make-indent amt) (define (make-indent amt)
(+ amt (current-indent))) (+ amt (current-indent)))
(define (indent) (define (indent)
(let ([i (current-indent)]) (define i (current-indent))
(unless (zero? i) (unless (zero? i) (display (make-string i #\space))))
(display (make-string i #\space)))))
(define (indented-newline) (define (indented-newline)
(newline) (newline)
(indent)) (indent))
@ -41,16 +41,11 @@
(define/override (render-part d ht) (define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d ht))]) (let ([number (collected-info-number (part-collected-info d ht))])
(for-each (lambda (n) (for ([n (in-list (reverse number))] #:when n) (printf "~s." n))
(when n
(printf "~s." n)))
(reverse number))
(when (part-title-content d) (when (part-title-content d)
(when (ormap values number) (when (ormap values number) (printf " "))
(printf " "))
(render-content (part-title-content d) d ht)) (render-content (part-title-content d) d ht))
(when (or (ormap values number) (when (or (ormap values number) (part-title-content d))
(part-title-content d))
(newline) (newline)
(newline)) (newline))
(render-flow (part-blocks d) d ht #f) (render-flow (part-blocks d) d ht #f)
@ -65,20 +60,18 @@
(define/override (render-flow f part ht starting-item?) (define/override (render-flow f part ht starting-item?)
(if (null? f) (if (null? f)
null null
(apply (append*
append
(render-block (car f) part ht starting-item?) (render-block (car f) part ht starting-item?)
(map (lambda (p) (for/list ([p (in-list (cdr f))])
(indented-newline) (indented-newline)
(render-block p part ht #f)) (render-block p part ht #f)))))
(cdr f)))))
(define/override (render-intrapara-block p part ri first? last? starting-item?) (define/override (render-intrapara-block p part ri first? last? starting-item?)
(unless first? (indented-newline)) (unless first? (indented-newline))
(super render-intrapara-block p part ri first? last? starting-item?)) (super render-intrapara-block p part ri first? last? starting-item?))
(define/override (render-table i part ht inline?) (define/override (render-table i part ht inline?)
(let ([flowss (table-blockss i)]) (define flowss (table-blockss i))
(if (null? flowss) (if (null? flowss)
null null
(let* ([strs (map (lambda (flows) (let* ([strs (map (lambda (flows)
@ -110,43 +103,40 @@
"")))]) "")))])
(for/fold ([indent? indent?]) ([sub-row (in-list row*)]) (for/fold ([indent? indent?]) ([sub-row (in-list row*)])
(when indent? (indent)) (when indent? (indent))
(for/fold ([space? #f]) ([col (in-list sub-row)] (for/fold ([space? #f])
([col (in-list sub-row)]
[w (in-list widths)]) [w (in-list widths)])
; (when space? (display " ")) ;; (when space? (display " "))
(let ([col (if (eq? col 'cont) (let ([col (if (eq? col 'cont) "" col)])
""
col)])
(display col) (display col)
(display (make-string (max 0 (- w (string-length col))) #\space))) (display (make-string (max 0 (- w (string-length col))) #\space)))
#t) #t)
(newline) (newline)
#t))) #t)))
#t) #t)
null)))) null)))
(define/override (render-itemization i part ht) (define/override (render-itemization i part ht)
(let ([flows (itemization-blockss i)]) (let ([flows (itemization-blockss i)])
(if (null? flows) (if (null? flows)
null null
(apply append (append*
(begin (begin (printf "* ")
(printf "* ")
(parameterize ([current-indent (make-indent 2)]) (parameterize ([current-indent (make-indent 2)])
(render-flow (car flows) part ht #t))) (render-flow (car flows) part ht #t)))
(map (lambda (d) (for/list ([d (in-list (cdr flows))])
(indented-newline) (indented-newline)
(printf "* ") (printf "* ")
(parameterize ([current-indent (make-indent 2)]) (parameterize ([current-indent (make-indent 2)])
(render-flow d part ht #f))) (render-flow d part ht #f)))))))
(cdr flows))))))
(define/override (render-paragraph p part ri) (define/override (render-paragraph p part ri)
(let ([o (open-output-string)]) (define o (open-output-string))
(parameterize ([current-output-port o]) (parameterize ([current-output-port o])
(super render-paragraph p part ri)) (super render-paragraph p part ri))
(let ([i (open-input-string (define i (open-input-string
(regexp-replace* #rx"\n" (get-output-string o) " "))] (regexp-replace* #rx"\n" (get-output-string o) " ")))
[px (indent->paragraph-px (current-indent))]) (define px (indent->paragraph-px (current-indent)))
(let loop ([indent? #f]) (let loop ([indent? #f])
(cond (cond
[(or (regexp-try-match px i) [(or (regexp-try-match px i)
@ -158,13 +148,13 @@
(loop #t))] (loop #t))]
[else [else
(regexp-try-match "^ +" i) (regexp-try-match "^ +" i)
(let ([b (read-byte i)]) (define b (read-byte i))
(unless (eof-object? b) (unless (eof-object? b)
(when indent? (indent)) (when indent? (indent))
(write-byte b) (write-byte b)
(copy-port i (current-output-port)) (copy-port i (current-output-port))
(newline)))]))) (newline))]))
null)) null)
(define/override (render-content i part ri) (define/override (render-content i part ri)
(if (and (element? i) (if (and (element? i)
@ -177,15 +167,13 @@
(super render-content i part ri))) (super render-content i part ri)))
(define/override (render-nested-flow i part ri starting-item?) (define/override (render-nested-flow i part ri starting-item?)
(let ([s (nested-flow-style i)]) (define s (nested-flow-style i))
(if (and s (if (and s (or (eq? (style-name s) 'inset)
(or (eq? (style-name s) 'inset)
(eq? (style-name s) 'code-inset))) (eq? (style-name s) 'code-inset)))
(begin (begin (printf " ")
(printf " ")
(parameterize ([current-indent (make-indent 2)]) (parameterize ([current-indent (make-indent 2)])
(super render-nested-flow i part ri starting-item?))) (super render-nested-flow i part ri starting-item?)))
(super render-nested-flow i part ri starting-item?)))) (super render-nested-flow i part ri starting-item?)))
(define/override (render-other i part ht) (define/override (render-other i part ht)
(cond (cond
@ -210,4 +198,4 @@
[else (write i)]) [else (write i)])
null) null)
(super-new)))) (super-new)))