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

add current-code-font and fix bounding box ascent/descent for pin-line operations

Browse Source 
svn: r5844
This commit is contained in:
Matthew Flatt 2007-03-30 01:42:54 +00:00
parent a3edbc9068
commit 615f6e0454
3 changed files with 22 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/texpict/code.ss
View File

@ -94,7 +94,7 @@
(define-signature code^
(typeset-code code-pict-bottom-line-pict pict->code-pict
comment-color keyword-color id-color const-color literal-color
code-align current-code-tt
code-align current-code-tt current-code-font
current-keyword-list current-const-list current-literal-list
code-colorize-enabled code-colorize-quote-enabled
code-italic-underscore-enabled code-scripts-enabled
@ -120,9 +120,11 @@
(define-unit code@
(import code-params^)
(export code^)
(define current-code-font (make-parameter `(bold . modern)))
(define (default-tt s)
(text s `(bold . modern) (current-font-size)))
(text s (current-code-font) (current-font-size)))
(define current-code-tt (make-parameter default-tt))
@ -286,31 +288,31 @@
(not (char=? #\_ (string-ref str 1))))
(mode-colorize
mode 'id
(text (substring str 1) `(bold italic . modern) (current-font-size)))]
(text (substring str 1) `(italic . ,(current-code-font)) (current-font-size)))]
[(and (code-scripts-enabled)
(regexp-match #rx"^(.+)_([0-9a-z]+)\\^([0-9a-z]+)$" str))
=> (lambda (m)
(hbl-append (colorize-id (cadr m) mode)
(cc-superimpose
(text (caddr m) `(subscript bold . modern) (current-font-size))
(text (cadddr m) `(superscript bold . modern) (current-font-size)))))]
(text (caddr m) `(subscript . ,(current-code-font)) (current-font-size))
(text (cadddr m) `(superscript . ,(current-code-font)) (current-font-size)))))]
[(and (code-scripts-enabled)
(regexp-match #rx"^(.+)\\^([0-9a-z]+)_([0-9a-z]+)$" str))
=> (lambda (m)
(hbl-append (colorize-id (cadr m) mode)
(cc-superimpose
(text (cadddr m) `(subscript bold . modern) (current-font-size))
(text (caddr m) `(superscript bold . modern) (current-font-size)))))]
(text (cadddr m) `(subscript . ,(current-code-font)) (current-font-size))
(text (caddr m) `(superscript . ,(current-code-font)) (current-font-size)))))]
[(and (code-scripts-enabled)
(regexp-match #rx"^(.+)\\^([0-9a-z]+)$" str))
=> (lambda (m)
(hbl-append (colorize-id (cadr m) mode)
(text (caddr m) `(superscript bold . modern) (current-font-size))))]
(text (caddr m) `(superscript . ,(current-code-font)) (current-font-size))))]
[(and (code-scripts-enabled)
(regexp-match #rx"^(.+)_([0-9a-z]+)$" str))
=> (lambda (m)
(hbl-append (colorize-id (cadr m) mode)
(text (caddr m) `(subscript bold . modern) (current-font-size))))]
(text (caddr m) `(subscript . ,(current-code-font)) (current-font-size))))]
[else
(mode-colorize
mode

8
collects/texpict/doc.txt
View File

@ -1155,9 +1155,13 @@ The _code^_ unit supplies the following
> $ - typesets as a vertical bar (for no
particularly good reason)
> current-code-tt - parameter for a one-argument function to turn a
> current-code-font - parameter for a base font used to typeset text.
The default is `(bold . modern).
> current-code-tt - parameter for a one-argument procedure to turn a
string into a pict, used to typeset text. The default is
(lambda (s) (text s `(bold . modern) (current-font-size)))
(lambda (s) (text s (current-code-font) (current-font-size)))
This procedure is not used to typeset subscripts or other items
that require font changes, but `current-code-font' is always used.
> current-comment-color - parameter for a string or color% for comments
> current-keyword-color - parameter for a string or color% for keywords

8
collects/texpict/utils.ss
View File

@ -795,9 +795,11 @@
(if color
(colorize p2 color)
p2)))])
(if under?
(cc-superimpose arrows base)
(cc-superimpose base arrows)))))
(refocus
(if under?
(cc-superimpose arrows base)
(cc-superimpose base arrows))
base))))
(define add-line
(opt-lambda (base src find-src dest find-dest [thickness #f] [color #f] [under? #f])