diff --git a/TeXmacs/progs/convert/html/tmhtml.scm b/TeXmacs/progs/convert/html/tmhtml.scm
index d6af9721..4d71d4a6 100644
--- a/TeXmacs/progs/convert/html/tmhtml.scm
+++ b/TeXmacs/progs/convert/html/tmhtml.scm
@@ -37,6 +37,7 @@
(define tmhtml-image-root-url (unix->url "image"))
(define tmhtml-image-root-string "image")
(define tmhtml-site-version #f)
+(define tmhtml-web-formats (list "gif" "jpg" "jpeg" "png" "bmp" "svg"))
(tm-define (tmhtml-initialize opts)
(set! tmhtml-env (make-ahash-table))
@@ -51,7 +52,7 @@
(set! tmhtml-image-cache (make-ahash-table))
(let* ((suffix (url-suffix current-save-target))
(n (+ (string-length suffix) 1)))
- (if (in? suffix '("html" "xhtml"))
+ (if (in? suffix '("html" "xhtml" "htm"))
(begin
(set! tmhtml-image-serial 0)
(set! tmhtml-image-root-url (url-unglue current-save-target n))
@@ -1280,6 +1281,7 @@
(if (string-starts? s "web-") 19000.0 20625.0)))
(define (tmhtml-png y)
+ ;; converts generic markup that can be displayed on screen to png format
(let* ((mag (ahash-ref tmhtml-env :mag))
(x (if (or tmhtml-css? (nstring? mag) (== mag "1")) y
(with nmag `(times (value "magnification") ,mag)
@@ -1305,7 +1307,7 @@
(bmar (number->htmlstring (- y3 y1)))
(rmar (number->htmlstring (- x2 x4)))
(tmar (number->htmlstring (- y2 y4)))
- (valign (number->htmlstring (- y3 (- y3 y1))))
+ (valign (number->htmlstring y1))
(height (number->htmlstring (- y4 y3)))
(style (string-append "margin-left: " lmar "em; "
"margin-bottom: " bmar "em; "
@@ -1339,37 +1341,42 @@
(if (== (url-suffix (caddr name)) "") name (url-suffix (caddr name))))
(else "")))
-(define (tmhtml-image-name name)
+(define (tmhtml-web-image-name name)
+ ;; make sure image is accessible from html
;; FIXME: we should replace ~, environment variables, etc.
- (with u (url-relative current-save-target (unix->url name))
- (if (and (or (string-ends? name ".ps")
- (string-ends? name ".eps")
- (string-ends? name ".pdf"))
- (url-exists? u))
- (receive (name-url name-string) (tmhtml-image-names "png")
- (system-2 "convert" u name-url)
- name-string)
- name)))
+ (let* ((un (unix->url name))
+ (u (url-relative current-save-target un))
+ (suf (url-suffix un)))
+ (if (url-exists? u)
+ name
+ (with u1 (url-relative (current-buffer-url) un)
+ (if (url-exists? u1)
+ (receive (name-url name-string) (tmhtml-image-names suf)
+ (system-copy u1 name-url)
+ name-string)
+ name))))) ;; image does not exist, can't do much
(define (tmhtml-image l)
;; FIXME: Should also test that width and height are not magnifications.
;; Currently, magnifications make tmlength->htmllength return #f.
- (cond ((in? (tmhtml-image-suffix (car l)) (list "ps" "eps" "pdf" "tif"))
+ (cond ((nin? (tmhtml-image-suffix (car l)) tmhtml-web-formats)
+ ;; linked or embedded non-web image: convert & save to png
(tmhtml-png (cons 'image l)))
((and (func? (car l) 'tuple 2)
(func? (cadar l) 'raw-data 1)
(string? (cadr (cadar l)))
(string? (caddar l)))
- (receive (name-url name-string) (tmhtml-image-names (caddar l))
- (when (in? (url-suffix name-url)
- (list "ps" "eps" "pdf" "tif"))
- (set! name-string (url->string name-url)))
+ ;; embedded web image, extract it
+ (receive (name-url name-string)
+ (tmhtml-image-names (url-suffix (caddar l)))
(string-save (cadr (cadar l)) name-url)
(tmhtml-image (cons name-string (cdr l)))))
((nstring? (first l))
+ ;; treat complex images as generic markup
(tmhtml-png (cons 'image l)))
(else
- (let* ((s (tmhtml-image-name (cork->html (first l))))
+ ;; web images
+ (let* ((s (tmhtml-web-image-name (cork->html (first l))))
(w (tmlength->htmllength (second l) #f))
(h (tmlength->htmllength (third l) #f)))
`((h:img (@ (class "image")