(*********************************************************************************) |
(* Cameleon *)
(* *)
(* Copyright (C) 2005,2006 Institut National de Recherche en Informatique *)
(* et en Automatique. All rights reserved. *)
(* *)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU Library General Public License as *)
(* published by the Free Software Foundation; either version 2 of the *)
(* License, or any later version. *)
(* *)
(* This program 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 Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General Public *)
(* License along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *)
(* 02111-1307 USA *)
(* *)
(* Contact: Maxence.Guesdon@inria.fr *)
(* *)
(*********************************************************************************) |
(* $Id: cam_multiview.ml 569 2007-07-17 08:54:21Z zoggy $ *)
class multiview () =
let hbox = GPack.hbox () in
let wnote = GPack.notebook ~packing: (hbox#pack ~expand: true) () in
object (self)
val mutable window = None
val mutable views = [| |]
method set_window w = window <- Some w
method window =
match window with
None -> failwith "No window!"
| Some w -> w
method close = Array.iter (fun v -> ignore (v#close)) views
method refresh =
try
let n = wnote#current_page in
views.(n)#refresh
with
_ -> ()
method box = hbox#coerce
method add_view res_name view_name args =
try
let title = Printf.sprintf "%s[%s]" res_name view_name in
let tab_label = (GMisc.label ~text: title ())#coerce in
let fpack = fun o -> ignore(wnote#append_page ~tab_label o) in
let v = Cam_view.open_ressource_no_window
res_name view_name args self#window fpack
in
views <- Array.append views [| v |]
with
Failure s ->
GToolbox.message_box Cam_messages.error s
end
class view (name : Cam_view.view_name)
(title : Cam_view.ressource_name)
(v : multiview)
(close_window_on_close : bool) =
object (self)
method changed = false
method close =
v#close;
close_window_on_close
method name = name
method refresh = v#refresh
method ressource = title
method ressource_kind : Cam_view.ressource_kind = `None
end
class factory : Cam_view.view_factory =
object (self)
method private open_views_from_args v args =
let rec iter = function
[] | [_] -> ()
| res_name :: view_name :: q ->
v#add_view res_name view_name [| |];
iter q
in
iter (Array.to_list args)
method create title args =
let mv = new multiview () in
let v = new view (self#name) title mv true in
let w = Cam_view.create_view_window
~title: (Printf.sprintf "%s [%s]" title self#name)
v
in
mv#set_window w#window;
self#open_views_from_args mv args;
let _ = w#vbox#pack ~expand: true mv#box in
(v, w#window)
method create_no_window window title args =
let mv = new multiview () in
let v = new view (self#name) title mv true in
mv#set_window window;
self#open_views_from_args mv args;
(v, mv#box)
method known_ressource_kinds = [`None]
method name = "multiview"
end
let factory = new factory
let _ = Cam_view.register_factory factory