← Back to branch summary

~ubuntu-branches/ubuntu/quantal/texmacs/quantal

« back to all changes in this revision

Viewing changes to TeXmacs/progs/convert/html/tmhtml.scm

  • Committer: Bazaar Package Importer
  • Author(s): Atsuhito KOHDA, Kamaraju Kusumanchi, kohda
  • Date: 2009-04-26 19:35:14 UTC
  • mfrom: (1.1.10 upstream) (4.1.4 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090426193514-9yo3oggdslgdls4b
Tags: 1:1.0.7.2-1
http://bugs.debian.org/484073
http://bugs.debian.org/497021
[Kamaraju Kusumanchi <kamaraju@gmail.com>]
* New upstream release
* texmacs crashes if /usr/share/texmacs/TeXmacs/misc/pixmaps/unknown.ps
  is not present. Do not remove it. (Closes: #484073, #497021)
* update patches 03_mupad.dpatch, 04_axiom.dpatch, 11-desktop-file.dpatch
* fix the mime problem in gnome. Thanks to Andrea Gamba for the fix.
[kohda]
* Refined a fix for the mime problem in gnome a bit.
* Try to fix /bin/sh problem (debian/fixsh) but it is not complete fix yet.
* Try to fix hard coded settings for ipa fonts(patches/09_ipa.dpatch), 
  especially for Debian where no ipa fonts exist yet.
* Fixed obsolete Build-Depends: changed libltdl3-dev to 
  libltdl-dev | libltdl7-dev (the latter for Ubuntu?)

Show diffs side-by-side

added added

removed removed

Lines of Context:
TeXmacs/progs/convert/html/tmhtml.scm
5
5
;; DESCRIPTION : conversion of TeXmacs trees into Html trees
6
6
;; COPYRIGHT   : (C) 2002  Joris van der Hoeven, David Allouche
7
7
;;
8
 
;; This software falls under the GNU general public license and comes WITHOUT
9
 
;; ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for details.
10
 
;; If you don't have this file, write to the Free Software Foundation, Inc.,
11
 
;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
8
;; This software falls under the GNU general public license version 3 or later.
 
9
;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
 
10
;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
12
11
;;
13
12
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14
13
 
31
30
(define tmhtml-css? #t)
32
31
(define tmhtml-mathml? #f)
33
32
(define tmhtml-images? #f)
34
 
(define tmhtml-serial 0)
 
33
(define tmhtml-image-serial 0)
35
34
(define tmhtml-image-cache (make-ahash-table))
36
35
(define tmhtml-image-root-url (string->url "image"))
37
36
(define tmhtml-image-root-string "image")
49
48
         (n (+ (string-length suffix) 1)))
50
49
    (if (in? suffix '("html" "xhtml"))
51
50
        (begin
 
51
          (set! tmhtml-image-serial 0)
52
52
          (set! tmhtml-image-root-url (url-unglue current-save-target n))
53
53
          (set! tmhtml-image-root-string
54
54
                (url->string (url-tail tmhtml-image-root-url))))
55
55
        (begin
 
56
          (set! tmhtml-image-serial 0)
56
57
          (set! tmhtml-image-root-url (string->url "image"))
57
58
          (set! tmhtml-image-root-string "image")))))
58
59
 
117
118
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
118
119
 
119
120
(define (tmhtml-find-title doc)
120
 
  (cond ((func? doc 'tmdoc-title 1) (cadr doc))
 
121
  (cond ((npair? doc) #f)
 
122
        ((func? doc 'doc-title 1) (cadr doc))
 
123
        ((func? doc 'tmdoc-title 1) (cadr doc))
121
124
        ((func? doc 'tmdoc-title* 2) (cadr doc))
122
125
        ((func? doc 'tmdoc-title** 3) (caddr doc))
123
 
        ((npair? doc) #f)
 
126
        ((func? doc 'hidden-title 1) (cadr doc))
124
127
        (else (with title (tmhtml-find-title (car doc))
125
128
                (if title title
126
129
                    (tmhtml-find-title (cdr doc)))))))
156
159
         (styles (cdadr l))
157
160
         (lang (caddr l))
158
161
         (tmpath (cadddr l))
159
 
         (title (tmhtml-force-string (tmhtml-find-title doc)))
 
162
         (title (tmhtml-find-title doc))
160
163
         (css `(h:style (@ (type "text/css")) ,(tmhtml-css-header)))
161
164
         (body (tmhtml doc)))
162
165
    (set! title (cond ((not title) "No title")
163
166
                      ((or (in? "tmdoc" styles) (in? "tmweb" styles))
164
 
                       `(concat ,title " (FSF GNU project)"))
165
 
                      (else title)))
 
167
                       `(concat ,(tmhtml-force-string title)
 
168
                                " (FSF GNU project)"))
 
169
                      (else (tmhtml-force-string title))))
166
170
    (if (or (in? "tmdoc" styles) (in? "tmweb" styles) (in? "mmxdoc" styles))
167
171
        (with ss (if (in? "mmxdoc" styles)
168
172
                     "http://www.texmacs.org/css/mmxdoc.css"
702
706
  `((h:font (@ (color ,(tmcolor->htmlcolor val))) ,@(tmhtml arg))))
703
707
 
704
708
(define (tmhtml-with-font-size val arg)
705
 
  (let* ((x (* (string->number val) 100))
706
 
         (s (cond ((< x 1) "-4") ((< x 55) "-4") ((< x 65) "-3")
707
 
                  ((< x 75) "-2") ((< x 95) "-1") ((< x 115) "0")
708
 
                  ((< x 135) "+1") ((< x 155) "+2") ((< x 185) "+3")
709
 
                  ((< x 225) "+4") ((< x 500) "+5") (else "+5"))))
710
 
    (if s `((h:font (@ (size ,s)) ,@(tmhtml arg))) (tmhtml arg))))
 
709
  (ahash-with tmhtml-env :mag val
 
710
    (let* ((x (* (string->number val) 100))
 
711
           (s (cond ((< x 1) "-4") ((< x 55) "-4") ((< x 65) "-3")
 
712
                    ((< x 75) "-2") ((< x 95) "-1") ((< x 115) "0")
 
713
                    ((< x 135) "+1") ((< x 155) "+2") ((< x 185) "+3")
 
714
                    ((< x 225) "+4") ((< x 500) "+5") (else "+5"))))
 
715
      (if s `((h:font (@ (size ,s)) ,@(tmhtml arg))) (tmhtml arg)))))
711
716
 
712
717
(define (tmhtml-with-block style arg)
713
718
  (with r (tmhtml (blockify arg))
842
847
          ((string-ends? s ".tm")
843
848
           (string-append (string-drop-right s 3)
844
849
                          (if tmhtml-mathml? ".xhtml" ".html")))
 
850
          ((string-ends? s ".texmacs")
 
851
           (string-append (string-drop-right s 8) ".tm"))
845
852
          (else s))))
846
853
 
847
854
(define (tmhtml-hyperlink l)
993
1000
;;; Pictures
994
1001
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
995
1002
 
 
1003
(define (tmhtml-collect-labels x)
 
1004
  (cond ((nlist? x) '())
 
1005
        ((and (func? x 'label 1) (string? (cadr x))) `((id ,(cadr x))))
 
1006
        (else (append-map tmhtml-collect-labels (cdr x)))))
 
1007
 
996
1008
(define (tmhtml-png-names)
997
 
  (set! tmhtml-serial (+ tmhtml-serial 1))
998
 
  (let* ((postfix (string-append "-" (number->string tmhtml-serial) ".png"))
 
1009
  (set! tmhtml-image-serial (+ tmhtml-image-serial 1))
 
1010
  (let* ((postfix (string-append
 
1011
                   "-" (number->string tmhtml-image-serial) ".png"))
999
1012
         (name-url (url-glue tmhtml-image-root-url postfix))
1000
1013
         (name-string (string-append tmhtml-image-root-string postfix)))
1001
1014
    (values name-url name-string)))
1002
1015
 
1003
 
(define (tmhtml-png x)
1004
 
  (with cached (ahash-ref tmhtml-image-cache x)
1005
 
    (if (not cached)
1006
 
        (receive (name-url name-string) (tmhtml-png-names)
1007
 
          (let* ((extents (print-snippet name-url x))
1008
 
                 (pixels (inexact->exact (/ (second extents) 2100)))
1009
 
                 (valign (number->htmlstring pixels))
1010
 
                 (style (string-append "vertical-align: " valign "px")))
1011
 
            ;;(display* x " -> " extents "\n")
1012
 
            (set! cached `((h:img (@ (src ,name-string) (style ,style)))))
1013
 
            (ahash-set! tmhtml-image-cache x cached)))
1014
 
        cached)))
 
1016
(define (tmhtml-png y)
 
1017
  (let* ((mag (ahash-ref tmhtml-env :mag))
 
1018
         (x (if (or (nstring? mag) (== mag "1")) y
 
1019
                `(with "font-size" ,mag ,y)))
 
1020
         (l1 (tmhtml-collect-labels y))
 
1021
         (l2 (if (null? l1) l1 (list (car l1)))))
 
1022
    (with cached (ahash-ref tmhtml-image-cache x)
 
1023
      (if (not cached)
 
1024
          (receive (name-url name-string) (tmhtml-png-names)
 
1025
            ;;(display* x " -> " name-url ", " name-string "\n")
 
1026
            (let* ((extents (print-snippet name-url x))
 
1027
                   ;;(pixels (inexact->exact (/ (second extents) 2100)))
 
1028
                   (pixels (inexact->exact (/ (second extents) 2000)))
 
1029
                   (valign (number->htmlstring pixels))
 
1030
                   (style (string-append "vertical-align: " valign "px")))
 
1031
              ;;(display* x " -> " extents "\n")
 
1032
              (set! cached
 
1033
                    `((h:img (@ (src ,name-string) (style ,style) ,@l2))))
 
1034
              (ahash-set! tmhtml-image-cache x cached)))
 
1035
          cached))))
1015
1036
 
1016
1037
(define (tmhtml-graphics l)
1017
1038
  (tmhtml-png (cons 'graphics l)))
1231
1252
      '()))
1232
1253
 
1233
1254
(tm-define (tmhtml-root x)
1234
 
  (ahash-with tmhtml-env :math #f
1235
 
    (ahash-with tmhtml-env :preformatted #f
1236
 
      (ahash-with tmhtml-env :left-margin 0
1237
 
        (ahash-with tmhtml-env :right-margin 0
1238
 
          (tmhtml x))))))
 
1255
  (ahash-with tmhtml-env :mag "1"
 
1256
    (ahash-with tmhtml-env :math #f
 
1257
      (ahash-with tmhtml-env :preformatted #f
 
1258
        (ahash-with tmhtml-env :left-margin 0
 
1259
          (ahash-with tmhtml-env :right-margin 0
 
1260
            (tmhtml x)))))))
1239
1261
 
1240
1262
(define (tmhtml x)
1241
1263
  ;; Main conversion function.
1403
1425
  (TeX ,(lambda x '("TeX")))
1404
1426
  (LaTeX ,(lambda x '("LaTeX")))
1405
1427
  ;; additional tags
 
1428
  (hidden-title ,tmhtml-noop)
1406
1429
  (doc-title-block ,tmhtml-doc-title-block)
1407
1430
  (equation* ,tmhtml-equation*)
1408
1431
  (equation-lab ,tmhtml-equation-lab)