suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 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

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

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