scribble: javascript and attribute hooks

svn: r9958

original commit: c9bf30746e830c0c69e66a903b20341c09814ad1

collects/scribble/html-render.ss

@@ -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,26 +757,34 @@
         [else (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))]
+             [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 ,@(super render-element e part ri)))]
+            [(italic) `((i ,(attribs) ,@(super render-element e part ri)))]
-           [(bold) `((b ,@(super render-element e part ri)))]
+            [(bold) `((b ,(attribs) ,@(super render-element e part ri)))]
-           [(tt) `((span ([class "stt"]) ,@(super render-element e part ri)))]
+            [(tt) `((span ([class "stt"] . ,(attribs)) ,@(super render-element e part ri)))]
-           [(no-break) `((span ([class "nobreak"])
+            [(no-break) `((span ([class "nobreak"] . ,(attribs))
                                 ,@(super render-element e part ri)))]
-           [(sf) `((b (font ([size "-1"] [face "Helvetica"])
+            [(sf) `((b (font ([size "-1"] [face "Helvetica"] . ,(attribs))
                              ,@(super render-element e part ri))))]
-           [(subscript) `((sub ,@(super render-element e part ri)))]
+            [(subscript) `((sub ,(attribs) ,@(super render-element e part ri)))]
-           [(superscript) `((sup ,@(super render-element e part ri)))]
+            [(superscript) `((sup ,(attribs) ,@(super render-element e part ri)))]
-           [(hspace) `((span ([class "hspace"])
+            [(hspace) `((span ([class "hspace"] . ,(attribs))
                               ,@(let ([str (content->string (element-content e))])
                                   (map (lambda (c) 'nbsp) (string->list str)))))]
-           [(newline) `((br))]
+            [(newline) `((br ,(attribs)))]
             [else (error 'html-render "unrecognized style symbol: ~e" style)])]
          [(string? style)
-         `((span ([class ,style]) ,@(super render-element e part ri)))]
+          `((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))
@@ -786,7 +804,8 @@
                                      (map (lambda (v)
                                             (let ([s (number->string v 16)])
                                               (if (< v 16) (string-append "0" s) s)))
-                                    (cdr style)))))])
+                                          (cdr style)))))]
+                   . ,(attribs))
                   ,@(super render-element e part ri)))]
          [(target-url? style)
           (if (current-no-links)
@@ -798,10 +817,11 @@
                                    addr))]
                       ,@(if (string? (target-url-style style))
                             `([class ,(target-url-style style)])
-                       null))
+                            null)
+                      . ,(attribs))
                      ,@(super render-element e part ri)))))]
          [(url-anchor? style)
-         `((a ([name ,(url-anchor-name 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))]
@@ -824,9 +844,13 @@
             `((img ([src ,(let ([p (install-file src)])
                             (if (path? p)
                                 (url->string (path->url (path->complete-path p)))
-                             p))])
+                                p))]
+                    . ,(attribs))
                    ,@sz)))]
-        [else (super render-element e part ri)]))
+         [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))

collects/scribble/manual.ss

@@ -334,8 +334,11 @@
 (define (procedure . 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)))
 
 (define (schemeerror . str)

collects/scribble/struct.ss

@@ -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])]

collects/scribblings/scribble/manual.scrbl

@@ -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?]{

collects/scribblings/scribble/struct.scrbl

@@ -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?))]