scribble: javascript and attribute hooks
svn: r9958 original commit: c9bf30746e830c0c69e66a903b20341c09814ad1
This commit is contained in:
Matthew Flatt
parent
a6f9520273
commit
7b524abcaa
|
|
@ -106,6 +106,11 @@
|
|||
|
||||
#reader scribble/reader (begin ; easier to format
|
||||
|
||||
(define mynoscript-setup
|
||||
@inlined-script{
|
||||
document.write('<style>mynoscript { display:none }</style>');
|
||||
})
|
||||
|
||||
(define search-script
|
||||
@inlined-script{
|
||||
var search_nodes = null;
|
||||
|
|
@ -523,6 +528,7 @@
|
|||
(meta ([http-equiv "content-type"]
|
||||
[content "text-html; charset=utf-8"]))
|
||||
,title
|
||||
,mynoscript-setup
|
||||
,(scribble-css-contents style-file css-path)
|
||||
,(scribble-js-contents script-file script-path))
|
||||
(body () ,@(render-toc-view d ri)
|
||||
|
|
@ -703,6 +709,10 @@
|
|||
[(hover-element? e)
|
||||
`((span ([title ,(hover-element-text e)])
|
||||
,@(render-plain-element e part ri)))]
|
||||
[(script-element? e)
|
||||
`((script ([type ,(script-element-type e)])
|
||||
,(literal (script-element-script e)))
|
||||
(mynoscript ,@(render-plain-element e part ri)))]
|
||||
[(target-element? e)
|
||||
`((a ([name ,(format "~a" (anchor-name (tag-key (target-element-tag e)
|
||||
ri)))]))
|
||||
|
|
@ -747,86 +757,100 @@
|
|||
[else (render-plain-element e part ri)]))
|
||||
|
||||
(define/private (render-plain-element e part ri)
|
||||
(define style (and (element? e) (element-style e)))
|
||||
(cond
|
||||
[(symbol? style)
|
||||
(case style
|
||||
[(italic) `((i ,@(super render-element e part ri)))]
|
||||
[(bold) `((b ,@(super render-element e part ri)))]
|
||||
[(tt) `((span ([class "stt"]) ,@(super render-element e part ri)))]
|
||||
[(no-break) `((span ([class "nobreak"])
|
||||
,@(super render-element e part ri)))]
|
||||
[(sf) `((b (font ([size "-1"] [face "Helvetica"])
|
||||
,@(super render-element e part ri))))]
|
||||
[(subscript) `((sub ,@(super render-element e part ri)))]
|
||||
[(superscript) `((sup ,@(super render-element e part ri)))]
|
||||
[(hspace) `((span ([class "hspace"])
|
||||
,@(let ([str (content->string (element-content e))])
|
||||
(map (lambda (c) 'nbsp) (string->list str)))))]
|
||||
[(newline) `((br))]
|
||||
[else (error 'html-render "unrecognized style symbol: ~e" style)])]
|
||||
[(string? style)
|
||||
`((span ([class ,style]) ,@(super render-element e part ri)))]
|
||||
[(and (pair? style) (memq (car style) '(color bg-color)))
|
||||
(unless (and (list? style)
|
||||
(or (and (= 4 (length style))
|
||||
(andmap byte? (cdr style)))
|
||||
(and (= 2 (length style))
|
||||
(member (cadr style)
|
||||
'("white" "black" "red" "green" "blue"
|
||||
"cyan" "magenta" "yellow")))))
|
||||
(error 'render-font "bad color style: ~e" style))
|
||||
`((font ([style
|
||||
,(format "~acolor: ~a"
|
||||
(if (eq? (car style) 'bg-color) "background-" "")
|
||||
(if (= 2 (length style))
|
||||
(cadr style)
|
||||
(string-append*
|
||||
"#"
|
||||
(map (lambda (v)
|
||||
(let ([s (number->string v 16)])
|
||||
(if (< v 16) (string-append "0" s) s)))
|
||||
(cdr style)))))])
|
||||
,@(super render-element e part ri)))]
|
||||
[(target-url? style)
|
||||
(if (current-no-links)
|
||||
(super render-element e part ri)
|
||||
(parameterize ([current-no-links #t])
|
||||
`((a ([href ,(let ([addr (target-url-addr style)])
|
||||
(if (path? addr)
|
||||
(from-root addr (get-dest-directory))
|
||||
addr))]
|
||||
,@(if (string? (target-url-style style))
|
||||
`([class ,(target-url-style style)])
|
||||
null))
|
||||
,@(super render-element e part ri)))))]
|
||||
[(url-anchor? style)
|
||||
`((a ([name ,(url-anchor-name style)])
|
||||
,@(super render-element e part ri)))]
|
||||
[(image-file? style)
|
||||
(let* ([src (main-collects-relative->path (image-file-path style))]
|
||||
[scale (image-file-scale style)]
|
||||
[to-num
|
||||
(lambda (s)
|
||||
(number->string
|
||||
(inexact->exact
|
||||
(floor (* scale (integer-bytes->integer s #f #t))))))]
|
||||
[sz (if (= 1.0 scale)
|
||||
null
|
||||
;; Try to extract file size:
|
||||
(call-with-input-file*
|
||||
src
|
||||
(lambda (in)
|
||||
(if (regexp-try-match #px#"^\211PNG.{12}" in)
|
||||
`([width ,(to-num (read-bytes 4 in))]
|
||||
[height ,(to-num (read-bytes 4 in))])
|
||||
null))))])
|
||||
`((img ([src ,(let ([p (install-file src)])
|
||||
(if (path? p)
|
||||
(url->string (path->url (path->complete-path p)))
|
||||
p))])
|
||||
,@sz)))]
|
||||
[else (super render-element e part ri)]))
|
||||
(let* ([raw-style (and (element? e) (element-style e))]
|
||||
[style (if (with-attributes? raw-style)
|
||||
(with-attributes-style raw-style)
|
||||
raw-style)]
|
||||
[attribs (lambda ()
|
||||
(if (with-attributes? raw-style)
|
||||
(map (lambda (p) (list (car p) (cdr p)))
|
||||
(with-attributes-assoc raw-style))
|
||||
null))])
|
||||
(cond
|
||||
[(symbol? style)
|
||||
(case style
|
||||
[(italic) `((i ,(attribs) ,@(super render-element e part ri)))]
|
||||
[(bold) `((b ,(attribs) ,@(super render-element e part ri)))]
|
||||
[(tt) `((span ([class "stt"] . ,(attribs)) ,@(super render-element e part ri)))]
|
||||
[(no-break) `((span ([class "nobreak"] . ,(attribs))
|
||||
,@(super render-element e part ri)))]
|
||||
[(sf) `((b (font ([size "-1"] [face "Helvetica"] . ,(attribs))
|
||||
,@(super render-element e part ri))))]
|
||||
[(subscript) `((sub ,(attribs) ,@(super render-element e part ri)))]
|
||||
[(superscript) `((sup ,(attribs) ,@(super render-element e part ri)))]
|
||||
[(hspace) `((span ([class "hspace"] . ,(attribs))
|
||||
,@(let ([str (content->string (element-content e))])
|
||||
(map (lambda (c) 'nbsp) (string->list str)))))]
|
||||
[(newline) `((br ,(attribs)))]
|
||||
[else (error 'html-render "unrecognized style symbol: ~e" style)])]
|
||||
[(string? style)
|
||||
`((span ([class ,style] . ,(attribs)) ,@(super render-element e part ri)))]
|
||||
[(and (pair? style) (memq (car style) '(color bg-color)))
|
||||
(unless (and (list? style)
|
||||
(or (and (= 4 (length style))
|
||||
(andmap byte? (cdr style)))
|
||||
(and (= 2 (length style))
|
||||
(member (cadr style)
|
||||
'("white" "black" "red" "green" "blue"
|
||||
"cyan" "magenta" "yellow")))))
|
||||
(error 'render-font "bad color style: ~e" style))
|
||||
`((font ([style
|
||||
,(format "~acolor: ~a"
|
||||
(if (eq? (car style) 'bg-color) "background-" "")
|
||||
(if (= 2 (length style))
|
||||
(cadr style)
|
||||
(string-append*
|
||||
"#"
|
||||
(map (lambda (v)
|
||||
(let ([s (number->string v 16)])
|
||||
(if (< v 16) (string-append "0" s) s)))
|
||||
(cdr style)))))]
|
||||
. ,(attribs))
|
||||
,@(super render-element e part ri)))]
|
||||
[(target-url? style)
|
||||
(if (current-no-links)
|
||||
(super render-element e part ri)
|
||||
(parameterize ([current-no-links #t])
|
||||
`((a ([href ,(let ([addr (target-url-addr style)])
|
||||
(if (path? addr)
|
||||
(from-root addr (get-dest-directory))
|
||||
addr))]
|
||||
,@(if (string? (target-url-style style))
|
||||
`([class ,(target-url-style style)])
|
||||
null)
|
||||
. ,(attribs))
|
||||
,@(super render-element e part ri)))))]
|
||||
[(url-anchor? style)
|
||||
`((a ([name ,(url-anchor-name style)] . ,(attribs))
|
||||
,@(super render-element e part ri)))]
|
||||
[(image-file? style)
|
||||
(let* ([src (main-collects-relative->path (image-file-path style))]
|
||||
[scale (image-file-scale style)]
|
||||
[to-num
|
||||
(lambda (s)
|
||||
(number->string
|
||||
(inexact->exact
|
||||
(floor (* scale (integer-bytes->integer s #f #t))))))]
|
||||
[sz (if (= 1.0 scale)
|
||||
null
|
||||
;; Try to extract file size:
|
||||
(call-with-input-file*
|
||||
src
|
||||
(lambda (in)
|
||||
(if (regexp-try-match #px#"^\211PNG.{12}" in)
|
||||
`([width ,(to-num (read-bytes 4 in))]
|
||||
[height ,(to-num (read-bytes 4 in))])
|
||||
null))))])
|
||||
`((img ([src ,(let ([p (install-file src)])
|
||||
(if (path? p)
|
||||
(url->string (path->url (path->complete-path p)))
|
||||
p))]
|
||||
. ,(attribs))
|
||||
,@sz)))]
|
||||
[else
|
||||
(if (with-attributes? raw-style)
|
||||
`((span ,(attribs) ,@(super render-element e part ri)))
|
||||
(super render-element e part ri))])))
|
||||
|
||||
(define/override (render-table t part ri need-inline?)
|
||||
(define t-style (table-style t))
|
||||
|
|
|
|||
|
|
@ -334,8 +334,11 @@
|
|||
(define (procedure . str)
|
||||
(make-element "schemeresult" `("#<procedure:" ,@(decode-content str) ">")))
|
||||
|
||||
(define (link url #:underline? [underline? #t] . str)
|
||||
(make-element (make-target-url url (if underline? #f "plainlink"))
|
||||
(define (link url
|
||||
#:underline? [underline? #t]
|
||||
#:style [style (if underline? #f "plainlink")]
|
||||
. str)
|
||||
(make-element (make-target-url url style)
|
||||
(decode-content str)))
|
||||
|
||||
(define (schemeerror . str)
|
||||
|
|
|
|||
|
|
@ -161,8 +161,13 @@
|
|||
[desc any/c])]
|
||||
[(aux-element element) ()]
|
||||
[(hover-element element) ([text string?])]
|
||||
[(script-element element) ([type string?]
|
||||
[script string?])]
|
||||
;; specific renders support other elements, especially strings
|
||||
|
||||
[with-attributes ([style any/c]
|
||||
[assoc (listof (cons/c symbol? string?))])]
|
||||
|
||||
[collected-info ([number (listof (or/c false/c integer?))]
|
||||
[parent (or/c false/c part?)]
|
||||
[info any/c])]
|
||||
|
|
|
|||
|
|
@ -791,9 +791,14 @@ The @tech{decode}d @scheme[pre-content] is hyperlinked to the definition
|
|||
of @scheme[id].}
|
||||
|
||||
|
||||
@defproc[(link [url string?] [pre-content any/c] ...) element?]{
|
||||
@defproc[(link [url string?] [pre-content any/c] ...
|
||||
[#:underline? underline? any/c #t]
|
||||
[#:style style any/c (if underline? #f "plainlink")])
|
||||
element?]{
|
||||
|
||||
The @tech{decode}d @scheme[pre-content] is hyperlinked to @scheme[url].}
|
||||
The @tech{decode}d @scheme[pre-content] is hyperlinked to
|
||||
@scheme[url]. If @scheme[style] is not supplied, then
|
||||
@scheme[underline?] determines how the link is rendered.}
|
||||
|
||||
|
||||
@defproc[(elemtag [t tag?] [pre-content any/c] ...) element?]{
|
||||
|
|
|
|||
|
|
@ -143,6 +143,18 @@ A @deftech{block} is either a @techlink{table}, an
|
|||
excluded in the text of a link when it
|
||||
appears in a referenced section name.}
|
||||
|
||||
@item{An instance of @scheme[hover-element] adds
|
||||
text to show in render HTML when the mouse
|
||||
hovers over the elements.}
|
||||
|
||||
@item{An instance of @scheme[script-element]
|
||||
provides script code (usually
|
||||
@as-index{Javascript}) to run in the browser
|
||||
to generate the element; the element's normal
|
||||
content is used when scripting is disabled in
|
||||
the browser, or for rendering to other
|
||||
formats.}
|
||||
|
||||
}}}}
|
||||
|
||||
@item{A @deftech{delayed block} is an instance of
|
||||
|
|
@ -361,7 +373,8 @@ The @scheme[style] field is normally either
|
|||
|
||||
@itemize{
|
||||
|
||||
@item{a string, which corresponds to a CSS class for HTML output;}
|
||||
@item{a string, which corresponds to a CSS class for HTML output and
|
||||
a macro name for Latex output;}
|
||||
|
||||
@item{one of the symbols that all renderers recognize: @scheme['tt],
|
||||
@scheme['italic], @scheme['bold], @scheme['sf],
|
||||
|
|
@ -382,9 +395,12 @@ The @scheme[style] field is normally either
|
|||
background color (with the same constraints and meanings as for
|
||||
@scheme['color]);}
|
||||
|
||||
@item{an instance of @scheme[target-url] to generate a hyperlink; or}
|
||||
@item{an instance of @scheme[target-url] to generate a hyperlink;}
|
||||
|
||||
@item{an instance of @scheme[image-file] to support an inline image.}
|
||||
@item{an instance of @scheme[image-file] to support an inline image; or}
|
||||
|
||||
@item{an instance of @scheme[with-attributes], which combines a base
|
||||
style with a set of additional HTML attributes.}
|
||||
|
||||
}
|
||||
|
||||
|
|
@ -461,6 +477,21 @@ Instances of this structure type are intended for use in titles, where
|
|||
|
||||
}
|
||||
|
||||
@defstruct[(hover-element element) ([text string?])]{
|
||||
|
||||
The @scheme[text] is displayed in HTML output when the mouse hovers
|
||||
over the element's content.}
|
||||
|
||||
|
||||
@defstruct[(script-element element) ([type string?]
|
||||
[script string?])]{
|
||||
|
||||
For HTML rendering, when scripting is enabled in the browser,
|
||||
@scheme[script] is used for the element instead of its normal
|
||||
content. The @scheme[type] string is normally
|
||||
@scheme["text/javascript"].}
|
||||
|
||||
|
||||
@defstruct[delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
|
||||
[sizer (-> any/c)]
|
||||
[plain (-> any/c)])]{
|
||||
|
|
@ -512,6 +543,11 @@ element remains intact (i.e., it is not replaced) by either the
|
|||
|
||||
}
|
||||
|
||||
@defstruct[with-attributes ([style any/c]
|
||||
[assoc (listof (cons/c symbol? string?))])]{
|
||||
|
||||
Used for an @scheme[element]'s style to combine a base style with
|
||||
arbitrary HTML attributes.}
|
||||
|
||||
|
||||
@defstruct[collected-info ([number (listof (or/c false/c integer?))]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user