diff --git a/applications/browser/Makefile b/applications/browser/Makefile
new file mode 100644
index 0000000..773f073
--- /dev/null
+++ b/applications/browser/Makefile
@@ -0,0 +1,46 @@
+# $Id$
+# Makefile for lablgtk.
+
+all: browser
+
+CAMLC = ocamlc
+CAMLOPT = ocamlopt
+COMPILER = $(CAMLC) $(MLFLAGS) -w s-40 -c
+LINKER = $(CAMLC) $(MLFLAGS)
+COMPOPT = $(CAMLOPT) $(MLFLAGS) -w s-40 -c
+LINKOPT = $(CAMLOPT) $(MLFLAGS)
+
+RANLIB = ranlib
+
+include ../../config.make
+
+MLFLAGS = -I ../../src -I +compiler-libs
+ifdef DEBUG
+MLFLAGS += -custom -g -ccopt -g #-cclib -lcamlrund
+endif
+
+# Rules
+.SUFFIXES: .ml .mli .cmo .cmi .cmx .c .o .var .h .opt .def
+.ml.cmo:
+	$(COMPILER) $<
+.mli.cmi:
+	$(COMPILER) $<
+.ml.cmx:
+	$(COMPOPT) $<
+
+# Targets
+MLOBJS =  list2.cmo jg_memo.cmo jg_message.cmo file.cmo \
+	lexical.cmo searchid.cmo searchpos.cmo \
+	shell.cmo editor.cmo
+
+browser: $(MLOBJS)
+	$(LINKER) -o $@	ocamlcommon.cma str.cma unix.cma \
+	    lablgtk.cma	$(MLOBJS)
+
+clean:
+	rm -f *.cm* browser
+
+.depend:
+	ocamldep *.ml *.mli > .depend
+
+include .depend
diff --git a/applications/browser/README b/applications/browser/README
new file mode 100644
index 0000000..0131bbe
--- /dev/null
+++ b/applications/browser/README
@@ -0,0 +1,18 @@
+	Browser: the beginning of a port of the OCamlBrowser
+
+This version of Browser is only compatible with OCaml 4.01.
+For older versions of OCaml, use the sources from a previous
+distribution of LablGTK (they shall be compatible with newer
+versions of the library).
+
+Installation:
+
+* just type "make"
+
+Use:
+
+When you run browser, you just get a customized editor with lexical
+coloring. Nothing very fancy.
+In the file menu you can open a shell, running ocaml as subprocess.
+
+Jacques Garrigue
diff --git a/applications/browser/TODO b/applications/browser/TODO
new file mode 100644
index 0000000..0c8bb53
--- /dev/null
+++ b/applications/browser/TODO
@@ -0,0 +1,4 @@
+* lexical coloring (done)
+* hyperlinks (call signal with position)
+* keyboard popup
+* protection
diff --git a/applications/browser/dune b/applications/browser/dune
new file mode 100644
index 0000000..d4001e6
--- /dev/null
+++ b/applications/browser/dune
@@ -0,0 +1,5 @@
+; (executable
+;  (name editor)
+; (public_name browser)
+; (flags :standard -w -6-10-27 -no-strict-sequence)
+; (libraries str compiler-libs.common lablgtk3))
diff --git a/applications/browser/editor.ml b/applications/browser/editor.ml
new file mode 100644
index 0000000..59415f6
--- /dev/null
+++ b/applications/browser/editor.ml
@@ -0,0 +1,147 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open StdLabels
+open GMain
+
+
+class editor ?packing ?show () = object (self)
+  val view = GText.view ?packing ?show ()
+  val mutable filename = None
+
+  method view = view
+
+  method buffer = view#buffer
+
+  method load_file name =
+    try
+      let b = Buffer.create 1024 in
+      File.with_file name ~f:(File.input_channel b);
+      let s = Glib.Convert.locale_to_utf8 (Buffer.contents b) in
+      let n_buff = GText.buffer ~text:s () in
+      Lexical.init_tags n_buff;
+      Lexical.tag n_buff;
+      view#set_buffer n_buff;
+      filename <- Some name;
+      n_buff#place_cursor n_buff#start_iter
+    with exn -> prerr_endline ("Load failed: " ^ Printexc.to_string exn)
+
+  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 file (file ^ "~");
+      let s = view#buffer#get_text () in
+      let oc = open_out file in
+      output_string oc (Glib.Convert.locale_from_utf8 s);
+      close_out oc;
+      filename <- Some file
+    with _ -> prerr_endline "Save failed"
+
+  initializer
+    Lexical.init_tags view#buffer;
+    view#buffer#connect#after#insert_text ~callback:
+      begin fun it s ->
+        let start = it#backward_chars (String.length s) in
+        Lexical.tag view#buffer
+          ~start:(start#set_line_index 0) ~stop:it#forward_to_line_end;
+      end;
+    view#buffer#connect#after#delete_range ~callback:
+      begin fun ~start ~stop ->
+        let start = start#set_line_index 0
+        and stop = start#forward_to_line_end in
+        Lexical.tag view#buffer ~start ~stop
+      end;
+    view#misc#modify_font_by_name "monospace";
+    view#misc#set_size_chars ~width:80 ~height:25 ~lang:"C" ();
+    ()
+end
+
+open GdkKeysyms
+
+class editor_window ?(show=false) () =
+  let window = GWindow.window ~title:"Program Editor" () in
+  let vbox = GPack.vbox ~packing:window#add () in
+
+  let menubar = GMenu.menu_bar ~packing:vbox#pack () in
+  let factory = new GMenu.factory menubar in
+  let accel_group = factory#accel_group
+  and file_menu = factory#add_submenu "File"
+  and edit_menu = factory#add_submenu "Edit"
+  and comp_menu = factory#add_submenu "Compiler" in
+
+  let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~packing:vbox#add () in
+  let editor = new editor ~packing:sw#add () in
+object (self)
+  inherit GObj.widget window#as_widget
+
+  method window = window
+  method editor = editor
+  method show = window#show
+
+  initializer
+    window#connect#destroy ~callback:(fun () -> Gc.full_major(); 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 "Shell"
+      ~callback:(fun () -> Shell.f ~prog:"ocaml" ~title:"Objective Caml Shell");
+    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:
+      (fun () -> editor#buffer#copy_clipboard GMain.clipboard);
+    factory#add_item "Cut" ~key:_X ~callback:
+      (fun () -> editor#buffer#cut_clipboard GMain.clipboard);
+    factory#add_item "Paste" ~key:_V ~callback:
+      (fun () -> editor#buffer#paste_clipboard GMain.clipboard);
+    factory#add_separator ();
+    factory#add_check_item "Word wrap" ~active:false ~callback:
+      (fun b -> editor#view#set_wrap_mode (if b then `WORD else `NONE));
+    factory#add_check_item "Read only" ~active:false
+      ~callback:(fun b -> editor#view#set_editable (not b));
+    let factory = new GMenu.factory comp_menu ~accel_group in
+    factory#add_item "Lex" ~key:_L
+      ~callback:(fun () -> Lexical.tag editor#buffer);
+    window#add_accel_group accel_group;
+    if show then self#show ();
+end
+
+let _ =
+  Main.init ();
+  if Array.length Sys.argv >= 2 && Sys.argv.(1) = "-shell" then
+    Shell.f ~prog:"ocaml" ~title:"Objective Caml Shell"
+  else
+    ignore (new editor_window ~show:true ());
+  Main.main ()
diff --git a/applications/browser/file.ml b/applications/browser/file.ml
new file mode 100644
index 0000000..5d7c386
--- /dev/null
+++ b/applications/browser/file.ml
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+let 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#filename in
+      sel#destroy ();
+      callback name
+    end;
+  sel#show ()
+
+let input_channel b ic =
+  let buf = Bytes.create 1024 and len = ref 0 in
+  while len := input ic buf 0 1024; !len > 0 do
+    Buffer.add_subbytes b buf 0 !len
+  done
+
+let with_file name ~f =
+  let ic = open_in name in
+  try f ic; close_in ic with exn -> close_in ic; raise exn
diff --git a/applications/browser/jg_memo.ml b/applications/browser/jg_memo.ml
new file mode 100644
index 0000000..2a1c353
--- /dev/null
+++ b/applications/browser/jg_memo.ml
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+type ('a, 'b) assoc_list =
+    Nil
+  | Cons of 'a * 'b * ('a, 'b) assoc_list
+
+let rec assq key = function
+    Nil -> raise Not_found
+  | Cons (a, b, l) ->
+      if key == a then b else assq key l
+
+let fast ~f =
+  let memo = ref Nil in
+  fun key ->
+    try assq key !memo
+    with Not_found ->
+      let data = f key in
+      memo := Cons(key, data, !memo);
+      data
+  
+  
diff --git a/applications/browser/jg_memo.mli b/applications/browser/jg_memo.mli
new file mode 100644
index 0000000..b11d706
--- /dev/null
+++ b/applications/browser/jg_memo.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+val fast : f:('a -> 'b) -> 'a -> 'b
+(* "fast" memoizer: uses a List.assq like function      *)
+(* Good for a smallish number of keys, phisically equal *)
diff --git a/applications/browser/jg_message.ml b/applications/browser/jg_message.ml
new file mode 100644
index 0000000..1ba6457
--- /dev/null
+++ b/applications/browser/jg_message.ml
@@ -0,0 +1,99 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open StdLabels
+
+(*
+class formatted ~parent ~width ~maxheight ~minheight =
+  val parent = (parent : Widget.any Widget.widget)
+  val width = width
+  val maxheight = maxheight
+  val minheight = minheight
+  val tw = Text.create ~parent ~width ~wrap:`Word
+  val fof = Format.get_formatter_output_functions ()
+  method parent = parent
+  method init =
+    pack [tw] ~side:`Left ~fill:`Both ~expand:true;
+    Format.print_flush ();
+    Format.set_margin (width - 2);
+    Format.set_formatter_output_functions ~out:(Jg_text.output tw)
+      ~flush:(fun () -> ())
+  method finish =
+    Format.print_flush ();
+    Format.set_formatter_output_functions ~out:(fst fof) ~flush:(snd fof);
+    let `Linechar (l, _) = Text.index tw ~index:(tposend 1) in
+    Text.configure tw ~height:(max minheight (min l maxheight));
+    if l > 5 then
+    pack [Jg_text.add_scrollbar tw] ~before:tw ~side:`Right ~fill:`Y
+end
+*)
+
+let formatted ~title ?on ?(ppf = Format.std_formatter)
+  ?(width=60) ?(maxheight=10) ?(minheight=0) () =
+  let frame =
+    match on with
+      Some frame ->
+        (frame :> GContainer.container)
+    | None ->
+        let tl = GWindow.window ~title () in
+        (GPack.hbox ~packing:tl#add () :> GContainer.container)
+  in
+  let sw =
+    GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
+      ~packing:frame#add () in
+  let tw = GText.view ~packing:sw#add ()  in
+  Format.pp_print_flush ppf ();
+  Format.pp_set_margin ppf (width - 2);
+  let fof,fff = Format.pp_get_formatter_output_functions ppf () in
+  Format.pp_set_formatter_output_functions ppf
+    (fun buf pos len -> tw#buffer#insert (String.sub buf ~pos ~len))
+    ignore;
+  tw,
+  begin fun () ->
+    Format.pp_print_flush ppf ();
+    Format.pp_set_formatter_output_functions ppf fof fff;
+  end
+
+let ask ~title ?master ?(no=true) ?(cancel=true) text =
+  let tl = GWindow.dialog ~title ~modal:true () in
+  Gaux.may (fun w -> tl#set_transient_for w#as_window) master;
+  GMisc.label ~text ~packing:tl#vbox#add ~xpad:20 ~ypad:10
+    ~width:250 ~justify:`LEFT ~line_wrap:true ~xalign:0. ();
+  let r = ref `Cancel in
+  let mkbutton label ~callback =
+    let b = GButton.button ~label ~packing:tl#action_area#add () in
+    ignore (b#connect#clicked ~callback)
+  in
+  mkbutton (if no || cancel then "Yes" else "Dismiss")
+    ~callback:(fun () -> r := `Yes; tl#destroy ());
+  if no then mkbutton "No" ~callback:(fun () -> r := `No; tl#destroy ());
+  if cancel then
+    mkbutton "Cancel" ~callback:(fun () -> r := `Cancel; tl#destroy ());
+  tl#connect#destroy ~callback:GMain.quit;
+  GMain.main ();
+  !r
+
+let info ~title ?master text =
+  ignore (ask ~title ?master ~no:false ~cancel:false text)
diff --git a/applications/browser/jg_message.mli b/applications/browser/jg_message.mli
new file mode 100644
index 0000000..e73c088
--- /dev/null
+++ b/applications/browser/jg_message.mli
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+val formatted :
+  title:string ->
+  ?on:#GContainer.container ->
+  ?ppf:Format.formatter ->
+  ?width:int ->
+  ?maxheight:int ->
+  ?minheight:int ->
+  unit -> GText.view * (unit -> unit)
+
+val ask :
+    title:string -> ?master:#GWindow.window_skel ->
+    ?no:bool -> ?cancel:bool -> string -> [`Cancel|`No|`Yes]
+
+val info :
+    title:string -> ?master:#GWindow.window_skel -> string -> unit
diff --git a/applications/browser/lexical.ml b/applications/browser/lexical.ml
new file mode 100644
index 0000000..ddbd01a
--- /dev/null
+++ b/applications/browser/lexical.ml
@@ -0,0 +1,163 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open StdLabels
+open Parser
+open Lexing
+
+let tags =
+  ["control"; "define"; "structure"; "char";
+   "infix"; "label"; "uident"]
+and colors =
+    ["blue"; "forestgreen"; "purple"; "gray40";
+     "indianred4"; "saddlebrown"; "midnightblue"]
+
+let init_tags (tb : GText.buffer) =
+  List.iter2 tags colors ~f:
+  begin fun tag col ->
+    ignore (tb#create_tag ~name:tag [`FOREGROUND col])
+  end;
+  tb#create_tag ~name:"error" [`FOREGROUND "red"; `WEIGHT `BOLD];
+  ()
+
+let tpos ~(start : GText.iter) pos =
+  let l = pos.pos_lnum - 1 in
+  if l = 0 then
+    start#set_line_index (pos.pos_cnum + start#line_index)
+  else
+    (start#forward_lines l)#set_line_index (pos.pos_cnum - pos.pos_bol)
+
+let tag ?start ?stop (tb : GText.buffer) =
+  let start = Gaux.default tb#start_iter ~opt:start
+  and stop = Gaux.default tb#end_iter ~opt:stop in
+  (* Printf.printf "tagging: %d-%d\n" start#offset stop#offset;
+     flush stdout; *)
+  let tpos = tpos ~start in
+  let text = tb#get_text ~start ~stop () in
+  let buffer = Lexing.from_string text in
+  tb#remove_all_tags ~start ~stop;
+  let last = ref (EOF, dummy_pos, dummy_pos) in
+  try
+    while true do
+    let token = Lexer.token buffer
+    and start = Lexing.lexeme_start_p buffer
+    and stop = Lexing.lexeme_end_p buffer in
+    let tag =
+      match token with
+        AMPERAMPER
+      | AMPERSAND
+      | BARBAR
+      | DO | DONE
+      | DOWNTO
+      | ELSE
+      | FOR
+      | IF
+      | LAZY
+      | MATCH
+      | OR
+      | THEN
+      | TO
+      | TRY
+      | WHEN
+      | WHILE
+      | WITH
+          -> "control"
+      | AND
+      | AS
+      | BAR
+      | CLASS
+      | CONSTRAINT
+      | EXCEPTION
+      | EXTERNAL
+      | FUN
+      | FUNCTION
+      | FUNCTOR
+      | IN
+      | INHERIT
+      | INITIALIZER
+      | LET
+      | METHOD
+      | MODULE
+      | MUTABLE
+      | NEW
+      | OF
+      | PRIVATE
+      | REC
+      | TYPE
+      | VAL
+      | VIRTUAL
+          -> "define"
+      | BEGIN
+      | END
+      | INCLUDE
+      | OBJECT
+      | OPEN
+      | SIG
+      | STRUCT
+          -> "structure"
+      | CHAR _
+      | STRING _
+          -> "char"
+      | BACKQUOTE
+      | INFIXOP1 _
+      | INFIXOP2 _
+      | INFIXOP3 _
+      | INFIXOP4 _
+      | PREFIXOP _
+      | HASH
+          -> "infix"
+      | LABEL _
+      | OPTLABEL _
+      | QUESTION
+      | TILDE
+          -> "label"
+      | UIDENT _ -> "uident"
+      | LIDENT _ ->
+          begin match !last with
+            (QUESTION | TILDE), _, _ -> "label"
+          | _ -> ""
+          end
+      | COLON ->
+          begin match !last with
+            LIDENT _, lstart, lstop ->
+              if lstop.pos_cnum = start.pos_cnum then
+                tb#apply_tag_by_name "label"
+                  ~start:(tpos lstart) ~stop:(tpos stop);
+              ""
+          | _ -> ""
+          end
+      | EOF -> raise End_of_file
+      | _ -> ""
+    in
+    if tag <> "" then begin
+      (* Printf.printf "%d-%d: %s\n" start.pos_cnum stop.pos_cnum tag;
+         flush stdout; *)
+      tb#apply_tag_by_name tag ~start:(tpos start) ~stop:(tpos stop);
+    end;
+    last := (token, start, stop)
+    done
+  with
+    End_of_file -> ()
+  | Lexer.Error _ -> ()
diff --git a/applications/browser/list2.ml b/applications/browser/list2.ml
new file mode 100644
index 0000000..eb1e39c
--- /dev/null
+++ b/applications/browser/list2.ml
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open StdLabels
+
+let exclude x l = List.filter l ~f:((<>) x)
+
+let rec flat_map ~f = function
+    [] -> []
+  | x :: l -> f x @ flat_map ~f l
diff --git a/applications/browser/searchid.ml b/applications/browser/searchid.ml
new file mode 100644
index 0000000..a7da385
--- /dev/null
+++ b/applications/browser/searchid.ml
@@ -0,0 +1,578 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open StdLabels
+open Asttypes
+open Location
+open Longident
+open Path
+open Typedtree
+open Types
+open Env
+open Btype
+open Ctype
+
+(* only empty here, but replaced by Pervasives later *)
+let start_env = ref Env.empty
+let module_list = ref []
+
+type pkind =
+    Pvalue
+  | Ptype
+  | Plabel
+  | Pconstructor
+  | Pmodule
+  | Pmodtype
+  | Pclass
+  | Pcltype
+
+let string_of_kind = function
+    Pvalue -> "v"
+  | Ptype -> "t"
+  | Plabel -> "l"
+  | Pconstructor -> "cn"
+  | Pmodule -> "m"
+  | Pmodtype -> "s"
+  | Pclass -> "c"
+  | Pcltype -> "ct"
+
+let rec longident_of_path = function
+    Pident id -> Lident (Ident.name id)
+  | Pdot (path, s, _) -> Ldot (longident_of_path path, s)
+  | Papply (p1, p2) -> Lapply (longident_of_path p1, longident_of_path p2)
+
+let rec remove_prefix lid ~prefix =
+  let rec remove_hd lid ~name =
+  match lid with
+    Ldot (Lident s1, s2) when s1 = name -> Lident s2
+  | Ldot (l, s) -> Ldot (remove_hd ~name l, s)
+  | _ -> raise Not_found
+  in
+  match prefix with
+    [] -> lid
+  | name :: prefix ->
+    try remove_prefix ~prefix (remove_hd ~name lid)
+    with Not_found -> lid
+
+let rec permutations l = match l with
+    [] | [_] -> [l]
+  | [a;b] -> [l; [b;a]]
+  | _ ->
+  let _, perms =
+    List.fold_left l ~init:(l,[]) ~f:
+    begin fun (l, perms) a ->
+      let l = List.tl l in
+      l @ [a],
+      List.map (permutations l) ~f:(fun l -> a :: l) @ perms
+    end
+  in perms
+
+let rec choose n ~card:l =
+  let len = List.length l in
+  if n = len then [l] else
+  if n = 1 then List.map l ~f:(fun x -> [x]) else
+  if n = 0 then [[]] else
+  if n > len then [] else
+  match l with [] -> []
+  | a :: l ->
+    List.map (choose (n-1) ~card:l) ~f:(fun l -> a :: l)
+    @ choose n ~card:l
+
+let rec arr p ~card:n =
+  if p = 0 then 1 else n * arr (p-1) ~card:(n-1)
+
+let rec all_args ty =
+  let ty = repr ty in
+  match ty.desc with
+    Tarrow(l, ty1, ty2, _) -> let (tl,ty) = all_args ty2 in ((l,ty1)::tl, ty)
+  | _ -> ([], ty)
+
+let rec equal ~prefix t1 t2 =
+  match (repr t1).desc, (repr t2).desc with
+    Tvar _, Tvar _ -> true
+  | Tvariant row1, Tvariant row2 ->
+      let row1 = row_repr row1 and row2 = row_repr row2 in
+      let fields1 = filter_row_fields false row1.row_fields
+      and fields2 = filter_row_fields false row1.row_fields
+      in
+      let r1, r2, pairs = merge_row_fields fields1 fields2 in
+      row1.row_closed = row2.row_closed && r1 = [] && r2 = [] &&
+      List.for_all pairs ~f:
+           begin fun (_,f1,f2) ->
+             match row_field_repr f1, row_field_repr f2 with
+               Rpresent None, Rpresent None -> true
+             | Rpresent(Some t1), Rpresent (Some t2) -> equal t1 t2 ~prefix
+             | Reither(c1, tl1, _, _), Reither(c2, tl2, _, _) ->
+                 c1 = c2 && List.length tl1 = List.length tl2 &&
+                 List.for_all2 tl1 tl2 ~f:(equal ~prefix)
+             | _ -> false
+           end
+  | Tarrow _, Tarrow _ ->
+      let l1, t1 = all_args t1 and l2, t2 = all_args t2 in
+      equal t1 t2 ~prefix &&
+      List.length l1 = List.length l2 &&
+      List.exists (permutations l1) ~f:
+      begin fun l1 ->
+        List.for_all2 l1 l2 ~f:
+        begin fun (p1,t1) (p2,t2) ->
+          (p1 = Nolabel || p1 = p2) && equal t1 t2 ~prefix
+        end
+      end
+  | Ttuple l1, Ttuple l2 ->
+      List.length l1 = List.length l2 &&
+      List.for_all2 l1 l2 ~f:(equal ~prefix)
+  | Tconstr (p1, l1, _), Tconstr (p2, l2, _) ->
+      remove_prefix ~prefix (longident_of_path p1) = (longident_of_path p2)
+      && List.length l1 = List.length l2
+      && List.for_all2 l1 l2 ~f:(equal ~prefix)
+  | _ -> false
+
+let is_opt = function Optional _ -> true | _ -> false
+let get_options = List.filter ~f:is_opt
+
+let rec included ~prefix t1 t2 =
+  match (repr t1).desc, (repr t2).desc with
+    Tvar _, _ -> true
+  | Tvariant row1, Tvariant row2 ->
+      let row1 = row_repr row1 and row2 = row_repr row2 in
+      let fields1 = filter_row_fields false row1.row_fields
+      and fields2 = filter_row_fields false row2.row_fields
+      in
+      let r1, r2, pairs = merge_row_fields fields1 fields2 in
+      r1 = [] &&
+      List.for_all pairs ~f:
+           begin fun (_,f1,f2) ->
+             match row_field_repr f1, row_field_repr f2 with
+               Rpresent None, Rpresent None -> true
+             | Rpresent(Some t1), Rpresent (Some t2) -> included t1 t2 ~prefix
+             | Reither(c1, tl1, _, _), Reither(c2, tl2, _, _) ->
+                 c1 = c2 && List.length tl1 = List.length tl2 &&
+                 List.for_all2 tl1 tl2 ~f:(included ~prefix)
+             | _ -> false
+           end
+  | Tarrow _, Tarrow _ ->
+      let l1, t1 = all_args t1 and l2, t2 = all_args t2 in
+      included t1 t2 ~prefix &&
+      let len1 = List.length l1 and len2 = List.length l2 in
+      let l2 = if arr len1 ~card:len2 < 100 then l2 else
+          let ll1 = get_options (fst (List.split l1)) in
+          List.filter l2
+          ~f:(fun (l,_) -> not (is_opt l) || List.mem l ll1)
+      in
+      len1 <= len2 &&
+      List.exists (List2.flat_map ~f:permutations (choose len1 ~card:l2)) ~f:
+      begin fun l2 ->
+        List.for_all2 l1 l2 ~f:
+        begin fun (p1,t1) (p2,t2) ->
+          (p1 = Nolabel || p1 = p2) && included t1 t2 ~prefix
+        end
+      end
+  | Ttuple l1, Ttuple l2 ->
+      let len1 = List.length l1 in
+      len1 <= List.length l2 &&
+      List.exists (List2.flat_map ~f:permutations (choose len1 ~card:l2)) ~f:
+      begin fun l2 ->
+        List.for_all2 l1 l2 ~f:(included ~prefix)
+      end
+  | _, Ttuple _ -> included (newty (Ttuple [t1])) t2 ~prefix
+  | Tconstr (p1, l1, _), Tconstr (p2, l2, _) ->
+      remove_prefix ~prefix (longident_of_path p1) = (longident_of_path p2)
+      && List.length l1 = List.length l2
+      && List.for_all2 l1 l2 ~f:(included ~prefix)
+  | _ -> false
+
+let mklid = function
+    [] -> raise (Invalid_argument "Searchid.mklid")
+  | x :: l ->
+      List.fold_left l ~init:(Lident x) ~f:(fun acc x -> Ldot (acc, x))
+
+let mkpath = function
+    [] -> raise (Invalid_argument "Searchid.mklid")
+  | x :: l ->
+      List.fold_left l ~init:(Pident (Ident.create x))
+      ~f:(fun acc x -> Pdot (acc, x, 0))
+
+let get_fields ~prefix ~sign self =
+  (* let env = open_signature Fresh (mkpath prefix) sign !start_env in *)
+  let env = add_signature sign !start_env in
+  match (expand_head env self).desc with
+    Tobject (ty_obj, _) ->
+      let l,_ = flatten_fields ty_obj in l
+  | _ -> []
+
+let rec search_type_in_signature t ~sign ~prefix ~mode =
+  let matches = match mode with
+        `Included -> included t ~prefix
+      | `Exact -> equal t ~prefix
+  and lid_of_id id = mklid (prefix @ [Ident.name id]) in
+  let matches_args = function
+      Cstr_tuple l -> List.exists l ~f:matches
+    | Cstr_record l ->
+        List.exists l ~f:(fun ld -> matches ld.ld_type)
+  in
+  List2.flat_map sign ~f:
+  begin fun item -> match item with
+        Sig_value (id, vd) ->
+          if matches vd.val_type then [lid_of_id id, Pvalue] else []
+      | Sig_type (id, td, _) ->
+          if
+          matches (newconstr (Pident id) td.type_params) ||
+          begin match td.type_manifest with
+            None -> false
+          | Some t -> matches t
+          end ||
+          begin match td.type_kind with
+            Type_abstract
+	  | Type_open -> false
+          | Type_variant l ->
+            List.exists l ~f:
+            begin fun {cd_args=a; cd_res=r} ->
+              matches_args a ||
+              match r with None -> false | Some x -> matches x
+            end
+          | Type_record(l, rep) ->
+            List.exists l ~f:(fun ld -> matches ld.ld_type)
+          end
+          then [lid_of_id id, Ptype] else []
+      | Sig_typext (id, l, _) ->
+          if matches_args l.ext_args
+          then [lid_of_id id, Pconstructor]
+          else []
+      | Sig_module (id, {md_type=Mty_signature sign}, _) ->
+          search_type_in_signature t ~sign ~mode
+            ~prefix:(prefix @ [Ident.name id])
+      | Sig_module _ -> []
+      | Sig_modtype _ -> []
+      | Sig_class (id, cl, _) ->
+          let self = self_type cl.cty_type in
+          if matches self
+          || (match cl.cty_new with None -> false | Some ty -> matches ty)
+          (* || List.exists (get_fields ~prefix ~sign self)
+              ~f:(fun (_,_,ty_field) -> matches ty_field) *)
+          then [lid_of_id id, Pclass] else []
+      | Sig_class_type (id, cl, _) ->
+          let self = self_type cl.clty_type in
+          if matches self
+          (* || List.exists (get_fields ~prefix ~sign self)
+              ~f:(fun (_,_,ty_field) -> matches ty_field) *)
+          then [lid_of_id id, Pclass] else []
+  end
+
+let search_all_types t ~mode =
+  let tl = match mode, t.desc with
+      `Exact, _ -> [t]
+    | `Included, Tarrow _ -> [t]
+    | `Included, _ ->
+      [t; newty(Tarrow(Nolabel,t,newvar(),Cok));
+       newty(Tarrow(Nolabel,newvar(),t,Cok))]
+  in List2.flat_map !module_list ~f:
+    begin fun modname ->
+    let mlid = Lident modname in
+    try match find_module (lookup_module ~load:true mlid !start_env) !start_env
+    with {md_type=Mty_signature sign} ->
+        List2.flat_map tl
+          ~f:(search_type_in_signature ~sign ~prefix:[modname] ~mode)
+    | _ -> []
+    with Not_found | Env.Error _ -> []
+    end
+
+exception Error of int * int
+
+let search_string_type text ~mode =
+  try
+    let sexp = Parse.interface (Lexing.from_string ("val z : " ^ text)) in
+    let sign =
+      try (Typemod.transl_signature !start_env sexp).sig_type with _ ->
+      let env = List.fold_left !module_list ~init:!start_env ~f:
+        begin fun acc m ->
+          try open_pers_signature m acc with Env.Error _ -> acc
+        end in
+      try (Typemod.transl_signature env sexp).sig_type
+      with Env.Error err -> []
+      | Typemod.Error (l,_,_) ->
+          let start_c = l.loc_start.Lexing.pos_cnum in
+          let end_c = l.loc_end.Lexing.pos_cnum in
+          raise (Error (start_c - 8, end_c - 8))
+      | Typetexp.Error (l,_,_) ->
+          let start_c = l.loc_start.Lexing.pos_cnum in
+          let end_c = l.loc_end.Lexing.pos_cnum in
+          raise (Error (start_c - 8, end_c - 8))
+    in match sign with
+        [ Sig_value (_, vd) ] ->
+          search_all_types vd.val_type ~mode
+      | _ -> []
+  with
+    Syntaxerr.Error(Syntaxerr.Unclosed(l,_,_,_)) ->
+      let start_c = l.loc_start.Lexing.pos_cnum in
+      let end_c = l.loc_end.Lexing.pos_cnum in
+      raise (Error (start_c - 8, end_c - 8))
+  | Syntaxerr.Error(Syntaxerr.Other l) ->
+      let start_c = l.loc_start.Lexing.pos_cnum in
+      let end_c = l.loc_end.Lexing.pos_cnum in
+      raise (Error (start_c - 8, end_c - 8))
+  | Lexer.Error (_, l) ->
+      let start_c = l.loc_start.Lexing.pos_cnum in
+      let end_c = l.loc_end.Lexing.pos_cnum in
+      raise (Error (start_c - 8, end_c - 8))
+
+let longident_of_string text =
+  let exploded = ref [] and l = ref 0 in
+  for i = 0 to String.length text - 2 do
+    if text.[i] ='.' then
+    (exploded := String.sub text ~pos:!l ~len:(i - !l) :: !exploded; l := i+1)
+  done;
+  let sym = String.sub text ~pos:!l ~len:(String.length text - !l) in
+  let rec mklid = function
+      [s] -> Lident s
+    | s :: l -> Ldot (mklid l, s)
+    | [] -> assert false in
+  sym, fun l -> mklid (sym :: !exploded @ l)
+
+
+let explode s =
+  let l = ref [] in
+  for i = String.length s - 1 downto 0 do
+    l := s.[i] :: !l
+  done; !l
+
+let rec check_match ~pattern s =
+  match pattern, s with
+    [], [] -> true
+  | '*'::l, l' -> check_match ~pattern:l l'
+                  || check_match ~pattern:('?'::'*'::l) l'
+  | '?'::l, _::l' -> check_match ~pattern:l l'
+  | x::l, y::l' when x == y -> check_match ~pattern:l l'
+  | _ -> false
+
+let search_pattern_symbol text =
+  if text = "" then [] else
+  let pattern = explode text in
+  let check i = check_match ~pattern (explode (Ident.name i)) in
+  let l = List.map !module_list ~f:
+    begin fun modname -> Lident modname,
+    try match
+      find_module (lookup_module ~load:true (Lident modname) !start_env)
+	!start_env
+    with {md_type=Mty_signature sign} ->
+        List2.flat_map sign ~f:
+          begin function
+            Sig_value (i, _) when check i -> [i, Pvalue]
+          | Sig_type (i, _, _) when check i -> [i, Ptype]
+          | Sig_typext (i, _, _) when check i -> [i, Pconstructor]
+          | Sig_module (i, _, _) when check i -> [i, Pmodule]
+          | Sig_modtype (i, _) when check i -> [i, Pmodtype]
+          | Sig_class (i, cl, _) when check i
+            || List.exists
+                (get_fields ~prefix:[modname] ~sign (self_type cl.cty_type))
+                ~f:(fun (name,_,_) -> check_match ~pattern (explode name))
+            -> [i, Pclass]
+          | Sig_class_type (i, cl, _) when check i
+            || List.exists
+                (get_fields ~prefix:[modname] ~sign (self_type cl.clty_type))
+                ~f:(fun (name,_,_) -> check_match ~pattern (explode name))
+            -> [i, Pcltype]
+          | _ -> []
+          end
+    | _ -> []
+    with Env.Error _ -> []
+    end
+  in
+  List2.flat_map l ~f:
+    begin fun (m, l) ->
+      List.map l ~f:(fun (i, p) -> Ldot (m, Ident.name i), p)
+    end
+
+(*
+let is_pattern s =
+  try for i = 0 to String.length s -1 do
+      if s.[i] = '?' || s.[i] = '*' then raise Exit
+    done; false
+  with Exit -> true
+*)
+
+let search_string_symbol text =
+  if text = "" then [] else
+  let lid = snd (longident_of_string text) [] in
+  let try_lookup f k =
+    try let _ = f lid !start_env in [lid, k]
+    with Not_found | Env.Error _ -> []
+  in
+  try_lookup lookup_constructor Pconstructor @
+  try_lookup (lookup_module ~load:true) Pmodule @
+  try_lookup lookup_modtype Pmodtype @
+  try_lookup lookup_value Pvalue @
+  try_lookup lookup_type Ptype @
+  try_lookup lookup_label Plabel @
+  try_lookup lookup_class Pclass
+
+open Parsetree
+
+let rec bound_variables pat =
+  match pat.ppat_desc with
+    Ppat_any | Ppat_constant _ | Ppat_type _ | Ppat_unpack _
+  | Ppat_interval _ -> []
+  | Ppat_var s -> [s.txt]
+  | Ppat_alias (pat,s) -> s.txt :: bound_variables pat
+  | Ppat_tuple l -> List2.flat_map l ~f:bound_variables
+  | Ppat_construct (_,None) -> []
+  | Ppat_construct (_,Some pat) -> bound_variables pat
+  | Ppat_variant (_,None) -> []
+  | Ppat_variant (_,Some pat) -> bound_variables pat
+  | Ppat_record (l, _) ->
+      List2.flat_map l ~f:(fun (_,pat) -> bound_variables pat)
+  | Ppat_array l ->
+      List2.flat_map l ~f:bound_variables
+  | Ppat_or (pat1,pat2) ->
+      bound_variables pat1 @ bound_variables pat2
+  | Ppat_constraint (pat,_) -> bound_variables pat
+  | Ppat_lazy pat -> bound_variables pat
+  | Ppat_extension _ -> []
+  | Ppat_exception pat -> bound_variables pat
+  | Ppat_open (_, pat) -> bound_variables pat
+
+let search_structure str ~name ~kind ~prefix =
+  let loc = ref 0 in
+  let rec search_module str ~prefix =
+    match prefix with [] -> str
+    | modu::prefix ->
+        let str =
+          List.fold_left ~init:[] str ~f:
+            begin fun acc item ->
+              match item.pstr_desc with
+                Pstr_module x when x.pmb_name.txt = modu ->
+                  loc := x.pmb_expr.pmod_loc.loc_start.Lexing.pos_cnum;
+                  begin match x.pmb_expr.pmod_desc with
+                    Pmod_structure str -> str
+                  | _ -> []
+                  end
+              | _ -> acc
+            end
+        in search_module str ~prefix
+  in
+  List.iter (search_module str ~prefix) ~f:
+    begin fun item ->
+      if match item.pstr_desc with
+        Pstr_value (_, l) when kind = Pvalue ->
+          List.iter l ~f:
+            begin fun {pvb_pat=pat} ->
+              if List.mem name (bound_variables pat)
+              then loc := pat.ppat_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | Pstr_primitive vd when kind = Pvalue -> name = vd.pval_name.txt
+      | Pstr_type (_, l) when kind = Ptype ->
+          List.iter l ~f:
+            begin fun td ->
+              if td.ptype_name.txt = name
+	      then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | Pstr_typext l when kind = Ptype ->
+          List.iter l.ptyext_constructors ~f:
+            begin fun td ->
+              if td.pext_name.txt = name
+	      then loc := td.pext_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | Pstr_exception pcd when kind = Pconstructor -> name = pcd.pext_name.txt
+      | Pstr_module x when kind = Pmodule -> name = x.pmb_name.txt
+      | Pstr_modtype x when kind = Pmodtype -> name = x.pmtd_name.txt
+      | Pstr_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
+          List.iter l ~f:
+            begin fun c ->
+              if c.pci_name.txt = name
+              then loc := c.pci_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | Pstr_class_type l when kind = Pcltype || kind = Ptype ->
+          List.iter l ~f:
+            begin fun c ->
+              if c.pci_name.txt = name
+              then loc := c.pci_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | _ -> false
+      then loc := item.pstr_loc.loc_start.Lexing.pos_cnum
+    end;
+  !loc
+
+let search_signature sign ~name ~kind ~prefix =
+  let loc = ref 0 in
+  let rec search_module_type  sign ~prefix =
+    match prefix with [] -> sign
+    | modu::prefix ->
+        let sign =
+          List.fold_left ~init:[] sign ~f:
+            begin fun acc item ->
+              match item.psig_desc with
+                Psig_module pmd when pmd.pmd_name.txt = modu ->
+                  loc := pmd.pmd_type.pmty_loc.loc_start.Lexing.pos_cnum;
+                  begin match pmd.pmd_type.pmty_desc with
+                    Pmty_signature sign -> sign
+                  | _ -> []
+                  end
+              | _ -> acc
+            end
+        in search_module_type sign ~prefix
+  in
+  List.iter (search_module_type sign ~prefix) ~f:
+    begin fun item ->
+      if match item.psig_desc with
+        Psig_value vd when kind = Pvalue -> name = vd.pval_name.txt
+      | Psig_type (_, l) when kind = Ptype ->
+          List.iter l ~f:
+            begin fun td ->
+              if td.ptype_name.txt = name
+	      then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | Psig_typext l when kind = Pconstructor ->
+          List.iter l.ptyext_constructors ~f:
+            begin fun td ->
+              if td.pext_name.txt = name
+	      then loc := td.pext_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | Psig_exception pcd when kind = Pconstructor -> name = pcd.pext_name.txt
+      | Psig_module pmd when kind = Pmodule -> name = pmd.pmd_name.txt
+      | Psig_modtype pmtd when kind = Pmodtype -> name = pmtd.pmtd_name.txt
+      | Psig_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
+          List.iter l ~f:
+            begin fun c ->
+              if c.pci_name.txt = name
+              then loc := c.pci_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | Psig_class_type l when kind = Ptype || kind = Pcltype ->
+          List.iter l ~f:
+            begin fun c ->
+              if c.pci_name.txt = name
+              then loc := c.pci_loc.loc_start.Lexing.pos_cnum
+            end;
+          false
+      | _ -> false
+      then loc := item.psig_loc.loc_start.Lexing.pos_cnum
+    end;
+  !loc
diff --git a/applications/browser/searchid.mli b/applications/browser/searchid.mli
new file mode 100644
index 0000000..919b2ed
--- /dev/null
+++ b/applications/browser/searchid.mli
@@ -0,0 +1,54 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+val start_env : Env.t ref
+val module_list : string list ref
+val longident_of_path :  Path.t ->Longident.t
+
+type pkind =
+    Pvalue
+  | Ptype
+  | Plabel
+  | Pconstructor
+  | Pmodule
+  | Pmodtype
+  | Pclass
+  | Pcltype
+
+val string_of_kind :  pkind -> string
+
+exception Error of int * int
+
+val search_string_type :
+      string -> mode:[`Exact|`Included] -> (Longident.t * pkind) list
+val search_pattern_symbol : string -> (Longident.t * pkind) list
+val search_string_symbol : string -> (Longident.t * pkind) list
+
+val search_structure :
+    Parsetree.structure ->
+    name:string -> kind:pkind -> prefix:string list -> int
+val search_signature :
+    Parsetree.signature ->
+    name:string -> kind:pkind -> prefix:string list -> int
diff --git a/applications/browser/searchpos.ml b/applications/browser/searchpos.ml
new file mode 100644
index 0000000..b744b20
--- /dev/null
+++ b/applications/browser/searchpos.ml
@@ -0,0 +1,924 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open StdLabels
+open Parsetree
+open Typedtree
+open Types
+open Location
+open Longident
+open Path
+open Env
+open Searchid
+
+(* auxiliary functions *)
+
+let (~!) = Jg_memo.fast ~f:Str.regexp
+
+let lines_to_chars n ~text:s =
+  let l = String.length s in
+  let rec ltc n ~pos =
+    if n = 1 || pos >= l then pos else
+    if s.[pos] = '\n' then ltc (n-1) ~pos:(pos+1) else ltc n ~pos:(pos+1)
+  in ltc n ~pos:0
+
+let in_loc loc ~pos =
+  loc.loc_ghost || pos >= loc.loc_start.Lexing.pos_cnum
+                   && pos < loc.loc_end.Lexing.pos_cnum
+
+let le_loc loc1 loc2 =
+  loc1.loc_start.Lexing.pos_cnum <= loc2.loc_start.Lexing.pos_cnum
+  && loc1.loc_end.Lexing.pos_cnum >= loc2.loc_end.Lexing.pos_cnum
+
+let add_found ~found sol ~env ~loc =
+  if loc.loc_ghost then () else
+  if List.exists !found ~f:(fun (_,_,loc') -> le_loc loc loc') then ()
+  else found := (sol, env, loc) ::
+    List.filter !found ~f:(fun (_,_,loc') -> not (le_loc loc' loc))
+
+let observe ~ref ?init f x =
+  let old = !ref in
+  begin match init with None -> () | Some x -> ref := x end;
+  try (f x : unit); let v = !ref in ref := old; v
+  with exn -> ref := old; raise exn
+
+let rec string_of_longident = function
+    Lident s -> s
+  | Ldot (id,s) -> string_of_longident id ^ "." ^ s
+  | Lapply (id1, id2) ->
+      string_of_longident id1 ^ "(" ^ string_of_longident id2 ^ ")"
+
+let string_of_path p = string_of_longident (Searchid.longident_of_path p)
+
+let parent_path = function
+    Pdot (path, _, _) -> Some path
+  | Pident _ | Papply _ -> None
+
+let ident_of_path ~default = function
+    Pident i -> i
+  | Pdot (_, s, _) -> Ident.create s
+  | Papply _ -> Ident.create default
+
+let rec head_id = function
+    Pident id -> id
+  | Pdot (path,_,_) -> head_id path
+  | Papply (path,_) -> head_id path (* wrong, but ... *)
+
+let rec list_of_path = function
+    Pident id -> [Ident.name id]
+  | Pdot (path, s, _) -> list_of_path path @ [s]
+  | Papply (path, _) -> list_of_path path (* wrong, but ... *)
+
+(* a simple wrapper *)
+
+class buffer ~size = object
+  val buffer = Buffer.create size
+  method out buf = Buffer.add_substring buffer buf
+  method get = Buffer.contents buffer
+end
+
+(* Search in a signature *)
+
+type skind = [`Type|`Class|`Module|`Modtype]
+
+let found_sig = ref ([] : ((skind * Longident.t) * Env.t * Location.t) list)
+let add_found_sig = add_found ~found:found_sig
+
+let rec search_pos_type t ~pos ~env =
+  if in_loc ~pos t.ptyp_loc then
+  begin match t.ptyp_desc with
+    Ptyp_any
+  | Ptyp_var _ -> ()
+  | Ptyp_variant(tl, _, _) ->
+      List.iter tl ~f:
+        begin function
+            Rtag (_,_,_,tl) -> List.iter tl ~f:(search_pos_type ~pos ~env)
+          | Rinherit st -> search_pos_type ~pos ~env st
+        end
+  | Ptyp_arrow (_, t1, t2) ->
+      search_pos_type t1 ~pos ~env;
+      search_pos_type t2 ~pos ~env
+  | Ptyp_tuple tl ->
+      List.iter tl ~f:(search_pos_type ~pos ~env)
+  | Ptyp_constr (lid, tl) ->
+      List.iter tl ~f:(search_pos_type ~pos ~env);
+      add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
+  | Ptyp_object (fl, _) ->
+      List.iter fl ~f:
+        (function Oinherit ty | Otag (_, _, ty) -> search_pos_type ty ~pos ~env)
+  | Ptyp_class (lid, tl) ->
+      List.iter tl ~f:(search_pos_type ~pos ~env);
+      add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
+  | Ptyp_alias (t, _)
+  | Ptyp_poly (_, t) -> search_pos_type ~pos ~env t
+  | Ptyp_package (_, stl) ->
+     List.iter stl ~f:(fun (_, ty) -> search_pos_type ty ~pos ~env)
+  | Ptyp_extension _ -> ()
+  end
+
+let rec search_pos_class_type cl ~pos ~env =
+  if in_loc cl.pcty_loc ~pos then
+    begin match cl.pcty_desc with
+      Pcty_constr (lid, _) ->
+        add_found_sig (`Class, lid.txt) ~env ~loc:cl.pcty_loc
+    | Pcty_signature  cl ->
+        List.iter cl.pcsig_fields ~f: (fun fl ->
+          begin match fl.pctf_desc with
+              Pctf_inherit cty -> search_pos_class_type cty ~pos ~env
+            | Pctf_val (_, _, _, ty)
+            | Pctf_method (_, _, _, ty) ->
+                if in_loc fl.pctf_loc ~pos then search_pos_type ty ~pos ~env
+            | Pctf_constraint (ty1, ty2) ->
+                if in_loc fl.pctf_loc ~pos then begin
+                  search_pos_type ty1 ~pos ~env;
+                  search_pos_type ty2 ~pos ~env
+                end
+	    | Pctf_attribute _
+            | Pctf_extension _ -> ()
+          end)
+    | Pcty_arrow (_, ty, cty) ->
+        search_pos_type ty ~pos ~env;
+        search_pos_class_type cty ~pos ~env
+    | Pcty_extension _ -> ()
+    | Pcty_open (_, _, cty) ->
+        search_pos_class_type cty ~pos ~env
+    end
+
+let search_pos_arguments ~pos ~env = function
+    Pcstr_tuple l -> List.iter l ~f:(search_pos_type ~pos ~env)
+  | Pcstr_record l -> List.iter l ~f:(fun ld -> search_pos_type ld.pld_type ~pos ~env)
+
+let search_pos_constructor pcd ~pos ~env =
+  if in_loc ~pos pcd.pcd_loc then begin
+    Misc.may (search_pos_type ~pos ~env) pcd.pcd_res;
+    search_pos_arguments ~pos ~env pcd.pcd_args
+  end
+
+let search_pos_type_decl td ~pos ~env =
+  if in_loc ~pos td.ptype_loc then begin
+    begin match td.ptype_manifest with
+      Some t -> search_pos_type t ~pos ~env
+    | None -> ()
+    end;
+    let rec search_tkind = function
+      Ptype_abstract
+    | Ptype_open -> ()
+    | Ptype_variant dl ->
+        List.iter dl ~f:(search_pos_constructor ~pos ~env)
+    | Ptype_record dl ->
+        List.iter dl ~f:(fun pld -> search_pos_type pld.pld_type ~pos ~env) in
+    search_tkind td.ptype_kind;
+    List.iter td.ptype_cstrs ~f:
+      begin fun (t1, t2, _) ->
+        search_pos_type t1 ~pos ~env;
+        search_pos_type t2 ~pos ~env
+      end
+  end
+
+let search_pos_extension ext ~pos ~env =
+  begin match ext.pext_kind with
+    Pext_decl (l, _) -> search_pos_arguments l ~pos ~env
+  | Pext_rebind _ -> ()
+  end
+  
+let rec search_pos_signature l ~pos ~env =
+  ignore (
+  List.fold_left l ~init:env ~f:
+  begin fun env pt ->
+    let env = match pt.psig_desc with
+      Psig_open {popen_override=ovf; popen_lid=id} ->
+        let path, mt = Typetexp.find_module env Location.none id.txt in
+        begin match open_signature ovf path env with
+          Some env -> env
+        | None -> env
+        end
+    | sign_item ->
+        try add_signature (Typemod.transl_signature env [pt]).sig_type env
+        with Typemod.Error _ | Typeclass.Error _
+        | Typetexp.Error _  | Typedecl.Error _ -> env
+    in
+    if in_loc ~pos pt.psig_loc then
+      begin match pt.psig_desc with
+        Psig_value desc -> search_pos_type desc.pval_type ~pos ~env
+      | Psig_type (_, l) ->
+          List.iter l ~f:(search_pos_type_decl ~pos ~env)
+      | Psig_typext pty ->
+	  List.iter pty.ptyext_constructors
+	    ~f:(search_pos_extension ~pos ~env);
+	  add_found_sig (`Type, pty.ptyext_path.txt) ~env ~loc:pt.psig_loc
+      | Psig_exception ext ->
+	  search_pos_extension ext ~pos ~env;
+	  add_found_sig (`Type, Lident "exn") ~env ~loc:pt.psig_loc
+      | Psig_module pmd ->
+          search_pos_module pmd.pmd_type ~pos ~env
+      | Psig_recmodule decls ->
+          List.iter decls ~f:(fun pmd -> search_pos_module pmd.pmd_type ~pos ~env)
+      | Psig_modtype {pmtd_type=Some t} ->
+          search_pos_module t ~pos ~env
+      | Psig_modtype _ -> ()
+      | Psig_class l ->
+          List.iter l
+            ~f:(fun ci -> search_pos_class_type ci.pci_expr ~pos ~env)
+      | Psig_class_type l ->
+          List.iter l
+            ~f:(fun ci -> search_pos_class_type ci.pci_expr ~pos ~env)
+      (* The last cases should not happen in generated interfaces *)
+      | Psig_open {popen_lid=lid} ->
+        add_found_sig (`Module, lid.txt) ~env ~loc:pt.psig_loc
+      | Psig_include {pincl_mod=t} -> search_pos_module t ~pos ~env
+      | Psig_attribute _ | Psig_extension _ -> ()
+      end;
+    env
+  end)
+
+and search_pos_module m ~pos ~env =
+  if in_loc m.pmty_loc ~pos then begin
+    begin match m.pmty_desc with
+      Pmty_ident lid -> add_found_sig (`Modtype, lid.txt) ~env ~loc:m.pmty_loc
+    | Pmty_alias lid -> add_found_sig (`Module, lid.txt) ~env ~loc:m.pmty_loc
+    | Pmty_signature sg -> search_pos_signature sg ~pos ~env
+    | Pmty_functor (_ , m1, m2) ->
+        Misc.may (search_pos_module ~pos ~env) m1;
+        search_pos_module m2 ~pos ~env
+    | Pmty_with (m, l) ->
+        search_pos_module m ~pos ~env;
+        List.iter l ~f:
+          begin function
+              Pwith_type (_, t) -> search_pos_type_decl t ~pos ~env
+            | _ -> ()
+          end
+    | Pmty_typeof md ->
+        ()   (* TODO? *)
+    | Pmty_extension _ -> ()
+    end
+  end
+
+let search_pos_signature l ~pos ~env =
+  observe ~ref:found_sig (search_pos_signature ~pos ~env) l
+
+(* the module display machinery *)
+
+type module_widgets =
+    { mw_frame: GPack.box;
+      mw_title: GMisc.label option;
+      mw_buttons: GPack.box; }
+
+let shown_modules = Hashtbl.create 17
+let default_frame = ref None
+let set_path = ref (fun _ ~sign -> assert false)
+let add_shown_module path ~widgets =
+  Hashtbl.add shown_modules path widgets;
+  widgets.mw_frame#connect#destroy ~callback:
+    (fun () -> Hashtbl.remove shown_modules path);
+  ()
+let find_shown_module path =
+  try
+    Hashtbl.find shown_modules path
+  with Not_found ->
+    match !default_frame with
+      None -> raise Not_found
+    | Some mw -> mw
+
+let is_shown_module path =
+  !default_frame <> None ||
+  Hashtbl.mem shown_modules path
+
+(* Viewing a signature *)
+
+(* Forward definitions of Viewer.view_defined and Editor.editor *)
+let view_defined_ref = ref (fun lid ~env -> ())
+let editor_ref = ref (fun ?file ?pos ?opendialog () -> ())
+
+let edit_source ~file ~path ~sign =
+  match sign with
+    [item] ->
+      let id, kind =
+        match item with
+          Sig_value (id, _) -> id, Pvalue
+        | Sig_type (id, _, _) -> id, Ptype
+        | Sig_typext (id, _, _) -> id, Pconstructor
+        | Sig_module (id, _, _) -> id, Pmodule
+        | Sig_modtype (id, _) -> id, Pmodtype
+        | Sig_class (id, _, _) -> id, Pclass
+        | Sig_class_type (id, _, _) -> id, Pcltype
+      in
+      let prefix = List.tl (list_of_path path) and name = Ident.name id in
+      let pos =
+        try
+          let chan = open_in file in
+          if Filename.check_suffix file ".ml" then
+            let parsed = Parse.implementation (Lexing.from_channel chan) in
+            close_in chan;
+            Searchid.search_structure parsed ~name ~kind ~prefix
+          else
+            let parsed = Parse.interface (Lexing.from_channel chan) in
+            close_in chan;
+            Searchid.search_signature parsed ~name ~kind ~prefix
+        with _ -> 0
+      in !editor_ref ~file ~pos ()
+  | _ -> !editor_ref ~file ()
+
+(* List of windows to destroy by Close All *)
+let top_widgets = ref []
+
+let dummy_item =
+  Sig_modtype (Ident.create "dummy",
+               {mtd_type=None; mtd_attributes=[]; mtd_loc=Location.none})
+
+let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
+  let env =
+    match path with None -> env
+    | Some path ->
+        match Env.open_signature Fresh path env with None -> env
+        | Some env -> env
+  in
+  let title =
+    match title, path with Some title, _ -> title
+    | None, Some path -> string_of_path path
+    | None, None -> "Signature"
+  in
+  let tw, finish =
+    try match path, !default_frame with
+      None, Some ({mw_title=Some label} as mw) when not detach ->
+        List.iter (mw.mw_frame#children @ mw.mw_buttons#children)
+          ~f:(fun w -> w#destroy ());
+        let detach =
+          GButton.button ~label:"Detach" ~packing:mw.mw_buttons#add () in
+        detach#connect#clicked
+          ~callback:(fun () -> view_signature sign ~title ~env ~detach:true);
+        label#set_text title;
+        Jg_message.formatted ~title ~on:mw.mw_frame ~maxheight:15 ()
+    | None, _ -> raise Not_found
+    | Some path, _ ->
+        let mw =
+          try find_shown_module path
+          with Not_found ->
+            view_module path ~env;
+            find_shown_module path
+        in
+        (try !set_path path ~sign with _ -> ());
+        begin match mw.mw_title with None -> ()
+        | Some label ->
+            label#set_text title
+        end;
+        List.iter (mw.mw_frame#children @ mw.mw_buttons#children)
+          ~f:(fun w -> w#destroy ());
+        let detach =
+          GButton.button ~label:"Detach" ~packing:mw.mw_buttons#add () in
+        detach#connect#clicked
+          ~callback:(fun () -> view_signature sign ~title ~env ~detach:true);
+        List.iter2 ["Impl"; "Intf"] [".ml"; ".mli"] ~f:
+          begin fun label ext ->
+            try
+              let id = head_id path in
+              let file =
+                Misc.find_in_path_uncap !Config.load_path
+                  ((Ident.name id) ^ ext) in
+              let button =
+                GButton.button ~label ~packing:mw.mw_buttons#add () in
+              button#connect#clicked
+                ~callback:(fun () -> edit_source ~file ~path ~sign);
+              ()
+            with Not_found -> ()
+          end;
+        begin match GWindow.toplevel mw.mw_frame with
+          Some top when not top#misc#visible -> top#misc#map ()
+        | _ -> ()
+        end;
+        Jg_message.formatted ~title ~on:mw.mw_frame ~maxheight:15 ()
+    with Not_found ->
+      let tw, finish = Jg_message.formatted ~title ~maxheight:15 () in
+      Gaux.may (GWindow.toplevel tw)
+        ~f:(fun w -> top_widgets := (w :> GWindow.window) :: !top_widgets);
+      tw, finish
+  in
+  Format.set_max_boxes 100;
+  Printtyp.wrap_printing_env env
+    (fun () -> Printtyp.signature Format.std_formatter sign);
+  finish ();
+  let tb = tw#buffer in
+  Lexical.init_tags tb;
+  Lexical.tag tb;
+  tw#set_editable false;
+  let text = tb#get_text () in
+  let tpos = Lexical.tpos ~start:tb#start_iter in
+  let pt =
+      try Parse.interface (Lexing.from_string text)
+      with Syntaxerr.Error e ->
+        let l = Syntaxerr.location_of_error e in
+        tb#apply_tag_by_name "error"
+          ~start:(tpos l.loc_start)
+          ~stop:(tpos l.loc_end);
+        tb#place_cursor (tpos l.loc_start);
+        tw#scroll_mark_onscreen `INSERT;
+        []
+    | Lexer.Error (_, l) ->
+        tb#apply_tag_by_name "error"
+          ~start:(tpos l.loc_start)
+          ~stop:(tpos l.loc_end);
+        tb#place_cursor (tpos l.loc_start);
+        tw#scroll_mark_onscreen `INSERT;
+        []
+  in
+  (* bind tw ~events:[`Modified([`Control], `KeyPressDetail"s")]
+    ~action:(fun _ -> Jg_text.search_string tw); *)
+  let module BE = GdkEvent.Button in
+  tw#event#connect#button_press ~callback:
+    begin fun ev ->
+      let it = tw#get_iter_at_location
+          ~x:(truncate (BE.x ev +. 0.1))
+          ~y:(truncate (BE.y ev +. 0.1)) in
+      let l = it#line and c = it#line_index in
+      let r = ref true in
+      if GdkEvent.get_type ev = `TWO_BUTTON_PRESS && BE.button ev = 1 then
+        begin try
+          match search_pos_signature pt ~pos:(lines_to_chars l ~text + c) ~env
+          with [] -> ()
+          | ((kind, lid), env, loc) :: _ -> view_decl lid ~kind ~env
+        with Not_found | Env.Error _ -> ()
+        end
+      else if GdkEvent.get_type ev = `BUTTON_PRESS && BE.button ev = 3 then
+        begin try
+          match search_pos_signature pt ~pos:(lines_to_chars l ~text + c) ~env
+          with [] -> ()
+          | ((kind, lid), env, loc) :: _ ->
+              let menu = view_decl_menu lid ~kind ~env in
+              menu#popup ~button:3 ~time:(BE.time ev)
+        with Not_found | Env.Error _ -> ()
+        end
+      else r := false;
+      !r
+    end;
+  ()
+
+and view_signature_item sign ~path ~env =
+  view_signature sign ~title:(string_of_path path)
+    ?path:(parent_path path) ~env
+
+and view_module path ~env =
+  match find_module path env with
+    {md_type=Mty_signature sign} ->
+      !view_defined_ref (Searchid.longident_of_path path) ~env
+  | modtype ->
+      let id = ident_of_path path ~default:"M" in
+      view_signature_item [Sig_module (id, modtype, Trec_not)] ~path ~env
+
+and view_module_id id ~env =
+  let path = lookup_module ~load:true id env in
+  view_module path ~env
+
+and view_type_decl path ~env =
+  let td = find_type path env in
+  try match td.type_manifest with None -> raise Not_found
+    | Some ty -> match Ctype.repr ty with
+        {desc = Tobject _} ->
+          let clt = find_cltype path env in
+          view_signature_item ~path ~env
+            [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first);
+             dummy_item; dummy_item]
+      | _ -> raise Not_found
+  with Not_found ->
+    view_signature_item ~path ~env
+      [Sig_type(ident_of_path path ~default:"t", td, Trec_first)]
+
+and view_type_id li ~env =
+  let path = lookup_type li env in
+  view_type_decl path ~env
+
+and view_class_id li ~env =
+  let path, cl = lookup_class li env in
+  view_signature_item ~path ~env
+     [Sig_class(ident_of_path path ~default:"c", cl, Trec_first);
+      dummy_item; dummy_item; dummy_item]
+
+and view_cltype_id li ~env =
+  let path, clt = lookup_cltype li env in
+  view_signature_item ~path ~env
+     [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first);
+      dummy_item; dummy_item]
+
+and view_modtype_id li ~env =
+  let path, td = lookup_modtype li env in
+  view_signature_item ~path ~env
+    [Sig_modtype(ident_of_path path ~default:"S", td)]
+
+and view_expr_type ?title ?path ?env ?(name="noname") t =
+  let title =
+    match title, path with Some title, _ -> title
+    | None, Some path -> string_of_path path
+    | None, None -> "Expression type"
+  and path, id =
+    match path with None -> None, Ident.create name
+    | Some path -> parent_path path, ident_of_path path ~default:name
+  in
+  view_signature ~title ?path ?env
+    [Sig_value (id, {val_type = t; val_kind = Val_reg; val_attributes=[];
+                     val_loc = Location.none})]
+
+and view_decl lid ~kind ~env =
+  match kind with
+    `Type -> view_type_id lid ~env
+  | `Class -> view_class_id lid ~env
+  | `Module -> view_module_id lid ~env
+  | `Modtype -> view_modtype_id lid ~env
+
+and view_decl_menu lid ~kind ~env =
+  let path, kname =
+    try match kind with
+      `Type -> lookup_type lid env, "Type"
+    | `Class -> fst (lookup_class lid env), "Class"
+    | `Module -> lookup_module ~load:true lid env, "Module"
+    | `Modtype -> fst (lookup_modtype lid env), "Module type"
+    with Env.Error _ -> raise Not_found
+  in
+  let menu = new GMenu.factory (GMenu.menu ()) in
+  let label = kname ^ " " ^ string_of_path path in
+  begin match path with
+    Pident _ ->
+      let m = menu#add_item label in
+      m#misc#set_sensitive false
+  | _ ->
+      menu#add_item label ~callback:(fun () -> view_decl lid ~kind ~env);
+      ()
+  end;
+  if kind = `Type || kind = `Modtype then begin
+    let buf = new buffer ~size:60 in
+    let (fo,ff) = Format.get_formatter_output_functions ()
+    and margin = Format.get_margin () in
+    Format.set_formatter_output_functions buf#out (fun () -> ());
+    Format.set_margin 60;
+    Format.open_hbox ();
+    Printtyp.wrap_printing_env env begin fun () ->
+      if kind = `Type then
+        Printtyp.type_declaration
+          (ident_of_path path ~default:"t")
+          Format.std_formatter
+          (find_type path env)
+      else
+        Printtyp.modtype_declaration
+          (ident_of_path path ~default:"S")
+          Format.std_formatter
+          (find_modtype path env)
+    end;
+    Format.close_box (); Format.print_flush ();
+    Format.set_formatter_output_functions fo ff;
+    Format.set_margin margin;
+    let l = Str.split ~!"\n" buf#get in
+    (* Menu.add_separator menu; *)
+    List.iter l
+      ~f:(fun label -> (menu#add_item label)#misc#set_sensitive false)
+  end;
+  menu#menu
+
+(* search and view in a structure *)
+
+type fkind = [
+    `Exp of
+      [`Expr|`Pat|`Const|`Val of Path.t|`Var of Path.t|`New of Path.t]
+        * type_expr
+  | `Class of Path.t * class_type
+  | `Module of Path.t * module_type
+]
+
+let view_type kind ~env =
+  match kind with
+    `Exp (k, ty) ->
+      begin match k with
+        `Expr -> view_expr_type ty ~title:"Expression type" ~env
+      | `Pat -> view_expr_type ty ~title:"Pattern type" ~env
+      | `Const -> view_expr_type ty ~title:"Constant type" ~env
+      | `Val path ->
+          begin try
+            let vd = find_value path env in
+            view_signature_item ~path ~env
+              [Sig_value(ident_of_path path ~default:"v", vd)]
+          with Not_found ->
+            view_expr_type ty ~path ~env
+          end
+      | `Var path ->
+          let vd = find_value path env in
+          view_expr_type vd.val_type ~env ~path ~title:"Variable type"
+      | `New path ->
+          let cl = find_class path env in
+          view_signature_item ~path ~env
+            [Sig_class(ident_of_path path ~default:"c", cl, Trec_first)]
+      end
+  | `Class (path, cty) ->
+      let cld = { cty_params = []; cty_variance = []; cty_type = cty;
+                  cty_path = path; cty_new = None; cty_loc = Location.none;
+                  cty_attributes = []} in
+      view_signature_item ~path ~env
+        [Sig_class(ident_of_path path ~default:"c", cld, Trec_first)]
+  | `Module (path, mty) ->
+      match mty with
+        Mty_signature sign -> view_signature sign ~path ~env
+      | modtype ->
+          let md =
+	    {md_type = mty; md_attributes = []; md_loc = Location.none} in
+          view_signature_item ~path ~env
+            [Sig_module(ident_of_path path ~default:"M", md, Trec_not)]
+
+let view_type_menu (kind : fkind) ~env =
+  let title =
+    match kind with
+      `Exp (`Expr,_) -> "Expression :"
+    | `Exp (`Pat, _) -> "Pattern :"
+    | `Exp (`Const, _) -> "Constant :"
+    | `Exp (`Val path, _) -> "Value " ^ string_of_path path ^ " :"
+    | `Exp (`Var path, _) ->
+        "Variable " ^ Ident.name (ident_of_path path ~default:"noname") ^ " :"
+    | `Exp (`New path, _) -> "Class " ^ string_of_path path ^ " :"
+    | `Class (path, _) -> "Class " ^ string_of_path path ^ " :"
+    | `Module (path,_) -> "Module " ^ string_of_path path in
+  let menu = new GMenu.factory (GMenu.menu ()) in
+  begin match kind with
+    `Exp((`Expr | `Pat | `Const | `Val (Pident _)),_)  ->
+      (menu#add_item title)#misc#set_sensitive false
+  | `Exp _ | `Class _ | `Module _ ->
+      menu#add_item title ~callback:(fun () -> view_type kind ~env);
+      ()
+  end;
+  begin match kind with `Module _ | `Class _ -> ()
+  | `Exp(_, ty) ->
+      let buf = new buffer ~size:60 in
+      let (fo,ff) = Format.get_formatter_output_functions ()
+      and margin = Format.get_margin () in
+      Format.set_formatter_output_functions buf#out ignore;
+      Format.set_margin 60;
+      Format.open_hbox ();
+      Printtyp.reset ();
+      Printtyp.mark_loops ty;
+      Printtyp.wrap_printing_env env
+        (fun () -> Printtyp.type_expr Format.std_formatter ty);
+      Format.close_box (); Format.print_flush ();
+      Format.set_formatter_output_functions fo ff;
+      Format.set_margin margin;
+      let l = Str.split ~!"\n" buf#get in
+      (* Menu.add_separator menu; *)
+      List.iter l ~f:
+        begin fun label -> match (Ctype.repr ty).desc with
+          Tconstr (path,_,_) | Tvariant {row_name = Some (path, _)} ->
+            menu#add_item label ~callback:(fun () -> view_type_decl path ~env);
+            ()
+        | _ ->
+            (menu#add_item label)#misc#set_sensitive false
+        end
+  end;
+  menu#menu
+
+let found_str = ref ([] : (fkind * Env.t * Location.t) list)
+let add_found_str = add_found ~found:found_str
+
+let rec search_pos_structure ~pos str =
+  List.iter str ~f:
+  begin function str -> match str.str_desc with
+    Tstr_eval (exp, _) -> search_pos_expr exp ~pos
+  | Tstr_value (rec_flag, l) ->
+      List.iter l ~f:
+      begin fun {vb_pat=pat;vb_expr=exp} ->
+        let env =
+          if rec_flag = Asttypes.Recursive then exp.exp_env else Env.empty in
+        search_pos_pat pat ~pos ~env;
+        search_pos_expr exp ~pos
+      end
+  | Tstr_module mb -> search_pos_module_expr mb.mb_expr ~pos
+  | Tstr_recmodule bindings ->
+      List.iter bindings ~f:(fun mb -> search_pos_module_expr mb.mb_expr ~pos)
+  | Tstr_class l ->
+      List.iter l ~f:(fun (ci, _) -> search_pos_class_expr ci.ci_expr ~pos)
+  | Tstr_include {incl_mod=m} -> search_pos_module_expr m ~pos
+  | Tstr_primitive _
+  | Tstr_type _
+  | Tstr_typext _
+  | Tstr_exception _
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_attribute _
+    -> ()
+  end
+
+and search_pos_class_structure ~pos cls =
+  List.iter cls.cstr_fields ~f:
+    begin function cf -> match cf.cf_desc with
+        Tcf_inherit (_, cl, _, _, _) ->
+          search_pos_class_expr cl ~pos
+      | Tcf_val (_, _, _, Tcfk_concrete (_, exp), _) -> search_pos_expr exp ~pos
+      | Tcf_val _ -> ()
+      | Tcf_method (_, _, Tcfk_concrete (_, exp)) -> search_pos_expr exp ~pos
+      | Tcf_initializer exp -> search_pos_expr exp ~pos
+      | Tcf_constraint _
+      | Tcf_attribute _
+      | Tcf_method _
+        -> () (* TODO !!!!!!!!!!!!!!!!! *)
+    end
+
+and search_pos_class_expr ~pos cl =
+  if in_loc cl.cl_loc ~pos then begin
+    begin match cl.cl_desc with
+      Tcl_ident (path, _, _) ->
+        add_found_str (`Class (path, cl.cl_type))
+          ~env:!start_env ~loc:cl.cl_loc
+    | Tcl_structure cls ->
+        search_pos_class_structure ~pos cls
+    | Tcl_fun (_, pat, iel, cl, _) ->
+        search_pos_pat pat ~pos ~env:pat.pat_env;
+        List.iter iel ~f:(fun (_,_, exp) -> search_pos_expr exp ~pos);
+        search_pos_class_expr cl ~pos
+    | Tcl_apply (cl, el) ->
+        search_pos_class_expr cl ~pos;
+        List.iter el ~f:(fun (_, x) -> Misc.may (search_pos_expr ~pos) x)
+    | Tcl_let (_, pel, iel, cl) ->
+        List.iter pel ~f:
+          begin fun {vb_pat=pat; vb_expr=exp} ->
+            search_pos_pat pat ~pos ~env:exp.exp_env;
+            search_pos_expr exp ~pos
+          end;
+        List.iter iel ~f:(fun (_,_, exp) -> search_pos_expr exp ~pos);
+        search_pos_class_expr cl ~pos
+    | Tcl_open (_, _, _, _, cl)
+    | Tcl_constraint (cl, _, _, _, _) ->
+        search_pos_class_expr cl ~pos
+    end;
+    add_found_str (`Class (Pident (Ident.create "c"), cl.cl_type))
+      ~env:!start_env ~loc:cl.cl_loc
+  end
+
+and search_case ~pos {c_lhs; c_guard; c_rhs} =
+  search_pos_pat c_lhs ~pos ~env:c_rhs.exp_env;
+  begin match c_guard with
+  | None -> ()
+  | Some g -> search_pos_expr g ~pos
+  end;
+  search_pos_expr c_rhs ~pos
+
+and search_pos_expr ~pos exp =
+  if in_loc exp.exp_loc ~pos then begin
+  begin match exp.exp_desc with
+    Texp_ident (path, _, _) ->
+      add_found_str (`Exp(`Val path, exp.exp_type))
+        ~env:exp.exp_env ~loc:exp.exp_loc
+  | Texp_constant v ->
+      add_found_str (`Exp(`Const, exp.exp_type))
+        ~env:exp.exp_env ~loc:exp.exp_loc
+  | Texp_let (_, expl, exp) ->
+      List.iter expl ~f:
+      begin fun {vb_pat=pat; vb_expr=exp'} ->
+        search_pos_pat pat ~pos ~env:exp.exp_env;
+        search_pos_expr exp' ~pos
+      end;
+      search_pos_expr exp ~pos
+  | Texp_function {cases=l; _} ->
+      List.iter l ~f:(search_case ~pos)
+  | Texp_apply (exp, l) ->
+      List.iter l ~f:(fun (_, x) -> Misc.may (search_pos_expr ~pos) x);
+      search_pos_expr exp ~pos
+  | Texp_match (exp, l, _, _) ->
+      search_pos_expr exp ~pos;
+      List.iter l ~f:(search_case ~pos)
+  | Texp_try (exp, l) ->
+      search_pos_expr exp ~pos;
+      List.iter l ~f:(search_case ~pos)
+  | Texp_tuple l -> List.iter l ~f:(search_pos_expr ~pos)
+  | Texp_construct (_, _, l) -> List.iter l ~f:(search_pos_expr ~pos)
+  | Texp_variant (_, None) -> ()
+  | Texp_variant (_, Some exp) -> search_pos_expr exp ~pos
+  | Texp_record {fields=l; extended_expression=opt} ->
+      Array.iter l ~f:
+        (function (_,Overridden(_,exp)) -> search_pos_expr exp ~pos | _ -> ());
+      (match opt with None -> () | Some exp -> search_pos_expr exp ~pos)
+  | Texp_field (exp, _, _) -> search_pos_expr exp ~pos
+  | Texp_setfield (a, _, _, b) ->
+      search_pos_expr a ~pos; search_pos_expr b ~pos
+  | Texp_array l -> List.iter l ~f:(search_pos_expr ~pos)
+  | Texp_ifthenelse (a, b, c) ->
+      search_pos_expr a ~pos; search_pos_expr b ~pos;
+      begin match c with None -> ()
+      | Some exp -> search_pos_expr exp ~pos
+      end
+  | Texp_sequence (a,b) ->
+      search_pos_expr a ~pos; search_pos_expr b ~pos
+  | Texp_while (a,b) ->
+      search_pos_expr a ~pos; search_pos_expr b ~pos
+  | Texp_for (_, _, a, b, _, c) ->
+      List.iter [a;b;c] ~f:(search_pos_expr ~pos)
+  | Texp_send (exp, _, _) -> search_pos_expr exp ~pos
+  | Texp_new (path, _, _) ->
+      add_found_str (`Exp(`New path, exp.exp_type))
+        ~env:exp.exp_env ~loc:exp.exp_loc
+  | Texp_instvar (_, path, _) ->
+      add_found_str (`Exp(`Var path, exp.exp_type))
+        ~env:exp.exp_env ~loc:exp.exp_loc
+  | Texp_setinstvar (_, path, _, exp) ->
+      search_pos_expr exp ~pos;
+      add_found_str (`Exp(`Var path, exp.exp_type))
+        ~env:exp.exp_env ~loc:exp.exp_loc
+  | Texp_override (_, l) ->
+      List.iter l ~f:(fun (_, _, exp) -> search_pos_expr exp ~pos)
+  | Texp_letmodule (id, _, modexp, exp) ->
+      search_pos_module_expr modexp ~pos;
+      search_pos_expr exp ~pos
+  | Texp_assert exp ->
+      search_pos_expr exp ~pos
+  | Texp_lazy exp ->
+      search_pos_expr exp ~pos
+  | Texp_object (cls, _) ->
+      search_pos_class_structure ~pos cls
+  | Texp_pack modexp ->
+      search_pos_module_expr modexp ~pos
+  | Texp_unreachable ->
+      ()
+  | Texp_extension_constructor _ ->
+      ()
+  | Texp_letexception (_, exp) ->
+      search_pos_expr exp ~pos
+  end;
+  add_found_str (`Exp(`Expr, exp.exp_type)) ~env:exp.exp_env ~loc:exp.exp_loc
+  end
+
+and search_pos_pat ~pos ~env pat =
+  if in_loc pat.pat_loc ~pos then begin
+  begin match pat.pat_desc with
+    Tpat_any -> ()
+  | Tpat_var (id, _) ->
+      add_found_str (`Exp(`Val (Pident id), pat.pat_type))
+        ~env ~loc:pat.pat_loc
+  | Tpat_alias (pat, _, _) -> search_pos_pat pat ~pos ~env
+  | Tpat_lazy pat -> search_pos_pat pat ~pos ~env
+  | Tpat_constant _ ->
+      add_found_str (`Exp(`Const, pat.pat_type)) ~env ~loc:pat.pat_loc
+  | Tpat_tuple l ->
+      List.iter l ~f:(search_pos_pat ~pos ~env)
+  | Tpat_construct (_, _, l) ->
+      List.iter l ~f:(search_pos_pat ~pos ~env)
+  | Tpat_variant (_, None, _) -> ()
+  | Tpat_variant (_, Some pat, _) -> search_pos_pat pat ~pos ~env
+  | Tpat_record (l, _) ->
+      List.iter l ~f:(fun (_, _, pat) -> search_pos_pat pat ~pos ~env)
+  | Tpat_array l ->
+      List.iter l ~f:(search_pos_pat ~pos ~env)
+  | Tpat_or (a, b, None) ->
+      search_pos_pat a ~pos ~env; search_pos_pat b ~pos ~env
+  | Tpat_or (_, _, Some _) ->
+      ()
+  end;
+  add_found_str (`Exp(`Pat, pat.pat_type)) ~env ~loc:pat.pat_loc
+  end
+
+and search_pos_module_expr ~pos (m :module_expr) =
+  if in_loc m.mod_loc ~pos then begin
+    begin match m.mod_desc with
+      Tmod_ident (path, _) ->
+        add_found_str (`Module (path, m.mod_type))
+          ~env:m.mod_env ~loc:m.mod_loc
+    | Tmod_structure str -> search_pos_structure str.str_items ~pos
+    | Tmod_functor (_, _, _, m) -> search_pos_module_expr m ~pos
+    | Tmod_apply (a, b, _) ->
+        search_pos_module_expr a ~pos; search_pos_module_expr b ~pos
+    | Tmod_constraint (m, _, _, _) -> search_pos_module_expr m ~pos
+    | Tmod_unpack (e, _) -> search_pos_expr e ~pos
+    end;
+    add_found_str (`Module (Pident (Ident.create "M"), m.mod_type))
+      ~env:m.mod_env ~loc:m.mod_loc
+  end
+
+let search_pos_structure ~pos str =
+  observe ~ref:found_str (search_pos_structure ~pos) str
+
+open Stypes
+
+let search_pos_ti ~pos = function
+    Ti_pat p   -> search_pos_pat ~pos ~env:p.pat_env p
+  | Ti_expr e  -> search_pos_expr ~pos e
+  | Ti_class c -> search_pos_class_expr ~pos c
+  | Ti_mod m   -> search_pos_module_expr ~pos m
+  | _ -> ()
+
+let rec search_pos_info ~pos = function
+    [] -> []
+  | ti :: l ->
+      if in_loc ~pos (get_location ti)
+      then observe ~ref:found_str (search_pos_ti ~pos) ti
+      else  search_pos_info ~pos l
diff --git a/applications/browser/searchpos.mli b/applications/browser/searchpos.mli
new file mode 100644
index 0000000..f3aa92d
--- /dev/null
+++ b/applications/browser/searchpos.mli
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+val top_widgets : GWindow.window list ref
+
+type module_widgets =
+    { mw_frame: GPack.box;
+      mw_title: GMisc.label option;
+      mw_buttons: GPack.box; }
+
+val add_shown_module : Path.t -> widgets:module_widgets -> unit
+val find_shown_module : Path.t -> module_widgets
+val is_shown_module : Path.t -> bool
+val default_frame : module_widgets option ref
+val set_path : (Path.t -> sign:Types.signature -> unit) ref
+
+val view_defined_ref : (Longident.t -> env:Env.t -> unit) ref
+val editor_ref :
+    (?file:string -> ?pos:int -> ?opendialog:bool -> unit -> unit) ref
+
+val view_signature :
+  ?title:string ->
+  ?path:Path.t -> ?env:Env.t -> ?detach:bool -> Types.signature -> unit
+val view_signature_item :
+  Types.signature -> path:Path.t -> env:Env.t -> unit
+val view_module_id : Longident.t -> env:Env.t -> unit
+val view_type_id : Longident.t -> env:Env.t -> unit
+val view_class_id : Longident.t -> env:Env.t -> unit
+val view_cltype_id : Longident.t -> env:Env.t -> unit
+val view_modtype_id : Longident.t -> env:Env.t -> unit
+val view_type_decl : Path.t -> env:Env.t -> unit
+
+type skind = [`Type|`Class|`Module|`Modtype]
+val search_pos_signature :
+    Parsetree.signature -> pos:int -> env:Env.t ->
+    ((skind * Longident.t) * Env.t * Location.t) list
+val view_decl : Longident.t -> kind:skind -> env:Env.t -> unit
+val view_decl_menu :
+    Longident.t -> kind:skind -> env:Env.t -> GMenu.menu
+
+type fkind = [
+    `Exp of
+      [`Expr|`Pat|`Const|`Val of Path.t|`Var of Path.t|`New of Path.t]
+        * Types.type_expr
+  | `Class of Path.t * Types.class_type
+  | `Module of Path.t * Types.module_type
+]
+val search_pos_structure :
+    pos:int -> Typedtree.structure_item list ->
+    (fkind * Env.t * Location.t) list
+val view_type : fkind -> env:Env.t -> unit
+val view_type_menu : fkind -> env:Env.t -> GMenu.menu
+
+val parent_path : Path.t -> Path.t option
+val string_of_path : Path.t -> string
+val string_of_longident : Longident.t -> string
+val lines_to_chars : int -> text:string -> int
+
diff --git a/applications/browser/shell.ml b/applications/browser/shell.ml
new file mode 100644
index 0000000..03d9a82
--- /dev/null
+++ b/applications/browser/shell.ml
@@ -0,0 +1,288 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open StdLabels
+module Unix = UnixLabels
+open GdkKeysyms
+open Printf
+
+(* Nice history class. May reuse *)
+
+class ['a] history () = object
+  val mutable history = ([] : 'a list)
+  val mutable count = 0
+  method empty = history = []
+  method add s = count <- 0; history <- s :: history
+  method previous =
+    let s = List.nth history count in
+    count <- (count + 1) mod List.length history;
+    s
+  method next =
+    let l = List.length history in
+    count <- (l + count - 1) mod l;
+    List.nth history ((l + count - 1) mod l)
+end
+
+(* The shell class. Now encapsulated *)
+
+let protect f x = try f x with _ -> ()
+
+class shell ~prog ~args ~env ?packing ?show () =
+  let (in2,out1) = Unix.pipe ()
+  and (in1,out2) = Unix.pipe ()
+  and (err1,err2) = Unix.pipe () in
+  let _ = List.iter ~f:Unix.set_nonblock [out1;in1;err1] in
+  let view = GText.view ?packing ?show () in
+  let buffer = view#buffer in
+object (self)
+  inherit GObj.widget view#as_widget
+  val pid = Unix.create_process_env
+      ~prog ~args ~env ~stdin:in2 ~stdout:out2 ~stderr:err2
+  val out = Unix.out_channel_of_descr out1
+  val h = new history ()
+  val mutable alive = true
+  val mutable reading = false
+  val input_start =
+    `MARK (buffer#create_mark ~left_gravity:true buffer#start_iter)
+  method private position = buffer#get_iter `INSERT
+  method private input_start = buffer#get_iter (input_start :> GText.position)
+  method private set_input_start () =
+    buffer#move_mark input_start self#position
+  method textview = view
+  method alive = alive
+  method kill () =
+    view#set_editable false;
+    if alive then begin
+      alive <- false;
+      protect close_out out;
+      List.iter ~f:(protect Unix.close) [in1; err1; in2; out2; err2];
+      try
+	Unix.kill ~pid ~signal:Sys.sigkill;
+	Unix.waitpid pid ~mode:[]; ()
+      with _ -> ()
+    end
+  method interrupt () =
+    if alive then try
+      reading <- false;
+      Unix.kill ~pid ~signal:Sys.sigint
+    with Unix.Unix_error _ -> ()
+  method send s =
+    if alive then try
+      output_string out s;
+      flush out
+    with Sys_error _ -> ()
+  method private read ~fd ~len =
+    try
+      let buf = Bytes.create len in
+      let len = Unix.read fd ~buf ~pos:0 ~len in
+      if len > 0 then begin
+	buffer#place_cursor buffer#end_iter;
+	self#insert (Bytes.sub_string buf ~pos:0 ~len);
+	self#set_input_start ();
+      end;
+      len
+    with Unix.Unix_error _ -> 0
+  method history (dir : [`next|`previous]) =
+    if not h#empty then begin
+      if reading then begin
+	buffer#delete ~start:(self#input_start) ~stop:(self#position);
+      end else begin
+	reading <- true;
+	self#set_input_start ();
+      end;
+      self#insert (if dir = `previous then h#previous else h#next);
+    end
+  method private lex ~start ~stop =
+    if start#compare stop < 0 then Lexical.tag buffer ~start ~stop
+  method insert text =
+    buffer#insert text
+  method private keypress c =
+    if not reading && c > " " then begin
+      reading <- true;
+      self#set_input_start ();
+    end
+  method private return () =
+    if reading then reading <- false else begin
+      let rec search (it : GText.iter) =
+        match it#backward_search "# " with None -> it
+        | Some (it1, it2) ->
+            if it1#starts_line then it2
+            else search it1
+      in
+      buffer#move_mark input_start (search self#position)
+    end;
+    let stop = self#position#forward_to_line_end in
+    buffer#place_cursor stop;
+    let s = buffer#get_text ~start:(self#input_start) ~stop () in
+    buffer#place_cursor buffer#end_iter;
+    h#add s;
+    self#send s;
+    self#send "\n"
+  method private paste () =
+    if not reading then begin
+      reading <- true;
+      self#set_input_start ();
+    end
+  initializer
+    Lexical.init_tags buffer;
+    view#misc#modify_font_by_name "monospace";
+    view#misc#set_size_chars ~width:80 ~height:25 ~lang:"C" ();
+    view#event#connect#key_press ~callback:
+      begin fun ev ->
+	if GdkEvent.Key.keyval ev = _Return && GdkEvent.Key.state ev = []
+	then self#return ()
+	else self#keypress (GdkEvent.Key.string ev);
+        false
+      end;
+    buffer#connect#after#insert_text ~callback:
+      begin fun it s ->
+        let start = it#backward_chars (String.length s) in
+        self#lex ~start:(start#set_line_index 0) ~stop:it#forward_to_line_end;
+        view#scroll_mark_onscreen `INSERT
+      end;
+    buffer#connect#after#delete_range ~callback:
+      begin fun ~start ~stop ->
+        let start = start#set_line_index 0
+        and stop = start#forward_to_line_end in
+        self#lex ~start ~stop
+      end;
+    view#event#connect#button_press ~callback:
+      begin fun ev ->
+	if GdkEvent.Button.button ev = 2 then self#paste ();
+	false
+      end;
+    view#connect#destroy ~callback:self#kill;
+    GMain.Timeout.add ~ms:100 ~callback:
+      begin fun () ->
+	if alive then begin
+	  List.iter [err1;in1]
+	    ~f:(fun fd -> while self#read ~fd ~len:1024 = 1024 do () done);
+	  true
+	end else false
+      end;
+    ()
+end
+
+(* Specific use of shell, for LablBrowser *)
+
+let shells : (string * shell) list ref = ref []
+
+(* Called before exiting *)
+let kill_all () =
+  List.iter !shells ~f:(fun (_,sh) -> if sh#alive then sh#kill ());
+  shells := []
+let _ = at_exit kill_all
+
+let get_all () =
+  let all = List.filter !shells ~f:(fun (_,sh) -> sh#alive) in
+  shells := all;
+  all
+
+let may_exec prog =
+  try Unix.access prog ~perm:[Unix.X_OK]; true
+  with Unix.Unix_error _ -> false
+
+let f ~prog ~title =
+  let progargs =
+    List.filter ~f:((<>) "") (Str.split (Str.regexp " ") prog) in
+  if progargs = [] then () else
+  let prog = List.hd progargs in
+  let path = try Sys.getenv "PATH" with Not_found -> "/bin:/usr/bin" in
+  let exec_path = Str.split (Str.regexp":") path in
+  let prog =
+    if not (Filename.is_implicit prog) then
+      if may_exec prog then prog else ""
+    else
+      List.fold_left exec_path ~init:"" ~f:
+	begin fun acc dir ->
+	  if acc <> "" then acc else
+	  let prog = Filename.concat dir prog in
+	  if may_exec prog then prog else acc
+	end
+  in
+  if prog = "" then () else
+  let reg = Str.regexp "TERM=" in
+  let env = Array.map (Unix.environment ()) ~f:
+      begin fun s ->
+ 	if Str.string_match reg s 0 then "TERM=dumb" else s
+      end in
+  let load_path =
+    List.flatten (List.map !Config.load_path ~f:(fun dir -> ["-I"; dir])) in
+  let args = Array.of_list (progargs @ load_path) in
+  let current_dir = ref (Unix.getcwd ()) in
+
+  let tl = GWindow.window ~title () in
+  let vbox = GPack.vbox ~packing:tl#add () in
+  let menus = GMenu.menu_bar ~packing:vbox#pack () in
+  let f = new GMenu.factory menus in
+  let accel_group = f#accel_group in
+  let file_menu = f#add_submenu "File"
+  and history_menu = f#add_submenu "History"
+  and signal_menu = f#add_submenu "Signal" in
+
+  let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~packing:vbox#add () in
+  let sh = new shell ~prog ~env ~args ~packing:sw#add () in
+
+  let f = new GMenu.factory file_menu ~accel_group in
+  f#add_item "Use..." ~callback:
+    begin fun () ->
+      File.dialog ~title:"Use File" ~filename:(!current_dir ^ "/") () ~callback:
+	begin fun name ->
+	  current_dir := Filename.dirname name;
+	  if Filename.check_suffix name ".ml" then
+	    let cmd = "#use \"" ^ name ^ "\";;\n" in
+	    sh#insert cmd;
+	    sh#send cmd
+	end
+    end;
+  f#add_item "Load..." ~callback:
+    begin fun () ->
+      File.dialog ~title:"Load File" ~filename:(!current_dir ^ "/") () ~callback:
+	begin fun name ->
+	  current_dir := Filename.dirname name;
+	  if Filename.check_suffix name ".cmo"
+          || Filename.check_suffix name ".cma"
+	  then
+	    let cmd = Printf.sprintf "#load \"%s\";;\n" name in
+	    sh#insert cmd;
+	    sh#send cmd
+	end
+    end;
+  f#add_item "Import path" ~callback:
+    begin fun () ->
+      List.iter (List.rev !Config.load_path)
+	~f:(fun dir -> sh#send (sprintf "#directory \"%s\";;\n" dir))
+    end;
+  f#add_item "Close" ~key:_W ~callback:tl#destroy;
+
+  let h = new GMenu.factory history_menu ~accel_group ~accel_modi:[`MOD1] in
+  h#add_item "Previous" ~key:_P ~callback:(fun () -> sh#history `previous);
+  h#add_item "Next" ~key:_N ~callback:(fun () -> sh#history `next);
+  let s = new GMenu.factory signal_menu ~accel_group in
+  s#add_item "Interrupt" ~key:_G ~callback:sh#interrupt;
+  s#add_item "Kill" ~callback:sh#kill;
+  shells := (title, sh) :: !shells;
+  tl#add_accel_group accel_group;
+  tl#show ()
diff --git a/applications/browser/useunix.ml b/applications/browser/useunix.ml
new file mode 100644
index 0000000..6bc286c
--- /dev/null
+++ b/applications/browser/useunix.ml
@@ -0,0 +1,59 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open Unix
+
+let get_files_in_directory dir =
+  try
+  let dirh = opendir dir in
+  let rec get_them () =
+    try
+      let x = readdir dirh in
+      x :: get_them ()
+    with
+      _ -> closedir dirh; [] 
+  in
+    Sort.list ~order:(<) (get_them ())
+  with Unix_error _ -> []
+
+let is_directory name =
+  try
+    (stat name).st_kind = S_DIR
+  with _ -> false
+
+let get_directories_in_files ~path =
+  List.filter ~pred:(fun x -> is_directory  (path ^ "/" ^ x))
+
+(************************************************** Subshell call *)
+let subshell ~cmd =
+  let rc = open_process_in ~cmd in
+  let rec it () =
+    try 
+      let x = input_line rc in x :: it ()
+    with _ -> []
+  in 
+  let answer = it () in
+  close_process_in rc;
+  answer
diff --git a/applications/browser/widgets.ml b/applications/browser/widgets.ml
new file mode 100644
index 0000000..30c6cbf
--- /dev/null
+++ b/applications/browser/widgets.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open GObj
+
+class multibox ~rows ~columns ?(row_view = rows) ?(col_view = columns)
+    ?packing ?show () =
+  let sw =
+    GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
+      ?show ?packing () in
+  let vp = GBin.viewport ~shadow_type:`NONE ~packing:sw#add in
+  let table =
+    GPack.table ~columns ~rows ~homogeneous:true ~packing:vp#add () in
+  let buttons =
+    Array.init ~len:columns
+      ~f:(fun left -> Array.init ~len:rows
+	  ~f:(fun top -> GButton.button
+              ~packing:(table#attach ~top ~left ~expand:`BOTH)))
+  in
+  object (self)
+    inherit widget sw#as_widget
+    method cell ~col ~row = buttons.(col).(row)
+    initializer
+      let id = ref None in
+      id := Some
+	  (sw#event#connect#expose ~after:true ~callback:
+	     begin fun _ ->
+	       may !id ~f:sw#connect#disconnect;
+	       let height = table#misc#allocation.height * row_view / rows
+	       and width = table#misc#allocation.width * col_view / columns in
+	       vp#misc#set_size ~height ~width;
+	       false
+	     end);
+      table#focus#set_vadjustment vp#vadjustment
+  end
diff --git a/applications/camlirc/.depend b/applications/camlirc/.depend
new file mode 100644
index 0000000..7324b6f
--- /dev/null
+++ b/applications/camlirc/.depend
@@ -0,0 +1,53 @@
+cf_manager.cmo: i_channel.cmi 
+cf_manager.cmx: i_channel.cmi 
+channel.cmo: ctcp.cmo i_channel.cmi members.cmo message.cmo \
+    message_handler.cmo message_utils.cmo reply.cmo server.cmo 
+channel.cmx: ctcp.cmx i_channel.cmi members.cmx message.cmx \
+    message_handler.cmx message_utils.cmx reply.cmx server.cmx 
+channelview.cmo: cf_manager.cmo general_channel.cmo message.cmo \
+    message_handler.cmo message_utils.cmo 
+channelview.cmx: cf_manager.cmx general_channel.cmx message.cmx \
+    message_handler.cmx message_utils.cmx 
+control.cmo: channelview.cmo constants.cmo message_handler.cmo server.cmo 
+control.cmx: channelview.cmx constants.cmx message_handler.cmx server.cmx 
+ctcp.cmo: message.cmo message_utils.cmo 
+ctcp.cmx: message.cmx message_utils.cmx 
+entry.cmo: channelview.cmo message_handler.cmo 
+entry.cmx: channelview.cmx message_handler.cmx 
+general_channel.cmo: constants.cmo ctcp.cmo i_channel.cmi message.cmo \
+    message_handler.cmo message_utils.cmo reply.cmo 
+general_channel.cmx: constants.cmx ctcp.cmx i_channel.cmi message.cmx \
+    message_handler.cmx message_utils.cmx reply.cmx 
+global.cmo: ctcp.cmo message.cmo message_handler.cmo message_utils.cmo \
+    reply.cmo 
+global.cmx: ctcp.cmx message.cmx message_handler.cmx message_utils.cmx \
+    reply.cmx 
+irc_widget.cmo: cf_manager.cmo channel.cmo channelview.cmo constants.cmo \
+    control.cmo entry.cmo global.cmo message.cmo message_handler.cmo \
+    server.cmo 
+irc_widget.cmx: cf_manager.cmx channel.cmx channelview.cmx constants.cmx \
+    control.cmx entry.cmx global.cmx message.cmx message_handler.cmx \
+    server.cmx 
+message.cmo: ircArg.cmo prefix.cmo 
+message.cmx: ircArg.cmx prefix.cmx 
+message_handler.cmo: eucjp.cmo message.cmo parser.cmo reply.cmo server.cmo 
+message_handler.cmx: eucjp.cmx message.cmx parser.cmx reply.cmx server.cmx 
+message_utils.cmo: message.cmo 
+message_utils.cmx: message.cmx 
+newmain.cmo: cf_manager.cmo channel.cmo channelview.cmo constants.cmo \
+    control.cmo entry.cmo global.cmo message.cmo message_handler.cmo \
+    server.cmo 
+newmain.cmx: cf_manager.cmx channel.cmx channelview.cmx constants.cmx \
+    control.cmx entry.cmx global.cmx message.cmx message_handler.cmx \
+    server.cmx 
+parser.cmo: ircArg.cmo message.cmo prefix.cmo reply.cmo 
+parser.cmx: ircArg.cmx message.cmx prefix.cmx reply.cmx 
+reply.cmo: ircArg.cmo prefix.cmo 
+reply.cmx: ircArg.cmx prefix.cmx 
+server.cmo: constants.cmo xml.cmo xml_lexer.cmi 
+server.cmx: constants.cmx xml.cmx xml_lexer.cmx 
+xml.cmo: xml_lexer.cmi 
+xml.cmx: xml_lexer.cmx 
+xml_lexer.cmo: xml_lexer.cmi 
+xml_lexer.cmx: xml_lexer.cmi 
+i_channel.cmi: message_handler.cmo server.cmo 
diff --git a/applications/camlirc/Makefile b/applications/camlirc/Makefile
new file mode 100644
index 0000000..1b4b1f9
--- /dev/null
+++ b/applications/camlirc/Makefile
@@ -0,0 +1,85 @@
+# Makefile for IRC Client
+# $Id$
+ARCH=$(shell uname) 
+
+ifeq ($(ARCH), FreeBSD)
+EXTRALIB=-cclib -lxpg4
+endif
+
+THFLAGS = -thread 
+THLIBS = unix.cma threads.cma gtkInit.cmo gtkThread.cmo
+
+CAMLC = ocamlc.opt
+CAMLOPT = ocamlopt.opt
+CAMLLEX = ocamllex
+COMPILER = $(CAMLC) $(MLFLAGS) -g -w msy -labels -c
+LINKER = $(CAMLC) $(MLFLAGS) -custom $(EXTRALIB)
+COMPOPT = $(CAMLOPT) $(MLFLAGS) -w msy -labels -c
+LINKOPT = $(CAMLOPT) $(MLFLAGS) 
+
+SETLIB = 1
+LIBDIR = $(shell ocamlc -where)
+MLFLAGS = $(THFLAGS) -I ../../src
+THOPTLIBS1 = $(THLIBS:.cma=.cmxa)
+THOPTLIBS = $(THOPTLIBS1:.cmo=.cmx)
+
+LIBRARIES = lablgtk.cma str.cma 
+LIBOBJECTS = property.cmo constants.cmo eucjp.cmo \
+	xml_lexer.cmo xml.cmo \
+	server.cmo prefix.cmo ircArg.cmo reply.cmo message.cmo \
+	parser.cmo message_utils.cmo message_handler.cmo ctcp.cmo \
+	members.cmo general_channel.cmo cf_manager.cmo \
+	channel.cmo channelview.cmo global.cmo \
+	control.cmo entry.cmo 
+
+OBJECTS =  $(LIBOBJECTS) newmain.cmo
+
+LIBIRCOBJECTS = $(LIBOBJECTS) irc_widget.cmo
+IRCLIB = irc.cma
+
+all: camlirc
+
+install: camlirc
+	cp camlirc /usr/local/bin
+
+camlirc: $(OBJECTS)
+	$(LINKER) $(LIBRARIES) $(THLIBS) $(OBJECTS) -g -o $@ 
+
+camlirc.opt: $(OBJECTS:.cmo=.cmx)
+	$(LINKOPT) -o $@ $(LIBRARIES:.cma=.cmxa) $(THOPTLIBS) \
+		$(OBJECTS:.cmo=.cmx) -o $@ 
+
+$(IRCLIB): $(LIBIRCOBJECTS)
+	$(CAMLC) -a -custom  $(MLFLAGS) -o $@ $(LIBRARIES) $(LIBIRCOBJECTS)
+
+$(IRCLIB:.cma=.cmxa): $(LIBIRCOBJECTS:.cmo=.cmx)
+	$(CAMLOPT) -a $(MLFLAGS) -o $@  \
+	$(LIBIRCOBJECTS:.cmo=.cmx)
+
+
+.SUFFIXES: .ml .mli .mll .cmo .cmi .cmx .c .o
+.c.o:
+	$(CCOMPILER) $<
+.ml.cmo:
+	$(COMPILER) $<
+.mli.cmi:
+	$(COMPILER) $<
+.ml.cmx:
+	$(COMPOPT) $<
+.mll.ml:
+	$(CAMLLEX) $<
+
+clean:
+	rm -f *.cm* *.o camlirc *~ xml_lexer.ml
+
+depend:
+	ocamldep *.ml *.mli > .depend
+
+xml_lexer.ml: xml_lexer.mll
+
+checkin:
+	cvs commit 
+	cvs commit -m "update date field" -f constants.ml
+
+include .depend
+
diff --git a/applications/camlirc/README b/applications/camlirc/README
new file mode 100644
index 0000000..7213a1e
--- /dev/null
+++ b/applications/camlirc/README
@@ -0,0 +1,26 @@
+	CamlIRC --- 
+	   an IRC (Internet Relay Chat) client written in Ocaml
+
+Requirements:
+	ocaml-3.12 or 4.00
+	lablgtk-2.*
+	
+How to compile:
+	In this directory, just type 'make'.
+
+How to use:
+  Run camlirc.
+  You first need to create a server:
+  * open Configure/Server
+  * press New
+  * input configuration name, press OK
+  * input sever address and configuration
+    example: irc.freenode.net
+  * press Finish
+  Then connect to server:
+  * open File/Connect
+  * choose server, press CONNECT
+  Enter chatroom
+  * open Operation/Join
+  * enter channel name, press OK
+  * input messages in the entry field in the middle of the window
diff --git a/applications/camlirc/cf_manager.ml b/applications/camlirc/cf_manager.ml
new file mode 100644
index 0000000..2977850
--- /dev/null
+++ b/applications/camlirc/cf_manager.ml
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+class channel_factory_manager =
+  object
+    val mutable channel_factory_table : 
+	(string * I_channel.i_channel_factory) list = []
+    method get_key = List.map (fun (s,_) -> s) channel_factory_table
+    method get_constructor s = 
+      (List.assoc s channel_factory_table)#new_channel_object
+    method add_channel_factory f =
+      channel_factory_table <- (f#module_name, f)::channel_factory_table
+  end
+    
+let channel_factory_manager = new channel_factory_manager
diff --git a/applications/camlirc/channel.ml b/applications/camlirc/channel.ml
new file mode 100644
index 0000000..1207954
--- /dev/null
+++ b/applications/camlirc/channel.ml
@@ -0,0 +1,259 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Message_utils
+
+class channel_signals ~(part:string GUtil.signal) 
+    ~(privmsg : (string * string) GUtil.signal)
+    : I_channel.i_channel_signals =
+object
+  inherit GUtil.ml_signals [part#disconnect; privmsg#disconnect]
+  method part = part#connect ~after
+  method privmsg = privmsg#connect ~after
+end 
+
+type channel_flags = 
+    {mutable a : bool; mutable i : bool; mutable m : bool; mutable n : bool; 
+     mutable q : bool; mutable p : bool; mutable s : bool; mutable r : bool;
+     mutable t : bool }
+
+let mem_space = Str.regexp "[ \t]+"
+
+let rec take_n n l =
+  if n = 0 then l
+  else 
+    match l with 
+      [] -> []
+    | (_::ltl) -> take_n (n-1) ltl
+
+let check_channel_flags s cf =
+  let v = ref false 
+  and ms = ref ""
+  and uparams = ref 0
+  and oparams = ref 0
+  in 
+  for i = 0 to (String.length s)-1 do
+    (match s.[i] with 
+      'a' -> cf.a  <- !v | 'i' -> cf.i  <- !v | 'm' -> cf.m <- !v
+    | 'n' -> cf.n  <- !v | 'q' -> cf.q  <- !v | 'p' -> cf.p <- !v
+    | 's' -> cf.s  <- !v | 'r' -> cf.r  <- !v | 't' -> cf.t <- !v 
+    | 'o' -> uparams := !uparams + 1 | 'v' -> oparams := !oparams + 1
+    | 'k' -> oparams := !oparams + 1 | 'l' -> oparams := !oparams + 1
+    | 'b' -> oparams := !oparams + 1 | 'e' -> oparams := !oparams + 1
+    | 'I' -> oparams := !oparams + 1 | '-' -> v := false | '+' -> v := true 
+    | _ -> ())
+  done;
+  (!uparams, !oparams)
+
+let rec check_channel_string ml cf o =
+  match ml with 
+    [] -> o
+  | (m::mtl) -> 
+      let (newun, newon) = check_channel_flags m cf
+      in
+      check_channel_string 
+	(take_n (newun+newon) mtl) cf ((newun > 0) || o)
+
+let message_text nick message =
+   Printf.sprintf "<%s> %s" nick message
+and my_message_text nick message =
+  Printf.sprintf ">%s< %s" nick message
+
+let mode_string t = List.fold_left (fun s t -> s^t^" ") "" t
+
+let channel_flag_string cf =
+  String.concat ""
+    (List.map2 (fun flag str -> if flag then str else "")
+       [cf.a;cf.i;cf.m;cf.n;cf.q;cf.p;cf.s;cf.r;cf.t]
+       ["a";"i";"m";"n";"q";"p";"s";"r";"t"])
+
+let set_topic label channel_name t = label#set_text (channel_name^" :"^t)
+and set_mode label t = label#set_text (" ["^t^"]")
+
+class channel ~(handler:Message_handler.irc_message_handler) 
+    ~(channel_name: string) ~(server:Server.server_info) 
+    ?packing ?show () : I_channel.i_channel =
+  let vb = GPack.vbox ?packing ?show ()
+  and adj = GData.adjustment ()
+  in
+  let topic_hb = GPack.hbox ~packing:vb#pack ~border_width:2 ()
+  in
+  let label = GMisc.label ~xalign:0.0 ~text:channel_name 
+      ~packing:topic_hb#pack ()
+  and mode_label = GMisc.label ~packing:topic_hb#pack ()
+  and control_hb =
+    GPack.button_box `HORIZONTAL ~packing:(topic_hb#pack ~from:`END) 
+      ~spacing:4 ()
+  in
+  let hb = GPack.hbox ~packing:(vb#pack ~expand:true) ()
+  in
+  let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~packing:hb#add () in
+  let view = GText.view ~packing:sw#add ()
+  and members = new Members.members ~width:100 ~packing:hb#pack ()
+  and h = handler
+  in
+  let names_buffer : string list ref = ref []
+  in
+  let cf = { a = false; i = false; m = false; n = false;
+	     q = false; p = false; s = false; r = false; t = false }
+  in
+  let colormap = view#misc#colormap
+  in
+  let red   = view#buffer#create_tag [`FOREGROUND "red"]
+  and green = view#buffer#create_tag [`FOREGROUND "green"]
+  and blue  = view#buffer#create_tag [`FOREGROUND "blue"]
+  in
+  let part =  new GUtil.signal ()
+  in
+  let m_check m =
+    match m with
+      (Some (name,_,_) , Message.MSG_PRIVATE, Some [c;m]) -> 
+	if c = channel_name then
+	  print_text ~u_tags:[red] ~emit:(server#auto_url_open())
+	    view (message_text name m)
+	else if name = channel_name then
+	  print_text ~u_tags:[red] ~emit:(server#auto_url_open())
+	    view (message_text name m)
+    | (None , Message.MSG_PRIVATE, Some [c;m]) -> 
+	if c = channel_name then
+	  print_text ~u_tags:[red] view 
+	    (message_text channel_name m)
+    | (Some (name,_,_), Message.MSG_TOPIC, Some [c;t]) ->
+	if c = channel_name then 
+	  begin 
+	    set_topic label channel_name t;
+	    print_text ~tags:[green] view 
+	      ("Topic set by "^name^": "^t)
+	  end
+    | (Some (n, _, _), Message.MSG_JOIN, Some [c]) ->
+	if c = channel_name then 
+	  (members#append n; 
+	   print_text ~tags:[red]
+	     view ("***  "^n^" has joined "^c); 
+	   ())
+    | (Some (n, _, _), Message.MSG_PART, Some [c; m]) ->
+	begin
+	  if c = channel_name then 
+	    begin
+	      (members#remove n;
+	       print_text ~tags:[red]
+		 view ("***  "^n^" has left "^c^" ("^m^")"); ());
+	      if n = server#nick () then
+		part#call ((handler#server)#part_message ());
+	    end
+	end
+    | (Some (n, _, _), Message.MSG_QUIT, Some [m]) ->
+	if members#check n then 
+	  begin
+	    members#remove n;
+	    print_text ~tags:[red]
+	      view ("***  "^n^" has left IRC. ("^m^")"); ()
+	  end
+    | (Some (n, _, _), Message.MSG_NICK, Some [new_n]) ->
+	begin
+	  print_text ~tags:[blue]
+	    view ("***  "^n^" is now known as "^new_n^"."); 
+	  members#change n new_n
+	end
+    | (Some (n, _, _), Message.MSG_MODE, Some (c::t)) ->
+	if c = channel_name then 
+	  begin
+	    print_text ~tags:[blue] view 
+	      ("New mode set by "^n^":"^(mode_string t));
+	    let
+		need_names = check_channel_string t cf false
+	    in
+	    set_mode mode_label (channel_flag_string cf);
+	    if need_names then 
+	      handler#send_message (None, Message.MSG_NAMES, Some [c]);
+	  end
+    | _ -> ()
+  and r_check r =
+    match r with 
+      Reply.Command (f, cr, arg)  ->
+	begin
+	  match (f,cr,arg) with 
+	    (_, Reply.RPL_TOPIC, Some [_;c;t]) ->  
+	      if c = channel_name then 
+		begin
+		  set_topic label channel_name t; 
+		  print_text ~tags:[green] view 
+		    ("Topic for this channel: "^t)
+		end
+	  | (_, Reply.RPL_NAMREPLY, Some [_;_;c;t]) -> 
+	      if c = channel_name then 
+		names_buffer := (Str.split mem_space t)@(!names_buffer)
+	  | (_, Reply.RPL_ENDOFNAMES, Some (_::c::_)) ->
+	      if c = channel_name then
+		begin
+		  members#clear ();
+		  List.map (fun s -> members#append s) (!names_buffer);
+		  names_buffer := []
+		end
+	  | (_, Reply.RPL_CHANNELMODEIS, Some (_::c::t)) -> 
+	      if c = channel_name 
+	      then 
+		begin
+		  check_channel_string t cf false;
+		  set_mode mode_label (channel_flag_string cf)
+		end
+	  | _ -> ()
+	end
+    | _ -> ()
+  in      
+  object (self)
+    inherit GObj.widget vb#as_widget
+    val view = view
+    val channelname = channel_name
+    val part = part
+    val privmsg = new GUtil.signal ()
+    method part = part
+    method part_command () =
+      h#send_message (None, Message.MSG_PART, 
+		      Some [self#channelname; 
+			    ":"^((handler#server)#part_message ())]);
+      self#part#call ((handler#server)#part_message ())
+    method topic_command () = 
+      Message_utils.topic_dialog ~handler:h ~channelname
+    method ctcp_command () =
+      Ctcp.send_ctcp_dialog ~handler:h ~members
+    method connect = new channel_signals ~part ~privmsg
+    method channelname = channelname
+    method initialize () = ()
+    method my_message = 
+      (fun x -> print_text ~u_tags:[red] view 
+	  (my_message_text (server#nick ()) x))
+    initializer
+      h#connect#message ~callback:m_check;
+      h#connect#reply ~callback:r_check;
+      members#connect#selected 
+	~callback:
+	(fun nick -> Message_utils.send_whois ~handler:h ~nick);
+      handler#send_message (None, Message.MSG_MODE, Some [channelname]);
+      ()
+  end
+
+class channel_factory : I_channel.i_channel_factory =
+  object
+    method module_name = "Text"
+    method new_channel_object 
+	~handler ~channel_name ~server ?packing ?show () = 
+      new channel ~handler ~channel_name ~server ?packing ?show ()
+  end
diff --git a/applications/camlirc/channelview.ml b/applications/camlirc/channelview.ml
new file mode 100644
index 0000000..2e8518d
--- /dev/null
+++ b/applications/camlirc/channelview.ml
@@ -0,0 +1,228 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+exception No_channel
+
+class channels_signals ~(channel_changed: string GUtil.signal) =
+  object
+    inherit GUtil.ml_signals [channel_changed#disconnect]
+    method channel_changed = channel_changed#connect ~after
+	
+  end
+
+class channels ~(handler:Message_handler.irc_message_handler)
+    ?packing ?show ?(width = 640) ?(height = 400)() =
+  let note = GPack.notebook ?packing ?show ~width ~height ()
+  and channel_changed = new GUtil.signal ()
+  in
+  let add_channel_page channel_name cv =
+    let tab_label = GMisc.label ~text:channel_name ()
+    and menu_label = GMisc.label ~text:channel_name ()
+    in
+    note#append_page ~tab_label:tab_label#coerce
+      ~menu_label:menu_label#coerce cv#coerce
+   in
+   object (self)
+     inherit GObj.widget note#as_widget
+     val note = note
+     val handler = handler
+     val mutable current_channel = None
+     val mutable channel_list = []
+     val mutable notify_channel_list = []
+     val mutable requested_channel_list = []
+     val mutable init_comp_id = None
+     val connect = new channels_signals ~channel_changed
+     val channel_changed = channel_changed 
+     method private cv_part_callback cv =
+       (fun _ -> 
+	 let
+	     id = note#page_num cv#coerce
+	 in
+	 if id >= 0 then 
+	   begin
+	     note#remove_page id;
+	     channel_list <- 
+	       List.filter (fun (_,n) -> not (n = id)) channel_list
+	   end)
+     method add_channel channel_name channel_mode =
+       begin
+	 try
+	   let 
+	       (s, n) = 
+	     List.find (fun (s,_) -> s#channelname = channel_name) 
+	       channel_list
+	   in
+	   self#set_channel s
+	 with 
+	   Not_found ->
+	     try 
+	       begin
+	       (* check server *)
+		 handler#server;
+		 handler#send_message(None, Message.MSG_JOIN,
+				      Some [channel_name]);
+		 requested_channel_list 
+		 <- (channel_name, channel_mode)::requested_channel_list 
+	       end
+	     with
+	       Message_handler.Server_not_configured -> ()
+       end
+     method add_priv priv_name =
+       begin
+	 try
+	   let 
+	       (s, n) = 
+	     List.find (fun (s,_) -> s#channelname = priv_name) 
+	       channel_list
+	   in
+	   self#set_channel s
+	 with 
+	   Not_found -> 
+	     try 
+	       begin
+		 let 
+		     cv = 
+		   (Cf_manager.channel_factory_manager#get_constructor "Text")
+		     ~handler ~channel_name:priv_name 
+		     ~server:(handler#server) ()
+		 in
+		 add_channel_page priv_name cv;
+		 cv#initialize ();
+		 (handler#server)#add_channel_list priv_name "General";
+		 channel_list <- 
+		   (cv, note#page_num cv#coerce) :: channel_list;
+		 self#set_channel cv
+	       end
+	     with
+	       Message_handler.Server_not_configured -> ()
+       end
+     method set_channel c = 
+       try
+	 let
+	     (_, n) = List.find (fun (s, _) -> 
+	       s#channelname = c#channelname) channel_list
+	 in
+	 current_channel <- Some c;
+	 note#goto_page n;
+	 channel_changed#call c#channelname
+       with
+	 Not_found -> raise No_channel
+     method current_channel () = 
+       match current_channel with
+	 Some c -> c | None -> raise No_channel
+     method send_message s = 
+       (self#current_channel ())#my_message s;
+
+       handler#send_message(None, Message.MSG_PRIVATE,
+			    Some [(self#current_channel ())#channelname;
+				  " :"^s])
+     initializer
+       handler#connect#message 
+	 ~callback:
+	 (fun m -> 
+	   begin
+	     match m with 
+	       (Some (n, _, _), Message.MSG_JOIN, Some [c]) ->
+		 let
+		     c_mode = 
+		   try
+		     List.assoc c requested_channel_list
+		   with 
+		     Not_found -> "Text"
+		 in
+		 let 
+		     cv = 
+		   (Cf_manager.channel_factory_manager#get_constructor c_mode)
+		     ~handler ~channel_name:c ~server:(handler#server) ()
+		 in
+		 if n = (handler#server)#nick () then
+		   begin
+		     add_channel_page c cv;
+		     cv#initialize ();
+		     (handler#server)#add_channel_list c c_mode;
+		     cv#connect#part ~callback:(self#cv_part_callback cv);
+		     channel_list <- 
+		       (cv, note#page_num cv#coerce) :: channel_list;
+		     self#set_channel cv;
+		     requested_channel_list <-
+		       List.filter (fun (s,_) -> not (s = c)) 
+			 requested_channel_list
+		   end
+	     | (Some (n, _, _), Message.MSG_NICK, Some [new_n]) ->
+		 if n = (handler#server#nick ()) then 
+		   handler#server#set_nick new_n
+	     | _ -> ()
+	   end);
+       handler#connect#connected
+	 ~callback:(fun () ->
+	   let general = new General_channel.general_channel ~handler ()
+	   in 
+	   general#connect#privmsg
+	     ~callback:(fun (ch, m) ->
+	       if List.exists 
+		   (fun s -> s = ch) notify_channel_list then
+		 begin
+		   let w = GWindow.dialog 
+		       ~title:"message" ~modal:true ()
+		   in
+		   let _ = GMisc.label ~text:ch ~packing:w#vbox#add ()
+		   and pb = GButton.button ~label:"OK" ~packing:w#vbox#add ()
+		   in
+		   begin 
+		     pb#connect#clicked 
+		       ~callback:(fun () -> w#destroy ());
+		     w#show ();
+		     ()
+		   end;
+		 end);
+	   add_channel_page "*Console*" general;
+	   channel_list <-  [(general, note#page_num general#coerce)];
+	   current_channel <- Some general );
+       init_comp_id <- 
+	 Some (handler#connect#init_complete
+		 ~callback:(fun () -> List.map 
+		     (fun (channel, mode) -> (* print_string channel; *)
+		       Message_utils.send_join ~handler ~channel;
+		       requested_channel_list 
+		       <- (channel, mode):: requested_channel_list)
+		     ((handler#server)#channel_list ());
+		   ()));
+       note#connect#switch_page
+	~callback:
+	(fun n -> 
+	  try 
+	    let
+		(s, _) = List.find (fun (_, id) -> n = id) channel_list
+	    in
+	    current_channel <- Some s;
+	    channel_changed#call s#channelname
+	  with 
+	    Not_found -> current_channel <- None);
+      handler#connect#disconnected
+	~callback:
+	(fun () -> 
+	  List.map (fun (cv, _) -> 
+	    let id = note#page_num cv#coerce
+	    in if id >= 0 then note#remove_page id) channel_list;
+	  channel_list <- [];
+	());
+      ()
+  end
+      
diff --git a/applications/camlirc/constants.ml b/applications/camlirc/constants.ml
new file mode 100644
index 0000000..34fb8b0
--- /dev/null
+++ b/applications/camlirc/constants.ml
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Str
+open Unix
+
+let doctype = Printf.sprintf "Caml IRC client %d.%d" 1 1
+let software = "CamlIRC"
+let version = "0.01"
+let datestring = 
+  match split (regexp " ") "$Date$" with
+  | [_;date;time;_] ->
+      date^"-"^(global_replace (regexp ":") "-" time) 
+  | _ -> "" 
+
+(* *)
+
+let id = software^" "^version^"("^datestring^")"
+and author = ""
+
+(* getlogin doesn't work all the time.  I observe it to raise an
+   exception when I log in via xdm on my Debian system, March 21, 2002.
+   Using getpwuid instead.  tim@fungible.com. *)
+
+let user_entry = getpwuid (getuid ());;
+
+let config_file = user_entry.pw_dir^"/.camlirc.xml";;
diff --git a/applications/camlirc/control.ml b/applications/camlirc/control.ml
new file mode 100644
index 0000000..89fddda
--- /dev/null
+++ b/applications/camlirc/control.ml
@@ -0,0 +1,436 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+class irc_control_signals =
+  object
+    inherit GUtil.ml_signals []
+  end
+
+let rec gen_int_list ~from_n ~to_n =
+  if from_n = to_n then []
+  else from_n::(gen_int_list ~from_n:(from_n+1) ~to_n)
+
+let join h c = 
+  fun () ->
+    let w = GWindow.dialog ~title:"JOIN" ~modal:true ~position:`CENTER ()
+    in 
+    let title = GBin.frame 
+	~shadow_type:`OUT ~packing:w#vbox#add ()
+    in
+    let entry_h = GPack.hbox ~packing:w#vbox#add ()
+    and mode_h = GPack.hbox ~packing:w#vbox#add ()
+    in
+    let e_label = GMisc.label ~text:"Channel Name" ~packing:entry_h#add ()
+    and e_entry = GEdit.entry ~packing:entry_h#add ()
+    and hbox = GPack.hbox ~packing:w#vbox#add ()
+    in
+    let ok_b = GButton.button  ~label:"OK" ~packing:hbox#add ()
+    and cancel_b = GButton.button  ~label:"cancel" ~packing:hbox#add ()
+    in
+    let _ = ok_b#connect#clicked 
+	~callback:
+	(fun () -> c#add_channel e_entry#text "Text";
+	  w#destroy ();
+	  ());
+    and _ = e_entry#connect#activate
+	~callback:
+	(fun () -> c#add_channel e_entry#text "Text";
+	  w#destroy ();
+	  ()); 
+    and _ = cancel_b#connect#clicked ~callback:(fun () -> w#destroy (); ())
+    in
+    w#show()
+
+let priv h c = 
+  fun () ->
+    let w = GWindow.dialog ~title:"PRIV" ~modal:true ~position:`CENTER ()
+    in 
+    let title = GBin.frame 
+	~shadow_type:`OUT ~packing:w#vbox#add ()
+    in
+    let hbox_entry = GPack.hbox ~packing:title#add ()
+    in
+    GMisc.label ~text:"Nickname:" ~packing:hbox_entry#add ();
+    let entry = GEdit.entry ~packing:hbox_entry#add ()
+    and hbox = GPack.hbox ~packing:w#vbox#add ()
+    in
+    let ok_b = GButton.button  ~label:"OK" ~packing:hbox#add ()
+    and cancel_b = GButton.button  ~label:"cancel" ~packing:hbox#add ()
+    in
+    let _ = ok_b#connect#clicked 
+	~callback:
+	(fun () -> c#add_priv entry#text;
+	  w#destroy ();
+	  ());
+    and _ = entry#connect#activate
+	~callback:
+	(fun () -> c#add_priv entry#text;
+	  w#destroy ();
+	  ()); 
+    and _ = cancel_b#connect#clicked ~callback:(fun () -> w#destroy (); ())
+    in
+    w#show()
+  
+let connect h s = fun () ->
+  let w = GWindow.dialog ~title:"Connect" ~modal:true ~position:`CENTER ()
+  in 
+  let title = GBin.frame
+    ~shadow_type:`OUT ~packing:w#vbox#add () in 
+  GMisc.label ~text:"Server" ~packing:title#add ();
+  let server_selection = 
+    GEdit.combo ~popdown_strings:(s#server_names())
+      ~value_in_list:true ~packing:w#vbox#add ~allow_empty:true ()
+  and ok_button =
+    GButton.button ~label:"CONNECT" ~packing:w#vbox#add ()
+  in
+  let _ =
+    ok_button#connect#clicked
+      ~callback:
+      (fun () ->
+	try 
+	  let 
+	      new_s = s#get_server_setting server_selection#entry#text
+	  in
+	  begin
+	    h#set_server new_s;
+	    w#destroy ();
+	    h#reload_server ();
+	    h#start_connection ();
+	    h#initial_sequence ()
+	  end
+	with 
+	  Server.Config_error ->
+	    let w = GWindow.dialog ~title:"ERROR" 
+		~modal:true ~position:`CENTER ()
+	    in
+	    let _ = GMisc.label ~text:"Config error" ~packing:w#vbox#add ()
+	    and ok_b = GButton.button ~label:"OK"~packing:w#vbox#add ()
+	    in
+	    let _ = ok_b#connect#clicked ~callback:w#destroy
+	    in
+	    w#show ())
+  in
+  w#show()
+
+and disconnect h = fun () ->
+  try
+    if h#status_connected () then
+      begin
+	h#final_sequence ();
+	h#kill_connection () 
+      end
+  with 
+    Message_handler.Server_not_configured -> ()
+
+class one_entry 
+    ~label ?default ?visibility ?packing ?show ?max_length () =
+  let hb = GPack.hbox ?packing ?show ()
+  in
+  let l = GMisc.label ~text:label ~xalign:0.0 ~packing:hb#pack ()
+  and e = GEdit.entry ?text:default ?visibility ?max_length
+      ~packing:(hb#pack ~from:`END) ()
+  in
+  object
+    method text = e#text
+    method set_text = e#set_text
+  end
+
+class server_selection_signal =
+  object
+    inherit GUtil.ml_signals []
+  end
+
+let new_config_dialog ~setting =
+  let w = GWindow.dialog ~title:"New server" ~modal:true ~position:`CENTER ()
+  in
+  let title = GBin.frame ~shadow_type:`OUT ~packing:w#vbox#add ()
+  in
+  let _ =  GMisc.label ~text:"Enter new server configuration name." 
+      ~packing:title#add ()
+  in
+  let entry = GEdit.entry ~packing:w#vbox#add
+      ~text:(setting#setting_name ()) ()
+  and ok_b = GButton.button ~label:"OK" ~packing:w#vbox#add ()
+  in
+  let _ = entry#connect#activate 
+      ~callback:
+      (fun () ->
+	begin 
+	  setting#set_setting_name entry#text;
+	  w#destroy ()
+	end)
+  and _ = ok_b#connect#clicked 
+      ~callback:
+      (fun () ->
+	begin 
+	  setting#set_setting_name entry#text;
+	  w#destroy ()
+	end)
+  in
+  w#show()
+   
+class config_dialog ~(settings : Server.server_info_list) () =
+  let w = GWindow.dialog ~title:"server configuration" 
+      ~modal:true ~position:`CENTER ()
+  in
+  let title = GBin.frame ~shadow_type:`OUT ~packing:w#vbox#add ()
+  in
+  let config_name = GEdit.combo ~packing:w#vbox#add 
+      ~popdown_strings:(settings#server_names ()) ()
+  and config_hbox = GPack.hbox ~packing:w#vbox#add ()
+  in
+  let config_box = GPack.vbox ~packing:config_hbox#add ()
+  in
+  let _ = settings#connect#changed 
+      ~callback:(fun () ->  
+	config_name#set_popdown_strings (settings#server_names ()))
+  and _ = config_name#entry#set_editable false
+  in
+  let server_entry = new one_entry ~label:"Server:" ~packing:config_box#add ()
+  and port_entry = new one_entry ~label:"Port:" 
+      ~packing:config_box#add ~default:"6667" ()
+  and passwd_entry = new one_entry ~label:"Password:" ~visibility:false 
+      ~packing:config_box#add ()
+  and nick_entry = new one_entry ~label:"Nickname:" 
+      ~packing:config_box#add ~max_length:9 ()
+  and name_entry = new one_entry ~label:"Username:" ~packing:config_box#add ()
+  and f_name_entry = new one_entry ~label:"Name:" ~packing:config_box#add ()
+  and part_msg_entry = new one_entry ~label:"Part Message:" 
+      ~packing:config_box#add ()
+  and quit_msg_entry = new one_entry ~label:"Quit Message:" 
+      ~packing:config_box#add ()
+(*  and auto_connect_toggle = 
+    GButton.check_button ~label:"Auto Connect" ~packing:config_box#add () *)
+  in
+  let channel_box = GPack.vbox ~packing:config_hbox#add ()
+  in
+  let _ = GMisc.label ~text:"Channels" ~packing:channel_box#pack ()
+  and chan_l = GList.clist ~selection_mode:`BROWSE 
+      ~columns:1 ~titles_show:false ~titles:["channel"]
+      ~packing:(channel_box#pack ~expand:true) ()
+  and chan_e_box = GPack.hbox ~packing:channel_box#pack ()
+  in
+  let chan_e = GEdit.entry ~packing:chan_e_box#pack ()
+  and chan_a_b = GButton.button ~label:"add" ~packing:chan_e_box#pack ()
+  and chan_e_b = GButton.button ~label:"delete" ~packing:chan_e_box#pack ()
+  and selected_cell : int option ref = ref None
+  in
+  let _ = chan_a_b#misc#set_sensitive false
+  and _ = chan_e_b#misc#set_sensitive false
+  and _ = chan_l#connect#select_row 
+      ~callback:(fun ~row ~column ~event -> 
+	begin
+	  chan_e_b#misc#set_sensitive true;
+	  selected_cell := Some row
+	end)
+  and _ = chan_a_b#connect#clicked
+      ~callback:
+      (fun () ->
+	begin
+	  chan_l#append [chan_e#text];
+	  chan_e#set_text "";
+	  chan_a_b#misc#set_sensitive false
+	end)
+  and _ = chan_e_b#connect#clicked
+      ~callback:
+      (fun () -> 
+	begin
+	  match !selected_cell with
+	    Some row -> chan_l#remove ~row
+	  | None -> ()
+	end;
+	selected_cell := None;
+	chan_l#unselect_all ();
+	chan_e_b#misc#set_sensitive false)
+  in
+  let _ = chan_e#connect#activate
+      ~callback:
+      (fun () -> 
+	begin
+	  chan_l#append [chan_e#text];
+	  chan_e#set_text "";
+	  chan_a_b#misc#set_sensitive false
+	end)
+  and _ = chan_e#connect#changed
+      ~callback:(fun () -> 
+	chan_a_b#misc#set_sensitive 
+	  (if chan_e#text_length = 0 then false else true))
+  in
+  let buttons = GPack.hbox ~packing:w#vbox#add ~homogeneous:true ()
+  in
+  let new_b = GButton.button  ~label:"New" ~packing:buttons#pack ()
+  and finish_b = GButton.button  ~label:"Finish" ~packing:buttons#pack ()
+  and delete_b = GButton.button  ~label:"Delete" ~packing:buttons#pack ()
+  and cancel_b = GButton.button  ~label:"Cancel" ~packing:buttons#pack ()
+  in
+  let set_server_entry s_info = 
+    begin
+      s_info#set_server server_entry#text;
+      s_info#set_nick nick_entry#text;
+      s_info#set_port (int_of_string port_entry#text);
+      s_info#set_passwd passwd_entry#text;
+      s_info#set_username name_entry#text;
+      s_info#set_fullname f_name_entry#text;
+      s_info#set_part_message part_msg_entry#text;
+      s_info#set_quit_message quit_msg_entry#text;
+      s_info#set_channel_list
+	(List.map (fun n -> chan_l#cell_text n 0, "Text")
+	   (gen_int_list ~from_n:0 ~to_n:chan_l#rows))
+    end
+  and get_server_entry s_info =
+    begin
+      server_entry#set_text (s_info#server ());
+      nick_entry#set_text (s_info#nick ());
+      port_entry#set_text (string_of_int (s_info#port ()));
+      passwd_entry#set_text (s_info#passwd ());
+      name_entry#set_text (s_info#username ());
+      f_name_entry#set_text (s_info#fullname ());
+      part_msg_entry#set_text (s_info#part_message ());
+      quit_msg_entry#set_text (s_info#quit_message ());
+      chan_l#clear ();
+      List.map (fun (s,m)-> chan_l#append [s]) (s_info#channel_list ())
+    end
+  in
+  object (self)
+    val mutable current_setting = None
+    method servers = settings
+    method show () = w#show()
+    method read_setting s = settings#get_server_setting s
+    initializer
+      current_setting <-
+	begin
+	  try Some (self#read_setting config_name#entry#text)
+	  with Server.Config_error -> None
+	end;
+      config_name#entry#connect#activate
+	~callback:(fun () ->
+	  begin
+	    match current_setting with 
+	      Some s -> set_server_entry s
+	    | None -> () 
+	  end;
+	  let s = config_name#entry#text
+	  in
+	  try
+	    let sc =  self#read_setting s 
+	    in
+	    begin
+	      get_server_entry sc;
+	      current_setting <- Some sc
+	    end
+	  with 
+	    Server.Config_error -> 
+	      try
+		let sc = new Server.server_info 
+		    ~setting_name:config_name#entry#text ()
+		in
+		begin
+		  set_server_entry sc;
+		  settings#add_server sc;
+		  current_setting <- Some sc
+		end
+	      with Server.Config_error -> ());
+      config_name#entry#connect#changed
+	~callback:(fun () ->
+	  begin
+	    match current_setting with 
+	      Some s -> 
+		if ((s#setting_name()) = config_name#entry#text) then
+		  begin
+		    set_server_entry s
+		  end
+	    | None -> () 
+	  end;
+	  let s = config_name#entry#text
+	  in
+	  try
+	    let sc =  self#read_setting s 
+	    in
+	    begin
+	      get_server_entry sc;
+	      current_setting <- Some sc
+	    end
+	  with Server.Config_error -> ());
+      new_b#connect#clicked
+	~callback:(fun () ->
+	  begin
+	    match current_setting with 
+	      Some s -> 
+		set_server_entry s;
+		settings#replace_server s;
+	    | None -> () 
+	  end;
+	  try
+	    let s = new Server.server_info 
+		~setting_name:"New" ()
+	    in
+	    let
+		_ = current_setting <- Some s;
+	    in
+	    let _ = s#connect#name_changed 
+		~callback:(fun (from_sn,to_sn) -> 
+		  settings#change_setting_name ~from_sn ~to_sn);
+	    in		
+	    begin
+	      new_config_dialog ~setting:s;
+	      get_server_entry s;
+	      settings#add_server s;
+	    end
+	  with Server.Config_error -> ());
+      delete_b#connect#clicked ~callback:
+	(fun () -> 
+	  settings#delete_server config_name#entry#text;
+	  ());
+      cancel_b#connect#clicked ~callback:
+	(fun () -> 
+	  w#destroy ();
+	  ());
+      finish_b#connect#clicked ~callback:
+	(fun () -> 
+	  begin
+	    match current_setting with 
+	      Some s -> 
+		set_server_entry s
+	    | None -> () 
+	  end;
+	  settings#save_settings ~file:Constants.config_file;
+	  w#destroy ();
+	  ());
+      begin
+      try
+	let 
+	    s = settings#get_server_setting config_name#entry#text
+	in
+	get_server_entry s;
+	current_setting <- Some s;
+	()
+      with Server.Config_error -> ()
+      end;
+      ()
+  end
+
+class irc_control ~(handler:Message_handler.irc_message_handler)
+    ~(channels:Channelview.channels) ~(servers:Server.server_info_list) =
+  object
+    method connect =  connect handler servers 
+    method disconnect = disconnect handler
+    method join = join handler channels
+    method priv = priv handler channels
+  end
diff --git a/applications/camlirc/ctcp.ml b/applications/camlirc/ctcp.ml
new file mode 100644
index 0000000..b7cf75b
--- /dev/null
+++ b/applications/camlirc/ctcp.ml
@@ -0,0 +1,160 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)  
+exception Unknown_ctcp of string
+
+open Str
+
+type ctcp_message =
+    CTCP_VERSION
+  | CTCP_PING
+  | CTCP_ACTION
+  | CTCP_TIME
+
+let get_ctcp_message s =
+  match s with
+    "VERSION" -> CTCP_VERSION
+  | "PING" -> CTCP_PING
+  | "ACTION" -> CTCP_ACTION
+  | "TIME" -> CTCP_TIME
+  | s -> raise (Unknown_ctcp s)
+
+let get_ctcp_string s =
+  match s with
+    CTCP_VERSION -> "VERSION"
+  | CTCP_PING -> "PING"
+  | CTCP_ACTION -> "ACTION"
+  | CTCP_TIME -> "TIME"
+
+let get_current_time () =
+  let
+      t = Unix.localtime (Unix.time ())
+  in
+  string_of_int 
+    (t.Unix.tm_sec + t.Unix.tm_min * 60 + 
+       t.Unix.tm_hour * 3600 + t.Unix.tm_yday * 86400)
+
+let ctime_day_of_the_week d = 
+  let
+      a = [|"Sun";"Mon";"Tue";"Wed";"Thu";"Fri";"Sat"|]
+  in a.(d)
+
+let ctime_month d = 
+  let
+      a = [|"Jan";"Feb";"Mar";"Apr";"May";"Jun";
+	    "Jul";"Aug";"Sep";"Oct";"Nov";"Dec"|]
+  in a.(d)
+
+let ctime tm =
+  Printf.sprintf "%s %s %d %02d:%02d:%02d %d"
+    (ctime_day_of_the_week tm.Unix.tm_wday) 
+    (ctime_month tm.Unix.tm_mon) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
+    tm.Unix.tm_sec (tm.Unix.tm_year + 1900)
+
+let get_current_formatted_time () = ctime (Unix.localtime (Unix.time ()))
+
+let ctcp_regexp = regexp "\001\\([A-Z]+\\)\\(\\|[ \t]+\\(.+\\)\\)\001"
+and p_pos = 1
+and arg_pos = 3
+    
+let check_ctcp m =
+  if string_match ctcp_regexp m 0
+  then Some (get_ctcp_message (matched_group p_pos m),
+	     try Some (matched_group arg_pos m)
+	     with Not_found -> None)
+  else None
+
+
+let send_ctcp ~handler ~ctcp_str ~to_nick ~message =
+  handler#send_message(None, Message.MSG_PRIVATE,
+		       Some [to_nick; 
+			     ":\001"^ctcp_str^
+			     (match message with None -> "" 
+			     | Some m -> " "^m)^"\001"])
+
+let send_ctcp_reply ~handler ~to_nick ~ctcp ?message () =
+  Message_utils.send_notice ~handler ~to_nick 
+    ~message:("\001"^(get_ctcp_string ctcp)^
+	      (match message with None -> "" | Some m -> " "^m)^"\001")
+
+let member_list ~members ~packing =
+  let 
+      a = GEdit.combo ~popdown_strings:(members#member_list) ~packing ()
+  in 
+  a#entry
+  
+let message_entry ~members ~packing = GEdit.entry ~packing ()
+
+let ctcp_strings = 
+  ["VERSION", [];
+   "PING", [];
+   "TIME", [];
+   "ACTION", [message_entry]]
+
+let send_ctcp_dialog ~handler ~members =
+  let
+      w = GWindow.dialog ~title:"CTCP" ~modal:true ~position:`CENTER ()
+  in
+  let title = GBin.frame 
+      ~shadow_type:`OUT ~packing:w#vbox#add ()
+  in
+  let ctcp_name = GEdit.combo
+      ~popdown_strings:(List.map (fun (s,_)-> s) ctcp_strings)
+      ~packing:w#vbox#add ()
+  and ctcp_to = GEdit.combo
+      ~popdown_strings:(members#member_list) ~packing:w#vbox#add ()
+  in
+  let ok_b = GButton.button  ~label:"OK" ~packing:w#vbox#add ()
+  in
+  let _ = ok_b#connect#clicked 
+      ~callback:
+      (fun () ->
+	let  args = List.assoc (ctcp_name#entry#text) ctcp_strings
+	in
+	match args with
+	  [] -> 
+	    begin
+	      send_ctcp 
+		~handler ~ctcp_str:ctcp_name#entry#text 
+		~to_nick:ctcp_to#entry#text
+		~message:None;
+	      w#destroy ()
+	    end
+	| _ ->
+	    let edits = 
+	      List.map (fun f -> f ~members ~packing:w#vbox#add) args
+	      in
+	      let ok2_b = GButton.button  
+		  ~label:"OK" ~packing:w#vbox#add ()	
+	      in
+	      let _ = ok2_b#connect#clicked
+		  ~callback:
+		  (fun () -> 
+		    send_ctcp 
+		      ~handler ~ctcp_str:ctcp_name#entry#text 
+		      ~to_nick:ctcp_to#entry#text
+		      ~message:(Some 
+				  (List.fold_left (fun s k -> s^k) ""
+				     (List.map (fun e -> e#text) edits)));
+		    w#destroy ())
+	      in
+	      ())
+  in
+  w#show ()
diff --git a/applications/camlirc/dune b/applications/camlirc/dune
new file mode 100644
index 0000000..102059b
--- /dev/null
+++ b/applications/camlirc/dune
@@ -0,0 +1,7 @@
+; (executable
+;  (name newmain)
+;  (flags :standard -w -3-9-10-26-27-33 -no-strict-sequence)
+;  (modules_without_implementation i_channel)
+;  (libraries str lablgtk3))
+
+; (ocamllex xml_lexer)
diff --git a/applications/camlirc/entry.ml b/applications/camlirc/entry.ml
new file mode 100644
index 0000000..0bf37aa
--- /dev/null
+++ b/applications/camlirc/entry.ml
@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+class message_entry_signals ~(message: string GUtil.signal)=
+  object
+    inherit GUtil.ml_signals [message#disconnect]
+    method message = message#connect ~after
+  end
+
+class message_entry ~(handler:Message_handler.irc_message_handler)
+    ~(channels:Channelview.channels) ?packing ?show () =
+  let e = GEdit.entry ?packing ?show ()
+  and message = new GUtil.signal ()
+  in
+  let _ = e#connect#activate 
+      ~callback:(fun () -> message#call e#text; e#set_text "")
+  in
+  object
+    val handler = handler
+    val channels = channels
+    method message = message
+    method connect = new message_entry_signals ~message
+  end
diff --git a/applications/camlirc/eucjp.ml b/applications/camlirc/eucjp.ml
new file mode 100644
index 0000000..04447f2
--- /dev/null
+++ b/applications/camlirc/eucjp.ml
@@ -0,0 +1,83 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open String
+open Char
+
+exception Conversion_error
+
+let ntol s =
+  let is_ascii = ref true
+  and dest = Buffer.create 0
+  and str = Stream.of_string s
+  in
+  try
+    while true do
+      let c = Stream.next str in
+      match c with
+	'\027' ->
+	  begin
+	    let c1 = Stream.next str
+	    and c2 = Stream.next str
+	    in
+	    match (c1,c2) with
+	      ('(', 'B') -> is_ascii := true
+	    | ('$', 'B') -> is_ascii := false
+	    | _ -> raise Conversion_error
+	  end
+      | _ ->
+	  Buffer.add_char dest 
+	    (if !is_ascii then c else (chr ((code c) + 128)))
+    done; Buffer.contents dest
+  with Stream.Failure -> Buffer.contents dest
+
+let lton s =
+  let is_ascii = ref true
+  and dest = Buffer.create 0
+  and str = Stream.of_string s
+  in
+  try
+    while true do
+      let c = Stream.next str in
+      if (code c) > 127 then
+	if !is_ascii then
+	  begin
+	    is_ascii := false;
+	    Buffer.add_string dest "\027$B";
+	    Buffer.add_char dest (chr ((code c) - 128))
+	  end
+	else Buffer.add_char dest (chr ((code c) - 128))
+      else
+	if !is_ascii then
+	  Buffer.add_char dest c
+	else 
+	  begin
+	    is_ascii := true;
+	    Buffer.add_string dest "\027(B";
+	    Buffer.add_char dest c
+	  end
+    done; 
+    if not !is_ascii then Buffer.add_string dest "\027(B";
+    Buffer.contents dest
+  with Stream.Failure -> 
+    if not !is_ascii then Buffer.add_string dest "\027(B";
+    Buffer.contents dest
+      
diff --git a/applications/camlirc/general_channel.ml b/applications/camlirc/general_channel.ml
new file mode 100644
index 0000000..b8333b0
--- /dev/null
+++ b/applications/camlirc/general_channel.ml
@@ -0,0 +1,192 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Message_utils
+
+class general_channel_signals ~(part:string GUtil.signal) 
+    ~(privmsg:(string * string) GUtil.signal) 
+: I_channel.i_channel_signals =
+object
+  inherit GUtil.ml_signals [part#disconnect; privmsg#disconnect]
+  method part = part#connect ~after
+  method privmsg = privmsg#connect ~after
+end 
+
+let mem_space = Str.regexp "[ \t]+"
+
+class general_channel ~(handler:Message_handler.irc_message_handler) 
+    ?packing ?show () : I_channel.i_channel =
+  let server = handler#server
+  in
+  let vb = GPack.vbox ?packing ?show ()
+  and channel_name = server#nick ()
+  in
+  let topic_hb = GPack.hbox ~packing:vb#pack ()
+  in
+  let label = GMisc.label ~xalign:0.0 ~text:(server#server ())
+      ~packing:topic_hb#pack ()
+  and hb = GPack.hbox ~packing:(vb#pack ~expand:true) () 
+  in
+  let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~packing:hb#add ()
+  in
+  let view = GText.view ~packing:sw#add ()
+  and members = GList.clist ~columns:1 ~titles:["nickname"] 
+      ~width:100 ~packing:hb#pack ()
+  and h = handler
+  in
+  let message_text nick message =
+    let	s = Printf.sprintf "<%s> %s" nick message
+    in 
+    s
+  and server_message_text message = "***  "^message
+  and my_message_text message =
+    print_text view (Printf.sprintf ">%s< %s" (server#nick ()) message)
+  in 
+  let privmsg_signal = new GUtil.signal ()
+  in
+  let m_check m =
+    match m with 
+      (Some (f, _, _) , Message.MSG_PRIVATE, Some [chan; mes]) ->
+	begin
+	  try
+	    match Ctcp.check_ctcp mes with
+	      None -> privmsg_signal#call (f, chan)
+	    | Some (ctcp, arg) ->
+		begin
+		  match ctcp with
+		    Ctcp.CTCP_VERSION -> 
+		      Ctcp.send_ctcp_reply ~handler ~to_nick:f ~ctcp 
+			~message:Constants.id ()
+		  | Ctcp.CTCP_PING -> 
+		      Ctcp.send_ctcp_reply ~handler ~to_nick:f ~ctcp
+			~message:(Ctcp.get_current_time ()) ()
+		  | Ctcp.CTCP_TIME -> 
+		      Ctcp.send_ctcp_reply ~handler ~to_nick:f ~ctcp
+			~message:(Ctcp.get_current_formatted_time ()) ()
+		  | Ctcp.CTCP_ACTION -> ()
+		end
+	  with Ctcp.Unknown_ctcp _ -> ()
+	end
+    | (Some (f, _, _), Message.MSG_NOTICE, Some [chan; mes]) ->
+	begin 
+	  try 
+	    match Ctcp.check_ctcp mes with 
+	      None -> privmsg_signal # call (f, chan)
+	    | Some(ctcp, arg) ->
+		print_text view
+		  (">"^f^"< CTCP_"^(Ctcp.get_ctcp_string ctcp)^":"
+		   ^(begin
+		     match arg with 
+		       Some arg -> arg
+		     | None -> ""
+		   end))
+	  with Ctcp.Unknown_ctcp _ -> ()
+	end
+    | (None, Message.MSG_NOTICE, Some [chan; mes]) ->
+	begin
+	  print_text view (">"^chan^"<"^mes)
+	end
+    | _ -> ()
+  and r_check r =
+    match r with 
+      Reply.Connection (f, cr, arg) ->
+	begin
+	  match (f, cr, arg) with 
+	    (_, Reply.RPL_MYINFO, Some [_;s]) -> 
+	      print_text view (server_message_text s); ()
+	  | (_, Reply.RPL_YOURHOST, Some [_;s]) -> 
+	      print_text view (server_message_text s); ()
+	  | (_, Reply.RPL_CREATED, Some [_;s]) -> 
+	      print_text view (server_message_text s); ()
+	  | (_, Reply.RPL_WELCOME, Some [_;s]) -> 
+	      begin
+		handler#emit_init_complete_signal ();
+		print_text view (server_message_text s); ()
+	      end
+	  | (_, Reply.RPL_BOUNCE, Some [_;s]) -> 
+	      print_text view (server_message_text s); ()
+	  | _ -> ()
+	end
+    | Reply.Error (f, er, arg) ->
+	begin
+	  match (f, er, arg) with
+	    (_, Reply.ERR_NICKNAMEINUSE, Some _) ->
+	      Message_utils.nick_config ~handler:h
+	  |  (_, Reply.ERR_PASSWDMISMATCH, Some _) ->
+	      Message_utils.passwd_config ~handler:h
+	  | _ -> ()
+	end
+    | Reply.Command (f, cr, arg) ->
+	begin
+	  match (f, cr, arg) with
+	    (_, Reply.RPL_LUSERCLIENT, Some [_;m]) ->
+	      print_text view (server_message_text m); ()
+	  | (_, Reply.RPL_LUSEROP, Some [_;n;m]) ->
+	      print_text view (server_message_text (n^" "^m)); ()
+	  | (_, Reply.RPL_LUSERUNKNOWN, Some [_;n;m]) ->
+	      print_text view (server_message_text (n^" "^m)); ()
+	  | (_, Reply.RPL_LUSERCHANNELS, Some [_;n;m]) ->
+	      print_text view (server_message_text (n^" "^m)); ()
+	  | (_, Reply.RPL_LUSERME, Some [_;m]) ->
+	      print_text view (server_message_text m); ()
+	  | (_, Reply.RPL_MOTDSTART, Some [_;m]) ->
+	      print_text view (server_message_text m); ()
+	  | (_, Reply.RPL_MOTD, Some [_;m]) ->
+	      print_text view (server_message_text m); ()
+	  | (_, Reply.RPL_ENDOFMOTD, Some [_;m]) -> ()
+	  | _ -> ()
+	end
+  in      
+  object (self)
+    inherit GObj.widget vb#as_widget
+    val view = view
+    val channelname = channel_name 
+    val part = new GUtil.signal ()
+    val privmsg = privmsg_signal
+    val repsigid = h#connect#reply ~callback:r_check
+    val messigid = h#connect#message ~callback:m_check
+    method part = part
+    method part_command () = ()
+    method topic_command () = ()
+    method ctcp_command () = ()
+    method connect = new general_channel_signals ~part ~privmsg
+    method channelname = server#nick ()
+    method my_message = my_message_text
+    method initialize () = ()
+    initializer
+      h#connect#disconnected 
+	~callback:
+	(fun () -> 
+	  begin
+	    h#reply_signal#disconnect repsigid;
+	    h#message_signal#disconnect messigid;
+	    ()
+	  end);
+      ()
+  end
+
+class channel_factory : I_channel.i_channel_factory =
+  object
+    method module_name = "General"
+    method new_channel_object
+	~handler ~channel_name ~server ?packing ?show () = 
+      new general_channel ~handler ?packing ?show ()
+  end
+
diff --git a/applications/camlirc/global.ml b/applications/camlirc/global.ml
new file mode 100644
index 0000000..282f8a1
--- /dev/null
+++ b/applications/camlirc/global.ml
@@ -0,0 +1,156 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Message_utils
+
+class global_signals =
+object
+  inherit GUtil.ml_signals []
+end 
+
+let mem_space = Str.regexp "[ \t]+"
+
+let ctcp_status label who ctcp msg =
+  label#set_text (who^":"^(Ctcp.get_ctcp_string ctcp)^
+		  (match msg with None -> "" | Some msg -> ":"^msg))
+
+class global_view ~(handler:Message_handler.irc_message_handler) 
+    ?packing ?show () =
+  let vb = GPack.vbox ?packing ?show ()
+  in
+  let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~packing:vb#add ()
+  in
+  let view = GText.view ~packing:sw#add ()
+  and h = handler
+  and status_frame = GBin.frame ~shadow_type:`IN ~packing:vb#pack ()
+  in
+  let status_l = GMisc.label ~text:"" ~packing:status_frame#add 
+      ~xalign:0.0 ()
+  in
+  let message_text nick channel message =
+    Printf.sprintf "<%s:%s> %s" channel nick message
+  and server_message_text message = "***  "^message
+  and my_message_text channel message =
+    print_text view (Printf.sprintf ">%s:%s< %s" 
+		       channel ((handler#server)#nick ()) message)
+  in 
+  let m_check m =
+    match m with 
+      (Some (f, _, _) , Message.MSG_PRIVATE, Some [chan; mes]) ->
+	begin
+	  try match Ctcp.check_ctcp mes with 
+	    None -> print_text view (message_text f chan mes)
+	  | Some (ctcp, arg) -> ctcp_status status_l f ctcp arg
+	  with Ctcp.Unknown_ctcp _ -> ()
+	end
+    | (Some (n, _, _), Message.MSG_PART, Some [c; m]) ->
+	begin
+	  print_text view ("***  "^n^" has left "^c^" ("^m^")"); 
+	  ()
+	end
+    | (Some (n, _, _), Message.MSG_QUIT, Some [m]) ->
+	begin
+	  print_text view ("***  "^n^" has left IRC. ("^m^")"); 
+	  ()
+	end
+    | (Some (n, _, _), Message.MSG_NOTICE, Some [c; m]) ->
+	begin 
+	  try 
+	    match Ctcp.check_ctcp m with 
+	      None -> ()
+	    | Some(ctcp, arg) ->
+		print_text view
+		  (">"^n^"< CTCP_"^(Ctcp.get_ctcp_string ctcp)^":"
+		   ^(begin
+		     match arg with 
+		       Some arg -> arg
+		     | None -> ""
+		   end))
+	  with Ctcp.Unknown_ctcp _ -> ()
+	end
+    | _ -> ()
+  and r_check r =
+    match r with 
+      Reply.Connection _ -> ()
+    | Reply.Command (f,cr,arg)  ->
+	begin
+	  match (f,cr,arg) with
+	    (_, Reply.RPL_WHOISUSER, Some [_;nick;uname;host;_;realname]) ->
+	      print_text view (nick^" is "^
+			       nick^"!"^uname^"@"^host^"("^realname^")")
+	  | (_, Reply.RPL_WHOISSERVER, Some [_;nick;server;info]) ->
+	      print_text view ("on via server "^server^"("^info^")")
+	  | (_, Reply.RPL_WHOISOPERATOR, Some [_;nick;info]) ->
+	      print_text view (nick^" "^info)
+	  | (_, Reply.RPL_WHOISIDLE, Some [_;nick;idletime;info]) ->
+	      print_text view (nick^" "^idletime^" "^info)
+	  | (_, Reply.RPL_WHOISCHANNELS, Some [_;nick;info]) ->
+	      print_text view ("channels:"^info)
+	  | (_, Reply.RPL_WHOWASUSER, Some [_;nick;uname;host;realname]) ->
+	      print_text view (nick^" was "^
+			       nick^"!"^uname^"@"^host^"("^realname^")")
+	  | (_, Reply.RPL_ENDOFWHOWAS, _ ) -> ()
+	  | (_, Reply.RPL_ENDOFWHOIS, _ ) -> ()
+	  | _ -> ()
+	end
+    | Reply.Error _ -> ()
+  in      
+  object (self)
+    inherit GObj.widget vb#as_widget
+    val view = view
+    val mutable messigid = None
+    val mutable repsigid = None
+    method channelname = (handler#server)#nick ()
+    method my_message = my_message_text
+    initializer
+      h#connect#connected
+	~callback:
+	(fun () ->
+	  messigid <- Some (h#connect#message ~callback:m_check);
+	  repsigid <- Some (h#connect#reply ~callback:r_check));
+      h#connect#disconnected 
+	~callback:
+	(fun () -> 
+	  begin
+	    begin
+	      match messigid with 
+		Some messigid -> 
+		  begin 
+		    h#message_signal#disconnect messigid;
+		    ()
+		  end
+	      | None -> ()
+	    end;
+	    begin
+	      match repsigid with 
+		Some repsigid -> 
+		  begin 
+		    h#reply_signal#disconnect repsigid;
+		    ()
+		  end
+	      | None -> ()
+	    end;
+            let buf = view#buffer in
+	    buf#delete ~start:buf#start_iter ~stop:buf#end_iter;
+	  end);
+      ()
+  end
+
+
diff --git a/applications/camlirc/i_channel.mli b/applications/camlirc/i_channel.mli
new file mode 100644
index 0000000..a6f96a0
--- /dev/null
+++ b/applications/camlirc/i_channel.mli
@@ -0,0 +1,60 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+class i_channel_signals :
+  object ('a)
+    val after : bool
+    val mutable disconnectors : (GtkSignal.id -> bool) list
+    method after : 'a
+    method disconnect : GtkSignal.id -> unit
+    method part : callback:(string -> unit) -> GtkSignal.id
+    method privmsg : callback:((string * string) -> unit) -> GtkSignal.id
+  end
+
+class i_channel :
+  object
+    val channelname : string
+    val part : string GUtil.signal
+    val privmsg : (string * string) GUtil.signal
+    val obj : Gtk.widget Gtk.obj
+    method as_widget : Gtk.widget Gtk.obj
+    method channelname : string
+    method coerce : GObj.widget
+    method connect : i_channel_signals
+    method destroy : unit -> unit
+    method drag : GObj.drag_ops
+    method get_oid : int
+    method misc : GObj.misc_ops
+    method my_message : string -> unit
+    method initialize : unit -> unit
+    method part_command : unit -> unit
+    method topic_command : unit -> unit
+    method ctcp_command : unit -> unit
+    method part : string GUtil.signal
+  end
+
+class i_channel_factory :
+    object 
+      method module_name : string
+      method new_channel_object :
+	  handler:Message_handler.irc_message_handler -> 
+	    channel_name:string -> server:Server.server_info ->
+	      ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> i_channel
+    end
+
diff --git a/applications/camlirc/ircArg.ml b/applications/camlirc/ircArg.ml
new file mode 100644
index 0000000..f2cff33
--- /dev/null
+++ b/applications/camlirc/ircArg.ml
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Str
+
+type arg = string list
+
+let sep = regexp " :"
+and spl = regexp "[ \t]+"
+
+let process_arg s =
+  let
+      (rest, taillist) = 
+    try
+      let s1 = " "^s
+      in  
+      let n = search_forward sep s1 0
+      in 
+      (string_before s1 n, [string_after s1 (n+2)])
+    with Not_found -> (s,[])
+  in
+  try
+    (split spl rest)@taillist 
+  with Not_found -> taillist
+
+let to_string sl = 
+  List.fold_left (fun s r -> (s^" "^r))  "" sl
diff --git a/applications/camlirc/irc_widget.ml b/applications/camlirc/irc_widget.ml
new file mode 100644
index 0000000..6a2ad7d
--- /dev/null
+++ b/applications/camlirc/irc_widget.ml
@@ -0,0 +1,114 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+class irc_widget_signals ~(url:string GUtil.signal) =
+object
+  inherit GUtil.ml_signals [url#disconnect]
+  method url = url#connect ~after
+end 
+
+class irc_widget ?packing ?show () =
+  let box = GPack.vbox ?packing ?show ()
+  in
+  let serverlist = new Server.server_info_list ~servers:[]
+  in
+  let _ = serverlist#load_settings ~file:Constants.config_file
+  and h = new Message_handler.irc_message_handler ()
+  in
+  let channels = new Channelview.channels ~handler:h  ()
+  and controlbox = GPack.hbox ~packing:box#pack ~spacing:4 ~border_width:2 ()
+  in
+  let url = new GUtil.signal ()
+  in
+  let channel_factory_list = 
+    let text_chan = new Channel.channel_factory
+    in
+    List.map ~f:Cf_manager.channel_factory_manager#add_channel_factory
+      [text_chan]
+  in
+  let control =
+    new Control.irc_control ~handler:h ~channels ~servers:serverlist
+      ~packing:controlbox#pack ()
+  in
+  let _ = serverlist#connect#changed 
+      ~callback:
+      (fun () ->
+	let 
+	    s = control#server_selection#entry#text
+	in
+	begin
+	  control#server_selection#set_popdown_strings
+	    (serverlist#server_names ());
+	  control#server_selection#entry#set_text s
+	end)
+  in
+  let config_button = 
+    GButton.button ~label:"CONFIG" ~packing:controlbox#add () 
+  in
+  let config = new Control.config_dialog ~settings:serverlist ()
+  in
+  let _ = config_button#connect#clicked
+      ~callback:
+      (fun () -> 
+	let
+	    c = new Control.config_dialog ~settings:serverlist ()
+	in
+	c#show())
+  in
+  let _ = box#pack ~expand:true channels#coerce
+  and entrybox =
+    new Entry.message_entry ~packing:box#pack ~handler:h 
+      ~channels ()
+  and globalview = 
+    new Global.global_view ~packing:box#add ~handler:h ()
+  in
+  let _ =
+    begin
+      entrybox#connect#message 
+	~callback:
+	(fun s -> 
+	  begin
+	    channels#send_message s;
+	    try
+	      begin
+		globalview#my_message
+		  ((channels#current_channel ())#channelname) s; ()
+	      end
+	    with Channelview.No_channel -> ();
+	      ()
+	  end)
+    end
+  in
+  object
+    method url = url
+    method connect = new irc_widget_signals ~url
+    initializer
+      box#connect#destroy ~callback:(fun _ -> Control.disconnect h ());
+      h#connect#message 
+	~callback:
+	(fun m ->
+	  match m with 
+	    (_,Message.MSG_PING, Some [s]) ->
+	      h#send_message(None, Message.MSG_PONG, 
+			     Some [":"^s])
+	  |  _ -> ());
+      ()
+  end
diff --git a/applications/camlirc/members.ml b/applications/camlirc/members.ml
new file mode 100644
index 0000000..c00f959
--- /dev/null
+++ b/applications/camlirc/members.ml
@@ -0,0 +1,106 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+exception Members
+
+class members_signals ~(selected: string GUtil.signal) =
+  object
+    inherit GUtil.ml_signals [selected#disconnect]
+    method selected = selected#connect ~after
+  end
+
+let nick_regexp = Str.regexp "@*\\(.+\\)"
+
+let non_prefixed_nick nick =
+  if Str.string_match nick_regexp nick 0 then
+    Str.matched_group 1 nick else nick
+
+class members ?width ?packing ?show () =
+  let adj_mem = GData.adjustment ()
+  in
+  let mem = GList.clist ~columns:1 ~vadjustment:adj_mem ~titles:["nickname"] 
+      ?width ?packing ?show ()
+  and sb_mem = 
+    GRange.scrollbar `VERTICAL ~adjustment:adj_mem ?packing ?show ()
+  and get_nid n l = 
+    try
+      (n, false, List.assoc n l)
+    with
+      Not_found -> (("@"^n), true, List.assoc ("@"^n) l)
+  and selected = new GUtil.signal ()
+  in
+  object (self)
+    val mutable mem_list = []
+    method append n = mem_list <- (n, mem#append [n])::mem_list
+    method clear () =
+      begin
+	mem_list <- [];
+	mem#clear ()
+      end
+    method remove n = 
+      try
+	let 
+	    (real_n, _, nid) = get_nid n mem_list
+	in
+	mem#remove ~row:nid;
+	mem_list <- List.remove_assoc real_n mem_list
+      with Not_found -> ()
+    method member_list = List.map 
+	(fun (n,_) -> non_prefixed_nick n) mem_list
+    method check n =
+      try
+	let _ = get_nid n mem_list
+	in true
+      with Not_found -> false
+    method change n new_n =
+      try
+	let (real_n, prefixed, nid) = get_nid n mem_list
+	in
+	mem#remove ~row:nid;
+	let
+	    new_real_n = if prefixed then "@"^new_n else new_n
+	in
+	begin
+	  mem#insert ~row:nid [new_real_n];
+	  mem_list <- (new_real_n, nid)::(List.remove_assoc real_n mem_list)
+	end
+      with Not_found -> ()
+    method selected = selected
+    method connect = new members_signals ~selected:self#selected
+    initializer
+      mem#connect#select_row
+	~callback:
+	(fun ~row ~column ~event ->
+	  begin
+	    let
+		nick = mem#cell_text row column
+	    in
+	    begin
+	      if Str.string_match nick_regexp nick 0 then
+		let nick = Str.matched_group 1 nick in
+		selected#call nick;
+		()
+	      else ();
+	      ()
+	    end
+	  end);
+      ()
+  end
diff --git a/applications/camlirc/message.ml b/applications/camlirc/message.ml
new file mode 100644
index 0000000..1ce7d5d
--- /dev/null
+++ b/applications/camlirc/message.ml
@@ -0,0 +1,206 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+exception Unknown_message
+
+type irc_message =
+   MSG_DNS
+ | MSG_HASH
+ | MSG_DIE
+ | MSG_CLOSE
+ | MSG_RESTART
+ | MSG_REHASH
+ | MSG_SERVSET
+ | MSG_SERVLIST
+ | MSG_SQUERY
+ | MSG_NOTE
+ | MSG_ISON
+ | MSG_USERHOST
+ | MSG_SERVICE
+ | MSG_RECONECT
+ | MSG_KICK
+ | MSG_UMODE
+ | MSG_MODE
+ | MSG_MOTD
+ | MSG_LUSERS
+ | MSG_PART
+ | MSG_NJOIN
+ | MSG_JOIN
+ | MSG_NOTICE
+ | MSG_TRACE
+ | MSG_ADMIN
+ | MSG_NAMES
+ | MSG_TIME
+ | MSG_WALLOPS
+ | MSG_PASS
+ | MSG_OPER
+ | MSG_PONG
+ | MSG_PING
+ | MSG_CONNECT
+ | MSG_AWAY
+ | MSG_ERROR
+ | MSG_HELP
+ | MSG_USERS
+ | MSG_STATS
+ | MSG_SUMMON
+ | MSG_LINKS
+ | MSG_INFO
+ | MSG_KILL
+ | MSG_SQUIT
+ | MSG_QUIT
+ | MSG_VERSION
+ | MSG_INVITE
+ | MSG_TOPIC
+ | MSG_LIST
+ | MSG_SERVER
+ | MSG_NICK
+ | MSG_USER
+ | MSG_WHOWAS
+ | MSG_WHOIS
+ | MSG_WHO
+ | MSG_PRIVATE
+
+type message = Prefix.prefix option * irc_message * IrcArg.arg option
+
+let get_message_id = function 
+   "PRIVMSG"	->	MSG_PRIVATE
+ | "UMODE"	->	MSG_UMODE
+ | "MODE"	->	MSG_MODE
+ | "PONG"	->	MSG_PONG
+ | "PING"	->	MSG_PING
+ | "WHOWAS"	->	MSG_WHOWAS
+ | "WHOIS"	->	MSG_WHOIS
+ | "WHO"	->	MSG_WHO
+ | "DNS"	->	MSG_DNS
+ | "CONNECT"	->	MSG_CONNECT
+ | "HAZH"	->	MSG_HASH
+ | "DIE"	->	MSG_DIE
+ | "CLOSE"	->	MSG_CLOSE
+ | "RESTART"	->	MSG_RESTART
+ | "REHASH"	->	MSG_REHASH
+ | "SERVSET"	->	MSG_SERVSET
+ | "SERVLIST"	->	MSG_SERVLIST
+ | "SQUERY"	->	MSG_SQUERY
+ | "NOTE"	->	MSG_NOTE
+ | "ISON"	->	MSG_ISON
+ | "USERHOST"	->	MSG_USERHOST
+ | "SERVICE"	->	MSG_SERVICE
+ | "RECONNECT"	->	MSG_RECONECT
+ | "KICK"	->	MSG_KICK
+ | "MOTD"	->	MSG_MOTD
+ | "LUSERS"	->	MSG_LUSERS
+ | "PART"	->	MSG_PART
+ | "NJOIN"	->	MSG_NJOIN
+ | "JOIN"	->	MSG_JOIN
+ | "NOTICE"	->	MSG_NOTICE
+ | "TRACE"	->	MSG_TRACE
+ | "ADMIN"	->	MSG_ADMIN
+ | "NAMES"	->	MSG_NAMES
+ | "TIME"	->	MSG_TIME
+ | "WALLOPS"	->	MSG_WALLOPS
+ | "PASS"	->	MSG_PASS
+ | "OPER"	->	MSG_OPER
+ | "AWAY"	->	MSG_AWAY
+ | "ERROR"	->	MSG_ERROR
+ | "HELP"	->	MSG_HELP
+ | "USERS"	->	MSG_USERS
+ | "STATS"	->	MSG_STATS
+ | "SUMMON"	->	MSG_SUMMON
+ | "LINKS"	->	MSG_LINKS
+ | "INFO"	->	MSG_INFO
+ | "KILL"	->	MSG_KILL
+ | "SQUIT"	->	MSG_SQUIT
+ | "QUIT"	->	MSG_QUIT
+ | "VERSION"	->	MSG_VERSION
+ | "INVITE"	->	MSG_INVITE
+ | "TOPIC"	->	MSG_TOPIC
+ | "LIST"	->	MSG_LIST
+ | "SERVER"	->	MSG_SERVER
+ | "NICK"	->	MSG_NICK
+ | "USER"	->	MSG_USER
+ | _	->	raise Unknown_message
+
+let to_string = function 
+    MSG_PRIVATE	->	"PRIVMSG"
+  | MSG_UMODE	->	"UMODE"
+  | MSG_MODE	->	"MODE"
+  | MSG_PONG	->	"PONG"
+  | MSG_PING	->	"PING"
+  | MSG_QUIT	->	"QUIT"
+  | MSG_NICK	->	"NICK"
+  | MSG_WHOWAS	->	"WHOWAS"
+  | MSG_WHOIS	->	"WHOIS"
+  | MSG_WHO	->	"WHO"
+  | MSG_DNS	->	"DNS"
+  | MSG_HASH	->	"HAZH"
+  | MSG_DIE	->	"DIE"
+  | MSG_CLOSE	->	"CLOSE"
+  | MSG_RESTART	->	"RESTART"
+  | MSG_REHASH	->	"REHASH"
+  | MSG_SERVSET	->	"SERVSET"
+  | MSG_SERVLIST	->	"SERVLIST"
+  | MSG_SQUERY	->	"SQUERY"
+  | MSG_NOTE	->	"NOTE"
+  | MSG_ISON	->	"ISON"
+  | MSG_USERHOST	->	"USERHOST"
+  | MSG_SERVICE	->	"SERVICE"
+  | MSG_RECONECT	->	"RECONNECT"
+  | MSG_KICK	->	"KICK"
+  | MSG_MOTD	->	"MOTD"
+  | MSG_LUSERS	->	"LUSERS"
+  | MSG_PART	->	"PART"
+  | MSG_NJOIN	->	"NJOIN"
+  | MSG_JOIN	->	"JOIN"
+  | MSG_NOTICE	->	"NOTICE"
+  | MSG_TRACE	->	"TRACE"
+  | MSG_ADMIN	->	"ADMIN"
+  | MSG_NAMES	->	"NAMES"
+  | MSG_TIME	->	"TIME"
+  | MSG_WALLOPS	->	"WALLOPS"
+  | MSG_PASS	->	"PASS"
+  | MSG_OPER	->	"OPER"
+  | MSG_CONNECT	->	"CONNECT"
+  | MSG_AWAY	->	"AWAY"
+  | MSG_ERROR	->	"ERROR"
+  | MSG_HELP	->	"HELP"
+  | MSG_USERS	->	"USERS"
+  | MSG_STATS	->	"STATS"
+  | MSG_SUMMON	->	"SUMMON"
+  | MSG_LINKS	->	"LINKS"
+  | MSG_INFO	->	"INFO"
+  | MSG_KILL	->	"KILL"
+  | MSG_SQUIT	->	"SQUIT"
+  | MSG_VERSION	->	"VERSION"
+  | MSG_INVITE	->	"INVITE"
+  | MSG_TOPIC	->	"TOPIC"
+  | MSG_LIST	->	"LIST"
+  | MSG_SERVER	->	"SERVER"
+  | MSG_USER	->	"USER"
+
+
+let construct_message_string (prefix, message, arg) =
+  (match prefix with
+    Some p -> ":"^(Prefix.to_string p)^" "
+  | None -> "")^
+  (to_string message)^" "^
+  (match arg with
+    Some a -> IrcArg.to_string a
+  | None -> "")^"\n"
+
diff --git a/applications/camlirc/message_handler.ml b/applications/camlirc/message_handler.ml
new file mode 100644
index 0000000..0d67e43
--- /dev/null
+++ b/applications/camlirc/message_handler.ml
@@ -0,0 +1,198 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Unix
+open Str
+
+exception Server_not_configured
+
+class irc_message_signals 
+    ~(message: Message.message GUtil.signal)
+    ~(reply: Reply.reply GUtil.signal)
+    ~(connected: unit GUtil.signal) ~(disconnected: unit GUtil.signal) 
+    ~(init_complete: unit GUtil.signal) =
+  object
+    inherit GUtil.ml_signals [connected#disconnect;disconnected#disconnect;
+			      message#disconnect;reply#disconnect]
+    method message = message#connect ~after
+    method reply = reply#connect ~after
+    method connected = connected#connect ~after
+    method init_complete = init_complete#connect ~after
+    method disconnected = disconnected#connect ~after
+  end
+
+exception Rest of string 
+
+type message_data = Quit | Data of string
+
+
+class irc_message_handler ?(server: Server.server_info option) () = 
+  let reply_signal = new GUtil.signal ()
+  and connected_signal = new GUtil.signal ()
+  and disconnected_signal = new GUtil.signal ()
+  and message_signal = new  GUtil.signal ()
+  and init_complete_signal = new  GUtil.signal ()
+  in
+  let main_read_loop in_c =
+    try
+      while true do
+	let s = input_line in_c
+	in
+	try
+	  match (Parser.process_one_message
+		   (Eucjp.ntol (String.sub 
+				  s 0 
+				  ((String.length s) -1)))) with
+	    Parser.MSG m -> message_signal#call m
+	  | Parser.REP r -> reply_signal#call r
+	with 
+	  Not_found -> ()
+	| Reply.Unknown_Reply n -> print_int n
+      done
+    with
+      End_of_file -> 
+	begin
+	  disconnected_signal#call (); Thread.exit ()
+	end
+    | Unix.Unix_error _ -> 
+	begin
+	  disconnected_signal#call ();
+	  Thread.exit ()
+	end
+    | Sys_error _ ->
+	begin
+	  disconnected_signal#call (); Thread.exit ()
+	end
+  and main_write_loop(out_c,message_channel,disconnect_channel) =
+      try
+      while true do
+	let data = Event.sync (Event.receive message_channel)
+	in
+	begin
+	  match data with
+	    Data m ->
+	      begin
+		output_string out_c (Eucjp.lton m);
+		flush out_c;
+		Thread.yield();
+	      end
+	  | Quit ->
+	      begin
+		Thread.exit ()
+	      end
+
+	end
+      done
+    with Sys_error _ -> Thread.exit ()
+
+  in
+  object (self)
+    val mutable server = server
+    method message_signal = message_signal
+    method reply_signal = reply_signal
+    method connected_signal = connected_signal
+    method disconnected_signal = disconnected_signal
+    method init_complete_signal = init_complete_signal
+    method set_server s = server <- Some s
+    method reload_server () = 
+      match server with
+	Some s -> server <- Some (s#self)
+      |	None -> ()
+    val mutable read_thread = None
+    val mutable write_thread = None
+    val mutable in_chan = Pervasives.stdin
+    val mutable out_chan = Pervasives.stdout
+    val mutable message_channel : message_data Event.channel = 
+      Event.new_channel ()
+    val mutable disconnect_channel : unit Event.channel = Event.new_channel ()
+    val mutable connected = false
+    method connect = 
+      new irc_message_signals 
+	~message:message_signal ~reply:reply_signal
+	~connected:connected_signal ~disconnected:disconnected_signal
+	~init_complete:init_complete_signal
+    method server = 
+      match server with 
+	Some s -> s 
+      | None -> raise Server_not_configured
+    method send_message m =
+      let
+	  ms = Message.construct_message_string m
+      in
+      Event.sync (Event.send message_channel (Data ms)); 
+      Thread.yield();
+      ()
+    method disconnect_write_channel () =
+      Event.sync (Event.send message_channel Quit)
+    method emit_init_complete_signal () = init_complete_signal#call ()
+    method status_connected () = connected
+    method start_connection () = 
+      let (in_c, out_c) = 
+	try 
+	  ThreadUnix.open_connection ((self#server)#sock_addr() )
+	with Server.Config_error ->
+	  begin
+	    self#server#make_server_addr ();
+	    ThreadUnix.open_connection ((self#server)#sock_addr() )
+	  end
+      and _ = message_channel <- Event.new_channel ()
+      and _ = disconnect_channel <- Event.new_channel ()
+      in 
+      let r = Thread.create main_read_loop in_c
+      and w = 
+	Thread.create main_write_loop
+	  (out_c,message_channel,disconnect_channel)
+      in
+      read_thread <- Some r ; write_thread <- Some w; 
+      in_chan <- in_c; out_chan <- out_c;
+      connected <- true;
+      connected_signal#call ()
+    method kill_connection ()  =
+      Unix.shutdown_connection in_chan;
+      connected <- false
+    method initial_sequence () =
+      if not ((self#server)#passwd () = "") then
+	self#send_message
+	  (None, Message.MSG_PASS, Some [(self#server)#passwd ()]);
+      self#send_message
+	(None, Message.MSG_NICK, Some [(self#server)#nick ()]);
+      self#send_message
+	(None, Message.MSG_USER, Some
+	   [(self#server)#username (); 
+	    "0"; "*"; ":"^((self#server)#fullname ())]);
+      ()
+    method final_sequence () =
+      let
+	  ms = Message.construct_message_string
+	  (None, Message.MSG_QUIT, 
+	   Some [":"^((self#server)#quit_message ())])
+      in
+      Event.sync (Event.send message_channel (Data ms));
+      Event.sync (Event.send message_channel Quit);
+      ()
+    initializer
+      self#connect#disconnected
+	~callback:
+	(fun _ -> self#disconnect_write_channel ());
+      ()
+  end
+    
+
+
diff --git a/applications/camlirc/message_utils.ml b/applications/camlirc/message_utils.ml
new file mode 100644
index 0000000..f60a14a
--- /dev/null
+++ b/applications/camlirc/message_utils.ml
@@ -0,0 +1,131 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+exception Msg_format_error
+
+class url_signals ~(url:string GUtil.signal) =
+object
+  inherit GUtil.ml_signals [url#disconnect]
+  method url = url#connect ~after
+end 
+
+class url_emitter () =
+  let url = new GUtil.signal ()
+  in
+  object
+    method url = url
+    method connect = new url_signals ~url
+  end
+
+let url_emit = new url_emitter ()
+
+let privmsg arg =
+  match arg with 
+    (frm, [target; message]) ->
+      begin
+	match frm with
+	  None -> (None, target, message)
+	| Some (nick, _, _) -> (Some nick, target, message)
+      end
+  | _ -> raise Msg_format_error
+
+let http_regexp = Str.regexp "http:/[a-zA-Z0-9./&=~?-_]*"
+
+let print_text_sub ?tags ?u_tags ?(emit=false) (view : GText.view) s =
+  match s with 
+    Str.Text s -> 
+      begin
+	view#buffer#insert ?tags s
+      end
+  | Str.Delim s -> 
+      begin
+	if emit then 
+	  begin
+	    url_emit#url#call s
+	  end;
+	view#buffer#insert ?tags:u_tags s;
+      end
+
+let print_text ?tags ?u_tags ?emit (view : GText.view) s =
+  let t = Unix.localtime (Unix.time ())
+  and slist =  Str.full_split http_regexp s
+  in
+  view#buffer#insert ?tags
+    (Printf.sprintf "%02d:%02d " t.Unix.tm_hour t.Unix.tm_min);
+  List.map (print_text_sub ?tags ?u_tags ?emit view) slist;
+  view#buffer#insert ?tags "\n"
+
+let one_config ~title ~text ~default ?visibility ?max_length addfun =
+  let w = GWindow.dialog ~title ~modal:true ~position:`CENTER ()
+  in
+  let heading = GBin.frame ~shadow_type:`OUT ~packing:w#vbox#add ()
+  in GMisc.label ~text ~packing:w#vbox#add ();
+  let e = GEdit.entry 
+      ~text:default ?visibility ?max_length ~packing:w#vbox#add ()
+  and ok_b = GButton.button  ~label:"OK" ~packing:w#vbox#add ()
+  in 
+  let _ = ok_b#connect#clicked
+	~callback: (fun () -> addfun e#text; w#destroy (); ())
+  and _ = e#connect#activate
+      ~callback: (fun () -> addfun e#text; w#destroy (); ())
+  in
+  w#show()
+
+let nick_config ~handler =
+ one_config 
+    ~title:"Your nickname is already used by someone else." 
+    ~text:"Nickname:"
+    ~default:((handler#server)#nick ())
+    ~max_length:9
+    (fun s -> (handler#server)#set_nick s;
+      handler#send_message(None, Message.MSG_NICK, 
+				 Some [(handler#server)#nick ()]))
+
+let passwd_config ~handler =
+ one_config 
+    ~title:"Password is required." 
+    ~text:"Password"
+    ~default:((handler#server)#passwd ())
+    ~visibility:false
+    (fun s -> (handler#server)#set_passwd s)
+
+
+let topic_dialog ~handler ~channelname =
+  one_config
+    ~title:"Enter new topic for this channel."
+    ~text:"Topic"
+    ~default:""
+    (fun s -> 
+      if not (s = "")
+      then handler#send_message(None, Message.MSG_TOPIC,
+				Some [channelname; ":"^s]))
+
+let send_notice ~handler ~to_nick ~message =
+  handler#send_message (None, Message.MSG_NOTICE,
+			Some [to_nick; ":"^message])
+
+let send_join ~handler ~channel =
+  handler#send_message (None, Message.MSG_JOIN, Some [":"^channel])
+
+let send_whois ~handler ~nick =
+  handler#send_message (None, Message.MSG_WHOIS, Some [nick])
+
+let send_simple_message h m t = h#send_message (None, m, ":"^t)
+
diff --git a/applications/camlirc/newmain.ml b/applications/camlirc/newmain.ml
new file mode 100644
index 0000000..2a000d1
--- /dev/null
+++ b/applications/camlirc/newmain.ml
@@ -0,0 +1,143 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+let _ = 
+  Gdk.Rgb.init ();
+  GtkBase.Widget.set_default_visual (Gdk.Rgb.get_visual ());
+  GtkBase.Widget.set_default_colormap (Gdk.Rgb.get_cmap ())
+
+let win = GWindow.window ()
+let box = GPack.vbox ~packing:win#add ()
+
+let serverlist = new Server.server_info_list ~servers:[]
+
+let channel_factory_list = 
+  let text_chan = new Channel.channel_factory
+  in
+  List.map Cf_manager.channel_factory_manager#add_channel_factory
+    [text_chan]
+
+let _ = serverlist#load_settings ~file:Constants.config_file
+
+let h = new Message_handler.irc_message_handler ()
+
+let channels = new Channelview.channels ~handler:h  ()
+
+let control =
+  new Control.irc_control ~handler:h ~channels ~servers:serverlist
+
+let menubar = GMenu.menu_bar ~packing:box#pack ()
+let menu_factory = new GMenu.factory menubar
+
+let file_menu = menu_factory#add_submenu "File"
+and config_menu = menu_factory#add_submenu "Configure"
+and operation_menu = menu_factory#add_submenu "Operation"
+and channel_menu = menu_factory#add_submenu "Channel"
+and help_menu = menu_factory#add_submenu "Help"
+
+let _ = 
+  let file_menu_factory = new GMenu.factory file_menu in
+  file_menu_factory#add_item "Connect" ~callback:control#connect;
+  file_menu_factory#add_item "Disconnect" ~callback:control#disconnect;
+  file_menu_factory#add_separator ();
+  file_menu_factory#add_item "Quit" ~callback:GMain.Main.quit;
+
+  let config_menu_factory = new GMenu.factory config_menu in
+  config_menu_factory#add_item "Server" 
+    ~callback:(fun () -> 
+      let
+	  c = new Control.config_dialog ~settings:serverlist ()
+      in
+      c#show());
+
+  let operation_menu_factory = new GMenu.factory operation_menu in
+  operation_menu_factory#add_item "Join" ~callback:control#join;
+  operation_menu_factory#add_item "Priv" ~callback:control#priv;
+  operation_menu_factory#add_item "CTCP Message"
+    ~callback:(fun () ->
+      try 
+	(channels#current_channel ())#ctcp_command ()
+      with 
+	Channelview.No_channel -> ());
+  
+  let channel_menu_factory = new GMenu.factory channel_menu in
+  channel_menu_factory#add_item "Part" 
+    ~callback:(fun () -> 
+      try 
+	(channels#current_channel ())#part_command ()
+      with
+	Channelview.No_channel -> ());
+  channel_menu_factory#add_item "Topic"
+    ~callback:(fun () -> 
+      try 
+	(channels#current_channel ())#topic_command ()
+      with
+	Channelview.No_channel -> ());
+  let help_menu_factory = new GMenu.factory help_menu in
+  help_menu_factory#add_item "About"
+    ~callback:
+    begin fun () ->
+      let w = GWindow.dialog ~title:"About" ~modal:true ~position:`CENTER () in
+      ignore (GMisc.label ~text:Constants.id ~packing:w#vbox#add 
+	        ~width:250 ~height:70 ());
+      let ok_b = GButton.button ~label:"OK" ~packing:w#vbox#add () in
+      ignore (ok_b#connect#clicked ~callback:w#destroy);
+      w#show ()
+    end
+    
+let controlbox = GPack.hbox ~border_width:2 ~packing:box#pack ()
+
+let _ = box#pack ~expand:true channels#coerce
+
+and entrybox =
+  new Entry.message_entry ~packing:box#pack ~handler:h 
+    ~channels ()
+
+and globalview = 
+  new Global.global_view ~packing:box#add ~handler:h ()
+
+let _ =
+  begin
+    entrybox#connect#message 
+      ~callback:
+      (fun s -> 
+	begin
+	  channels#send_message s;
+	  try
+	    begin
+	      globalview#my_message
+		((channels#current_channel ())#channelname) s; ()
+	    end
+	  with Channelview.No_channel -> ();
+	  ()
+	end)
+  end
+let _ = 
+  h#connect#message 
+    ~callback:
+    (fun m ->
+	match m with 
+	  (_,Message.MSG_PING, Some [s]) ->
+	    h#send_message(None, Message.MSG_PONG, 
+			   Some [":"^s])
+	|  _ -> ());
+  win#connect#destroy ~callback:GMain.Main.quit;
+  win#show();
+  GtkThread.main ()
diff --git a/applications/camlirc/parser.ml b/applications/camlirc/parser.ml
new file mode 100644
index 0000000..395ce4b
--- /dev/null
+++ b/applications/camlirc/parser.ml
@@ -0,0 +1,78 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Str
+
+exception Illegal_format
+
+let prefix_regexp = regexp "^:\\([^ \t]+\\)[ \t]+\\(.+\\)$"
+and prefix_loc = 1
+and rest_loc = 2
+
+let message_regexp = regexp "^\\([A-Z]+\\)\\($\\|[ \t]+\\(.+\\)$\\)"
+and message_id_loc = 1
+and message_arg_loc = 3
+
+let reply_regexp = regexp "^\\([0-9][0-9][0-9]\\)\\($\\|[ \t]+\\(.+\\)$\\)"
+and reply_id_loc = 1
+and reply_arg_loc = 3
+
+type m = 
+    MSG of Message.message
+  | REP of Reply.reply
+
+let process_one_message s =
+  let (prefix, np_s) = 
+    if string_match prefix_regexp s 0
+    then (Some (Prefix.parse_prefix (matched_group prefix_loc s)),
+	  (matched_group rest_loc s))
+    else (None, s)
+  in
+  if string_match message_regexp np_s 0
+  then 
+    begin
+      let
+	  id = Message.get_message_id (matched_group message_id_loc np_s)
+      in
+      MSG (prefix, 
+	   id,
+	   try Some (IrcArg.process_arg (matched_group message_arg_loc np_s))
+	   with Not_found -> None)
+    end
+  else if string_match reply_regexp np_s 0
+  then 
+    begin
+      let
+	  id = int_of_string (matched_group reply_id_loc np_s)
+      and arg = 
+	try Some (IrcArg.process_arg 
+		    (matched_group reply_arg_loc np_s))
+	with Not_found -> None
+      in
+      REP 
+      (match Reply.check_reply_type id with
+	Reply.Type_connection ->
+	  Reply.Connection (prefix, Reply.get_connection_reply id, arg)
+      |	Reply.Type_command ->
+	  Reply.Command (prefix, Reply.get_command_reply id, arg)
+      |	Reply.Type_error ->
+	  Reply.Error (prefix, Reply.get_error_reply id, arg))
+    end
+  else raise Illegal_format
diff --git a/applications/camlirc/prefix.ml b/applications/camlirc/prefix.ml
new file mode 100644
index 0000000..3259b7c
--- /dev/null
+++ b/applications/camlirc/prefix.ml
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Str
+
+type prefix = string * string option * string option
+let prefix_regexp =
+  regexp "^\\([^@!]+\\)\\(\\|\\(!\\([^@!]+\\)\\|\\)@\\([^@!]+\\)\\)$"
+and nick_loc = 1
+and user_loc = 4
+and host_loc = 5
+
+let parse_prefix s =
+  let result = string_match prefix_regexp s 0
+  in
+  let nick = matched_group nick_loc s
+  and user = 
+    try Some (matched_group user_loc s) with Not_found -> None
+  and host = 
+    try Some (matched_group host_loc s) with Not_found -> None
+  in
+  (nick, user, host)
+    
+let to_string (nick, user, host) =
+  nick^
+  (match user with Some s -> "!"^s | None -> "")^
+  (match host with Some s -> "@"^s | None -> "")
diff --git a/applications/camlirc/property.ml b/applications/camlirc/property.ml
new file mode 100644
index 0000000..0ecddc2
--- /dev/null
+++ b/applications/camlirc/property.ml
@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+module Data = struct
+  let data_directory = "data"
+end
+  
+module Interface = struct
+  let width = ref 680
+  let height = ref 500
+  let columns = 6
+  let rows = 6
+end
+
+module Constants = struct
+  let schedule_doctype = "PooMee Schedule 1.1"
+end
diff --git a/applications/camlirc/reply.ml b/applications/camlirc/reply.ml
new file mode 100644
index 0000000..e720d4f
--- /dev/null
+++ b/applications/camlirc/reply.ml
@@ -0,0 +1,730 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+exception Unknown_Reply of int
+
+type command_reply =
+   RPL_TRYAGAIN
+ | RPL_TRACEEND
+ | RPL_TRACELOG
+ | RPL_ADMINEMAIL
+ | RPL_ADMINLOC2
+ | RPL_ADMINLOC1
+ | RPL_ADMINME
+ | RPL_LUSERME
+ | RPL_LUSERCHANNELS
+ | RPL_LUSERUNKNOWN
+ | RPL_LUSEROP
+ | RPL_LUSERCLIENT
+ | RPL_STATSDLINE
+ | RPL_STATSDEBUG
+ | RPL_STATSDEFINE
+ | RPL_STATSBLINE
+ | RPL_STATSPING
+ | RPL_STATSSLINE
+ | RPL_STATSHLINE
+ | RPL_STATSOLINE
+ | RPL_STATSUPTIME
+ | RPL_STATSLLINE
+ | RPL_STATSVLINE
+ | RPL_SERVLISTEND
+ | RPL_SERVLIST
+ | RPL_SERVICE
+ | RPL_ENDOFSERVICES
+ | RPL_SERVICEINFO
+ | RPL_UMODEIS
+ | RPL_ENDOFSTATS
+ | RPL_STATSYLINE
+ | RPL_STATSQLINE
+ | RPL_STATSKLINE
+ | RPL_STATSILINE
+ | RPL_STATSNLINE
+ | RPL_STATSCLINE
+ | RPL_STATSCOMMANDS
+ | RPL_STATSLINKINFO
+ | RPL_TRACERECONNECT
+ | RPL_TRACECLASS
+ | RPL_TRACENEWTYPE
+ | RPL_TRACESERVICE
+ | RPL_TRACESERVER
+ | RPL_TRACEUSER
+ | RPL_TRACEOPERATOR
+ | RPL_TRACEUNKNOWN
+ | RPL_TRACEHANDSHAKE
+ | RPL_TRACECONNECTING
+ | RPL_TRACELINK
+ | RPL_NOUSERS
+ | RPL_ENDOFUSERS
+ | RPL_USERS
+ | RPL_USERSSTART
+ | RPL_TIME
+ | RPL_NOTOPERANYMORE
+ | RPL_MYPORTIS
+ | RPL_YOURESERVICE
+ | RPL_REHASHING
+ | RPL_YOUREOPER
+ | RPL_ENDOFMOTD
+ | RPL_MOTDSTART
+ | RPL_ENDOFINFO
+ | RPL_INFOSTART
+ | RPL_MOTD
+ | RPL_INFO
+ | RPL_ENDOFBANLIST
+ | RPL_BANLIST
+ | RPL_ENDOFLINKS
+ | RPL_LINKS
+ | RPL_CLOSEEND
+ | RPL_CLOSING
+ | RPL_KILLDONE
+ | RPL_ENDOFNAMES
+ | RPL_NAMREPLY
+ | RPL_ENDOFWHO
+ | RPL_WHOREPLY
+ | RPL_VERSION
+ | RPL_SUMMONING
+ | RPL_INVITING
+ | RPL_TOPIC
+ | RPL_NOTOPIC
+ | RPL_CHANNELMODEIS
+ | RPL_LISTEND
+ | RPL_LIST
+ | RPL_LISTSTART
+ | RPL_WHOISCHANNELS
+ | RPL_ENDOFWHOIS
+ | RPL_WHOISIDLE
+ | RPL_WHOISCHANOP
+ | RPL_ENDOFWHOWAS
+ | RPL_WHOWASUSER
+ | RPL_WHOISOPERATOR
+ | RPL_WHOISSERVER
+ | RPL_WHOISUSER
+ | RPL_NOWAWAY
+ | RPL_UNAWAY
+ | RPL_TEXT
+ | RPL_ISON
+ | RPL_USERHOST
+ | RPL_AWAY
+ | RPL_NONE
+
+and error_reply = 
+ | ERR_USERSDONTMATCH
+ | ERR_UMODEUNKNOWNFLAG
+ | ERR_NOSERVICEHOST
+ | ERR_NOOPERHOST
+ | ERR_RESTRICTED
+ | ERR_CANTKILLSERVER
+ | ERR_CHANOPRIVSNEEDED
+ | ERR_NOPRIVILEGES
+ | ERR_NOCHANMODES
+ | ERR_BADCHANMASK
+ | ERR_BADCHANNELKEY
+ | ERR_BANNEDFROMCHAN
+ | ERR_INVITEONLYCHAN
+ | ERR_UNKNOWNMODE
+ | ERR_CHANNELISFULL
+ | ERR_KEYSET
+ | ERR_YOUWILLBEBANNED
+ | ERR_YOUREBANNEDCREEP
+ | ERR_PASSWDMISMATCH
+ | ERR_NOPERMFORHOST
+ | ERR_ALREADYREGISTRED
+ | ERR_NEEDMOREPARAMS
+ | ERR_NOTREGISTERED
+ | ERR_USERSDISABLED
+ | ERR_SUMMONDISABLED
+ | ERR_NOLOGIN
+ | ERR_USERONCHANNEL
+ | ERR_NOTONCHANNEL
+ | ERR_USERNOTINCHANNEL
+ | ERR_UNAVAILRESOURCE
+ | ERR_NICKCOLLISION
+ | ERR_SERVICECONFUSED
+ | ERR_SERVICENAMEINUSE
+ | ERR_NICKNAMEINUSE
+ | ERR_ERRONEUSNICKNAME
+ | ERR_NONICKNAMEGIVEN
+ | ERR_FILEERROR
+ | ERR_NOADMININFO
+ | ERR_NOMOTD
+ | ERR_UNKNOWNCOMMAND
+ | ERR_TOOMANYMATCHES
+ | ERR_BADMASK
+ | ERR_WILDTOPLEVEL
+ | ERR_NOTOPLEVEL
+ | ERR_NOTEXTTOSEND
+ | ERR_NORECIPIENT
+ | ERR_NOORIGIN
+ | ERR_NOSUCHSERVICE
+ | ERR_TOOMANYTARGETS
+ | ERR_WASNOSUCHNICK
+ | ERR_TOOMANYCHANNELS
+ | ERR_CANNOTSENDTOCHAN
+ | ERR_NOSUCHCHANNEL
+ | ERR_NOSUCHSERVER
+ | ERR_NOSUCHNICK
+
+and connection_reply =
+    RPL_BOUNCE
+ |  RPL_MYINFO
+ |  RPL_CREATED
+ |  RPL_YOURHOST
+ |  RPL_WELCOME
+
+type irc_reply =
+    Connection_reply of connection_reply
+  | Command_reply of command_reply
+  | Error_reply of error_reply
+
+and reply_type =
+    Type_connection
+  | Type_command
+  | Type_error
+
+and reply =
+    Connection of  Prefix.prefix option * connection_reply * IrcArg.arg option
+  | Command of  Prefix.prefix option * command_reply * IrcArg.arg option
+  | Error of  Prefix.prefix option * error_reply * IrcArg.arg option
+let get_command_reply n =
+match n with
+   263	->	 RPL_TRYAGAIN
+ | 319	->	 RPL_WHOISCHANNELS
+ | 318	->	 RPL_ENDOFWHOIS
+ | 317	->	 RPL_WHOISIDLE
+ | 316	->	 RPL_WHOISCHANOP
+ | 369	->	 RPL_ENDOFWHOWAS
+ | 314	->	 RPL_WHOWASUSER
+ | 313	->	 RPL_WHOISOPERATOR
+ | 312	->	 RPL_WHOISSERVER
+ | 311	->	 RPL_WHOISUSER
+ | 262	->	 RPL_TRACEEND
+ | 261	->	 RPL_TRACELOG
+ | 259	->	 RPL_ADMINEMAIL
+ | 258	->	 RPL_ADMINLOC2
+ | 257	->	 RPL_ADMINLOC1
+ | 256	->	 RPL_ADMINME
+ | 255	->	 RPL_LUSERME
+ | 254	->	 RPL_LUSERCHANNELS
+ | 253	->	 RPL_LUSERUNKNOWN
+ | 252	->	 RPL_LUSEROP
+ | 251	->	 RPL_LUSERCLIENT
+ | 250	->	 RPL_STATSDLINE
+ | 249	->	 RPL_STATSDEBUG
+ | 248	->	 RPL_STATSDEFINE
+ | 247	->	 RPL_STATSBLINE
+ | 246	->	 RPL_STATSPING
+ | 245	->	 RPL_STATSSLINE
+ | 244	->	 RPL_STATSHLINE
+ | 243	->	 RPL_STATSOLINE
+ | 242	->	 RPL_STATSUPTIME
+ | 241	->	 RPL_STATSLLINE
+ | 240	->	 RPL_STATSVLINE
+ | 235	->	 RPL_SERVLISTEND
+ | 234	->	 RPL_SERVLIST
+ | 233	->	 RPL_SERVICE
+ | 232	->	 RPL_ENDOFSERVICES
+ | 231	->	 RPL_SERVICEINFO
+ | 221	->	 RPL_UMODEIS
+ | 219	->	 RPL_ENDOFSTATS
+ | 218	->	 RPL_STATSYLINE
+ | 217	->	 RPL_STATSQLINE
+ | 216	->	 RPL_STATSKLINE
+ | 215	->	 RPL_STATSILINE
+ | 214	->	 RPL_STATSNLINE
+ | 213	->	 RPL_STATSCLINE
+ | 212	->	 RPL_STATSCOMMANDS
+ | 211	->	 RPL_STATSLINKINFO
+ | 210	->	 RPL_TRACERECONNECT
+ | 209	->	 RPL_TRACECLASS
+ | 208	->	 RPL_TRACENEWTYPE
+ | 207	->	 RPL_TRACESERVICE
+ | 206	->	 RPL_TRACESERVER
+ | 205	->	 RPL_TRACEUSER
+ | 204	->	 RPL_TRACEOPERATOR
+ | 203	->	 RPL_TRACEUNKNOWN
+ | 202	->	 RPL_TRACEHANDSHAKE
+ | 201	->	 RPL_TRACECONNECTING
+ | 200	->	 RPL_TRACELINK
+ | 395	->	 RPL_NOUSERS
+ | 394	->	 RPL_ENDOFUSERS
+ | 393	->	 RPL_USERS
+ | 392	->	 RPL_USERSSTART
+ | 391	->	 RPL_TIME
+ | 385	->	 RPL_NOTOPERANYMORE
+ | 384	->	 RPL_MYPORTIS
+ | 383	->	 RPL_YOURESERVICE
+ | 382	->	 RPL_REHASHING
+ | 381	->	 RPL_YOUREOPER
+ | 376	->	 RPL_ENDOFMOTD
+ | 375	->	 RPL_MOTDSTART
+ | 374	->	 RPL_ENDOFINFO
+ | 373	->	 RPL_INFOSTART
+ | 372	->	 RPL_MOTD
+ | 371	->	 RPL_INFO
+ | 368	->	 RPL_ENDOFBANLIST
+ | 367	->	 RPL_BANLIST
+ | 365	->	 RPL_ENDOFLINKS
+ | 364	->	 RPL_LINKS
+ | 363	->	 RPL_CLOSEEND
+ | 362	->	 RPL_CLOSING
+ | 361	->	 RPL_KILLDONE
+ | 366	->	 RPL_ENDOFNAMES
+ | 353	->	 RPL_NAMREPLY
+ | 315	->	 RPL_ENDOFWHO
+ | 352	->	 RPL_WHOREPLY
+ | 351	->	 RPL_VERSION
+ | 342	->	 RPL_SUMMONING
+ | 341	->	 RPL_INVITING
+ | 332	->	 RPL_TOPIC
+ | 331	->	 RPL_NOTOPIC
+ | 324	->	 RPL_CHANNELMODEIS
+ | 323	->	 RPL_LISTEND
+ | 322	->	 RPL_LIST
+ | 321	->	 RPL_LISTSTART
+ | 306	->	 RPL_NOWAWAY
+ | 305	->	 RPL_UNAWAY
+ | 304	->	 RPL_TEXT
+ | 303	->	 RPL_ISON
+ | 302	->	 RPL_USERHOST
+ | 301	->	 RPL_AWAY
+ | 300	->	 RPL_NONE
+ | _ -> raise (Unknown_Reply n)
+
+and get_error_reply n =
+match n with
+  502	->	 ERR_USERSDONTMATCH
+ | 501	->	 ERR_UMODEUNKNOWNFLAG
+ | 492	->	 ERR_NOSERVICEHOST
+ | 491	->	 ERR_NOOPERHOST
+ | 484	->	 ERR_RESTRICTED
+ | 483	->	 ERR_CANTKILLSERVER
+ | 482	->	 ERR_CHANOPRIVSNEEDED
+ | 481	->	 ERR_NOPRIVILEGES
+ | 477	->	 ERR_NOCHANMODES
+ | 476	->	 ERR_BADCHANMASK
+ | 475	->	 ERR_BADCHANNELKEY
+ | 474	->	 ERR_BANNEDFROMCHAN
+ | 473	->	 ERR_INVITEONLYCHAN
+ | 472	->	 ERR_UNKNOWNMODE
+ | 471	->	 ERR_CHANNELISFULL
+ | 467	->	 ERR_KEYSET
+ | 466	->	 ERR_YOUWILLBEBANNED
+ | 465	->	 ERR_YOUREBANNEDCREEP
+ | 464	->	 ERR_PASSWDMISMATCH
+ | 463	->	 ERR_NOPERMFORHOST
+ | 462	->	 ERR_ALREADYREGISTRED
+ | 461	->	 ERR_NEEDMOREPARAMS
+ | 451	->	 ERR_NOTREGISTERED
+ | 446	->	 ERR_USERSDISABLED
+ | 445	->	 ERR_SUMMONDISABLED
+ | 444	->	 ERR_NOLOGIN
+ | 443	->	 ERR_USERONCHANNEL
+ | 442	->	 ERR_NOTONCHANNEL
+ | 441	->	 ERR_USERNOTINCHANNEL
+ | 437	->	 ERR_UNAVAILRESOURCE
+ | 436	->	 ERR_NICKCOLLISION
+ | 435	->	 ERR_SERVICECONFUSED
+ | 434	->	 ERR_SERVICENAMEINUSE
+ | 433	->	 ERR_NICKNAMEINUSE
+ | 432	->	 ERR_ERRONEUSNICKNAME
+ | 431	->	 ERR_NONICKNAMEGIVEN
+ | 424	->	 ERR_FILEERROR
+ | 423	->	 ERR_NOADMININFO
+ | 422	->	 ERR_NOMOTD
+ | 421	->	 ERR_UNKNOWNCOMMAND
+ | 416	->	 ERR_TOOMANYMATCHES
+ | 415	->	 ERR_BADMASK
+ | 414	->	 ERR_WILDTOPLEVEL
+ | 413	->	 ERR_NOTOPLEVEL
+ | 412	->	 ERR_NOTEXTTOSEND
+ | 411	->	 ERR_NORECIPIENT
+ | 409	->	 ERR_NOORIGIN
+ | 408	->	 ERR_NOSUCHSERVICE
+ | 407	->	 ERR_TOOMANYTARGETS
+ | 406	->	 ERR_WASNOSUCHNICK
+ | 405	->	 ERR_TOOMANYCHANNELS
+ | 404	->	 ERR_CANNOTSENDTOCHAN
+ | 403	->	 ERR_NOSUCHCHANNEL
+ | 402	->	 ERR_NOSUCHSERVER
+ | 401	->	 ERR_NOSUCHNICK
+ | _ -> raise (Unknown_Reply n)
+
+and get_connection_reply n =
+  match n with
+    5	-> RPL_BOUNCE
+  | 4	-> RPL_MYINFO
+  | 3	-> RPL_CREATED
+  | 2	-> RPL_YOURHOST
+  | 1	-> RPL_WELCOME
+  | _	->	raise (Unknown_Reply n)
+
+
+let get_reply_id n =
+  if 200 <= n && n <= 399 then Command_reply (get_command_reply n)
+  else if 400 <= n && n <= 599 then Error_reply (get_error_reply n)
+  else if n < 100 then Connection_reply (get_connection_reply n)
+  else raise (Unknown_Reply n)
+
+and check_reply_type n = 
+  if n < 100 then Type_connection
+  else if 200 <= n && n <= 399 then Type_command
+  else if 400 <= n && n <= 599 then Type_error
+  else raise (Unknown_Reply n)
+      
+let get_reply_id_from_string = function 
+    "319"	->	Command_reply RPL_WHOISCHANNELS
+  | "394"	->	Command_reply RPL_ENDOFUSERS
+  | "393"	->	Command_reply RPL_USERS
+  | "392"	->	Command_reply RPL_USERSSTART
+  | "318"	->	Command_reply RPL_ENDOFWHOIS
+  | "317"	->	Command_reply RPL_WHOISIDLE
+  | "316"	->	Command_reply RPL_WHOISCHANOP
+  | "369"	->	Command_reply RPL_ENDOFWHOWAS
+  | "314"	->	Command_reply RPL_WHOWASUSER
+  | "313"	->	Command_reply RPL_WHOISOPERATOR
+  | "312"	->	Command_reply RPL_WHOISSERVER
+  | "311"	->	Command_reply RPL_WHOISUSER
+  | "263"	->	Command_reply RPL_TRYAGAIN
+  | "262"	->	Command_reply RPL_TRACEEND
+  | "261"	->	Command_reply RPL_TRACELOG
+  | "259"	->	Command_reply RPL_ADMINEMAIL
+  | "258"	->	Command_reply RPL_ADMINLOC2
+  | "257"	->	Command_reply RPL_ADMINLOC1
+  | "256"	->	Command_reply RPL_ADMINME
+  | "255"	->	Command_reply RPL_LUSERME
+  | "254"	->	Command_reply RPL_LUSERCHANNELS
+  | "253"	->	Command_reply RPL_LUSERUNKNOWN
+  | "252"	->	Command_reply RPL_LUSEROP
+  | "251"	->	Command_reply RPL_LUSERCLIENT
+  | "250"	->	Command_reply RPL_STATSDLINE
+  | "249"	->	Command_reply RPL_STATSDEBUG
+  | "248"	->	Command_reply RPL_STATSDEFINE
+  | "247"	->	Command_reply RPL_STATSBLINE
+  | "246"	->	Command_reply RPL_STATSPING
+  | "245"	->	Command_reply RPL_STATSSLINE
+  | "244"	->	Command_reply RPL_STATSHLINE
+  | "243"	->	Command_reply RPL_STATSOLINE
+  | "242"	->	Command_reply RPL_STATSUPTIME
+  | "241"	->	Command_reply RPL_STATSLLINE
+  | "240"	->	Command_reply RPL_STATSVLINE
+  | "235"	->	Command_reply RPL_SERVLISTEND
+  | "234"	->	Command_reply RPL_SERVLIST
+  | "233"	->	Command_reply RPL_SERVICE
+  | "232"	->	Command_reply RPL_ENDOFSERVICES
+  | "231"	->	Command_reply RPL_SERVICEINFO
+  | "221"	->	Command_reply RPL_UMODEIS
+  | "219"	->	Command_reply RPL_ENDOFSTATS
+  | "218"	->	Command_reply RPL_STATSYLINE
+  | "217"	->	Command_reply RPL_STATSQLINE
+  | "216"	->	Command_reply RPL_STATSKLINE
+  | "215"	->	Command_reply RPL_STATSILINE
+  | "214"	->	Command_reply RPL_STATSNLINE
+  | "213"	->	Command_reply RPL_STATSCLINE
+  | "212"	->	Command_reply RPL_STATSCOMMANDS
+  | "211"	->	Command_reply RPL_STATSLINKINFO
+  | "210"	->	Command_reply RPL_TRACERECONNECT
+  | "209"	->	Command_reply RPL_TRACECLASS
+  | "208"	->	Command_reply RPL_TRACENEWTYPE
+ | "207"	->	Command_reply RPL_TRACESERVICE
+ | "206"	->	Command_reply RPL_TRACESERVER
+ | "205"	->	Command_reply RPL_TRACEUSER
+ | "204"	->	Command_reply RPL_TRACEOPERATOR
+ | "203"	->	Command_reply RPL_TRACEUNKNOWN
+ | "202"	->	Command_reply RPL_TRACEHANDSHAKE
+ | "201"	->	Command_reply RPL_TRACECONNECTING
+ | "200"	->	Command_reply RPL_TRACELINK
+ | "395"	->	Command_reply RPL_NOUSERS
+ | "391"	->	Command_reply RPL_TIME
+ | "385"	->	Command_reply RPL_NOTOPERANYMORE
+ | "384"	->	Command_reply RPL_MYPORTIS
+ | "383"	->	Command_reply RPL_YOURESERVICE
+ | "382"	->	Command_reply RPL_REHASHING
+ | "381"	->	Command_reply RPL_YOUREOPER
+ | "376"	->	Command_reply RPL_ENDOFMOTD
+ | "375"	->	Command_reply RPL_MOTDSTART
+ | "374"	->	Command_reply RPL_ENDOFINFO
+ | "373"	->	Command_reply RPL_INFOSTART
+ | "372"	->	Command_reply RPL_MOTD
+ | "371"	->	Command_reply RPL_INFO
+ | "368"	->	Command_reply RPL_ENDOFBANLIST
+ | "367"	->	Command_reply RPL_BANLIST
+ | "365"	->	Command_reply RPL_ENDOFLINKS
+ | "364"	->	Command_reply RPL_LINKS
+ | "363"	->	Command_reply RPL_CLOSEEND
+ | "362"	->	Command_reply RPL_CLOSING
+ | "361"	->	Command_reply RPL_KILLDONE
+ | "366"	->	Command_reply RPL_ENDOFNAMES
+ | "353"	->	Command_reply RPL_NAMREPLY
+ | "315"	->	Command_reply RPL_ENDOFWHO
+ | "352"	->	Command_reply RPL_WHOREPLY
+ | "351"	->	Command_reply RPL_VERSION
+ | "342"	->	Command_reply RPL_SUMMONING
+ | "341"	->	Command_reply RPL_INVITING
+ | "332"	->	Command_reply RPL_TOPIC
+ | "331"	->	Command_reply RPL_NOTOPIC
+ | "324"	->	Command_reply RPL_CHANNELMODEIS
+ | "323"	->	Command_reply RPL_LISTEND
+ | "322"	->	Command_reply RPL_LIST
+ | "321"	->	Command_reply RPL_LISTSTART
+ | "306"	->	Command_reply RPL_NOWAWAY
+ | "305"	->	Command_reply RPL_UNAWAY
+ | "304"	->	Command_reply RPL_TEXT
+ | "303"	->	Command_reply RPL_ISON
+ | "302"	->	Command_reply RPL_USERHOST
+ | "301"	->	Command_reply RPL_AWAY
+ | "300"	->	Command_reply RPL_NONE
+ | "502"	->	Error_reply ERR_USERSDONTMATCH
+ | "501"	->	Error_reply ERR_UMODEUNKNOWNFLAG
+ | "492"	->	Error_reply ERR_NOSERVICEHOST
+ | "491"	->	Error_reply ERR_NOOPERHOST
+ | "484"	->	Error_reply ERR_RESTRICTED
+ | "483"	->	Error_reply ERR_CANTKILLSERVER
+ | "482"	->	Error_reply ERR_CHANOPRIVSNEEDED
+ | "481"	->	Error_reply ERR_NOPRIVILEGES
+ | "477"	->	Error_reply ERR_NOCHANMODES
+ | "476"	->	Error_reply ERR_BADCHANMASK
+ | "475"	->	Error_reply ERR_BADCHANNELKEY
+ | "474"	->	Error_reply ERR_BANNEDFROMCHAN
+ | "473"	->	Error_reply ERR_INVITEONLYCHAN
+ | "472"	->	Error_reply ERR_UNKNOWNMODE
+ | "471"	->	Error_reply ERR_CHANNELISFULL
+ | "467"	->	Error_reply ERR_KEYSET
+ | "466"	->	Error_reply ERR_YOUWILLBEBANNED
+ | "465"	->	Error_reply ERR_YOUREBANNEDCREEP
+ | "464"	->	Error_reply ERR_PASSWDMISMATCH
+ | "463"	->	Error_reply ERR_NOPERMFORHOST
+ | "462"	->	Error_reply ERR_ALREADYREGISTRED
+ | "461"	->	Error_reply ERR_NEEDMOREPARAMS
+ | "451"	->	Error_reply ERR_NOTREGISTERED
+ | "446"	->	Error_reply ERR_USERSDISABLED
+ | "445"	->	Error_reply ERR_SUMMONDISABLED
+ | "444"	->	Error_reply ERR_NOLOGIN
+ | "443"	->	Error_reply ERR_USERONCHANNEL
+ | "442"	->	Error_reply ERR_NOTONCHANNEL
+ | "441"	->	Error_reply ERR_USERNOTINCHANNEL
+ | "437"	->	Error_reply ERR_UNAVAILRESOURCE
+ | "436"	->	Error_reply ERR_NICKCOLLISION
+ | "435"	->	Error_reply ERR_SERVICECONFUSED
+ | "434"	->	Error_reply ERR_SERVICENAMEINUSE
+ | "433"	->	Error_reply ERR_NICKNAMEINUSE
+ | "432"	->	Error_reply ERR_ERRONEUSNICKNAME
+ | "431"	->	Error_reply ERR_NONICKNAMEGIVEN
+ | "424"	->	Error_reply ERR_FILEERROR
+ | "423"	->	Error_reply ERR_NOADMININFO
+ | "422"	->	Error_reply ERR_NOMOTD
+ | "421"	->	Error_reply ERR_UNKNOWNCOMMAND
+ | "416"	->	Error_reply ERR_TOOMANYMATCHES
+ | "415"	->	Error_reply ERR_BADMASK
+ | "414"	->	Error_reply ERR_WILDTOPLEVEL
+ | "413"	->	Error_reply ERR_NOTOPLEVEL
+ | "412"	->	Error_reply ERR_NOTEXTTOSEND
+ | "411"	->	Error_reply ERR_NORECIPIENT
+ | "409"	->	Error_reply ERR_NOORIGIN
+ | "408"	->	Error_reply ERR_NOSUCHSERVICE
+ | "407"	->	Error_reply ERR_TOOMANYTARGETS
+ | "406"	->	Error_reply ERR_WASNOSUCHNICK
+ | "405"	->	Error_reply ERR_TOOMANYCHANNELS
+ | "404"	->	Error_reply ERR_CANNOTSENDTOCHAN
+ | "403"	->	Error_reply ERR_NOSUCHCHANNEL
+ | "402"	->	Error_reply ERR_NOSUCHSERVER
+ | "401"	->	Error_reply ERR_NOSUCHNICK
+ | "005"	->	Connection_reply RPL_BOUNCE
+ | "004"	->	Connection_reply RPL_MYINFO
+ | "003"	->	Connection_reply RPL_CREATED
+ | "002"	->	Connection_reply RPL_YOURHOST
+ | "001"	->	Connection_reply RPL_WELCOME
+ | x	->	raise (Unknown_Reply (int_of_string x))
+
+let getReplyNumber r = 
+  match r with
+    Command_reply rs ->
+      begin
+	match rs with
+	  RPL_TRYAGAIN	->	"263"
+	|  RPL_TRACEEND	->	"262"
+	|  RPL_TRACELOG	->	"261"
+	|  RPL_ADMINEMAIL	->	"259"
+	|  RPL_ADMINLOC2	->	"258"
+	|  RPL_ADMINLOC1	->	"257"
+	|  RPL_ADMINME	->	"256"
+	|  RPL_LUSERME	->	"255"
+	|  RPL_LUSERCHANNELS	->	"254"
+	|  RPL_LUSERUNKNOWN	->	"253"
+	|  RPL_LUSEROP	->	"252"
+	|  RPL_LUSERCLIENT	->	"251"
+	|  RPL_STATSDLINE	->	"250"
+	|  RPL_STATSDEBUG	->	"249"
+	|  RPL_STATSDEFINE	->	"248"
+	|  RPL_STATSBLINE	->	"247"
+	|  RPL_STATSPING	->	"246"
+	|  RPL_STATSSLINE	->	"245"
+	|  RPL_STATSHLINE	->	"244"
+	|  RPL_STATSOLINE	->	"243"
+	|  RPL_STATSUPTIME	->	"242"
+	|  RPL_STATSLLINE	->	"241"
+	|  RPL_STATSVLINE	->	"240"
+	|  RPL_SERVLISTEND	->	"235"
+	|  RPL_SERVLIST	->	"234"
+	|  RPL_SERVICE	->	"233"
+	|  RPL_ENDOFSERVICES	->	"232"
+	|  RPL_SERVICEINFO	->	"231"
+	|  RPL_UMODEIS	->	"221"
+	|  RPL_ENDOFSTATS	->	"219"
+	|  RPL_STATSYLINE	->	"218"
+	|  RPL_STATSQLINE	->	"217"
+	|  RPL_STATSKLINE	->	"216"
+	|  RPL_STATSILINE	->	"215"
+	|  RPL_STATSNLINE	->	"214"
+	|  RPL_STATSCLINE	->	"213"
+	|  RPL_STATSCOMMANDS	->	"212"
+	|  RPL_STATSLINKINFO	->	"211"
+	|  RPL_TRACERECONNECT	->	"210"
+	|  RPL_TRACECLASS	->	"209"
+	|  RPL_TRACENEWTYPE	->	"208"
+	|  RPL_TRACESERVICE	->	"207"
+	|  RPL_TRACESERVER	->	"206"
+	|  RPL_TRACEUSER	->	"205"
+	|  RPL_TRACEOPERATOR	->	"204"
+	|  RPL_TRACEUNKNOWN	->	"203"
+	|  RPL_TRACEHANDSHAKE	->	"202"
+	|  RPL_TRACECONNECTING	->	"201"
+	|  RPL_TRACELINK	->	"200"
+	|  RPL_NOUSERS	->	"395"
+	|  RPL_ENDOFUSERS	->	"394"
+	|  RPL_USERS	->	"393"
+	|  RPL_USERSSTART	->	"392"
+	|  RPL_TIME	->	"391"
+	|  RPL_NOTOPERANYMORE	->	"385"
+	|  RPL_MYPORTIS	->	"384"
+	|  RPL_YOURESERVICE	->	"383"
+	|  RPL_REHASHING	->	"382"
+	|  RPL_YOUREOPER	->	"381"
+	|  RPL_ENDOFMOTD	->	"376"
+	|  RPL_MOTDSTART	->	"375"
+	|  RPL_ENDOFINFO	->	"374"
+	|  RPL_INFOSTART	->	"373"
+	|  RPL_MOTD	->	"372"
+	|  RPL_INFO	->	"371"
+	|  RPL_ENDOFBANLIST	->	"368"
+	|  RPL_BANLIST	->	"367"
+	|  RPL_ENDOFLINKS	->	"365"
+	|  RPL_LINKS	->	"364"
+	|  RPL_CLOSEEND	->	"363"
+	|  RPL_CLOSING	->	"362"
+	|  RPL_KILLDONE	->	"361"
+	|  RPL_ENDOFNAMES	->	"366"
+	|  RPL_NAMREPLY	->	"353"
+	|  RPL_ENDOFWHO	->	"315"
+	|  RPL_WHOREPLY	->	"352"
+	|  RPL_VERSION	->	"351"
+	|  RPL_SUMMONING	->	"342"
+	|  RPL_INVITING	->	"341"
+	|  RPL_TOPIC	->	"332"
+	|  RPL_NOTOPIC	->	"331"
+	|  RPL_CHANNELMODEIS	->	"324"
+	|  RPL_LISTEND	->	"323"
+	|  RPL_LIST	->	"322"
+	|  RPL_LISTSTART	->	"321"
+	|  RPL_WHOISCHANNELS	->	"319"
+	|  RPL_ENDOFWHOIS	->	"318"
+	|  RPL_WHOISIDLE	->	"317"
+	|  RPL_WHOISCHANOP	->	"316"
+	|  RPL_ENDOFWHOWAS	->	"369"
+	|  RPL_WHOWASUSER	->	"314"
+	|  RPL_WHOISOPERATOR	->	"313"
+	|  RPL_WHOISSERVER	->	"312"
+	|  RPL_WHOISUSER	->	"311"
+	|  RPL_NOWAWAY	->	"306"
+	|  RPL_UNAWAY	->	"305"
+	|  RPL_TEXT	->	"304"
+	|  RPL_ISON	->	"303"
+	|  RPL_USERHOST	->	"302"
+	|  RPL_AWAY	->	"301"
+	|  RPL_NONE	->	"300"
+      end
+  | Error_reply rs ->
+      begin
+	match rs with
+	  ERR_USERSDONTMATCH	->	"502"
+	| ERR_UMODEUNKNOWNFLAG	->	"501"
+	| ERR_NOSERVICEHOST	->	"492"
+	| ERR_NOOPERHOST	->	"491"
+	| ERR_RESTRICTED	->	"484"
+	| ERR_CANTKILLSERVER	->	"483"
+	| ERR_CHANOPRIVSNEEDED	->	"482"
+	| ERR_NOPRIVILEGES	->	"481"
+	| ERR_NOCHANMODES	->	"477"
+	| ERR_BADCHANMASK	->	"476"
+	| ERR_BADCHANNELKEY	->	"475"
+	| ERR_BANNEDFROMCHAN	->	"474"
+	| ERR_INVITEONLYCHAN	->	"473"
+	| ERR_UNKNOWNMODE	->	"472"
+	| ERR_CHANNELISFULL	->	"471"
+	| ERR_KEYSET	->	"467"
+	| ERR_YOUWILLBEBANNED	->	"466"
+	| ERR_YOUREBANNEDCREEP	->	"465"
+	| ERR_PASSWDMISMATCH	->	"464"
+	| ERR_NOPERMFORHOST	->	"463"
+	| ERR_ALREADYREGISTRED	->	"462"
+	| ERR_NEEDMOREPARAMS	->	"461"
+	| ERR_NOTREGISTERED	->	"451"
+	| ERR_USERSDISABLED	->	"446"
+	| ERR_SUMMONDISABLED	->	"445"
+	| ERR_NOLOGIN	->	"444"
+	| ERR_USERONCHANNEL	->	"443"
+	| ERR_NOTONCHANNEL	->	"442"
+	| ERR_USERNOTINCHANNEL	->	"441"
+	| ERR_UNAVAILRESOURCE	->	"437"
+	| ERR_NICKCOLLISION	->	"436"
+	| ERR_SERVICECONFUSED	->	"435"
+	| ERR_SERVICENAMEINUSE	->	"434"
+	| ERR_NICKNAMEINUSE	->	"433"
+	| ERR_ERRONEUSNICKNAME	->	"432"
+	| ERR_NONICKNAMEGIVEN	->	"431"
+	| ERR_FILEERROR	->	"424"
+	| ERR_NOADMININFO	->	"423"
+	| ERR_NOMOTD	->	"422"
+	| ERR_UNKNOWNCOMMAND	->	"421"
+	| ERR_TOOMANYMATCHES	->	"416"
+	| ERR_BADMASK	->	"415"
+	| ERR_WILDTOPLEVEL	->	"414"
+	| ERR_NOTOPLEVEL	->	"413"
+	| ERR_NOTEXTTOSEND	->	"412"
+	| ERR_NORECIPIENT	->	"411"
+	| ERR_NOORIGIN	->	"409"
+	| ERR_NOSUCHSERVICE	->	"408"
+	| ERR_TOOMANYTARGETS	->	"407"
+	| ERR_WASNOSUCHNICK	->	"406"
+	| ERR_TOOMANYCHANNELS	->	"405"
+	| ERR_CANNOTSENDTOCHAN	->	"404"
+	| ERR_NOSUCHCHANNEL	->	"403"
+	| ERR_NOSUCHSERVER	->	"402"
+	| ERR_NOSUCHNICK	->	"401"
+      end
+  | Connection_reply rs ->
+      begin 
+	match rs with
+	  RPL_BOUNCE	->	"005"
+	| RPL_MYINFO	->	"004"
+	| RPL_CREATED	->	"003"
+	| RPL_YOURHOST	->	"002"
+	| RPL_WELCOME	->	"001"
+      end
+
+
diff --git a/applications/camlirc/server.ml b/applications/camlirc/server.ml
new file mode 100644
index 0000000..551b96b
--- /dev/null
+++ b/applications/camlirc/server.ml
@@ -0,0 +1,249 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+open Unix
+open Printf
+open Xml_lexer
+open Xml
+
+exception Config_error
+exception Unknown_server_error of string
+
+class server_info_signals ~(name_changed: (string * string) GUtil.signal) =
+  object
+    inherit GUtil.ml_signals [name_changed#disconnect]
+    method name_changed = name_changed#connect ~after
+  end
+
+
+class server_info ~(setting_name : string)
+    ?(server = "") ?(port = 6667) ?(timeout = 0.01) 
+    ?(passwd = "") ?(quit = "CamlIRC") ?(part = "bye...") 
+     () =
+  let user_entry = Constants.user_entry
+  and name_changed = new GUtil.signal ()
+  in
+  object (self)
+    val mutable setting_name = setting_name
+    val mutable server = server
+    val mutable port = port
+    val mutable timeout = timeout
+    val mutable nick = user_entry.pw_name
+    val mutable clienthost = gethostname()
+    val mutable username = user_entry.pw_name
+    val mutable server_addr = None
+    val mutable passwd = passwd
+    val mutable fullname = user_entry.pw_gecos
+    val mutable quit = quit
+    val mutable part = part
+    val mutable channel_list  : (string * string) list = []
+    val mutable auto_connect = false
+    val mutable auto_url_open = false
+    method name_changed = name_changed
+    method connect = new server_info_signals ~name_changed
+    method setting_name () = setting_name
+    method server () = server
+    method port () = port
+    method sock_addr () = 
+      match server_addr with Some s -> s 
+      | None -> raise Config_error
+    method timeout () = timeout
+    method clienthost () = clienthost
+    method nick () = nick
+    method username () = username
+    method passwd () = passwd
+    method fullname () = fullname
+    method quit_message () = quit
+    method part_message () = part
+    method channel_list () = channel_list
+    method auto_connect () = auto_connect
+    method auto_url_open () = auto_url_open
+    method make_server_addr () = 
+      let server_entry = 
+	try gethostbyname server 
+	with Not_found -> raise Config_error
+      in
+      server_addr <- 
+	Some 
+	  (ADDR_INET (Array.get server_entry.h_addr_list 0, port))
+    method set_setting_name s = 
+      let
+	  org_s = setting_name 
+      in setting_name <- s; name_changed#call (org_s, s)
+    method set_server a =
+      begin
+	server <- a;
+      end
+    method set_sock_addr a = server_addr <- a
+    method set_timeout a = timeout <- a
+    method set_port a = port <- a
+    method set_clienthost a = 
+      clienthost <- if a = "" then gethostname () else a 
+    method set_nick a =
+      nick <- if a = "" then user_entry.pw_name else a
+    method set_username a =
+      username <- if a = "" then user_entry.pw_name else a
+    method set_passwd a = passwd <- a
+    method set_fullname a = 
+      fullname <- if a = "" then user_entry.pw_gecos else a
+    method set_quit_message a = quit <- a
+    method set_part_message a = part <- a
+    method add_channel_list cn cm = 
+      if not (List.exists (fun (s,_) -> s = cn) channel_list) then
+	channel_list <- (cn, cm) :: channel_list
+    method remove_channel_list cn = 
+      channel_list <- List.filter (fun (s,_) -> not (cn = s)) channel_list
+    method set_channel_list cn = channel_list <- cn
+    method set_auto_connect b = auto_connect <- b
+    method set_auto_url_open b = auto_url_open <- b
+    method self = self
+    initializer
+      ()
+  end
+
+class server_info_list_signals ~(changed: unit GUtil.signal) =
+  object
+    inherit GUtil.ml_signals [changed#disconnect]
+    method changed = changed#connect ~after
+  end
+
+class server_info_list ~(servers : server_info list) =
+  let changed = new GUtil.signal ()
+  in
+  object (self)
+    val mutable servers = List.map (fun s-> (s#setting_name(), s)) servers
+    method servers () = servers
+    method changed = changed
+    method connect = new server_info_list_signals ~changed:self#changed
+    method add_server s = 
+      begin 
+	servers <- (s#setting_name(), s)::servers;
+	changed#call ()
+      end
+    method delete_server s = 
+      begin 
+	servers <- List.remove_assoc s servers;
+	changed#call ()
+      end
+    method replace_server s = 
+      servers <- List.remove_assoc (s#setting_name()) servers;
+      servers <- (s#setting_name(), s)::servers;
+      print_string ("replaced "^(s#setting_name())^" as "^
+		    (s#server ())^"\n");
+	flush Pervasives.stdout;
+    method change_setting_name ~from_sn ~(to_sn:string) =
+      let
+	  s = self#get_server_setting from_sn
+      in
+      begin 
+	self#delete_server from_sn;
+	self#add_server s
+      end
+    method server_names () =  List.map (fun s -> fst s) servers
+    method get_server_setting s = 
+      try
+	List.assoc s servers 
+      with Not_found -> raise Config_error
+    method get_primary_setting () =
+      match servers with
+	[] -> None
+      | h::_ -> Some h
+
+    method load_settings ~file =
+      try
+        let setting_dtd =
+          { tags =
+              ("channel", (["mode",`Required], text)) ::
+            List.map (fun tag -> tag, ([], text))
+                ["server"; "port"; "nick"; "username"; "passwd"; "fullname";
+                 "quitmessage"; "partmessage"; "autoconnect"; "autourlopen"];
+            allow = `Tags } in
+        let dtd =
+          { tags = ["setting", (["name",`Required], setting_dtd)];
+            allow = `Tags } in
+        let handle_subnode ~e elt =
+          match elt.elt_desc with
+          | Node(tag, attrs, l) ->
+              let l = List.map  
+                  (function {elt_desc=Text s} -> s | _ -> assert false) l in
+              let s = String.concat "\n" l in
+              begin match tag with
+	      | "server"      -> e#set_server s
+	      | "port"        -> e#set_port (int_of_string s)
+	      | "nick"        -> e#set_nick s
+	      | "username"    -> e#set_username s
+	      | "passwd"      -> e#set_passwd s
+	      | "fullname"    -> e#set_fullname s
+	      | "quitmessage" -> e#set_quit_message s
+	      | "partmessage" -> e#set_part_message s
+	      | "channel"     -> e#add_channel_list s (List.assoc "mode" attrs)
+	      | "autoconnect" -> e#set_auto_connect (bool_of_string s)
+	      | "autourlopen" -> e#set_auto_url_open (bool_of_string s)
+	      | _ -> assert false
+              end
+          | _ -> assert false
+        in
+        let handle_setting elt =
+          match elt.elt_desc with
+          | Node ("setting", attrs, subnodes) ->
+              let e =
+                new server_info ~setting_name:(List.assoc "name" attrs) () in
+              List.iter (handle_subnode ~e) subnodes ;
+              self#add_server e
+	  | _ -> assert false
+        in
+        List.iter handle_setting
+          (Xml.parse_file file ~doctype:Constants.doctype ~dtd)
+      with
+      | Xml_lexer.Error (err, pos) ->
+	  eprintf "In file %s, char %d: %s.\n" file pos
+	    (Xml_lexer.error_string err);
+          flush Pervasives.stderr
+      | Sys_error _ -> ()
+	    
+    method save_settings ~file =
+      let oc = open_out file in
+      fprintf oc "<!DOCTYPE \"%s\">\n" Constants.doctype;
+      List.iter
+        begin fun e ->
+	  let e = snd e
+	  in
+          fprintf oc "<SETTING NAME=\"%s\">\n" (e#setting_name ());
+          List.iter
+            (fun (tag, text) -> fprintf oc "  <%s>%s</%s>\n" tag text tag)
+            [ "SERVER", e#server ();
+	      "PORT", string_of_int (e#port ());
+              "NICK", e#nick ();
+	      "USERNAME", e#username ();
+	      "PASSWD", e#passwd ();
+	      "FULLNAME", e#fullname ();
+	      "AUTOCONNECT", string_of_bool (e#auto_connect ());
+	      "AUTOURLOPEN", string_of_bool (e#auto_url_open ());
+	      "QUITMESSAGE", e#quit_message ();
+	      "PARTMESSAGE", e#part_message ()];
+	  List.iter
+            (fun (t,m) -> 
+	      fprintf oc "  <CHANNEL MODE=\"%s\">%s</CHANNEL>\n" m t)
+	    (e#channel_list ());
+          fprintf oc "</SETTING>\n"
+        end 
+	servers ;
+      close_out oc
+  end
diff --git a/applications/camlirc/xml.ml b/applications/camlirc/xml.ml
new file mode 100644
index 0000000..87cbad0
--- /dev/null
+++ b/applications/camlirc/xml.ml
@@ -0,0 +1,162 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+open Xml_lexer
+
+type element = { elt_desc: element_desc; elt_start: int; elt_end: int}
+and element_desc =
+  | Node of string * (string * string) list * element list
+  | Text of string
+
+type presence = [`Required | `Optional]
+type dtd =
+    { tags: (string * ((string * presence) list * dtd)) list;
+      allow: [`Mixed | `Tags | `Any] }
+
+let any = {tags = []; allow = `Any}
+let text = {tags = []; allow = `Mixed}
+
+let check_tag ~name ~attrs ~dtd =
+  try
+    let attr_dtd, child_dtd = List.assoc name dtd.tags in
+    List.iter (fun (key,_) -> ignore (List.assoc key attr_dtd)) attrs;
+    List.iter 
+      (function (key,`Required) -> ignore (List.assoc key attrs) | _ -> ())
+      attr_dtd ;
+    child_dtd
+  with Not_found ->
+    if dtd.allow = `Any then any else
+    raise (Error(Other"input does not conform to DTD", token_start ()))
+
+let check_text ~dtd =
+  if dtd.allow = `Tags then
+    raise (Error(Other"input does not conform to DTD", token_start ()))
+
+let parse ?doctype ?(dtd=any) lexbuf =
+  begin match doctype with None -> ()
+  | Some doctype -> match token lexbuf with
+    | Tag ("!doctype", attrs, _) ->
+        if not (List.mem_assoc (String.lowercase doctype) attrs) then
+          raise (Error(Other"Document type differs", token_start ()))
+    | _ ->
+        raise (Error(Other"Document type missing", token_start ()))
+  end;
+  let mkelt d =
+    { elt_desc = d;
+      elt_start = token_start ();
+      elt_end = Lexing.lexeme_end lexbuf } in
+  let rec parse ~prev ~dtd =
+    match token lexbuf with
+    | Tag (name, attrs, closed) ->
+        let closed = closed || name.[0] = '!' in
+        let child_dtd = check_tag ~name ~attrs:attrs ~dtd in
+        if closed then
+          parse ~prev:(mkelt(Node (name, attrs, [])) :: prev) ~dtd
+        else begin
+          let nodes, closing = parse ~prev:[] ~dtd:child_dtd in
+          let prev = mkelt(Node (name, attrs, List.rev nodes)) :: prev in
+          if closing = Some name then
+            parse ~prev ~dtd
+          else
+            prev, closing
+        end
+    | Chars s ->
+        check_text ~dtd;
+        parse ~prev:(mkelt(Text s) :: prev) ~dtd
+    | Endtag name ->
+        prev, Some name
+    | EOF ->
+        prev, None
+  in parse ~prev:[] ~dtd
+
+let parse_lexbuf ?doctype ?dtd lexbuf =
+  List.rev (fst (parse lexbuf ?doctype ?dtd))
+
+let parse_string ?doctype ?dtd s =
+  parse_lexbuf (Lexing.from_string s) ?doctype ?dtd
+
+type 'a result = Ok of 'a | Exn of exn
+let protect f x = try Ok (f x) with exn -> Exn exn
+let return = function Ok x -> x | Exn exn -> raise exn
+
+let parse_file ?doctype ?dtd name =
+  let ic = open_in name in
+  let res = protect (parse_lexbuf ?doctype ?dtd) (Lexing.from_channel ic) in
+  close_in ic;
+  return res
+
+(*
+class reader lexbuf ~name ~attrs ~closed =
+  object (self)
+    val mutable closed = closed
+    val mutable closing = None
+    val mutable current = None
+    val start = token_start ()
+    method name = name
+    method attrs = attrs
+    method get_attr key : string = List.assoc (String.lowercase key) attrs
+    method has_attr key = List.mem_assoc (String.lowercase key) attrs
+
+    method finish =
+      while not closed do ignore (self#next_child) done;
+      closing
+      
+    method next_child : [`NODE of string * reader | `TEXT of string | `NONE] =
+      begin match current with None -> ()
+      | Some node ->
+          current <- None;
+          match node#finish with None -> ()
+          | Some name' ->
+              if name <> name' then closing <- Some name';
+              closed <- true
+      end;
+      if closed then `NONE else begin
+        match token lexbuf with
+        | Tag (name, attrs, closed) ->
+            let attrs =
+              List.map attrs ~f:(fun (k,v) -> String.lowercase k,v) in
+            let closed = closed || name.[0] = '!' in
+            let node = new reader lexbuf ~name ~attrs ~closed in
+            current <- Some node;
+            `NODE (name, node)
+        | Chars s ->
+            `TEXT s
+        | Endtag name' ->
+            if name' <> name then closing <- Some name';
+            `NONE
+        | EOF ->
+            closing <- Some "";
+            `NONE
+      end
+
+    method iter (f : [`NODE of string * reader | `TEXT of string] -> unit) =
+      while match self#next_child with
+        `NODE _ | `TEXT _ as x -> f x; true
+      | `NONE -> false
+      do () done
+  end
+
+let reader ic =
+  new reader (Lexing.from_channel ic) ~name:"" ~attrs:[] ~closed:false
+
+let string_reader s =
+  new reader (Lexing.from_string s) ~name:"" ~attrs:[] ~closed:false
+*)
diff --git a/applications/camlirc/xml_lexer.mli b/applications/camlirc/xml_lexer.mli
new file mode 100644
index 0000000..9216f50
--- /dev/null
+++ b/applications/camlirc/xml_lexer.mli
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+type error =
+  | Illegal_character of char
+  | Bad_entity of string
+  | Unterminated of string
+  | Tag_expected
+  | Other of string
+exception Error of error * int
+val error_string : error -> string
+
+type token =
+  | Tag of string * (string * string) list * bool
+        (* [Tag (name, attributes, closed)] denotes an opening tag with
+           the specified [name] and [attributes]. If [closed], then the tag
+           ended in "/>", meaning that it has no sub-elements. *)
+  | Chars of string
+        (* Some text between the tags, cut by line *)
+  | Endtag of string
+        (* A closing tag *)
+  | EOF
+        (* End of input *)
+val token : Lexing.lexbuf -> token
+val token_start : unit -> int
+
+val base64 : Lexing.lexbuf -> int
+    (* Decode base 64 data to 6-bit ints, skipping blanks *)
diff --git a/applications/camlirc/xml_lexer.mll b/applications/camlirc/xml_lexer.mll
new file mode 100644
index 0000000..a34831d
--- /dev/null
+++ b/applications/camlirc/xml_lexer.mll
@@ -0,0 +1,195 @@
+(**************************************************************************)
+(*     Lablgtk - Camlirc                                                  *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Nobuaki Yoshida  <nyoshi@dd.iij4u.or.jp>                          *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+{
+open Lexing
+
+type error =
+  | Illegal_character of char
+  | Bad_entity of string
+  | Unterminated of string
+  | Tag_expected
+  | Other of string
+
+let error_string = function
+  | Illegal_character c ->
+      "illegal character '" ^ Char.escaped c ^ "'"
+  | Bad_entity s ->
+      "\"&" ^ s ^ ";\" is not a valid entity"
+  | Unterminated s -> "unterminated " ^ s ^ " starts here"
+  | Tag_expected -> "a tag was expected"
+  | Other s -> s
+
+exception Error of error * int
+
+type token =
+  | Tag of string * (string * string) list * bool
+  | Chars of string
+  | Endtag of string
+  | EOF
+
+let string_start_pos = ref 0
+and comment_start_pos = ref 0
+and token_start_pos = ref 0
+
+let token_start () = !token_start_pos
+
+let string_buffer = Buffer.create 80
+let reset_string lexbuf =
+  string_start_pos := lexeme_start lexbuf;
+  Buffer.reset string_buffer
+
+let reset_comment lexbuf =
+  comment_start_pos := lexeme_start lexbuf
+
+let entities = [ "lt", "<"; "gt", ">"; "ampers", "&" ]
+
+}
+
+let break = ['\010' '\013' '\012']
+let space = [' ' '\009']
+let identchar =  ['A'-'Z' 'a'-'z' '_' '0'-'9']
+
+rule token = parse
+  | break +
+      { token lexbuf }
+  | space +
+      { token lexbuf }
+
+  | "<!--"
+      { reset_comment lexbuf; comment lexbuf; token lexbuf }
+  | "</"
+      { token_start_pos := lexeme_start lexbuf;
+        let tag = tag_name lexbuf in close_tag lexbuf; Endtag tag }
+        
+  | "<"
+      { token_start_pos := lexeme_start lexbuf;
+        let tag = tag_name lexbuf in
+        let attribs, closed = attributes lexbuf in
+        Tag(tag, attribs, closed) }
+  | space * [ ^ ' ' '\009' '\010' '\013' '\012' '<' '>' '&'] +
+      { token_start_pos := lexeme_start lexbuf;
+        reset_string lexbuf;
+        Buffer.add_string string_buffer (lexeme lexbuf);
+        Chars(chars lexbuf) }
+  | "&"
+      { token_start_pos := lexeme_start lexbuf;
+        reset_string lexbuf;
+        Buffer.add_string string_buffer (entity lexbuf);
+        Chars(chars lexbuf)  }
+  | eof
+      { EOF }
+  | _
+      { raise (Error(Illegal_character (lexeme_char lexbuf 0),
+                     lexeme_start lexbuf)) }
+
+and chars = parse
+  | [ ^ '\010' '\013' '\012' '<' '>' '&' ] +
+      { Buffer.add_string string_buffer (lexeme lexbuf);
+        chars lexbuf }
+  | "&"
+      { Buffer.add_string string_buffer (entity lexbuf);
+        chars lexbuf  }
+  | ""
+      { Buffer.contents string_buffer }
+
+and entity = parse
+  | identchar + ";"
+      { let s = lexeme lexbuf in
+      let s = String.sub s 0 (String.length s - 1) in
+        try List.assoc (String.lowercase s) entities
+        with Not_found ->
+          "&" ^ String.lowercase s ^ ";" }
+  | _
+      { raise (Error (Unterminated "entity", lexeme_start lexbuf)) }
+
+and tag_name = parse
+  | ('!' ?) (identchar +)
+      { String.lowercase (lexeme lexbuf) }
+  | _
+      { raise (Error(Tag_expected, lexeme_start lexbuf)) }
+
+and close_tag = parse
+  | (space|break) +
+      { close_tag lexbuf }
+  | ">"
+      { () }
+  | _
+      { raise (Error(Illegal_character (lexeme_char lexbuf 0),
+                     lexeme_start lexbuf)) }
+
+and attributes = parse
+  | (space|break) +
+      { attributes lexbuf }
+  | ">"
+      { [], false }
+  | "/>"
+      { [], true }
+  | ""
+      { let key = attribute lexbuf in
+        let data = attribute_data lexbuf in
+        let others, closed = attributes lexbuf in
+        (String.lowercase key, data) :: others, closed }
+
+and attribute = parse
+  | '"'
+      { reset_string lexbuf; string lexbuf }
+  | [ ^ ' ' '\010' '\013' '\009' '\012' '=' '<' '>' '"' ] +
+      { lexeme lexbuf }
+
+and attribute_data = parse
+  | "=" { attribute lexbuf }
+  | ""  { "" }
+
+and string = parse
+  | '"'
+      { Buffer.contents string_buffer }
+  | "\\" [ '"' '\\' ]
+      { Buffer.add_char string_buffer (lexeme_char lexbuf 1); string lexbuf }
+  | eof
+      { raise (Error(Unterminated "string", !string_start_pos)) }
+  | _
+      {  Buffer.add_char string_buffer (lexeme_char lexbuf 0); string lexbuf }
+
+and comment = parse
+  | "-->"
+      { () }
+  | eof
+      { raise (Error(Unterminated "comment", !comment_start_pos)) }
+  | _
+      { comment lexbuf }
+
+and base64 = parse
+  | (space|break) +
+      { base64 lexbuf }
+  | ['A'-'Z']
+      { Char.code (lexeme_char lexbuf 0) - Char.code 'A' }
+  | ['a'-'z']
+      { Char.code (lexeme_char lexbuf 0) - Char.code 'a' + 26 }
+  | ['0'-'9']
+      { Char.code (lexeme_char lexbuf 0) - Char.code '0' + 52 }
+  | '+'
+      { 62 }
+  | '/'
+      { 63 }
+  | _
+      { raise (Error(Illegal_character (lexeme_char lexbuf 0),
+                     lexeme_start lexbuf)) }
diff --git a/applications/osiris/osiris.ml b/applications/osiris/osiris.ml
new file mode 100644
index 0000000..44b537b
--- /dev/null
+++ b/applications/osiris/osiris.ml
@@ -0,0 +1,768 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+type handle = Gtk.widget Gobject.obj
+type menuhandle = Gtk.menu_shell Gobject.obj
+type richcolor = Gdk.Color.t
+type hres
+type hresources
+
+type richeffect =
+    FE_AUTOCOLOR
+  | FE_BOLD
+  | FE_ITALIC
+  | FE_STRIKEOUT
+  | FE_UNDERLINE
+  | FE_PROTECTED
+
+type stringtype =
+    ST_ALPHANUM
+  | ST_SPACES
+  | ST_OTHER
+
+type show_window_state = Maximize | Minimize | Normal
+type align = AlNone | AlLeft | AlRight | AlTop | AlBottom | AlClient | AlCenter
+type border = BdNone | BdSingle | BdNormal
+
+type question_result = QR_YES | QR_NO | QR_CANCEL
+
+type sel = {
+    mutable smin : int;
+    mutable smax : int
+}
+
+type keys = {
+    k_del : int;
+    k_enter : int;
+    k_esc : int;
+    k_fun : int
+}
+
+type richformat = {
+    rf_effects : richeffect list;
+    rf_height : int option;
+    rf_color : richcolor option;
+    rf_fontface : string option;
+}
+
+type 'a tree = Empty | Tree of ('a * 'a tree list)
+
+type event = (unit -> unit) -> unit
+type event_bool = (unit -> bool) -> unit
+type event_key = (int -> unit) -> unit
+
+class type mouse_events =
+  object
+    method on_click : event
+    method on_dblclick : event
+    method on_rdblclick : event
+    method on_mdblclick : event
+    method on_ldown : event
+    method on_rdown : event
+    method on_mdown : event
+    method on_lup : event
+    method on_rup : event
+    method on_mup : event
+    method on_mousemove : (int -> int -> unit) -> unit
+  end
+
+class type key_events =
+  object    
+    method on_key_down : event_key
+    method on_key_up : event_key
+  end
+
+class font w =
+  object (self)
+    val desc =
+      Pango.Context.get_font_description
+	(GtkBase.Widget.get_pango_context w)
+    method private update =
+      GtkBase.Widget.modify_font w desc
+    method face s =
+      Pango.Font.set_family desc s; self#update
+    method size n =
+      Pango.Font.set_size desc n; self#update
+    method bold b =
+      Pango.Font.set_weight desc (if b then `BOLD else `NORMAL);
+      self#update
+    method italic b =
+      Pango.Font.set_style desc (if b then `ITALIC else `NORMAL);
+      self#update
+    (* underline : not on GTK *)
+    (* color : GDI low-level *)
+  end
+
+class type virtual component =
+  object
+    method handle : handle
+    method parent : container option
+    method visible : bool -> unit
+    method is_visible : bool
+    method enable : bool -> unit
+    method is_enabled : bool
+    method caption : string -> unit
+    method get_caption : string
+    method x : int -> unit
+    method get_x : int
+    method y : int -> unit
+    method get_y : int
+    method width : int -> unit
+    method get_width : int
+    method height : int -> unit
+    method get_height : int
+    method align : align -> unit
+    method get_align : align
+    method virtual update : unit
+    method component : component
+    method destroy : unit
+    method is_destroyed : bool
+    method font : font
+    method focus : unit
+
+    method set_custom : (unit -> unit) -> unit
+    method call_custom : unit
+  end
+and
+ virtual container =
+  object
+    inherit component
+
+    method span : int -> unit
+    method space : int -> unit
+    method container : container
+  end
+
+class type menu =
+  object
+    method handle : menuhandle
+    method destroy : unit
+    method popup : unit
+  end
+
+class type window =
+  object
+    inherit container
+    inherit mouse_events
+    inherit key_events
+
+    method process : bool -> bool
+    method update : unit
+    method close : unit
+
+    method state : show_window_state -> unit
+    method get_state : show_window_state
+    method on_top : bool -> unit
+
+    method menu : menu  
+    method on_closequery : event_bool
+    method on_destroy : event
+    method on_resize : event
+    method on_move : event
+  end
+
+class type panel =
+  object
+    inherit container
+    inherit mouse_events
+    inherit key_events
+
+    method update : unit
+    method clear : unit
+    method border : border -> unit
+    method get_border : border
+  end
+
+class type button =
+  object
+    inherit component
+    inherit mouse_events
+
+    method update : unit    
+  end
+
+class type genlist =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method listprint : (unit -> string list) -> unit
+
+    method redraw : unit
+    method update : unit
+
+    method selected : int option
+    method is_selected : int -> bool
+    method set_selected : int option -> unit
+
+    method on_selchange : event
+    method genlist : genlist
+  end
+
+class type listbox =
+  object
+    inherit genlist
+    method multiselect : bool -> unit
+    method is_multiselect : bool
+    method top_index : int
+    method set_top_index : int -> unit
+  end
+
+class type combobox =
+  object
+    inherit genlist
+  end
+
+class type ['a] litems =
+  object
+    method redraw : unit
+    method list : (unit -> 'a list) -> unit
+    method print : ('a -> string) -> unit
+    method equal : ('a -> 'a -> bool) -> unit
+    method sort : ('a -> 'a -> int) option -> unit
+    method curlist : 'a list
+    method selection : 'a list
+    method selected : 'a option
+    method is_selected : 'a -> bool
+    method set_selected : 'a option -> unit
+    method set_selection : 'a list -> unit  
+  end
+
+class type virtual toggle =
+  object
+    inherit component
+    inherit mouse_events
+
+    method state : bool -> unit
+    method get_state : bool
+    method on_statechange : event
+    method update : unit
+    method toggle : toggle
+  end
+
+class type radiobutton =
+  object
+    inherit toggle
+  end
+
+class type checkbox =
+  object
+    inherit toggle
+  end
+
+class type label =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method update : unit
+  end
+
+class type edit =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method on_change : event
+    method undo : unit  
+    method update : unit
+  end
+
+class type richedit =
+  object
+    inherit component
+
+    method update : unit
+    
+    method tabsize : int -> unit
+    method wordwrap : bool -> unit
+    method selection : sel -> unit
+    method get_selection : sel
+    method get_tabsize : int
+    method get_wordwrap : bool
+
+    method line_from_char : int -> int
+    method char_from_line : int -> int
+    method set_format : bool -> richformat -> unit
+    method get_format : bool -> richformat
+    method get_text : sel -> string
+
+    method colorize : (stringtype -> string -> int -> richcolor option) -> sel option -> unit
+
+    method on_change : event
+
+    method undo : unit
+    method redo : unit
+  end
+
+
+class type resources =
+  object
+    method add_source : string -> unit
+
+    method add_icon : string -> hres
+    method add_bitmap : string -> hres
+
+    method handle : hresources
+  end
+
+class type treeview =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method update : unit
+    method redraw : unit
+
+    method treeprint : (unit -> (string*hres option) tree) -> unit
+
+    method icons : resources option
+    method set_icons : resources option -> unit
+    method on_selchange : event
+
+    method selected : int option
+    method set_selected : int option -> unit
+    method hittest : int -> int -> int option
+
+  end
+
+let bts x =
+  let x = if x < 0 then 0 else if x > 255 then 255 else x in
+  x * 257
+
+let make_richcolor ~red ~green ~blue =
+  let colormap = Gdk.Color.get_system_colormap () in
+  Gdk.Color.alloc ~colormap (`RGB(bts red, bts green, bts blue))
+
+open GdkKeysyms
+let keys = {
+    k_del = _Delete;
+    k_enter = _Return;
+    k_esc = _Escape;
+    k_fun = _F1;
+}
+
+let no_event _ = ()
+let no_event_2 _ _ = ()
+let event_true _ = true
+let event_false _ = false
+
+open StdLabels
+open GtkBase
+open GtkButton
+open GtkData
+open GtkMain
+open GtkMenu
+open GtkMisc
+open GtkPack
+open GtkWindow
+
+type button_id = [`APPLY|`CANCEL|`CLOSE|`HELP|`NO|`OK|`YES]
+
+let make_dialog ~title ~message ~buttons ?(no_delete=false) () = 
+  let dia = Dialog.create () in
+  Window.set_title dia title;
+  let label = Label.create message in
+  Label.set_line_wrap label true;
+  Misc.set_padding label ~x:10 ~y:10 ();
+  Container.add (Dialog.vbox dia) label;
+  Widget.show label;
+  List.iter buttons ~f:
+    (fun (#button_id as id) ->
+      Dialog.add_button dia
+        (GtkStock.convert_id id) (Dialog.std_response id));
+  begin match buttons with
+    (#button_id as id) :: _ ->
+      Dialog.set_default_response dia (Dialog.std_response id)
+  | _ -> ()
+  end;
+  let rec check resp =
+    if no_delete && resp = Dialog.std_response `DELETE_EVENT
+    then check (Dialog.run dia)
+    else resp
+  in
+  let r = check (Dialog.run dia) in
+  Object.destroy dia;
+  r
+
+let message_box message =
+  ignore (make_dialog ~title:"Message:" ~message ~buttons:[`OK] ())
+
+let question_box message =
+  let r =
+    make_dialog ~title:"Message:" ~message ~buttons:[`YES;`NO]
+      ~no_delete:true () in
+  r = Dialog.std_response `YES
+
+let question_cancel_box message =
+  let r =
+    make_dialog ~title:"Message:" ~message ~buttons:[`YES;`NO;`CANCEL] () in
+  if r = GtkWindow.Dialog.std_response `YES then QR_YES else
+  if r = GtkWindow.Dialog.std_response `NO then QR_NO else
+  QR_CANCEL
+
+let file_dialog ~title ?default () =
+  let sel = FileSelection.create title in
+  FileSelection.hide_fileop_buttons sel;
+  Gaux.may default ~f:(FileSelection.set_filename sel);
+  Window.set_modal sel true;
+  let name = ref None in
+  GtkSignal.connect sel ~sgn:Object.Signals.destroy ~callback:Main.quit;
+  GtkSignal.connect (FileSelection.get_cancel_button sel)
+    ~sgn:Button.Signals.clicked
+    ~callback:(fun () -> Object.destroy sel);
+  GtkSignal.connect (FileSelection.get_ok_button sel)
+    ~sgn:Button.Signals.clicked
+    ~callback:
+    (fun () ->
+      name := Some (FileSelection.get_filename sel); Object.destroy sel);
+  Widget.show sel;
+  Main.main ();
+  !name
+
+let open_file _ =
+  file_dialog ~title:"Osiris Open Dialog" ()
+
+let create_file ~default ~exts =
+  file_dialog ~title:"Osiris Create Dialog" ~default ()
+
+let select_directory ~title =
+  file_dialog ~title ()
+
+let mouse_pos () =
+  Gdk.Window.get_pointer_location (Gdk.Window.root_parent ())
+
+let exit_application = Main.quit
+
+class menuitem parent item =
+  object
+    val item = item
+    val mutable label = None
+    val mutable enabled = true
+    val mutable break = true
+    val mutable submenu = None
+    method caption s =
+      break <- false;
+      match label with
+        Some l ->
+          Label.set_text l s
+      | None ->
+          let l = Label.create s in
+          label <- Some l;
+          Widget.show l;
+          Container.add item l
+    method get_caption =
+      match label with
+        Some l -> Label.get_text l
+      | None   -> ""
+    method parent : menu = parent
+    method enable b =
+      Widget.set_sensitive item b;
+      enabled <- b
+    method is_enabled =
+      enabled
+    method check b =
+      break <- false;
+      CheckMenuItem.set_show_toggle item true;
+      CheckMenuItem.set_active item b
+    method is_checked =
+      CheckMenuItem.get_active item
+    method break b =
+      break <- b;
+      if b then begin
+        CheckMenuItem.set_show_toggle item false;
+        match label with None -> ()
+        | Some l ->
+            Container.remove item l;
+            Object.destroy l;
+            label <- None
+      end
+    method is_break = break
+    method submenu opt =
+      if submenu <> None then MenuItem.remove_submenu item;
+      match opt with
+        None -> ()
+      | Some (sub : menu) ->
+          break <- false;
+          let menu =
+            try Menu.cast sub#handle
+            with _ -> failwith "Cannot add a window menu as submenu"
+          in
+          MenuItem.set_submenu item menu;
+          submenu <- Some sub
+    method get_submenu = submenu
+    method on_click : event = fun callback ->
+      ignore (GtkSignal.connect item ~sgn:MenuItem.Signals.activate ~callback)
+  end
+
+let new_menuitem (menu : menu) =
+  let item = CheckMenuItem.create () in
+  CheckMenuItem.set_show_toggle item false;
+  MenuShell.append menu#handle item;
+  Widget.show item;
+  new menuitem menu item
+
+let current_button_event = ref None
+
+class imenu menu =
+  object
+    method handle : menuhandle = menu
+    method destroy = GtkBase.Object.destroy menu
+    method popup =
+      let menu =
+	try Menu.cast menu
+        with _ -> failwith "Cannot popup a window menu"
+      and (button, time) =
+	match !current_button_event with
+	  Some ev -> GdkEvent.Button.button ev, GdkEvent.Button.time ev
+	| None -> 0, Int32.zero
+      in Menu.popup menu ~button ~time
+  end
+
+let new_menu () =
+  let m = Menu.create () in
+  Widget.show m;
+  new imenu (m :> menuhandle)
+
+class virtual icomponent ?parent w =
+  object (self)
+    val w = w
+    val parent = (parent : #container option :> container option)
+    val mutable caption = ""
+    val mutable align = AlNone
+    val mutable destroyed = false
+    val mutable custom = fun () -> ()
+    val mutable x = 0
+    val mutable y = 0
+    method handle = (w :> Gtk.widget Gobject.obj)
+    method parent = parent
+    method visible b =
+      if b then Widget.show w else Widget.hide w
+    method is_visible = Object.get_flag w `VISIBLE
+    method enable = Widget.set_sensitive w
+    method is_enabled = Object.get_flag w `SENSITIVE
+    method caption c = caption <- c
+    method get_caption = caption
+    method x x0 = x <- x0
+    method y y0 = y <- y0
+    method get_x = x
+    method get_y = y
+    method width width = Widget.set_usize w ~width ~height:(-2)
+    method height height = Widget.set_usize w ~width:(-2) ~height
+    method get_width = (Widget.allocation w).Gtk.width
+    method get_height = (Widget.allocation w).Gtk.height
+    method align al =
+      align <- al;
+      match parent with None -> ()
+      | Some ct -> ct#update
+    method get_align = align
+    method virtual update : unit
+    method component = (self :> component)
+    method destroy = Object.destroy w
+    method is_destroyed = destroyed
+    initializer
+      ignore (GtkSignal.connect w ~sgn:Object.Signals.destroy
+		~callback:(fun () -> destroyed <- true))
+    method font = new font w
+    method focus = Widget.grab_focus w
+    method set_custom f = custom <- f
+    method call_custom = custom ()
+  end
+
+class icontainer ?parent w =
+  object
+    inherit icomponent ?parent w
+    val mutable space = 0
+    val mutable span = 0
+    val mutable children = []
+    val mutable boxes = []
+    method space n = space <- n
+    method span n = span <- n
+    method update =
+      List.iter boxes ~f:
+	begin fun b ->
+	  List.iter (Container.children b) ~f:(Container.remove b);
+	  Object.destroy b
+	end;
+      let fixed = Fixed.create () in
+      boxes <- [(fixed :> Gtk.container Gobject.obj)];
+      let rec align box horiz = function
+	  [] -> ()
+	| (al, comp) :: rem ->
+	    let box', horiz' =
+	      if horiz && (al = AlTop || al = AlBottom) then
+		Box.create `VERTICAL ~spacing:space (), false
+	      else if (al = AlLeft || al = AlRight) then
+		Box.create `HORIZONTAL ~spacing:space (), true
+	      else box, horiz
+	    in
+	    if Gobject.get_oid box <> Gobject.get_oid box' then begin
+	      boxes <- (box' :> Gtk.container Gobject.obj) :: boxes;
+	      Widget.show box';
+	      Box.pack box box';
+	    end;
+	    let w = comp#handle in
+	    begin match al with
+	      AlClient -> Container.add box' w
+	    | AlCenter -> Box.pack box' w ~fill:true
+	    | AlTop | AlLeft -> Box.pack box' w
+	    | AlBottom | AlRight -> Box.pack box' w ~from:`END
+	    | AlNone -> Fixed.put fixed w ~x:comp#get_x ~y:comp#get_y
+	    end;
+	    align box' horiz' rem
+      in
+      let hbox = Box.create `HORIZONTAL () in
+      Container.set_border_width hbox space;
+      Widget.show hbox;
+      Container.add w hbox;
+      let vbox = Box.create `VERTICAL () in
+      Widget.show vbox;
+      Container.add hbox vbox;
+      align vbox false children
+  end
+
+let press_events = ref []
+
+let do_action o x =
+  match o with
+    None -> false
+  | Some f -> f x; true
+
+class imouse_events w : mouse_events =
+  object (self)
+    val mutable on_click = None
+    val on_dblclick = Array.create 3 None
+    val on_down = Array.create 3 None
+    val on_up = Array.create 3 None
+    val mutable on_mousemove = None
+    val mutable button_press_installed = false
+    val mutable button_release_installed = false
+    val mutable mousemove_installed = false
+    method private button_event ev =
+      let b = GdkEvent.Button.button ev - 1 in
+      if b < 0 || b > 2 then false else
+      let action =
+        match GdkEvent.get_type ev with
+          `BUTTON_PRESS -> on_down.(b)
+        | `TWO_BUTTON_PRESS -> on_dblclick.(b)
+        | `THREE_BUTTON_PRESS -> None
+        | `BUTTON_RELEASE ->
+            if b <> 0 then on_up.(b) else
+            match on_up.(b), on_click with
+            | Some f1, Some f2 -> f1 (); on_click
+            | None, a -> a
+            | a, None -> a
+      in
+      do_action a ()
+          
+    method private install_button_press =
+      if not button_press_installed then begin
+        GtkSignal.connect w ~sgn:Widget.Signals.Event.button_press
+          ~callback:self#button_event;
+        button_press_installed <- true;
+      end
+    method private install_button_release =
+      if not button_release_installed then begin
+        button_press_installed <- true;
+        ignore (GtkSignal.connect w ~sgn:Widget.Signals.Event.button_release
+                  ~callback:self#button_event)
+      end
+
+    method on_mousemove f =
+      if not mousemove_installed then begin
+        GtkSignal.connect w ~sgn:Widget.Signals.Event.motion_notify ~callback:
+          begin fun ev ->
+            match on_mousemove with
+              None -> false
+            | Some f ->
+                f (truncate (GdkEvent.Motion.x ev))
+                  (truncate (GdkEvent.Motion.y ev));
+                true
+          end;
+        mousemove_installed <- true;
+      end;
+      on_mousemove <- Some f
+
+    method on_click f =
+      self#install_button_release;
+      on_click <- Some f
+    method private on_up n f =
+      self#install_button_release;
+      on_up.(n) <- Some f
+    method on_lup = self#on_up 0
+    method on_mup = self#on_up 1
+    method on_rup = self#on_up 2
+    method private on_down n f =
+      self#install_button_press;
+      on_down.(n) <- Some f
+    method on_ldown = self#on_down 0
+    method on_mdown = self#on_down 1
+    method on_rdown = self#on_down 2
+    method private on_dblclick0 n f =
+      self#install_button_press;
+      on_dblclick.(n) <- Some f
+    method on_dblclick = self#on_dblclick0 0
+    method on_mdblclick = self#on_dblclick0 1
+    method on_rdblclick = self#on_dblclick0 2
+  end
+
+class ikey_events w : key_events =
+  object
+    val mutable on_key_down = None
+    val mutable on_key_up = None
+    val mutable key_down_installed = false
+    val mutable key_up_installed = false
+    method on_key_down f =
+      if not key_down_installed then begin
+        GtkSignal.connect w ~sgn:Widget.Signals.Event.key_press ~callback:
+          begin fun ev ->
+            do_action on_key_down (GdkEvent.Key.keyval ev)
+          end;
+        key_down_installed <- true;
+      end;
+      on_key_down <- Some f
+    method on_key_release f =
+      if not key_up_installed then begin
+        GtkSignal.connect w ~sgn:Widget.Signals.Event.key_release ~callback:
+          begin fun ev ->
+            do_action on_key_up (GdkEvent.Key.keyval ev)
+          end;
+        key_up_installed <- true;
+      end;
+      on_on_key_up <- Some f
+  end
+
+class iwindow w =
+  object
+    inherit icontainer w
+    inherit imouse_events w
+    inherit ikey_events w
+
+    method process = Glib.Main.iteration
+    method close = Object.destroy w
+    method window_state = function
+        Maximize ->
diff --git a/applications/osiris/osiris.mli b/applications/osiris/osiris.mli
new file mode 100644
index 0000000..d029960
--- /dev/null
+++ b/applications/osiris/osiris.mli
@@ -0,0 +1,400 @@
+(**************************************************************************)
+(*     Lablgtk - Applications                                             *)
+(*                                                                        *)
+(*    * You are free to do anything you want with this code as long       *)
+(*      as it is for personal use.                                        *)
+(*                                                                        *)
+(*    * Redistribution can only be "as is".  Binary distribution          *)
+(*      and bug fixes are allowed, but you cannot extensively             *)
+(*      modify the code without asking the authors.                       *)
+(*                                                                        *)
+(*    The authors may choose to remove any of the above                   *)
+(*    restrictions on a per request basis.                                *)
+(*                                                                        *)
+(*    Authors:                                                            *)
+(*      Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>                  *)
+(*      Benjamin Monate  <Benjamin.Monate@free.fr>                        *)
+(*      Olivier Andrieu  <oandrieu@nerim.net>                             *)
+(*      Jun Furuse       <Jun.Furuse@inria.fr>                            *)
+(*      Hubert Fauque    <hubert.fauque@wanadoo.fr>                       *)
+(*      Koji Kagawa      <kagawa@eng.kagawa-u.ac.jp>                      *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* $Id$ *)
+
+type handle = Gtk.widget Gobject.obj
+type menuhandle = Gtk.menu_shell Gobject.obj
+type richcolor
+type hres
+type hresources
+
+type richeffect =
+    FE_AUTOCOLOR
+  | FE_BOLD
+  | FE_ITALIC
+  | FE_STRIKEOUT
+  | FE_UNDERLINE
+  | FE_PROTECTED
+
+type stringtype =
+    ST_ALPHANUM
+  | ST_SPACES
+  | ST_OTHER
+
+type show_window_state = Maximize | Minimize | Normal
+type align = AlNone | AlLeft | AlRight | AlTop | AlBottom | AlClient | AlCenter
+type border = BdNone | BdSingle | BdNormal
+
+type question_result = QR_YES | QR_NO | QR_CANCEL
+
+type sel = {
+    mutable smin : int;
+    mutable smax : int
+}
+
+type keys = {
+    k_del : int;
+    k_enter : int;
+    k_esc : int;
+    k_fun : int
+}
+
+type richformat = {
+    rf_effects : richeffect list;
+    rf_height : int option;
+    rf_color : richcolor option;
+    rf_fontface : string option;
+}
+
+type 'a tree = Empty | Tree of ('a * 'a tree list)
+
+type event = (unit -> unit) -> unit
+type event_bool = (unit -> bool) -> unit
+type event_key = (int -> unit) -> unit
+
+class type font =
+  object
+    method face : string -> unit
+    method size : int -> unit
+    method bold : bool -> unit
+    method italic : bool -> unit
+    (* color : GDI low-level *)
+  end
+
+class type mouse_events =
+  object
+    method on_click : event
+    method on_dblclick : event
+    method on_rdblclick : event
+    method on_mdblclick : event
+    method on_ldown : event
+    method on_rdown : event
+    method on_mdown : event
+    method on_lup : event
+    method on_rup : event
+    method on_mup : event
+    method on_mousemove : (int -> int -> unit) -> unit
+  end
+
+class type key_events =
+  object    
+    method on_key_down : event_key
+    method on_key_up : event_key
+  end
+
+class type virtual component =
+  object
+    method handle : handle
+    method parent : container option
+    method visible : bool -> unit
+    method is_visible : bool
+    method enable : bool -> unit
+    method is_enabled : bool
+    method caption : string -> unit
+    method get_caption : string
+    method x : int -> unit
+    method get_x : int
+    method y : int -> unit
+    method get_y : int
+    method width : int -> unit
+    method get_width : int
+    method height : int -> unit
+    method get_height : int
+    method align : align -> unit
+    method get_align : align
+    method virtual update : unit
+    method component : component
+    method destroy : unit
+    method is_destroyed : bool
+    method font : font
+    method focus : unit
+
+    method set_custom : (unit -> unit) -> unit
+    method call_custom : unit
+  end
+and
+ virtual container =
+  object
+    inherit component
+
+    method span : int -> unit
+    method space : int -> unit
+    method container : container
+  end
+
+class type menu =
+  object
+    method handle : menuhandle
+    method destroy : unit
+    method popup : unit
+  end
+
+class type menuitem =
+  object
+    method caption : string -> unit
+    method get_caption : string
+    method parent : menu
+    method enable : bool -> unit
+    method is_enabled : bool
+    method check : bool -> unit
+    method is_checked : bool
+    method break : bool -> unit
+    method is_break : bool
+    method submenu : menu option -> unit
+    method get_submenu : menu option    
+    method on_click : event
+  end
+
+class type window =
+  object
+    inherit container
+    inherit mouse_events
+    inherit key_events
+
+    method process : bool -> bool
+    method update : unit
+    method close : unit
+
+    method state : show_window_state -> unit
+    method get_state : show_window_state
+    method on_top : bool -> unit
+
+    method menu : menu  
+    method on_closequery : event_bool
+    method on_destroy : event
+    method on_resize : event
+    method on_move : event
+  end
+
+class type panel =
+  object
+    inherit container
+    inherit mouse_events
+    inherit key_events
+
+    method update : unit
+    method clear : unit
+    method border : border -> unit
+    method get_border : border
+  end
+
+class type button =
+  object
+    inherit component
+    inherit mouse_events
+
+    method update : unit    
+  end
+
+class type genlist =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method listprint : (unit -> string list) -> unit
+
+    method redraw : unit
+    method update : unit
+
+    method selected : int option
+    method is_selected : int -> bool
+    method set_selected : int option -> unit
+
+    method on_selchange : event
+    method genlist : genlist
+  end
+
+class type listbox =
+  object
+    inherit genlist
+    method multiselect : bool -> unit
+    method is_multiselect : bool
+    method top_index : int
+    method set_top_index : int -> unit
+  end
+
+class type combobox =
+  object
+    inherit genlist
+  end
+
+class type ['a] litems =
+  object
+    method redraw : unit
+    method list : (unit -> 'a list) -> unit
+    method print : ('a -> string) -> unit
+    method equal : ('a -> 'a -> bool) -> unit
+    method sort : ('a -> 'a -> int) option -> unit
+    method curlist : 'a list
+    method selection : 'a list
+    method selected : 'a option
+    method is_selected : 'a -> bool
+    method set_selected : 'a option -> unit
+    method set_selection : 'a list -> unit  
+  end
+
+class type virtual toggle =
+  object
+    inherit component
+    inherit mouse_events
+
+    method state : bool -> unit
+    method get_state : bool
+    method on_statechange : event
+    method update : unit
+    method toggle : toggle
+  end
+
+class type radiobutton =
+  object
+    inherit toggle
+  end
+
+class type checkbox =
+  object
+    inherit toggle
+  end
+
+class type label =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method update : unit
+  end
+
+class type edit =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method on_change : event
+    method undo : unit  
+    method update : unit
+  end
+
+class type richedit =
+  object
+    inherit component
+
+    method update : unit
+    
+    method tabsize : int -> unit
+    method wordwrap : bool -> unit
+    method selection : sel -> unit
+    method get_selection : sel
+    method get_tabsize : int
+    method get_wordwrap : bool
+
+    method line_from_char : int -> int
+    method char_from_line : int -> int
+    method set_format : bool -> richformat -> unit
+    method get_format : bool -> richformat
+    method get_text : sel -> string
+
+    method colorize : (stringtype -> string -> int -> richcolor option) -> sel option -> unit
+
+    method on_change : event
+
+    method undo : unit
+    method redo : unit
+  end
+
+
+class type resources =
+  object
+    method add_source : string -> unit
+
+    method add_icon : string -> hres
+    method add_bitmap : string -> hres
+
+    method handle : hresources
+  end
+
+class type treeview =
+  object
+    inherit component
+    inherit mouse_events
+    inherit key_events
+
+    method update : unit
+    method redraw : unit
+
+    method treeprint : (unit -> (string*hres option) tree) -> unit
+
+    method icons : resources option
+    method set_icons : resources option -> unit
+    method on_selchange : event
+
+    method selected : int option
+    method set_selected : int option -> unit
+    method hittest : int -> int -> int option
+
+  end
+
+val make_richcolor : red:int -> green:int -> blue:int -> richcolor
+
+val keys : keys
+
+val no_event : 'a -> unit
+val no_event_2 : 'a -> 'b -> unit
+val event_true : 'a -> bool
+val event_false : 'a -> bool
+
+val message_box : string -> unit
+val question_box : string -> bool
+val question_cancel_box : string -> question_result
+
+val open_file : (string*string list) list -> string option
+val create_file :
+  default:string -> exts:(string*string list) list -> string option
+val select_directory : title:string -> string option
+val mouse_pos : unit -> int * int
+val exit_application : unit -> unit
+
+val new_menuitem : menu -> menuitem
+val new_menu : unit -> menu
+(*
+val new_popupmenu : unit -> popupmenu
+
+val new_window : unit -> window
+val new_panel : #container -> panel
+
+val new_button : #container -> button
+val new_listbox : #container -> listbox
+val new_combobox : #container -> combobox
+val new_radiobutton : #container -> radiobutton
+val new_checkbox : #container -> checkbox
+val new_label : #container -> label
+val new_edit : #container -> edit
+val new_richedit : #container -> richedit
+val new_treeview : #container -> treeview
+
+val new_litems : genlist -> 'a litems
+val new_resources : width:int -> height:int -> resources
+*)
+(*****************************************************************************)
diff --git a/applications/unison/README b/applications/unison/README
new file mode 100644
index 0000000..f6835f2
--- /dev/null
+++ b/applications/unison/README
@@ -0,0 +1,13 @@
+	A GUI for Unison
+
+Normally, unison works with LablGTK snapshots.
+You may just compile it after having installed lablgtk.
+
+	http://www.cis.upenn.edu/~bcpierce/unison/
+
+In order to circumvent bugs in GTK+OSX apply those patches to
+unison-2.27.57 and unison-2.40.16 (concerns only users of Quartz GTK).
+
+Jacques Garrigue
+
+$Id$
diff --git a/applications/unison/unison-2.27.57.diffs b/applications/unison/unison-2.27.57.diffs
new file mode 100644
index 0000000..a2eed81
--- /dev/null
+++ b/applications/unison/unison-2.27.57.diffs
@@ -0,0 +1,45 @@
+*** uigtk2.ml~	Sun Jan 20 00:04:13 2008
+--- uigtk2.ml	Fri May  8 18:15:57 2009
+***************
+*** 1560,1567 ****
+    let yellowPixel = "999900" in
+    let lightbluePixel = "8888FF" in
+    let blackPixel  = "000000" in
+    let buildPixmap p =
+!     GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:p () in
+    let buildPixmaps f c1 =
+      (buildPixmap (f c1), buildPixmap (f lightbluePixel)) in
+  
+--- 1560,1574 ----
+    let yellowPixel = "999900" in
+    let lightbluePixel = "8888FF" in
+    let blackPixel  = "000000" in
++   toplevelWindow#misc#realize ();
++   let colormap = toplevelWindow#misc#colormap in
+    let buildPixmap p =
+!     let pm, mask = Gdk.Pixmap.create_from_xpm_d ~data:p ~colormap
+! 	~window:toplevelWindow#misc#window
+! 	~transparent:(mainWindow#misc#style#bg `NORMAL) () in
+!     if Gdk.Windowing.platform = `QUARTZ then
+!       new GDraw.pixmap pm ~colormap      (* bug in pixmap masking *)
+!     else new GDraw.pixmap pm ~colormap ~mask in
+    let buildPixmaps f c1 =
+      (buildPixmap (f c1), buildPixmap (f lightbluePixel)) in
+  
+***************
+*** 2466,2472 ****
+      Uicommon.Text -> Uitext.Body.start Uicommon.Text
+    | Uicommon.Graphic ->
+        let displayAvailable =
+!         Util.osType = `Win32
+            ||
+          try Unix.getenv "DISPLAY" <> "" with Not_found -> false
+        in
+--- 2473,2479 ----
+      Uicommon.Text -> Uitext.Body.start Uicommon.Text
+    | Uicommon.Graphic ->
+        let displayAvailable =
+!         Gdk.Windowing.platform <> `X11
+            ||
+          try Unix.getenv "DISPLAY" <> "" with Not_found -> false
+        in
diff --git a/applications/unison/unison-2.40.16.diffs b/applications/unison/unison-2.40.16.diffs
new file mode 100644
index 0000000..97954a3
--- /dev/null
+++ b/applications/unison/unison-2.40.16.diffs
@@ -0,0 +1,63 @@
+--- uigtk2.ml.orig	2010-04-16 02:29:31.000000000 +0900
++++ uigtk2.ml	2010-05-20 17:55:16.000000000 +0900
+@@ -2763,6 +2763,10 @@
+     GList.clist ~columns:5 ~titles_show:true
+       ~selection_mode:`MULTIPLE ~packing:mainWindowSW#add ()
+   in
++  if Gdk.Windowing.platform = `QUARTZ then begin
++    mainWindow#set_row_height 16; (* hard coded for quartz *)
++    mainWindow#misc#grab_focus ();
++  end;
+ (*
+   let cols = new GTree.column_list in
+   let c_replica1 = cols#add Gobject.Data.string in
+@@ -3094,8 +3098,15 @@
+   let yellowPixel = "999900" in
+   let blackPixel  = "000000" in
+ *)
++  toplevelWindow#misc#realize ();
++  let colormap = toplevelWindow#misc#colormap in
+   let buildPixmap p =
+-    GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:p () in
++    let pm, mask = Gdk.Pixmap.create_from_xpm_d ~data:p ~colormap
++	~window:toplevelWindow#misc#window
++	~transparent:(mainWindow#misc#style#bg `NORMAL) () in
++    if Gdk.Windowing.platform = `QUARTZ then
++      new GDraw.pixmap pm ~colormap      (* bug in pixmap masking *)
++    else new GDraw.pixmap pm ~colormap ~mask in
+   let buildPixmaps f c1 =
+     (buildPixmap (f c1), buildPixmap (f lightbluePixel)) in
+ 
+@@ -3723,19 +3734,19 @@
+   (*********************************************************************
+     Quit button
+    *********************************************************************)
+-(*  actionBar#insert_space ();
+-  ignore (actionBar#insert_button ~text:"Quit"
++(*  actionBar#insert_space (); *)
++  (* I like to have a quit button... *)
++  ignore (actionBar#insert_button ~text:" Quit "
+             ~icon:((GMisc.image ~stock:`QUIT ())#coerce)
+             ~tooltip:"Exit Unison"
+             ~callback:safeExit ());
+-*)
+ 
+   (*********************************************************************
+     go button
+    *********************************************************************)
+ (*  actionBar#insert_space ();*)
+   grAdd grGo
+-    (actionBar#insert_button ~text:"Go"
++    (actionBar#insert_button ~text:"  Go  "
+        (* tooltip:"Go with displayed actions" *)
+        ~icon:((GMisc.image ~stock:`EXECUTE ())#coerce)
+        ~tooltip:"Perform the synchronization"
+@@ -4288,7 +4299,7 @@
+     Uicommon.Text -> Uitext.Body.start Uicommon.Text
+   | Uicommon.Graphic ->
+       let displayAvailable =
+-        Util.osType = `Win32
++        Gdk.Windowing.platform <> `X11
+           ||
+         try System.getenv "DISPLAY" <> "" with Not_found -> false
+       in
diff --git a/dune-project b/dune-project
index 389cd19..da00e4e 100644
--- a/dune-project
+++ b/dune-project
@@ -1,2 +1,3 @@
 (lang dune 1.8)
 (name lablgtk3)
+(version 3.1.2)
diff --git a/lablgtk3-goocanvas2.opam b/lablgtk3-goocanvas2.opam
index 3e89a31..41a9dd9 100644
--- a/lablgtk3-goocanvas2.opam
+++ b/lablgtk3-goocanvas2.opam
@@ -12,11 +12,11 @@ authors: ["Jacques Garrigue et al., Nagoya University"]
 homepage: "https://github.com/garrigue/lablgtk"
 bug-reports: "https://github.com/garrigue/lablgtk/issues"
 dev-repo: "git+https://github.com/garrigue/lablgtk.git"
-doc: "https://garrigue.github.io/lablgtk/lablgtk3-sourceview3"
+doc: "https://garrigue.github.io/lablgtk/lablgtk3/lablgtk3-goocanvas2"
 license: "LGPL with linking exception"
 
 depends: [
-  "ocaml"                {         >= "4.05.0" }
+  "ocaml"                {         >= "4.09.0" }
   "dune"                 {         >= "1.8.0"  }
   "lablgtk3"             {          = version  }
   "conf-goocanvas2"      { build & >= "0"      }
diff --git a/lablgtk3-gtkspell3.opam b/lablgtk3-gtkspell3.opam
index 395ee28..fa31e14 100644
--- a/lablgtk3-gtkspell3.opam
+++ b/lablgtk3-gtkspell3.opam
@@ -13,11 +13,11 @@ authors: ["Jacques Garrigue et al., Nagoya University"]
 homepage: "https://github.com/garrigue/lablgtk"
 bug-reports: "https://github.com/garrigue/lablgtk/issues"
 dev-repo: "git+https://github.com/garrigue/lablgtk.git"
-doc: "https://garrigue.github.io/lablgtk/lablgtk3-gtkspell3"
+doc: "https://garrigue.github.io/lablgtk/lablgtk3/lablgtk3-gtkspell3"
 license: "LGPL with linking exception"
 
 depends: [
-  "ocaml"                { >= "4.05.0" }
+  "ocaml"                { >= "4.09.0" }
   "dune"                 { >= "1.8.0"  }
   "lablgtk3"             {  = version  }
 ]
diff --git a/lablgtk3-sourceview3.opam b/lablgtk3-sourceview3.opam
index 6ac4b9b..33239db 100644
--- a/lablgtk3-sourceview3.opam
+++ b/lablgtk3-sourceview3.opam
@@ -12,11 +12,11 @@ authors: ["Jacques Garrigue et al., Nagoya University"]
 homepage: "https://github.com/garrigue/lablgtk"
 bug-reports: "https://github.com/garrigue/lablgtk/issues"
 dev-repo: "git+https://github.com/garrigue/lablgtk.git"
-doc: "https://garrigue.github.io/lablgtk/lablgtk3-sourceview3"
+doc: "https://garrigue.github.io/lablgtk/lablgtk3/lablgtk3-sourceview3"
 license: "LGPL with linking exception"
 
 depends: [
-  "ocaml"                {         >= "4.05.0" }
+  "ocaml"                {         >= "4.09.0" }
   "dune"                 {         >= "1.8.0"  }
   "lablgtk3"             {          = version  }
   "conf-gtksourceview3"  { build & >= "0"      }
diff --git a/lablgtk3.opam b/lablgtk3.opam
index 549b014..856aaaa 100644
--- a/lablgtk3.opam
+++ b/lablgtk3.opam
@@ -13,10 +13,10 @@ homepage: "https://github.com/garrigue/lablgtk"
 bug-reports: "https://github.com/garrigue/lablgtk/issues"
 dev-repo: "git+https://github.com/garrigue/lablgtk.git"
 license: "LGPL with linking exception"
-doc: "https://garrigue.github.io/lablgtk/lablgtk3"
+doc: "https://garrigue.github.io/lablgtk/lablgtk3/lablgtk3"
 
 depends: [
-  "ocaml"     {         >= "4.05.0" }
+  "ocaml"     {         >= "4.09.0" }
   "dune"      {         >= "1.8.0"  }
   "cairo2"    {         >= "0.6"    }
   "conf-gtk3" { build & >= "18"     }
@@ -27,3 +27,6 @@ depends: [
 build: [
   [ "dune" "build" "-p" name "-j" jobs ]
 ]
+run-test: [
+  [ "dune" "build" "-p" name "-j" jobs "examples/buttons.exe" ]
+]