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

fix `slideshow/code' for datum after multi-line datum

Browse Source 
as in
   (a b
      c) d
 or
   (a b
      c) (code:comment "here")
This commit is contained in:
Matthew Flatt 2011-06-30 13:08:28 -06:00
parent e921f20b6a
commit c8f235ba1c
1 changed files with 53 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/texpict/code.rkt
View File

@ -125,6 +125,32 @@
[(x (... ...)) ,illegal-use-of-once] [(x (... ...)) ,illegal-use-of-once]
[x (get-val)])))])) [x (get-val)])))]))
;; Find which line `stx' ends on, #f for unknown
(define (syntax-end-line stx)
(cond
[(syntax? stx) (or (syntax-end-line (syntax-e stx))
(syntax-line stx))]
[(pair? stx) (or (syntax-end-line (cdr stx))
(syntax-end-line (car stx)))]
[(vector? stx) (syntax-end-line (reverse (vector->list stx)))]
[else #f]))
;; Find which column `stx' ends on if it's not on `line'
(define (syntax-end-column stx line delta)
(cond
[(syntax? stx) (or (syntax-end-column (syntax-e stx) line delta)
(let ([line2 (syntax-line stx)])
(and line line2
(not (= line line2))
(let ([span (syntax-span stx)]
[col (syntax-column stx)])
(and span col (+ col span delta))))))]
[(pair? stx) (or (syntax-end-column (cdr stx) line (+ delta 1))
(and (or (null? (cdr stx))
(and (syntax? (cdr stx)) (null? (cdr stx))))
(syntax-end-column (car stx) line (+ delta 1))))]
[else #f]))
(define-unit code@ (define-unit code@
(import code-params^) (import code-params^)
(export code^) (export code^)
@ -282,14 +308,18 @@
[(#\{) close-curly-p] [(#\{) close-curly-p]
[else close-paren-p])))) [else close-paren-p]))))
(define (add-close p closes) (define (add-close p closes [force-line #f])
(cond (cond
[(null? closes) p] [(null? closes) p]
[(memq (caar closes) '(contract line)) [(memq (caar closes) '(contract line))
(add-close p (cdr closes))] (add-close p (cdr closes) force-line)]
[else [else
(let ([p (if force-line
(vl-append p (tt ""))
p)])
(add-close (code-hbl-append p (get-close (caar closes) (cdar closes))) (add-close (code-hbl-append p (get-close (caar closes) (cdar closes)))
(cdr closes))])) (cdr closes)
#f))]))
(define (pad-left space p) (define (pad-left space p)
(if (= 0 space) (if (= 0 space)
@ -453,13 +483,17 @@
[else stx])) [else stx]))
closes 'line)] closes 'line)]
[(code:comment s ...) [(code:comment s ...)
(let ([p
(apply htl-append (apply htl-append
(color-semi-p) (color-semi-p)
(map (lambda (s) (map (lambda (s)
(if (pict? (syntax-e s)) (if (pict? (syntax-e s))
(syntax-e s) (syntax-e s)
(maybe-colorize (tt (syntax-e s)) (current-comment-color)))) (maybe-colorize (tt (syntax-e s)) (current-comment-color))))
(syntax->list #'(s ...))))] (syntax->list #'(s ...))))])
;; Ungraceful handling of ungraceful closes by adding a line
;; --- better than sticking them to the right of the comment, at least
(add-close p closes 'force-line))]
[(code:template i ...) [(code:template i ...)
(add-semis (loop #'(code:line i ...) closes 'template))] (add-semis (loop #'(code:line i ...) closes 'template))]
[(a b i ... c) [(a b i ... c)
@ -547,10 +581,13 @@
(loop (cdr stxs) (loop (cdr stxs)
(cdr ps) (cdr ps)
p p
(or (syntax-end-column (car stxs) line 0)
(if (not (syntax-column (car stxs))) (if (not (syntax-column (car stxs)))
+inf.0 +inf.0
(+ col space (get-span (car stxs)))) (+ col space (get-span (car stxs)))))
(or line (syntax-line (car stxs))) (or (syntax-end-line (car stxs))
line
(syntax-line (car stxs)))
#t #t
col->width)))] col->width)))]
[else [else