From b2877336f74a7ae2f8d73d3d78ee8eacfccf4e2a Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 10 Jan 2011 15:08:14 -0700
Subject: [PATCH] support ".svg" in `scribble/base' `image' for HTML output

---
 collects/scribble/html-render.rkt        | 64 +++++++++++++++++-------
 collects/scribblings/scribble/base.scrbl |  4 +-
 2 files changed, 48 insertions(+), 20 deletions(-)

diff --git a/collects/scribble/html-render.rkt b/collects/scribble/html-render.rkt
index 76a7bdea49..bf0dde4760 100644
--- a/collects/scribble/html-render.rkt
+++ b/collects/scribble/html-render.rkt
@@ -966,24 +966,52 @@
                    (number->string
                     (inexact->exact
                      (floor (* scale (integer-bytes->integer s #f #t))))))]
-                [src (select-suffix src suffixes '(".png" ".gif"))]
-                [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))]
-                   [alt ,(content->string (element-content e))]
-                   ,@sz
-                   ,@(attribs)))))]
+                [src (select-suffix src suffixes '(".png" ".gif" ".svg"))]
+                [svg? (regexp-match? #rx#"[.]svg$" (if (path? src) (path->bytes src) src))]
+                [sz (cond
+                     [svg?
+                      (call-with-input-file*
+                       src
+                       (lambda (in)
+                         (with-handlers ([exn:fail? (lambda (exn) 
+                                                      (log-warning
+                                                       (format "warning: error while reading SVG file for size: ~a"
+                                                               (if (exn? exn)
+                                                                   (exn-message exn)
+                                                                   (format "~e" exn))))
+                                                      null)])
+                           (let* ([d (xml:read-xml in)]
+                                  [attribs (xml:element-attributes 
+                                            (xml:document-element d))]
+                                  [check-name (lambda (n)
+                                                (lambda (a)
+                                                  (and (eq? n (xml:attribute-name a))
+                                                       (xml:attribute-value a))))]
+                                  [w (ormap (check-name 'width) attribs)]
+                                  [h (ormap (check-name 'height) attribs)])
+                             (if (and w h)
+                                 `([width ,w][height ,h])
+                                 null)))))]
+                     [(= 1.0 scale) null]
+                     [else
+                      ;; Try to extract file size:
+                      (call-with-input-file*
+                       src
+                       (lambda (in)
+                         (cond
+                          [(regexp-try-match #px#"^\211PNG.{12}" in)
+                           `([width ,(to-num (read-bytes 4 in))]
+                             [height ,(to-num (read-bytes 4 in))])]
+                          [else
+                           null])))])])
+           `((,(if svg? 'iframe 'img)
+              ([src ,(let ([p (install-file src)])
+                       (if (path? p)
+                           (url->string (path->url (path->complete-path p)))
+                           p))]
+               [alt ,(content->string (element-content e))]
+               ,@sz
+               ,@(attribs)))))]
         [(and (or (element? e) (multiarg-element? e))
               (ormap (lambda (v) (and (script-property? v) v))
                      (let ([s (if (element? e)
diff --git a/collects/scribblings/scribble/base.scrbl b/collects/scribblings/scribble/base.scrbl
index 4a0c32750a..3c7c2186ab 100644
--- a/collects/scribblings/scribble/base.scrbl
+++ b/collects/scribblings/scribble/base.scrbl
@@ -329,8 +329,8 @@ See also @racket[verbatim].}
  
  The strings in @racket[suffixes] are filtered to those supported by
  given renderer, and then the acceptable suffixes are tried in
- order. The HTML renderer supports @racket[".png"] and
- @racket[".gif"], while the Latex renderer supports @racket[".png"],
+ order. The HTML renderer supports @racket[".png"],
+ @racket[".gif"], and @racket[".svg"], while the Latex renderer supports @racket[".png"],
  @racket[".pdf"], and @racket[".ps"] (but @racket[".ps"] works only
  when converting Latex output to DVI, and @racket[".png"] and
  @racket[".pdf"] work only for converting Latex output to PDF).