1 (* Copyright (C) 2000, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://cs.unibo.it/helm/.
26 (**************************************************************************)
30 (* Andrea Asperti <asperti@cs.unibo.it> *)
33 (**************************************************************************)
39 | Mtext of attr * string
42 | Mgliph of attr * string
43 | Mrow of attr * 'a mpres list
44 | Mfrac of attr * 'a mpres * 'a mpres
45 | Msqrt of attr * 'a mpres
46 | Mroot of attr * 'a mpres * 'a mpres
47 | Mstyle of attr * 'a mpres
48 | Merror of attr * 'a mpres
49 | Mpadded of attr * 'a mpres
50 | Mphantom of attr * 'a mpres
51 | Mfenced of attr * 'a mpres list
52 | Menclose of attr * 'a mpres
53 | Msub of attr * 'a mpres * 'a mpres
54 | Msup of attr * 'a mpres * 'a mpres
55 | Msubsup of attr * 'a mpres * 'a mpres *'a mpres
56 | Munder of attr * 'a mpres * 'a mpres
57 | Mover of attr * 'a mpres * 'a mpres
58 | Munderover of attr * 'a mpres * 'a mpres *'a mpres
59 (* | Multiscripts of ??? NOT IMPLEMEMENTED *)
60 | Mtable of attr * 'a row list
61 | Maction of attr * 'a mpres list
62 | Mobject of attr * 'a
63 and 'a row = Mtr of attr * 'a mtd list
64 and 'a mtd = Mtd of attr * 'a mpres
65 and attr = (string option * string * string) list
68 let smallskip = Mspace([None,"width","0.5em"]);;
69 let indentation = Mspace([None,"width","1em"]);;
72 Mrow([],[indentation;elem]);;
74 let standard_tbl_attr =
75 [None,"align","baseline 1";None,"equalrows","false";None,"columnalign","left"]
78 let two_rows_table attr a b =
79 Mtable(attr@standard_tbl_attr,
81 Mtr([],[Mtd([],b)])]);;
83 let two_rows_table_with_brackets attr a b op =
84 (* only the open bracket is added; the closed bracket must be in b *)
85 Mtable(attr@standard_tbl_attr,
86 [Mtr([],[Mtd([],Mrow([],[Mtext([],"(");a]))]);
87 Mtr([],[Mtd([],Mrow([],[indentation;op;b]))])]);;
89 let two_rows_table_without_brackets attr a b op =
90 Mtable(attr@standard_tbl_attr,
92 Mtr([],[Mtd([],Mrow([],[indentation;op;b]))])]);;
94 let row_with_brackets attr a b op =
95 (* by analogy with two_rows_table_with_brackets we only add the
97 Mrow(attr,[Mtext([],"(");a;op;b;Mtext([],")")])
99 let row_without_brackets attr a b op =
105 let print_mpres obj_printer mpres =
106 let module X = Xml in
109 Mi (attr,s) -> X.xml_nempty ~prefix "mi" attr (X.xml_cdata s)
110 | Mn (attr,s) -> X.xml_nempty ~prefix "mn" attr (X.xml_cdata s)
113 let len = String.length s in
114 if len > 1 && s.[0] = '\\'
115 then String.sub s 1 (len - 1)
118 X.xml_nempty ~prefix "mo" attr (X.xml_cdata s)
119 | Mtext (attr,s) -> X.xml_nempty ~prefix "mtext" attr (X.xml_cdata s)
120 | Mspace attr -> X.xml_empty ~prefix "mspace" attr
121 | Ms (attr,s) -> X.xml_nempty ~prefix "ms" attr (X.xml_cdata s)
122 | Mgliph (attr,s) -> X.xml_nempty ~prefix "mgliph" attr (X.xml_cdata s)
123 (* General Layout Schemata *)
125 X.xml_nempty ~prefix "mrow" attr
126 [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
128 | Mfrac (attr,m1,m2) ->
129 X.xml_nempty ~prefix "mfrac" attr [< aux m1; aux m2 >]
131 X.xml_nempty ~prefix "msqrt" attr [< aux m >]
132 | Mroot (attr,m1,m2) ->
133 X.xml_nempty ~prefix "mroot" attr [< aux m1; aux m2 >]
134 | Mstyle (attr,m) -> X.xml_nempty ~prefix "mstyle" attr [< aux m >]
135 | Merror (attr,m) -> X.xml_nempty ~prefix "merror" attr [< aux m >]
136 | Mpadded (attr,m) -> X.xml_nempty ~prefix "mpadded" attr [< aux m >]
137 | Mphantom (attr,m) -> X.xml_nempty ~prefix "mphantom" attr [< aux m >]
138 | Mfenced (attr,l) ->
139 X.xml_nempty ~prefix "mfenced" attr
140 [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
142 | Menclose (attr,m) -> X.xml_nempty ~prefix "menclose" attr [< aux m >]
143 (* Script and Limit Schemata *)
144 | Msub (attr,m1,m2) ->
145 X.xml_nempty ~prefix "msub" attr [< aux m1; aux m2 >]
146 | Msup (attr,m1,m2) ->
147 X.xml_nempty ~prefix "msup" attr [< aux m1; aux m2 >]
148 | Msubsup (attr,m1,m2,m3) ->
149 X.xml_nempty ~prefix "msubsup" attr [< aux m1; aux m2; aux m3 >]
150 | Munder (attr,m1,m2) ->
151 X.xml_nempty ~prefix "munder" attr [< aux m1; aux m2 >]
152 | Mover (attr,m1,m2) ->
153 X.xml_nempty ~prefix "mover" attr [< aux m1; aux m2 >]
154 | Munderover (attr,m1,m2,m3) ->
155 X.xml_nempty ~prefix "munderover" attr [< aux m1; aux m2; aux m3 >]
156 (* | Multiscripts of ??? NOT IMPLEMEMENTED *)
157 (* Tables and Matrices *)
158 | Mtable (attr, rl) ->
159 X.xml_nempty ~prefix "mtable" attr
160 [< (List.fold_right (fun x i -> [< (aux_mrow x) ; i >]) rl [<>]) >]
161 (* Enlivening Expressions *)
162 | Maction (attr, l) ->
163 X.xml_nempty ~prefix "maction" attr
164 [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >]
165 | Mobject (attr, obj) ->
166 let box_stream = obj_printer obj in
167 X.xml_nempty ~prefix "semantics" attr
168 [< X.xml_nempty ~prefix "annotation-xml" [None, "encoding", "BoxML"]
172 let module X = Xml in
175 X.xml_nempty ~prefix "mtr" attr
176 [< (List.fold_right (fun x i -> [< (aux_mtd x) ; i >]) l [<>])
179 let module X = Xml in
181 Mtd (attr,m) -> X.xml_nempty ~prefix "mtd" attr
183 X.xml_nempty ~prefix "mphantom" []
184 (X.xml_nempty ~prefix "mtext" [] (X.xml_cdata "(")) >]
189 let document_of_mpres pres =
190 [< Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
192 Xml.xml_nempty ~prefix "math"
193 [Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
194 Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
195 Some "xmlns","xlink","http://www.w3.org/1999/xlink"
196 ] (Xml.xml_nempty ~prefix "mstyle" [None, "mathvariant", "normal"; None,
197 "rowspacing", "0.6ex"] (print_mpres (fun _ -> assert false) pres))
200 let get_attr = function
221 | Msubsup (attr, _, _, _)
225 | Munder (attr, _, _)
226 | Munderover (attr, _, _, _) ->
229 let set_attr attr = function
230 | Maction (_, x) -> Maction (attr, x)
231 | Menclose (_, x) -> Menclose (attr, x)
232 | Merror (_, x) -> Merror (attr, x)
233 | Mfenced (_, x) -> Mfenced (attr, x)
234 | Mfrac (_, x, y) -> Mfrac (attr, x, y)
235 | Mgliph (_, x) -> Mgliph (attr, x)
236 | Mi (_, x) -> Mi (attr, x)
237 | Mn (_, x) -> Mn (attr, x)
238 | Mo (_, x) -> Mo (attr, x)
239 | Mobject (_, x) -> Mobject (attr, x)
240 | Mover (_, x, y) -> Mover (attr, x, y)
241 | Mpadded (_, x) -> Mpadded (attr, x)
242 | Mphantom (_, x) -> Mphantom (attr, x)
243 | Mroot (_, x, y) -> Mroot (attr, x, y)
244 | Mrow (_, x) -> Mrow (attr, x)
245 | Ms (_, x) -> Ms (attr, x)
246 | Mspace _ -> Mspace attr
247 | Msqrt (_, x) -> Msqrt (attr, x)
248 | Mstyle (_, x) -> Mstyle (attr, x)
249 | Msub (_, x, y) -> Msub (attr, x, y)
250 | Msubsup (_, x, y, z) -> Msubsup (attr, x, y, z)
251 | Msup (_, x, y) -> Msup (attr, x, y)
252 | Mtable (_, x) -> Mtable (attr, x)
253 | Mtext (_, x) -> Mtext (attr, x)
254 | Munder (_, x, y) -> Munder (attr, x, y)
255 | Munderover (_, x, y, z) -> Munderover (attr, x, y, z)