(* $Id$ *)
-exception PopupClosed
open Printf
let wrap_callback0 f = fun _ -> try f () with Not_found -> assert false
(fun renderer -> GTree.view_column ~renderer ())
renderers
in
- object (self)
+ object
val text_columns = text_columns
initializer
let lookup_pixbuf tag =
try List.assoc tag tags with Not_found -> assert false
in
- object (self)
+ object
initializer
tree_view#set_model (Some (list_store :> GTree.model));
ignore (tree_view#append_column tag_vcolumn);
])
in
let toggle_vcol = GTree.view_column ~renderer:toggle_rend () in
- object (self)
+ object
initializer
tree_view#set_model (Some (list_store :> GTree.model));
ignore (tree_view#append_column text_vcol);
end
let popup_message
- ~title ~message ~buttons ~callback
+ ~title ~message ~buttons
?(message_type=`QUESTION) ?parent ?(use_markup=true)
?(destroy_with_parent=true) ?icon ?(modal=true) ?(resizable=false)
?screen ?type_hint
?type_hint ~position ?wmclass ?border_width ?width ?height
~show ()
in
- ignore(m#connect#response
- ~callback:(fun a -> GMain.Main.quit ();callback a));
- ignore(m#connect#close
- ~callback:(fun _ -> GMain.Main.quit ();raise PopupClosed));
- GtkThread.main ();
+ ignore(m#run ()) ;
m#destroy ()
let popup_message_lowlevel
- ~title ~message ?(no_separator=true) ~message_type ~buttons
+ ~title ~message ?no_separator:(_=true) ~message_type ~buttons
?parent ?(destroy_with_parent=true)
- ?icon ?(modal=true) ?(resizable=false) ?screen ?type_hint
+ ?icon ?modal:(_=true) ?(resizable=false) ?screen ?type_hint
?(position=`CENTER_ON_PARENT) ?wmclass ?border_width ?width
?height ()
=
) ()
let report_error ~title ~message ?parent () =
- let callback _ = () in
- let buttons = GWindow.Buttons.ok in
- try
- popup_message
- ~title ~message ~message_type:`ERROR ~callback ~buttons ?parent ()
- with
- | PopupClosed -> ()
-
+ let buttons = GWindow.Buttons.ok in
+ popup_message ~title ~message ~message_type:`ERROR ~buttons ?parent ()
let utf8_parsed_text s floc =
let start, stop = HExtlib.loc_of_floc floc in