File: gMathViewAux.ml

package info (click to toggle)
lablgtkmathview 0.7.8-7
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 332 kB
  • sloc: ml: 777; ansic: 177; makefile: 139; xml: 132
file content (281 lines) | stat: -rw-r--r-- 8,535 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
(* Copyright (C) 2000-2005,
 *    Luca Padovani	      <lpadovan@cs.unibo.it>
 *    Claudio Sacerdoti Coen  <sacerdot@cs.unibo.it>
 *    Stefano Zacchiroli      <zacchiro@cs.unibo.it>
 *
 * This file is part of lablgtkmathview, the Ocaml binding for the
 * GtkMathView widget.
 * 
 * lablgtkmathview is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License as
 * published by the Free Software Foundation; either version 2 of the
 * License, or (at your option) any later version.
 *
 * lablgtkmathview is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with lablgtkmathview; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 * 02111-1307, USA.
 * 
 * For details, send a mail to the authors.
 *)

(* finds the common node ancestor of two nodes *)
let common_ancestor (first : Gdome.node) (last : Gdome.node) =
 let rec path n =
  match n#get_parentNode with
     None -> [n]
   | Some p -> n::(path p)
 in
  let rec last_common =
   function
      _, hd1::tl1, hd2::tl2 when hd1#isSameNode hd2 -> (last_common ((Some hd1),tl1,tl2))
    | Some e, _, _ -> e
    | _,_,_ -> assert false
  in
   (last_common (None,(List.rev (path first)),(List.rev (path last))))
 
let same_element (e1 : Gdome.element option) (e2 : Gdome.element option) =
 match e1, e2 with
    None, None -> true
  | Some e1, Some e2 when (e1 :> Gdome.node)#isSameNode (e2 :> Gdome.node) -> true
  | _ -> false
        
(* true if n1 is n2 or one of n2's descendants *)
let rec descendant_of (n1 : Gdome.node) (n2 : Gdome.node) =
 if n1#isSameNode n2 then true
 else
  match n1#get_parentNode with
     None -> false
   | Some n1' -> descendant_of n1' n2

let remove_descendants_of (el : Gdome.element) =
 let rec aux =
  function
     [] -> []
   | hd::tl when descendant_of (hd :> Gdome.node) (el :> Gdome.node) -> aux tl
   | hd::tl -> hd::(aux tl)
 in
  aux

(* mem el l = true if the node n is stored in the list l *)
let mem (el : Gdome.element) =
 let rec mem_aux =
  function
     hd::_ when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> true
   | _::tl -> mem_aux tl
   | _ -> false
 in
  mem_aux

(* remove el l = l' where l' has the same nodes as l except that all
 * the occurrences of n have been removed *)
let remove (el : Gdome.element) =
 let rec remove_aux =
  function
     hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) ->
      remove_aux tl
   | hd::tl -> hd::(remove_aux tl)
   | [] -> []
 in
  remove_aux

class single_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
 object
  inherit GMathView.math_view_signals obj
  method selection_changed = set_selection_changed
 end
;;

