]> matita.cs.unibo.it Git - helm.git/blob - helm/ocaml/content_pres/box.ml
added contextual menu to act over selected terms
[helm.git] / helm / ocaml / content_pres / box.ml
1 (* Copyright (C) 2000-2005, HELM Team.
2  * 
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.
6  * 
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.
11  * 
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.
16  *
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,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://cs.unibo.it/helm/.
24  *)
25
26 (*************************************************************************)
27 (*                                                                       *)
28 (*                           PROJECT HELM                                *)
29 (*                                                                       *)
30 (*                Andrea Asperti <asperti@cs.unibo.it>                   *)
31 (*                             13/2/2004                                 *)
32 (*                                                                       *)
33 (*************************************************************************)
34
35 type 
36   'expr box =
37     Text of attr * string
38   | Space of attr
39   | Ink of attr
40   | H of attr * ('expr box) list
41   | V of attr * ('expr box) list
42   | HV of attr * ('expr box) list
43   | HOV of attr * ('expr box) list
44   | Object of attr * 'expr
45   | Action of attr * ('expr box) list
46
47 and attr = (string option * string * string) list
48
49 let smallskip = Space([None,"width","0.5em"]);;
50 let skip = Space([None,"width","1em"]);;
51
52 let indent t = H([],[skip;t]);;
53
54 (* BoxML prefix *)
55 let prefix = "b";;
56
57 let tag_of_box = function
58   | H _ -> "h"
59   | V _ -> "v"
60   | HV _ -> "hv"
61   | HOV _ -> "hov"
62   | _ -> assert false
63  
64 let box2xml ~obj2xml box =
65   let rec aux =
66    let module X = Xml in
67     function
68         Text (attr,s) -> X.xml_nempty ~prefix "text" attr (X.xml_cdata s)
69       | Space attr -> X.xml_empty ~prefix "space" attr
70       | Ink attr -> X.xml_empty ~prefix "ink" attr
71       | H (attr,l)
72       | V (attr,l)
73       | HV (attr,l)
74       | HOV (attr,l) as box ->
75           X.xml_nempty ~prefix (tag_of_box box) attr 
76             [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
77             >]
78       | Object (attr,m) ->
79           X.xml_nempty ~prefix "obj" attr [< obj2xml m >]
80       | Action (attr,l) ->
81           X.xml_nempty ~prefix "action" attr 
82             [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >]
83   in
84   aux box
85 ;;
86
87 let rec map f = function
88   | (Text _) as box -> box
89   | (Space _) as box -> box
90   | (Ink _) as box -> box
91   | H (attr, l) -> H (attr, List.map (map f) l)
92   | V (attr, l) -> V (attr, List.map (map f) l)
93   | HV (attr, l) -> HV (attr, List.map (map f) l)
94   | HOV (attr, l) -> HOV (attr, List.map (map f) l)
95   | Action (attr, l) -> Action (attr, List.map (map f) l)
96   | Object (attr, obj) -> Object (attr, f obj)
97 ;;
98
99 (*
100 let document_of_box ~obj2xml pres =
101  [< Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
102     Xml.xml_cdata "\n";
103     Xml.xml_nempty ~prefix "box"
104      [Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
105       Some "xmlns","b","http://helm.cs.unibo.it/2003/BoxML" ;
106       Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
107       Some "xmlns","xlink","http://www.w3.org/1999/xlink"
108      ] (print_box pres)
109  >]
110 *)
111
112 let b_h a b = H(a,b)
113 let b_v a b = V(a,b)
114 let b_hv a b = HV(a,b)
115 let b_hov a b = HOV(a,b)
116 let b_text a b = Text(a,b)
117 let b_object b = Object ([],b)
118 let b_indent = indent
119 let b_space = Space [None, "width", "0.5em"]
120 let b_kw = b_text (RenderingAttrs.object_keyword_attributes `BoxML)
121
122 let pp_attr attr =
123   let pp (ns, n, v) =
124     Printf.sprintf "%s%s=%s" (match ns with None -> "" | Some s -> s ^ ":") n v
125   in
126   String.concat " " (List.map pp attr)
127
128 let get_attr = function
129   | Text (attr, _)
130   | Space attr
131   | Ink attr
132   | H (attr, _)
133   | V (attr, _)
134   | HV (attr, _)
135   | HOV (attr, _)
136   | Object (attr, _)
137   | Action (attr, _) ->
138       attr
139
140 let set_attr attr = function
141   | Text (_, x) -> Text (attr, x)
142   | Space _ -> Space attr
143   | Ink _ -> Ink attr
144   | H (_, x) -> H (attr, x)
145   | V (_, x) -> V (attr, x)
146   | HV (_, x) -> HV (attr, x)
147   | HOV (_, x) -> HOV (attr, x)
148   | Object (_, x) -> Object (attr, x)
149   | Action (_, x) -> Action (attr, x)
150