*** html/tmhtml.scm	Sat Aug  7 12:51:10 2004
--- tmhtml.scm	Wed Sep 29 16:37:56 2004
***************
*** 16,21 ****
--- 16,22 ----
    (:use (convert tools tmconcat) (convert mathml tmmath)
  	(convert tools stm) (convert tools tmlength) (convert tools tmtable)
  	(convert tools sxml) (convert tools environment) (convert tools sxhtml)
+ 	(convert tools tmcolor)
  	(convert html htmlout))
    (:export texmacs->html tmhtml-root))
  
***************
*** 97,102 ****
--- 98,157 ----
  		 ".title-block { width: 100%; text-align: center } "
  		 ".title-block p { margin: 0px } "))
  
+ ;;;  This was stolen from htmltm.scm.  It's the wrong way to do it, and
+ ;;; should be erased once my tmcolor patches are in.
+ (define html-named-colors
+     '(("black" (0 0 0)) ("silver" (192 192 192)) ("gray" (128 128 128))
+       ("white" (255 255 255)) ("maroon" (128 0 0)) ("red" (255 0 0))
+       ("purple" (128 0 128)) ("fuchsia" (255 0 255)) ("green" (0 128 0))
+       ("lime" (0 255 0)) ("olive" (128 128 0)) ("yellow" (255 255 0))
+       ("navy" (0 0 128)) ("blue" (0 0 255)) ("teal" (0 128 128))
+       ("aqua" (0 0 255)) ("orange" (255 102 0))))
+ 
+ ;;;mine
+ (define call/cc call-with-current-continuation)
+ 
+ ;;; This should be erased once my tmcolor patches are in.
+ (define (text-color->htmlrgb text-color-name)
+   (string-append
+    "#"
+    (list->string
+     (map
+            ;;; instead of just number->string we need to
+            ;;; convert it as a *2 digit* hex number
+      (lambda (z)
+        (if (= 1 (string-length (number->string z 16)))
+ 	   (string-append "0" (number->string z 16))
+ 	   (number->string z 16)))
+      (call/cc
+       (lambda (cont)
+ 	(map (lambda (x)
+ 	       (if (equal? text-color-name (car x))
+ 		   (cont (cadr x))
+ 		   #f))
+ 	     html-named-colors)))))))
+ 
+ ;;; Leave this function!  This is the correct way to do it
+ (define (rgb->htmlrgb rgb-list)
+   (string-append
+    "#"
+    (apply string-append
+     (map
+            ;;; instead of just number->string we need to
+            ;;; convert it as a *2 digit* hex number
+      (lambda (z)
+        (if (= 1 (string-length (number->string z 16)))
+ 	   (string-append "0" (number->string z 16))
+ 	   (number->string z 16)))
+      rgb-list))))     
+ 
+ ;;; Leave this function!  This is the correct way to do it
+ (define (name->htmlrgb name)
+   (rgb->htmlrgb
+    (tmcolor->rgb255
+     (name->tmcolor name))))
+ 
+ 
  (define (tmhtml-file env l)
    ;; This handler is special:
    ;; Since !file is a special node used only at the top of trees
***************
*** 122,132 ****
  	  (set! body (tmhtml-tmdoc-post body))))
      `(h:html
        (h:head
         (h:title ,@(tmhtml env title))
         (h:meta (@ (name "generator")
  		  (content ,(string-append "TeXmacs " (texmacs-version)))))
         ,css)
!       (h:body ,@body))))
  
  (define (tmhtml-finalize-document top)
    ;; @top must be a node produced by tmhtml-file
--- 177,213 ----
  	  (set! body (tmhtml-tmdoc-post body))))
      `(h:html
        (h:head
+ ;;; this was for linking is a stylesheet file named "site.css".  Currently
+ ;;; useless, but could need to be reserected when we try to export
+ ;;; "floating" figures       
+ ;       (h:link (@ (rel "stylesheet") (type "text/css") (href "site.css")))
         (h:title ,@(tmhtml env title))
         (h:meta (@ (name "generator")
  		  (content ,(string-append "TeXmacs " (texmacs-version)))))
+ ;;; use this for debugging. uncomment, and stuff information here, then look
+ ;;; for it in the generated html file.       
+ ;       (h:meta (@ (name "rabbid bit-bucket")
+ ;		 (debugging message ,(get-env "bg-color"))))
         ,css)
!       (h:body
!        (@
! ;   the stuff not implemented in a dynamic way yet.
! ;	(background "ideas/redskull03.gif")
! ;	(alink "#000099")
! ;	(vlink "#990099")
! ;       (link "#000099")
! 
! ;; the stuff implemented in a dynamic way
! ;; uncomment the text-color->htmlrgb line and uncomment
! ;; the name->htmlrgb line if you don't have the "tmcolor patch"
! 	(bgcolor
! 	 ,(name->htmlrgb (get-env "bg-color")))
! ;	 ,(text-color->htmlrgb (get-env "bg-color")))
! 	(text
! 	 ,(name->htmlrgb (get-env "color")))
! ;	 ,(text-color->htmlrgb (get-env "color")))
! 	)
!        ,@body))))
  
  (define (tmhtml-finalize-document top)
    ;; @top must be a node produced by tmhtml-file
***************
*** 551,557 ****
  
  (define (tmhtml-table-contents env p)
    (define (cell x)
!     `(h:td ,@(tmhtml env x)))
    (define (row l)
      `(h:tr ,@(map cell l)))
    (map row (p 'rows 'content)))
--- 632,642 ----
  
  (define (tmhtml-table-contents env p)
    (define (cell x)
!     `(h:td
! ;;; uncomment this to have all table contents align to the top of the cell
! ;;; comment this out to have all table contents align to the middle of the cell
!       (@ (valign "top"))   ;this line
!       ,@(tmhtml env x)))
    (define (row l)
      `(h:tr ,@(map cell l)))
    (map row (p 'rows 'content)))