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

scribble: javascript and attribute hooks

Browse Source 
svn: r9958

original commit: c9bf30746e830c0c69e66a903b20341c09814ad1
This commit is contained in:
Matthew Flatt 2008-05-26 14:03:38 +00:00
parent a6f9520273
commit 7b524abcaa
5 changed files with 160 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

184
collects/scribble/html-render.ss
View File

@ -106,6 +106,11 @@
#reader scribble/reader (begin ; easier to format #reader scribble/reader (begin ; easier to format
(define mynoscript-setup
@inlined-script{
document.write('<style>mynoscript { display:none }</style>');
})
(define search-script (define search-script
@inlined-script{ @inlined-script{
var search_nodes = null; var search_nodes = null;
@ -523,6 +528,7 @@
(meta ([http-equiv "content-type"] (meta ([http-equiv "content-type"]
[content "text-html; charset=utf-8"])) [content "text-html; charset=utf-8"]))
,title ,title
,mynoscript-setup
,(scribble-css-contents style-file css-path) ,(scribble-css-contents style-file css-path)
,(scribble-js-contents script-file script-path)) ,(scribble-js-contents script-file script-path))
(body () ,@(render-toc-view d ri) (body () ,@(render-toc-view d ri)
@ -703,6 +709,10 @@
[(hover-element? e) [(hover-element? e)
`((span ([title ,(hover-element-text e)]) `((span ([title ,(hover-element-text e)])
,@(render-plain-element e part ri)))] ,@(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) [(target-element? e)
`((a ([name ,(format "~a" (anchor-name (tag-key (target-element-tag e) `((a ([name ,(format "~a" (anchor-name (tag-key (target-element-tag e)
ri)))])) ri)))]))
@ -747,86 +757,100 @@
[else (render-plain-element e part ri)])) [else (render-plain-element e part ri)]))
(define/private (render-plain-element e part ri) (define/private (render-plain-element e part ri)
(define style (and (element? e) (element-style e))) (let* ([raw-style (and (element? e) (element-style e))]
(cond [style (if (with-attributes? raw-style)
[(symbol? style) (with-attributes-style raw-style)
(case style raw-style)]
[(italic) `((i ,@(super render-element e part ri)))] [attribs (lambda ()
[(bold) `((b ,@(super render-element e part ri)))] (if (with-attributes? raw-style)
[(tt) `((span ([class "stt"]) ,@(super render-element e part ri)))] (map (lambda (p) (list (car p) (cdr p)))
[(no-break) `((span ([class "nobreak"]) (with-attributes-assoc raw-style))
,@(super render-element e part ri)))] null))])
[(sf) `((b (font ([size "-1"] [face "Helvetica"]) (cond
,@(super render-element e part ri))))] [(symbol? style)
[(subscript) `((sub ,@(super render-element e part ri)))] (case style
[(superscript) `((sup ,@(super render-element e part ri)))] [(italic) `((i ,(attribs) ,@(super render-element e part ri)))]
[(hspace) `((span ([class "hspace"]) [(bold) `((b ,(attribs) ,@(super render-element e part ri)))]
,@(let ([str (content->string (element-content e))]) [(tt) `((span ([class "stt"] . ,(attribs)) ,@(super render-element e part ri)))]
(map (lambda (c) 'nbsp) (string->list str)))))] [(no-break) `((span ([class "nobreak"] . ,(attribs))
[(newline) `((br))] ,@(super render-element e part ri)))]
[else (error 'html-render "unrecognized style symbol: ~e" style)])] [(sf) `((b (font ([size "-1"] [face "Helvetica"] . ,(attribs))
[(string? style) ,@(super render-element e part ri))))]
`((span ([class ,style]) ,@(super render-element e part ri)))] [(subscript) `((sub ,(attribs) ,@(super render-element e part ri)))]
[(and (pair? style) (memq (car style) '(color bg-color))) [(superscript) `((sup ,(attribs) ,@(super render-element e part ri)))]
(unless (and (list? style) [(hspace) `((span ([class "hspace"] . ,(attribs))
(or (and (= 4 (length style)) ,@(let ([str (content->string (element-content e))])
(andmap byte? (cdr style))) (map (lambda (c) 'nbsp) (string->list str)))))]
(and (= 2 (length style)) [(newline) `((br ,(attribs)))]
(member (cadr style) [else (error 'html-render "unrecognized style symbol: ~e" style)])]
'("white" "black" "red" "green" "blue" [(string? style)
"cyan" "magenta" "yellow"))))) `((span ([class ,style] . ,(attribs)) ,@(super render-element e part ri)))]
(error 'render-font "bad color style: ~e" style)) [(and (pair? style) (memq (car style) '(color bg-color)))
`((font ([style (unless (and (list? style)
,(format "~acolor: ~a" (or (and (= 4 (length style))
(if (eq? (car style) 'bg-color) "background-" "") (andmap byte? (cdr style)))
(if (= 2 (length style)) (and (= 2 (length style))
(cadr style) (member (cadr style)
(string-append* '("white" "black" "red" "green" "blue"
"#" "cyan" "magenta" "yellow")))))
(map (lambda (v) (error 'render-font "bad color style: ~e" style))
(let ([s (number->string v 16)]) `((font ([style
(if (< v 16) (string-append "0" s) s))) ,(format "~acolor: ~a"
(cdr style)))))]) (if (eq? (car style) 'bg-color) "background-" "")
,@(super render-element e part ri)))] (if (= 2 (length style))
[(target-url? style) (cadr style)
(if (current-no-links) (string-append*
(super render-element e part ri) "#"
(parameterize ([current-no-links #t]) (map (lambda (v)
`((a ([href ,(let ([addr (target-url-addr style)]) (let ([s (number->string v 16)])
(if (path? addr) (if (< v 16) (string-append "0" s) s)))
(from-root addr (get-dest-directory)) (cdr style)))))]
addr))] . ,(attribs))
,@(if (string? (target-url-style style)) ,@(super render-element e part ri)))]
`([class ,(target-url-style style)]) [(target-url? style)
null)) (if (current-no-links)
,@(super render-element e part ri)))))] (super render-element e part ri)
[(url-anchor? style) (parameterize ([current-no-links #t])
`((a ([name ,(url-anchor-name style)]) `((a ([href ,(let ([addr (target-url-addr style)])
,@(super render-element e part ri)))] (if (path? addr)
[(image-file? style) (from-root addr (get-dest-directory))
(let* ([src (main-collects-relative->path (image-file-path style))] addr))]
[scale (image-file-scale style)] ,@(if (string? (target-url-style style))
[to-num `([class ,(target-url-style style)])
(lambda (s) null)
(number->string . ,(attribs))
(inexact->exact ,@(super render-element e part ri)))))]
(floor (* scale (integer-bytes->integer s #f #t))))))] [(url-anchor? style)
[sz (if (= 1.0 scale) `((a ([name ,(url-anchor-name style)] . ,(attribs))
null ,@(super render-element e part ri)))]
;; Try to extract file size: [(image-file? style)
(call-with-input-file* (let* ([src (main-collects-relative->path (image-file-path style))]
src [scale (image-file-scale style)]
(lambda (in) [to-num
(if (regexp-try-match #px#"^\211PNG.{12}" in) (lambda (s)
`([width ,(to-num (read-bytes 4 in))] (number->string
[height ,(to-num (read-bytes 4 in))]) (inexact->exact
null))))]) (floor (* scale (integer-bytes->integer s #f #t))))))]
`((img ([src ,(let ([p (install-file src)]) [sz (if (= 1.0 scale)
(if (path? p) null
(url->string (path->url (path->complete-path p))) ;; Try to extract file size:
p))]) (call-with-input-file*
,@sz)))] src
[else (super render-element e part ri)])) (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/override (render-table t part ri need-inline?)
(define t-style (table-style t)) (define t-style (table-style t))

7
collects/scribble/manual.ss
View File

@ -334,8 +334,11 @@
(define (procedure . str) (define (procedure . str)
(make-element "schemeresult" `("#<procedure:" ,@(decode-content str) ">"))) (make-element "schemeresult" `("#<procedure:" ,@(decode-content str) ">")))
(define (link url #:underline? [underline? #t] . str) (define (link url
(make-element (make-target-url url (if underline? #f "plainlink")) #:underline? [underline? #t]
#:style [style (if underline? #f "plainlink")]
. str)
(make-element (make-target-url url style)
(decode-content str))) (decode-content str)))
(define (schemeerror . str) (define (schemeerror . str)

5
collects/scribble/struct.ss
View File

@ -161,8 +161,13 @@
[desc any/c])] [desc any/c])]
[(aux-element element) ()] [(aux-element element) ()]
[(hover-element element) ([text string?])] [(hover-element element) ([text string?])]
[(script-element element) ([type string?]
[script string?])]
;; specific renders support other elements, especially strings ;; 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?))] [collected-info ([number (listof (or/c false/c integer?))]
[parent (or/c false/c part?)] [parent (or/c false/c part?)]
[info any/c])] [info any/c])]

9
collects/scribblings/scribble/manual.scrbl
View File

@ -791,9 +791,14 @@ The @tech{decode}d @scheme[pre-content] is hyperlinked to the definition
of @scheme[id].} 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?]{ @defproc[(elemtag [t tag?] [pre-content any/c] ...) element?]{

42
collects/scribblings/scribble/struct.scrbl
View File

@ -143,6 +143,18 @@ A @deftech{block} is either a @techlink{table}, an
excluded in the text of a link when it excluded in the text of a link when it
appears in a referenced section name.} 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 @item{A @deftech{delayed block} is an instance of
@ -361,7 +373,8 @@ The @scheme[style] field is normally either
@itemize{ @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], @item{one of the symbols that all renderers recognize: @scheme['tt],
@scheme['italic], @scheme['bold], @scheme['sf], @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 background color (with the same constraints and meanings as for
@scheme['color]);} @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?)] @defstruct[delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any/c)] [sizer (-> any/c)]
[plain (-> 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?))] @defstruct[collected-info ([number (listof (or/c false/c integer?))]