Add rudimentary responsive support for Scribble images

Make image responsive if image has img-responsive class, like so: @image["img/some-image.gif" #:style "img-responsive"]
greghendershott · Nov 12, 2016 · 3d3cc2f · 3d3cc2f
1 parent 9e21bca
commit 3d3cc2f
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 3 deletions.
diff --git a/example/_src/posts/2013-06-19-a-scribble-post.scrbl b/example/_src/posts/2013-06-19-a-scribble-post.scrbl
@@ -99,3 +99,9 @@ Here's a fancier one:
   (standard-fish 30 30 #:color "red" #:direction 'right)
   (standard-fish 25 20 #:color "blue" #:direction 'left)))
 ]
+
+@subsection[#:style 'unnumbered]{B SubSection}
+
+A responsive big black image:
+
+@image["img/800px-image.gif" #:style "img-responsive"]
diff --git a/frog/enhance-body.rkt b/frog/enhance-body.rkt
@@ -32,24 +32,33 @@
 (define responsive-images
   (let ([magick-notice-displayed? #f])
     (λ (xs)
+      (define (remote-host url)
+        (url-host (string->url url)))
       (define (do-it xs)
         (for/list ([x xs])
           (match x
             [`(div ([class ,classes])
-                   (img ([src ,url] ,attrs ...))
+                   (img ,(list-no-order `[src ,url] attrs ...))
                    ,content ...)
              #:when (and (regexp-match #px"\\bfigure\\b" classes)
-                         (not (url-host (string->url url))))
+                         (not (remote-host url)))
              (let ([sizes-attr (assq 'sizes attrs)])
                `(div ([class ,classes])
-                     (img ([class "img-responsive"] ; Bootstrap class
+                     (img ([class "img-responsive"] ; Add Bootstrap class
                            ,@(make-responsive url (cond [sizes-attr => second]
                                                         [#t #f]))
                            ,@(if sizes-attr
                                  (remove sizes-attr attrs)
                                  attrs)))
                      ,@content))
              ]
+            ;; xexpr-map?
+            [`(p () (img ,(list-no-order `[src ,url] `[class ,classes] attrs ...)))
+             #:when (and (regexp-match #px"\\bimg-responsive\\b" classes)
+                         (not (remote-host url)))
+             `(p () (img ([class ,classes]
+                          ,@(make-responsive url #f) ; TODO honor custom sizes?
+                          ,@attrs)))]
             [x x])))
       (cond [(current-responsive-images?)
              (if magick-available?
@@ -86,6 +95,18 @@
                                 [src "/img/1x1.gif"]
                                 [srcset "/img/1x1.gif 2w"]
                                 [sizes "some-custom-size-spec"])))))
+      (test-equal? "Img with img-responsive class inside p tag"
+                   (responsive-images
+                    '((p () (img ([src "/img/1x1.gif"]
+                                  [alt ""]
+                                  [class "img-responsive among-others"]
+                                  [foo-attr "bar"])))))
+                   '((p () (img ([class "img-responsive among-others"]
+                                 [src "/img/1x1.gif"]
+                                 [srcset "/img/1x1.gif 2w"]
+                                 [sizes "(max-width: 2px) 100vw, 2px"]
+                                 [alt ""]
+                                 [foo-attr "bar"])))))
       (test-equal? "Image bigger than maximum size"
                    (responsive-images
                     '((div ([class "figure pull-right"])