helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/browser/editor.ml

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