class single_selection_math_view obj =
  object(self)
   inherit GMathView.math_view_skel obj
   val mutable first_selected = None
   val mutable root_selected = None
   val mutable selection_changed = (fun _ -> ())

   method set_selection elem =
    self#freeze ;
    begin
     match root_selected with
        None -> ()
      | Some e -> self#unselect e
    end;
    root_selected <- elem ;
    begin
     match elem with
        None -> ()
      | Some e -> self#select e
    end ;
    self#thaw

   method get_selection = root_selected

   method connect =
    new
     single_selection_math_view_signals obj
      (function f -> selection_changed <- f)

   method action_toggle (elem : Gdome.element) =
    match elem#get_namespaceURI, elem#get_localName with
       Some ns, Some ln
        when 
	 (ns#to_string = "http://www.w3.org/1998/Math/MathML" && ln#to_string = "maction") ||
	 (ns#to_string = "http://helm.cs.unibo.it/2003/BoxML" && ln#to_string = "action")
       ->
        begin
         let selection_attr = Gdome.domString "selection" in
         let selection =
          if elem#hasAttribute ~name:selection_attr then
           int_of_string (elem#getAttribute ~name:selection_attr)#to_string
          else
           1
         in
          self#freeze ;
          (* the widget will cast the index back into a valid range *)
          elem#setAttribute ~name:selection_attr
           ~value:(Gdome.domString (string_of_int (selection + 1))) ;
          self#thaw ;
          true
        end
     | _ ->
        begin
         match elem#get_parentNode with
            Some p ->
             begin
              try
               self#action_toggle (new Gdome.element_of_node p)
              with
               GdomeInit.DOMCastException _ -> false
             end
          | None -> assert false (* every element has a parent *)
        end
     
   initializer
    selection_changed <- self#set_selection ;

    ignore
     (self#connect#select_begin
       (fun ((elem : Gdome.element option), _, _, _) ->
         if not (same_element root_selected elem) then selection_changed elem ;
         first_selected <- elem)) ;

    ignore
     (self#connect#select_over
       (fun ((elem : Gdome.element option), _, _, _) ->
         let new_selected =
          match first_selected, elem with
             Some first', Some last' ->
              (Some
               (new Gdome.element_of_node
                (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node))))
           | _ -> None
         in
          if not (same_element root_selected new_selected) then
            selection_changed new_selected)) ;
             
    ignore
     (self#connect#select_end
       (fun ((elem : Gdome.element option), _, _, _) -> first_selected <- None)) ;

    ignore
     (self#connect#select_abort
       (fun () ->
         first_selected <- None ;
         selection_changed None)) ;

    ignore (self#connect#click (fun _ -> self#set_selection None))
  end
;;

let single_selection_math_view ?hadjustment ?vadjustment ?font_size ?log_verbosity =
  GtkBase.Widget.size_params ~cont:(
  OgtkMathViewProps.pack_return
    (fun p -> OgtkMathViewProps.set_params (new single_selection_math_view
    (GtkMathViewProps.MathView_GMetaDOM.create p)) ~font_size ~log_verbosity)) []
;;

class multi_selection_math_view_signals obj
 (set_selection_changed : (Gdome.element option -> unit) -> unit)
=
 object
  inherit GMathView.math_view_signals obj
  method selection_changed = set_selection_changed
 end
;;

class multi_selection_math_view obj =
  object(self)
   inherit single_selection_math_view obj
   val mutable selected : Gdome.element list = []

   method remove_selection (elem : Gdome.element) =
    if mem elem selected then
     selected <- remove elem selected ;
     self#unselect elem

   method remove_selections =
    self#freeze ;
    List.iter (fun e -> self#unselect e) selected ;
    selected <- [] ;
    begin
     match self#get_selection with
        None -> ()
      | Some e -> self#select e
    end ;
    self#thaw

   method add_selection (elem : Gdome.element) =
    List.iter self#unselect selected ;
    selected <- elem::(remove_descendants_of elem selected) ;
    List.iter self#select selected

   method get_selections = selected

   method set_selection elem =
    self#freeze ;
    begin
     match root_selected with
        None -> ()
      | Some e -> self#unselect e ; List.iter (fun e -> self#select e) selected
    end;
    root_selected <- elem;
    begin
     match elem with
        None -> ()
      | Some e -> self#select e
    end ;
    self#thaw

   initializer
    ignore
     (self#connect#select_begin
       (fun (_,_,_,state) ->
         if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then
          self#remove_selections)) ;

    ignore
     (self#connect#select_end
       (fun (_,_,_,state) ->
         if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then
          self#remove_selections ;
         match root_selected with
            None -> ()
         | Some e -> self#set_selection None ; self#add_selection e)) ;

    ignore
     (self#connect#click
       (fun _ -> self#remove_selections))
   end
 ;;

let multi_selection_math_view ?hadjustment ?vadjustment ?font_size ?log_verbosity =
  GtkBase.Widget.size_params ~cont:(
  OgtkMathViewProps.pack_return
    (fun p -> OgtkMathViewProps.set_params (new multi_selection_math_view
    (GtkMathViewProps.MathView_GMetaDOM.create p)) ~font_size ~log_verbosity)) []
;;