helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/editor.ml

   1 (* $Id$ *)
   2
   3 open GMain
   4
   5 let file_dialog ~title ~callback ?filename () =
   6   let sel =
   7     GWindow.file_selection ~title ~modal:true ?filename () in
   8   sel#cancel_button#connect#clicked ~callback:sel#destroy;
   9   sel#ok_button#connect#clicked ~callback:
  10     begin fun () ->
  11       let name = sel#get_filename in
  12       sel#destroy ();
  13       callback name
  14     end;
  15   sel#show ()
  16
  17 class editor ?packing ?show () = object (self)
  18   val text = GEdit.text ~editable:true ?packing ?show ()
  19   val mutable filename = None
  20
  21   method text = text
  22
  23   method load_file name =
  24     try
  25       let ic = open_in name in
  26       filename <- Some name;
  27       text#freeze ();
  28       text#delete_text ~start:0 ~stop:text#length;
  29       let buf = String.create 1024 and len = ref 0 in
  30       while len := input ic ~buf ~pos:0 ~len:1024; !len > 0 do
  31         if !len = 1024 then text#insert buf
  32         else text#insert (String.sub buf ~pos:0 ~len:!len)
  33       done;
  34       text#set_point 0;
  35       text#thaw ();
  36       close_in ic
  37     with _ -> ()
  38
  39   method open_file () = file_dialog ~title:"Open" ~callback:self#load_file ()
  40
  41   method save_dialog () =
  42     file_dialog ~title:"Save" ?filename
  43       ~callback:(fun file -> self#output ~file) ()
  44
  45   method save_file () =
  46     match filename with
  47       Some file -> self#output ~file
  48     | None -> self#save_dialog ()
  49
  50   method output ~file =
  51     try
  52       if Sys.file_exists file then Sys.rename ~src:file ~dst:(file ^ "~");
  53       let oc = open_out file in
  54       output_string oc (text#get_chars ~start:0 ~stop:text#length);
  55       close_out oc;
  56       filename <- Some file
  57     with _ -> prerr_endline "Save failed"
  58 end
  59
  60 let window = GWindow.window ~width:500 ~height:300 ~title:"editor" ()
  61 let vbox = GPack.vbox ~packing:window#add ()
  62
  63 let menubar = GMenu.menu_bar ~packing:vbox#pack ()
  64 let factory = new GMenu.factory menubar
  65 let accel_group = factory#accel_group
  66 let file_menu = factory#add_submenu "File"
  67 let edit_menu = factory#add_submenu "Edit"
  68
  69 let hbox = GPack.hbox ~packing:vbox#add ()
  70 let editor = new editor ~packing:hbox#add ()
  71 let scrollbar = GRange.scrollbar `VERTICAL ~packing:hbox#pack ()
  72
  73 open GdkKeysyms
  74
  75 let _ =
  76   window#connect#destroy ~callback:Main.quit;
  77   let factory = new GMenu.factory file_menu ~accel_group in
  78   factory#add_item "Open..." ~key:_O ~callback:editor#open_file;
  79   factory#add_item "Save" ~key:_S ~callback:editor#save_file;
  80   factory#add_item "Save as..." ~callback:editor#save_dialog;
  81   factory#add_separator ();
  82   factory#add_item "Quit" ~key:_Q ~callback:window#destroy;
  83   let factory = new GMenu.factory edit_menu ~accel_group in
  84   factory#add_item "Copy" ~key:_C ~callback:editor#text#copy_clipboard;
  85   factory#add_item "Cut" ~key:_X ~callback:editor#text#cut_clipboard;
  86   factory#add_item "Paste" ~key:_V ~callback:editor#text#paste_clipboard;
  87   factory#add_separator ();
  88   factory#add_check_item "Word wrap" ~active:false
  89     ~callback:editor#text#set_word_wrap;
  90   factory#add_check_item "Read only" ~active:false
  91     ~callback:(fun b -> editor#text#set_editable (not b));
  92   window#add_accel_group accel_group;
  93   editor#text#event#connect#button_press
  94     ~callback:(fun ev ->
  95       let button = GdkEvent.Button.button ev in
  96       if button = 3 then begin
  97         file_menu#popup ~button ~time:(GdkEvent.Button.time ev); true
  98       end else false);
  99   editor#text#set_vadjustment scrollbar#adjustment;
 100   window#show ();
 101   Main.main ()