X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Feditor.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Feditor.ml;h=5e3da80cd59a15b06cf60f78b1918c22c8ba9dd2;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/editor.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/editor.ml
new file mode 100644
index 000000000..5e3da80cd
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/editor.ml
@@ -0,0 +1,101 @@
+(* $Id$ *)
+
+open GMain
+
+let file_dialog ~title ~callback ?filename () =
+  let sel =
+    GWindow.file_selection ~title ~modal:true ?filename () in
+  sel#cancel_button#connect#clicked ~callback:sel#destroy;
+  sel#ok_button#connect#clicked ~callback:
+    begin fun () ->
+      let name = sel#get_filename in
+      sel#destroy ();
+      callback name
+    end;
+  sel#show ()
+
+class editor ?packing ?show () = object (self)
+  val text = GEdit.text ~editable:true ?packing ?show ()
+  val mutable filename = None
+
+  method text = text
+
+  method load_file name =
+    try
+      let ic = open_in name in
+      filename <- Some name;
+      text#freeze ();
+      text#delete_text ~start:0 ~stop:text#length;
+      let buf = String.create 1024 and len = ref 0 in
+      while len := input ic ~buf ~pos:0 ~len:1024; !len > 0 do
+	if !len = 1024 then text#insert buf
+	else text#insert (String.sub buf ~pos:0 ~len:!len)
+      done;
+      text#set_point 0;
+      text#thaw ();
+      close_in ic
+    with _ -> ()
+
+  method open_file () = file_dialog ~title:"Open" ~callback:self#load_file ()
+
+  method save_dialog () =
+    file_dialog ~title:"Save" ?filename
+      ~callback:(fun file -> self#output ~file) ()
+
+  method save_file () =
+    match filename with
+      Some file -> self#output ~file
+    | None -> self#save_dialog ()
+
+  method output ~file =
+    try
+      if Sys.file_exists file then Sys.rename ~src:file ~dst:(file ^ "~");
+      let oc = open_out file in
+      output_string oc (text#get_chars ~start:0 ~stop:text#length);
+      close_out oc;
+      filename <- Some file
+    with _ -> prerr_endline "Save failed"
+end
+
+let window = GWindow.window ~width:500 ~height:300 ~title:"editor" ()
+let vbox = GPack.vbox ~packing:window#add ()
+
+let menubar = GMenu.menu_bar ~packing:vbox#pack ()
+let factory = new GMenu.factory menubar
+let accel_group = factory#accel_group
+let file_menu = factory#add_submenu "File"
+let edit_menu = factory#add_submenu "Edit"
+
+let hbox = GPack.hbox ~packing:vbox#add ()
+let editor = new editor ~packing:hbox#add ()
+let scrollbar = GRange.scrollbar `VERTICAL ~packing:hbox#pack ()
+
+open GdkKeysyms
+
+let _ =
+  window#connect#destroy ~callback:Main.quit;
+  let factory = new GMenu.factory file_menu ~accel_group in
+  factory#add_item "Open..." ~key:_O ~callback:editor#open_file;
+  factory#add_item "Save" ~key:_S ~callback:editor#save_file;
+  factory#add_item "Save as..." ~callback:editor#save_dialog;
+  factory#add_separator ();
+  factory#add_item "Quit" ~key:_Q ~callback:window#destroy;
+  let factory = new GMenu.factory edit_menu ~accel_group in
+  factory#add_item "Copy" ~key:_C ~callback:editor#text#copy_clipboard;
+  factory#add_item "Cut" ~key:_X ~callback:editor#text#cut_clipboard;
+  factory#add_item "Paste" ~key:_V ~callback:editor#text#paste_clipboard;
+  factory#add_separator ();
+  factory#add_check_item "Word wrap" ~active:false
+    ~callback:editor#text#set_word_wrap;
+  factory#add_check_item "Read only" ~active:false
+    ~callback:(fun b -> editor#text#set_editable (not b));
+  window#add_accel_group accel_group;
+  editor#text#event#connect#button_press
+    ~callback:(fun ev ->
+      let button = GdkEvent.Button.button ev in
+      if button = 3 then begin
+	file_menu#popup ~button ~time:(GdkEvent.Button.time ev); true
+      end else false);
+  editor#text#set_vadjustment scrollbar#adjustment;
+  window#show ();
+  Main.main ()