Commits

Anonymous committed 9ac80ec

Add support for images

Comments (0)

Files changed (1)

 (define raw-html
   (any-of html-comment (html-inline-element)))
 
+(define image
+  (bind (->> (any-of explicit-link reference-link)
+             (preceded-by (is #\!)))
+        (lambda (link)
+          (result
+           (if (eq? 'reference-link (car link))
+               (cons 'reference-image (cdr link))
+               (cons 'image (cdr link)))))))
+
 (define inline
   (any-of (is #\>)
           (as-string (one-or-more normal-char))
 (define references
   (make-parameter #f))
 
+(define (call-with-reference attrs proc)
+  (let ((ref (-> (car (alist-ref 'ref attrs))
+                 (alist-ref (references) equal?))))
+    (if ref
+        (proc ref attrs)
+        (alist-ref 'input attrs))))
+
+(define (make-image ref #!optional attrs)
+  `(img (@ (src ,(alist-ref 'href ref))
+           (alt . ,(alist-ref 'label (or attrs ref)))
+           . ,(maybe-attr-ref 'title ref))))
+
+(define (make-anchor ref #!optional attrs)
+  `(a (@ (href ,(alist-ref 'href ref))
+         . ,(maybe-attr-ref 'title ref))
+      . ,(alist-ref 'label (or attrs ref))))
+
 (define markdown-html-conversion-rules*
   `((explicit-link . ,(lambda (_ attrs)
-                        `(a (@ (href ,(alist-ref 'href attrs))
-                               . ,(maybe-attr-ref 'title attrs))
-                            . ,(alist-ref 'label attrs))))
+                        (make-anchor attrs)))
     (reference-link . ,(lambda (_ attrs)
-                         (let ((ref (-> (car (alist-ref 'ref attrs))
-                                        (alist-ref (references) equal?))))
-                           (if ref
-                               `(a (@ (href ,(alist-ref 'href ref))
-                                      . ,(maybe-attr-ref 'title ref))
-                                   . ,(alist-ref 'label attrs))
-                               (alist-ref 'input attrs)))))
+                         (call-with-reference attrs make-anchor)))
     (auto-link . ,(lambda (_ attrs)
                     `(a (@ (href . ,(alist-ref 'href attrs)))
                         . ,(alist-ref 'label attrs))))
+    (image . ,(lambda (_ attrs)
+                (make-image attrs)))
+    (reference-image . ,(lambda (_ attrs)
+                          (call-with-reference attrs make-image)))
     (verbatim . ,(lambda (_ contents)
                    `(pre (code . ,contents))))
     (bullet-list . ,(lambda (_ items)