(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Library General Public License as            *)
(*    published by the Free Software Foundation; either version 2 of the         *)
(*    License, or  any later version.                                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library General Public          *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)


(* $Id: cam_doc_gui.ml 334 2006-10-06 07:34:42Z zoggy $ *)

(** Gui for doc searching and browsing. *)


open Odoc_info
open Parameter
open Value
open Type
open Exception
open Class
open Module

open Cam_doc

let buffer_position b =
  (b#get_iter_at_mark (`NAME "insert"))#offset

let widget_has_focus w =
  w#coerce#misc#get_property "has_focus" = `BOOL true

let prerr_modifier_list l =
  List.iter
    (fun m ->
      prerr_endline
      (match m with
        `SHIFT -> "`SHIFT"
      |        `LOCK -> "`LOCK"
      |        `CONTROL -> "`CONTROL"
      |        `MOD1 -> "`MOD1"
      |        `MOD2 -> "`MOD2"
      |        `MOD3 -> "`MOD3"
      |        `MOD4 -> "`MOD4"
      |        `MOD5 -> "`MOD5"
      |        `BUTTON1 -> "`BUTTON1"
      |        `BUTTON2 -> "`BUTTON2"
      |        `BUTTON3 -> "`BUTTON3"
      |        `BUTTON4 -> "`BUTTON4"
      |        `BUTTON5 -> "`BUTTON5"
      )
    )
    l

type link_kind =
    LinkLink of Cam_doc.element
  | LinkCode of Odoc_info.location

(** This function is initiliazed at the end of this module. Is can be used to search and display one or more elements from their exact names.*)

let f_search_exact = ref (fun (_:Odoc_info.Module.t_module list ref) (_ : string) -> ())

(** This function initialized at the end of this module must be called when bookmarks have been updated. *)

let f_update_bookmarks = ref (fun (_:Odoc_info.Module.t_module list ref) -> ())

class text_doc =
  let last_search = ref "" in
  fun doc_modules ->

  let window = GWindow.window ~kind: `TOPLEVEL
      ~width: 500 ~height: 600 ()
  in

  let vbox = GPack.vbox ~packing: window#add () in
  let wb_back = GButton.button
      ~label: Cam_messages.back
      ~packing: (vbox#pack ~expand: false)
      ()
  in
  let wscroll = GBin.scrolled_window ~packing: (vbox#pack ~expand: true) () in

  let tag_table = GText.tag_table () in
  let buffer = GText.buffer ~tag_table () in
  let view = GText.view ~buffer ~editable: false ~packing: wscroll#add () in

  let hbox_search = GPack.hbox ~packing: (vbox#pack ~expand: false) () in
  let _wl_search = GMisc.label ~text: Cam_messages.search
      ~packing: (hbox_search#pack ~expand: false)
      ()
  in
  let we_search = GEdit.entry
      ~editable: true
      ~packing: (hbox_search#pack ~expand: true) ()
  in
  let new_tag props =
    let t = GText.tag () in
    t#set_properties props;
    tag_table#add t#as_tag;
    t
  in
  let fixed_font = new_tag [`FONT Cam_doc.font_doc_code#get] in
  let fixed_bold_font = new_tag [`FONT Cam_doc.font_doc_code_bold#get] in
  let bold_font = new_tag [`FONT Cam_doc.font_doc_bold#get] in
  (* FIXME: use this ! : *)
  let _normal_font = new_tag [`FONT Cam_doc.font_doc_normal#get] in
  let keyword_color = new_tag [`FOREGROUND Cam_doc.color_doc_keyword#get] in
  let constructor_color = new_tag [`FOREGROUND Cam_doc.color_doc_constructor#get] in
  let type_color = new_tag [`FOREGROUND Cam_doc.color_doc_type#get] in
  let code_color = new_tag [`FOREGROUND Cam_doc.color_doc_code#get] in

  let selected = new_tag [`BACKGROUND "Red"in

  object (self)
    val mutable stack = Stack.create ()

    
    (** positions of elements *)

    val mutable elements = ([] : (element * int) list)

    
    (** elements by position. ((pos start, pos end), link) They are ordered with the smallest position first. *)

    val mutable links = ([] : ((int * int) * (link_kind list)) list)


    method box = vbox
    method window = window
    method pop =
      try
        let ele = Stack.pop stack in
        try
          let ele2 = Stack.top stack in
          self#display ele2
        with
          _ -> self#push ele
      with
        _ -> ()

    method push ele =
      try
        self#display ele ;
        Stack.push ele stack
      with
        Failure s ->
          GToolbox.message_box Cam_messages.error s

    method current_ele =
      try Some (Stack.top stack)
      with _ -> None

    method add_current_to_doc_bookmarks =
      match self#current_ele with
        None -> ()
      |        Some e ->
          Cam_doc.add_doc_bookmark (self#name_of_ele e) ;
          !f_update_bookmarks doc_modules

    method name_of_ele ele =
      match ele with
        E_Module name
      |        E_Module_type name
      |        E_Class name
      |        E_Class_type name
      |        E_Type name
      |        E_Value name
      |        E_Exception name
      |        E_Attribute name
      |        E_Method name
      |        E_Section name -> name

    method display ele =
      match ele with
        E_Module name ->
          (
           match Cam_doc.get_module !doc_modules name with
             None ->
               raise (Failure (Cam_messages.error_not_found_module name))
           | Some m ->
               self#display_module m ;
               self#set_title name
          )
      |        E_Module_type name ->
          (
           match Cam_doc.get_module_type !doc_modules name with
             None ->
               raise (Failure (Cam_messages.error_not_found_module_type name))
           | Some m ->
               self#display_module_type m ;
               self#set_title name
          )
      |        E_Class name ->
          (
           match Cam_doc.get_class !doc_modules name with
             None ->
               raise (Failure (Cam_messages.error_not_found_class name))
           | Some c ->
               self#display_class c ;
               self#set_title name
          )
      |        E_Class_type name ->
          (
           match Cam_doc.get_class_type !doc_modules name with
             None ->
               raise (Failure (Cam_messages.error_not_found_class_type name))
           | Some ct ->
               self#display_class_type ct ;
               self#set_title name
          )
      |        E_Type name ->
          (
           match Cam_doc.get_module_of_type !doc_modules name with
             None ->
               (
                match Cam_doc.get_module_type_of_type !doc_modules name with
                  None ->
                    raise (Failure (Cam_messages.error_not_found_mmt name))
                | Some mt ->
                    self#display_module_type mt ;
                    self#set_title mt.mt_name ;
                    try
                      let pos = List.assoc ele elements in
                      self#goto pos (Name.simple name)
                    with
                      Not_found ->
                        ()
               )
           | Some m ->
               self#display_module m ;
               self#set_title m.m_name ;
               try
                 let pos = List.assoc ele elements in
                 self#goto pos (Name.simple name)
               with
                 Not_found ->
                   ()
          )
      |        E_Value name ->
          (
           match Cam_doc.get_module_of_value !doc_modules name with
             None ->
               (
                match Cam_doc.get_module_type_of_value !doc_modules name with
                  None ->
                    raise (Failure (Cam_messages.error_not_found_mmt name))
                | Some mt ->
                    self#display_module_type mt ;
                    self#set_title mt.mt_name ;
                    try
                      let pos = List.assoc ele elements in
                      self#goto pos (Name.simple name)
                    with
                      Not_found ->
                        ()
               )
           | Some m ->
               self#display_module m ;
               self#set_title m.m_name ;
               try
                 let pos = List.assoc ele elements in
                 self#goto pos (Name.simple name)
               with
                 Not_found ->
                   ()
          )
      |        E_Exception name ->
          (
           match Cam_doc.get_module_of_exception !doc_modules name with
             None ->
               (
                match Cam_doc.get_module_type_of_exception !doc_modules name with
                  None ->
                    raise (Failure (Cam_messages.error_not_found_mmt name))
                | Some mt ->
                    self#display_module_type mt ;
                    self#set_title mt.mt_name ;
                    try
                      let pos = List.assoc ele elements in
                      self#goto pos (Name.simple name)
                    with
                      Not_found ->
                        ()
               )
           | Some m ->
               self#display_module m ;
               self#set_title m.m_name ;
               try
                 let pos = List.assoc ele elements in
                 self#goto pos (Name.simple name)
               with
                 Not_found ->
                   ()
          )
      |        E_Attribute name ->
          (
           match Cam_doc.get_class_of_attribute !doc_modules name with
             None ->
               (
                match Cam_doc.get_class_type_of_attribute !doc_modules name with
                  None ->
                    raise (Failure (Cam_messages.error_not_found_cct name))
                | Some ct ->
                    self#display_class_type ct ;
                    self#set_title ct.clt_name ;
                    try
                      let pos = List.assoc ele elements in
                      self#goto pos (Name.simple name)
                    with
                      Not_found ->
                        ()
               )
           | Some c ->
               self#display_class c ;
               self#set_title c.cl_name ;
               try
                 let pos = List.assoc ele elements in
                 self#goto pos (Name.simple name)
               with
                 Not_found ->
                   ()
          )
      |        E_Method name ->
          (
           match Cam_doc.get_class_of_method !doc_modules name with
             None ->
               (
                match Cam_doc.get_class_type_of_method !doc_modules name with
                  None ->
                    raise (Failure (Cam_messages.error_not_found_cct name))
                | Some ct ->
                    self#display_class_type ct ;
                    self#set_title ct.clt_name ;
                    try
                      let pos = List.assoc ele elements in
                      self#goto pos (Name.simple name)
                    with
                      Not_found ->
                        ()
               )
           | Some c ->
               self#display_class c ;
               self#set_title c.cl_name ;
               try
                 let pos = List.assoc ele elements in
                 self#goto pos (Name.simple name)
               with
                 Not_found ->
                   ()
          )

      |        E_Section name ->
            let pere = Odoc_info.Name.father name in
            match pere with
              "" -> ()
            | _ ->
                match pere.[0] with
                  'A'..'M' ->
                    (
                     match get_module !doc_modules pere with
                       None ->
                         (
                          match get_module_type !doc_modules pere with
                            None ->
                              raise (Failure (Cam_messages.error_not_found_mmt pere))
                          | Some mt ->
                              (
                               self#display_module_type mt ;
                               self#set_title mt.mt_name ;
                               try
                                 let pos = self#get_section_pos name in
                                 self#goto pos (Name.simple name)
                               with
                                 Not_found ->
                                   ()
                              )
                         )
                     | Some m ->
                         (
                          self#display_module m ;
                          self#set_title m.m_name ;
                          try
                            let pos = self#get_section_pos name in
                            self#goto pos (Name.simple name)
                          with
                            Not_found -> ()
                         )
                    )

                | _ ->
                    (
                     match get_class !doc_modules pere with
                       None ->
                         (
                          match get_class_type !doc_modules pere with
                            None ->
                              raise (Failure (Cam_messages.error_not_found_cct pere))
                          | Some ct ->
                              (
                               self#display_class_type ct ;
                               self#set_title ct.clt_name ;
                               try
                                 let pos = self#get_section_pos name in
                                 self#goto pos (Name.simple name)
                               with
                                 Not_found ->
                                   ()
                              )
                         )
                     | Some c ->
                         (
                          self#display_class c ;
                          self#set_title c.cl_name ;
                          try
                            let pos = self#get_section_pos name in
                            self#goto pos (Name.simple name)
                          with
                            Not_found ->
                              ()
                         )
                    )

    method set_title t = window#set_title t

    method goto pos s =
      self#goto2 pos (String.length s)

    method goto2 pos len =
      buffer#remove_tag selected ~start: buffer#start_iter ~stop: buffer#end_iter;
      let it = buffer#get_iter (`OFFSET pos) in
(*
      prerr_endline (Printf.sprintf "goto2: pos=%d len=%d" pos len);
      prerr_endline (Printf.sprintf "it#offset = %d" it#offset);
*)

      buffer#place_cursor it ;
      let it2 = buffer#get_iter (`OFFSET (pos + len)) in
      buffer#apply_tag selected ~start: it ~stop:it2;
      ignore(view#scroll_to_mark ~use_align: true ~xalign: 0.5 ~yalign: 0.1 (`NAME "insert"))

    method clear =
      buffer#delete ~start: buffer#start_iter ~stop: buffer#end_iter ;
      links <- [] ;
      elements <- []

    method add_element start element = elements <- (element, start) :: elements

    method add_link start len link_kinds = links <- links @ [(start, start + len), link_kinds]

    method links_by_pos pos =
      try
        snd
          (List.find
             (fun ((st, en), link_kinds) -> st <= pos && pos <= en)
             links
          )
      with
        Not_found -> []

    
    (** Get the position of the given section name, fom the list of elements. @raise Not_found if the section name was not found.*)

    method get_section_pos name =
      let simple = Name.simple name in
      snd (List.find
             (fun (e, _) -> e = E_Section simple)
             elements)


    
    (** Display a keyword. *)

    method put_keyword s = buffer#insert
        ~tags: [fixed_font ; keyword_color]
        s

    
    (** Display a constructor. *)

    method put_constructor s = buffer#insert
        ~tags: [fixed_font ;constructor_color]
        s

    
    (** Display a string containing some type_expr and add links to the definition of these types. *)

    method put_string_type_expr m_name s =
      let s_re = "\\([A-Z]\\([a-zA-Z_\\'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_\\'0-9]*\\)" in
      let re = Str.regexp s_re in
      let rec f str =
        let pos_opt =
          try Some (Str.search_forward re str 0)
          with Not_found ->
            None
        in
        match pos_opt with
          None ->
            buffer#insert ~tags:[fixed_font;type_color] str
        | Some pos ->
            let match_s = Str.matched_string str in
            let len = String.length match_s in
            let before = String.sub str 0 pos in
            let after = String.sub str (pos + len) ((String.length str) - pos - len) in
            buffer#insert ~tags:[fixed_font; type_color] before ;
            let rel = Name.get_relative m_name match_s in
            self#add_link buffer#end_iter#offset (String.length rel) [ LinkLink (E_Type match_s)] ;
            buffer#insert ~tags:[fixed_font; type_color] rel;
            f after
      in
      f s

    
    (** Display a string containing some module types and add links to the definition of these types. *)

    method put_string_module_type_expr m_name s =
      let s_re = "\\([A-Z]\\([a-zA-Z_\\'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_\\'0-9]*\\)" in
      let re = Str.regexp s_re in
      let rec f str =
        let pos_opt =
          try Some (Str.search_forward re str 0)
          with Not_found ->
            None
        in
        match pos_opt with
          None ->
            buffer#insert ~tags: [fixed_font; type_color] str
        | Some pos ->
            let match_s = Str.matched_string str in
            let len = String.length match_s in
            let before = String.sub str 0 pos in
            let after = String.sub str (pos + len) ((String.length str) - pos - len) in
            buffer#insert ~tags:[fixed_font; type_color] before ;
            let rel = Name.get_relative m_name match_s in
            self#add_link buffer#end_iter#offset (String.length rel) [LinkLink (E_Module_type match_s)] ;
            buffer#insert ~tags:[fixed_font; type_color] rel;
            f after
      in
      f s

    
    (** Display a Types.type_expr.*)

    method put_type_expr m_name t =
      let s = String.concat "\n"
          (Str.split (Str.regexp "\n") (Odoc_info.string_of_type_expr t))
      in
      let s2 = Str.global_replace (Str.regexp "\n""\n       " s in
      self#put_string_type_expr m_name s2

    
    (** Display a Types.class_type.*)

    method put_class_type_expr m_name t =
      let s = String.concat "\n"
          (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type t))
      in
      let s2 = Str.global_replace (Str.regexp "\n""\n       " s in
      self#put_string_type_expr m_name s2

    
    (** Display a Types.type_expr list.*)

    method put_type_expr_list m_name sep l =
      let s = Odoc_info.string_of_type_list sep l in
      let s2 = Str.global_replace (Str.regexp "\n""\n       " s in
      self#put_string_type_expr m_name s2

    
    (** Display a Types.module_type. *)

    method put_module_type m_name t =
      let s = String.concat "\n"
          (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t))
      in
      let s2 = Str.global_replace (Str.regexp "\n""\n       " s in
      self#put_string_module_type_expr m_name s2

    
    (** Display OCaml code. *)

    method put_code ?(with_pre=false) code =
      buffer#insert ~tags:[fixed_font; code_color] code

    
    (** Display a text element. *)

    method put_text_ele bold fixed e =
      match e with
      |        Odoc_info.Raw s ->
          (
           match bold, fixed with
             truetrue -> buffer#insert ~tags: [fixed_bold_font] s
           | truefalse -> buffer#insert ~tags: [bold_font] s
           | falsetrue -> buffer#insert ~tags:[fixed_font] s
           | falsefalse -> buffer#insert s
          )
      |        Odoc_info.Code s ->
          buffer#insert
            ~tags: ((if bold then fixed_bold_font else fixed_font)::[code_color])
            s
      |        Odoc_info.CodePre s ->
          buffer#insert ~tags: [code_color; fixed_font] ("\n"^s^"\n")
      |        Odoc_info.Verbatim s -> buffer#insert s
      |        Odoc_info.Bold t -> self#put_text ~bold: true ~fixed t
      |        Odoc_info.Italic t -> self#put_text ~bold ~fixed t
      |        Odoc_info.Emphasize t -> self#put_text ~bold ~fixed t
      |        Odoc_info.Center t -> self#put_text ~bold ~fixed t
      |        Odoc_info.Left t ->  self#put_text ~bold ~fixed t
      |        Odoc_info.Right t -> self#put_text ~bold ~fixed t
      |        Odoc_info.List tl ->
          List.iter
            (fun t -> self#put_text ~bold ~fixed ((Raw "\n  - ") ::  t))
            tl;
          buffer#insert "\n"
      |        Odoc_info.Enum tl ->
          List.iter
            (fun t -> self#put_text ~bold ~fixed ((Raw "\n  - ") ::  t))
            tl;
          buffer#insert "\n"
      |        Odoc_info.Newline ->
          buffer#insert "\n"
      |        Odoc_info.Block t ->
          buffer#insert "\n";
          self#put_text ~bold ~fixed t;
          buffer#insert "\n"
      |        Odoc_info.Title (n, label_opt, t) ->
          buffer#insert "\n";
          (match label_opt with
            None -> ()
          | Some l -> self#add_element buffer#end_iter#offset (E_Section l)
          );
          self#put_text ~bold: true ~fixed t;
          buffer#insert "\n"
      |        Odoc_info.Latex _ ->
          (* don't care about LaTeX stuff in HTML. *)
          ()
      |        Odoc_info.Link (s, t) ->
          self#put_text ~bold ~fixed t
      |        Odoc_info.Ref (s, kind_opt) ->
          (
           match kind_opt with
             None ->
              buffer#insert ~tags:[fixed_font] s ;
               ()
           | Some kind ->
               let ele =
                match kind with
                  Odoc_info.RK_module -> E_Module s
                | Odoc_info.RK_module_type -> E_Module_type s
                | Odoc_info.RK_class -> E_Class s
                | Odoc_info.RK_class_type -> E_Class_type s
                | Odoc_info.RK_value -> E_Value s
                | Odoc_info.RK_type -> E_Type s
                | Odoc_info.RK_exception -> E_Exception s
                | Odoc_info.RK_attribute -> E_Attribute s
                | Odoc_info.RK_method -> E_Method s
                | Odoc_info.RK_section t -> E_Section s
               in
               self#add_link buffer#end_iter#offset (String.length s) [ LinkLink ele ] ;
               buffer#insert ~tags:[fixed_bold_font] s ;
               ()
          )
      |        Odoc_info.Superscript t ->
          buffer#insert "{^";
          self#put_text ~bold ~fixed t;
          buffer#insert "}"
      |        Odoc_info.Subscript t ->
          buffer#insert "{_";
          self#put_text ~bold ~fixed t;
          buffer#insert "}"
      |        Odoc_info.Module_list _ ->
          ()
      |        Odoc_info.Index_list ->
          ()
      |        _ (*Odoc_info.Custom _*) ->
          ()

    
    (** Display a text. *)

    method put_text ?(bold=false) ?(fixed=false) t =
      List.iter (self#put_text_ele bold fixed) t

    
    (** Display an author list. *)

    method put_author_list l =
      match l with
        [] ->
          ()
      | _ ->
          buffer#insert ~tags: [bold_font] (Cam_messages.authors^": ") ;
          buffer#insert ((String.concat ", " l)^"\n")

    
    (** Display the given optional version information.*)

    method put_version_opt v_opt =
      match v_opt with
        None -> ()
      | Some v ->
          buffer#insert ~tags: [bold_font] (Cam_messages.version^": ") ;
          buffer#insert (v^"\n")

    
    (** Display the given optional since information.*)

    method put_since_opt s_opt =
      match s_opt with
        None -> ()
      | Some s ->
          buffer#insert ~tags: [bold_font] Cam_messages.since ;
          buffer#insert (" "^s^"\n")

    
    (** Display the given list of raised exceptions.*)

    method put_raised_exceptions l =
      match l with
        [] -> ()
      | (s, t) :: [] ->
          buffer#insert ~tags:[bold_font] Cam_messages.raises ;
          buffer#insert ~tags:[fixed_font] (" "^s^" ") ;
          self#put_text t;
          buffer#insert "\n"
      | _ ->
          buffer#insert ~tags:[bold_font] Cam_messages.raises ;
          let f (ex, desc) =
            buffer#insert ~tags:[fixed_font] ("\n  - "^ex^" ");
            self#put_text desc;
          in
          List.iter f l;
          buffer#insert "\n"

    
    (** Display the given "see also" reference. *)

    method put_see (see_ref, t)  =
      let t_ref =
        match see_ref with
          Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ]
        | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t
        | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t
      in
      self#put_text t_ref

    
    (** Display the given list of "see also" references.*)

    method put_sees l =
      match l with
        [] -> ()
      | see :: [] ->
          buffer#insert ~tags:[bold_font] Cam_messages.see_also ;
          self#put_see see ;
          buffer#insert "\n"
      | _ ->
          buffer#insert ~tags:[bold_font] Cam_messages.see_also;
          let f see =
            buffer#insert ~tags:[fixed_font] "\n  - " ;
            self#put_see see
          in
          List.iter f l;
          buffer#insert "\n"

    
    (** Display the given optional return information.*)

    method put_return_opt return_opt =
      match return_opt with
        None -> ()
      | Some s ->
          buffer#insert ~tags:[bold_font] (Cam_messages.returns^" ");
          self#put_text s ;
          buffer#insert "\n"

    
    (** Display a description, except for the i_params field. *)

    method put_info info_opt =
      match info_opt with
        None ->
          buffer#insert "\n"
      | Some info ->
          let module M = Odoc_info in
          (match info.M.i_deprecated with
            None -> ()
          | Some d ->
              buffer#insert ~tags:[bold_font] Cam_messages.deprecated ;
              self#put_text d);
          (match info.M.i_desc with
            None -> ()
          | Some d when d = [Odoc_info.Raw ""-> ()
          | Some d -> self#put_text d ; buffer#insert "\n" );

          self#put_author_list info.M.i_authors ;
          self#put_version_opt info.M.i_version ;
          self#put_since_opt info.M.i_since ;
          self#put_raised_exceptions info.M.i_raised_exceptions ;
          self#put_return_opt info.M.i_return_value ;
          self#put_sees info.M.i_sees ;
          buffer#insert "\n"

    
    (** Display the description of a parameter. *)

    method put_parameter_description p =
      match Parameter.names p with
        [] ->
          buffer#insert "\n"
      | name :: [] ->
          (
           (* Only one name, no need for label for the description. *)
           match Parameter.desc_by_name p name with
             None -> ()
           | Some t -> self#put_text t ;
          );
          buffer#insert "\n"
      | l ->
          (*  A list of names, we display those with a description. *)
          let l2 = List.filter (fun n -> (Parameter.desc_by_name p n) <> None) l in
          match l2 with
            [] -> buffer#insert "\n"
          | _ ->
              List.iter
                (fun n ->
                  match Parameter.desc_by_name p n with
                    None -> ()
                  | Some t ->
                      buffer#insert ~tags:[fixed_bold_font] ("  "^n);
                      self#put_text t;
                      buffer#insert "\n"
                )
                l2


    
    (** Display the list of described parameters, among the given list . *)

    method put_described_parameter_list father l =
      (* get the params which have a name, and at least one name described. *)
      let l2 = List.filter
          (fun p ->
            List.exists
              (fun n -> (Parameter.desc_by_name p n) <> None)
              (Parameter.names p))
          l
      in
      let f p =
        self#put_code (Parameter.complete_name p) ;
        buffer#insert " : " ;
        self#put_parameter_description p
      in
      match l2 with
        [] -> ()
      |        _ -> List.iter f l2 ; buffer#insert "\n"

    
    (** Display a value. *)

    method put_value v =
      Odoc_info.reset_type_names ();
      self#put_keyword "val " ;
      self#add_element buffer#end_iter#offset (E_Value v.val_name);
      let s = Name.simple v.val_name in
      self#add_link buffer#end_iter#offset (String.length s) [ LinkCode v.val_loc ] ;
      buffer#insert ~tags:[fixed_bold_font] (s^" : ") ;
      self#put_type_expr (Name.father v.val_name) v.val_type ;
      buffer#insert "\n" ;
      self#put_info v.val_info;
      self#put_described_parameter_list (Name.father v.val_name) v.val_parameters

    
    (** Display an exception. *)

    method put_exception e =
      Odoc_info.reset_type_names ();
      self#put_keyword "exception " ;
      self#add_element buffer#end_iter#offset (E_Exception e.ex_name) ;
      let s = Name.simple e.ex_name in
      self#add_link buffer#end_iter#offset (String.length s) [ LinkCode e.ex_loc ] ;
      buffer#insert ~tags:[fixed_bold_font] s ;
      (match e.ex_args with
        [] -> ()
      |        _ ->
          self#put_keyword " of " ;
          self#put_type_expr_list (Name.father e.ex_name) " -> " e.ex_args
      ) ;
      (match e.ex_alias with
        None -> ()
      | Some ea ->
          buffer#insert ~tags:[fixed_font] " = " ;
          (
           match ea.ea_ex with
             None -> buffer#insert ~tags:[fixed_font] ea.ea_name
           | Some e ->
               let s = e.ex_name in
               self#add_link buffer#end_iter#offset (String.length s)
                 [ LinkLink (E_Exception s) ; LinkCode e.ex_loc ] ;
               buffer#insert ~tags:[fixed_font] e.ex_name
          );
      );
      buffer#insert "\n" ;
      self#put_info e.ex_info

    
    (** Display a type. *)

    method put_type t =
      Odoc_info.reset_type_names ();
      let father = Name.father t.ty_name in
      self#put_keyword "type ";
      (match t.ty_parameters with
        [] -> ()
      |        (tp, _, _) :: [] ->
          self#put_type_expr father tp ;  (* A VOIR: variance *)
          buffer#insert ~tags:[fixed_font] " "
      |        l ->
          self#put_type_expr_list father ", "
            (List.map (fun (t,_,_) -> t) l) ; (* A VOIR: variance *)
          buffer#insert ~tags:[fixed_font] " "
      ) ;
      self#add_element buffer#end_iter#offset (E_Type t.ty_name) ;
      let s = Name.simple t.ty_name in
      self#add_link buffer#end_iter#offset (String.length s) [ LinkCode t.ty_loc ] ;
      buffer#insert ~tags:[fixed_bold_font] (s^" ") ;
      (match t.ty_manifest with
        None -> ()
      | Some typ ->
          buffer#insert ~tags:[fixed_font] "= " ;
          self#put_type_expr father typ ;
          buffer#insert ~tags:[fixed_font] " "
      );
      (match t.ty_kind with
        Type_abstract ->
          buffer#insert "\n"
      |        Type_variant (l, pv) ->
          buffer#insert ~tags:[fixed_font] ("= "^(if pv then "private" else "")^"\n") ;
          let f constr =
            self#put_keyword "   | " ;
            self#put_constructor constr.vc_name ;
            (match constr.vc_args with
              [] -> ()
            | l ->
                self#put_keyword " of " ;
                self#put_type_expr_list father " * " l ;
            ) ;
            (match constr.vc_text with
              None ->
                ()
            | Some t ->
                self#put_text ((Italic [ Raw "  (* " ]) :: t) ;
                self#put_text [Italic [ Raw " *)" ]] ;
            );
            buffer#insert "\n"
          in
          List.iter f l

      |        Type_record (l, pv) ->
          buffer#insert ~tags:[fixed_font] ("= "^(if pv then "private " else "")^"{\n");
          let f r =
            buffer#insert ~tags:[fixed_font] "   " ;
            (if r.rf_mutable then self#put_keyword "mutable " else ()) ;
            buffer#insert ~tags:[fixed_font] (r.rf_name^" : ") ;
            self#put_type_expr father r.rf_type ;
            buffer#insert ~tags:[fixed_font] ";" ;
            (match r.rf_text with
              None ->
                ()
            | Some t ->
                self#put_text ((Italic [ Raw "  (* " ]) :: t) ;
                self#put_text [Italic [ Raw " *)" ]] ;
            ) ;
            buffer#insert "\n"
          in
          List.iter f l ;
          buffer#insert "}\n"
      ) ;
      self#put_info t.ty_info


    
    (** Display a class attribute. *)

    method put_attribute a =
      self#put_keyword "val " ;
      (* html mark *)
      (if a.att_mutable then self#put_keyword "mutable " else ()) ;
      self#add_element buffer#end_iter#offset (E_Attribute a.att_value.val_name) ;
      let s = Name.simple a.att_value.val_name in
      self#add_link buffer#end_iter#offset (String.length s) [ LinkCode a.att_value.val_loc ] ;
      buffer#insert ~tags:[fixed_bold_font] (s^" : ") ;
      self#put_type_expr (Name.father a.att_value.val_name) a.att_value.val_type ;
      buffer#insert "\n";
      self#put_info a.att_value.val_info

    
    (** Display a class method. *)

    method put_method m =
      self#put_keyword "method " ;
      (if m.met_private then self#put_keyword "private " else ()) ;
      (if m.met_virtual then self#put_keyword "virtual " else ()) ;
      self#add_element buffer#end_iter#offset (E_Method m.met_value.val_name) ;
      let s = Name.simple m.met_value.val_name in
      self#add_link buffer#end_iter#offset (String.length s) [ LinkCode m.met_value.val_loc ] ;
      buffer#insert ~tags:[fixed_bold_font] (s^" : ") ;
      self#put_type_expr (Name.father m.met_value.val_name) m.met_value.val_type ;
      buffer#insert "\n";
      self#put_info m.met_value.val_info;
      self#put_described_parameter_list (Name.father m.met_value.val_name) m.met_value.val_parameters

    
    (** Display a list of parameters. *)

    method put_parameter_list m_name l =
      match l with
        [] ->
          ()
      | _ ->
          buffer#insert ~tags:[bold_font] (Cam_messages.parameters^":\n") ;
          List.iter
            (fun p ->
              self#put_code (Parameter.complete_name p) ;
              buffer#insert " : " ;
              self#put_type_expr m_name (Parameter.typ p) ;
              buffer#insert "\n" ;
              self#put_parameter_description p ;
            )
            l

    
    (** Display a list of module parameters. *)

    method put_module_parameter_list m_name l =
      match l with
        [] ->
          ()
      | _ ->
          buffer#insert ~tags:[bold_font] (Cam_messages.parameters^": ") ;
          let f (p, desc_opt) =
            buffer#insert ~tags:[fixed_font] ("\n  - "^p.mp_name^" : ") ;
            self#put_module_type m_name p.mp_type ;
            (match desc_opt with
              None -> ()
            | Some t ->
                buffer#insert "\n" ;
                self#put_text t
            );
            buffer#insert "\n"
          in
          List.iter f l

    
    (** Display a module. *)

    method put_module m =
      Odoc_info.reset_type_names ();
      self#put_keyword "module ";
      self#add_link buffer#end_iter#offset (String.length m.m_name)
        [LinkLink (E_Module m.m_name) ; LinkCode m.m_loc ];
      buffer#insert ~tags:[fixed_bold_font; constructor_color] m.m_name;
      buffer#insert " : ";
      self#put_module_type (Name.father m.m_name) m.m_type ;
      buffer#insert "\n" ;
      self#put_info m.m_info

    
    (** Display a module type. *)

    method put_modtype ?(with_link=true) mt =
      Odoc_info.reset_type_names ();
      self#put_keyword "module type ";
      self#add_link buffer#end_iter#offset (String.length mt.mt_name)
        [LinkLink (E_Module_type mt.mt_name) ; LinkCode mt.mt_loc] ;
      buffer#insert ~tags:[fixed_bold_font; constructor_color]mt.mt_name;
      (match mt.mt_type with
      |        Some t ->
          buffer#insert " = ";
          self#put_module_type (Name.father mt.mt_name) t
      |        None -> ()
      );
      buffer#insert "\n" ;
      self#put_info mt.mt_info


    
    (** Display an included module. *)

    method put_included_module im =
      self#put_keyword "include " ;
      (
       match im.im_module with
         None ->
           buffer#insert ~tags:[fixed_font] im.im_name
       | Some mmt ->
           match mmt with
             Mod m ->
               let s = m.m_name in
               self#add_link buffer#end_iter#offset (String.length s) [ LinkLink (E_Module s)] ;
               buffer#insert ~tags:[fixed_font] s
           | Modtype mt ->
               let s = mt.mt_name in
               self#add_link buffer#end_iter#offset (String.length s)  [LinkLink (E_Module_type s)] ;
               buffer#insert ~tags:[fixed_font] s
      ) ;
      buffer#insert "\n"

    
    (** Display a class. *)

    method put_class c =
      Odoc_info.reset_type_names ();
      self#put_keyword "class " ;
      (if c.cl_virtual then self#put_keyword "virtual " else ());
      (
       match c.cl_type_parameters with
        [] -> ()
      |        l -> buffer#insert ~tags:[fixed_font] ("["^(Odoc_info.string_of_type_list ", " l)^"] ")
      ) ;
      let s = Name.simple c.cl_name in
      self#add_link buffer#end_iter#offset (String.length s)
        [LinkLink (E_Class c.cl_name) ; LinkCode c.cl_loc] ;
      buffer#insert ~tags:[fixed_bold_font] s ;
      buffer#insert " : ";
      self#put_class_type_expr (Name.father c.cl_name) c.cl_type;
      buffer#insert "\n";
      self#put_info c.cl_info

    
    (** display a class type. *)

    method put_class_type ct =
      Odoc_info.reset_type_names ();
      self#put_keyword "class type " ;
      (if ct.clt_virtual then self#put_keyword "virtual " else ());
      (
       match ct.clt_type_parameters with
        [] -> ()
      |        l -> buffer#insert ~tags:[fixed_font] ("["^(Odoc_info.string_of_type_list ", " l)^"] ")
      ) ;
      let s = Name.simple ct.clt_name in
      self#add_link buffer#end_iter#offset (String.length s)
        [LinkLink (E_Class_type ct.clt_name) ; LinkCode ct.clt_loc] ;
      buffer#insert ~tags:[fixed_bold_font] s ;
      buffer#insert " = ";
      self#put_class_type_expr (Name.father ct.clt_name) ct.clt_type;
      buffer#insert "\n";
      self#put_info ct.clt_info

    
    (** Display a class comment.*)

    method put_class_comment text = self#put_module_comment text

    
    (** Display a module comment.*)

    method put_module_comment text = self#put_text (text @ [Newline ; Newline])

    
    (** Display the given list of inherited classes. *)

    method put_inheritance_info inher_l =
      let f tab inh =
        buffer#insert ~tags:[fixed_font] tab;
        (
         match inh.ic_class with
           None -> (* we can't make the link. *)
             buffer#insert ~tags:[fixed_bold_font] (inh.ic_name^"  ") ;
             (match inh.ic_text with
               None -> ()
             | Some t -> self#put_text t
             )
         | Some cct ->
            (* we can create the link. *)
             let real_name = (* even if it should be the same *)
               match cct with
                 Cl c ->
                  let s = c.cl_name in
                  self#add_link buffer#end_iter#offset (String.length s)
                    [LinkLink (E_Class s) ; LinkCode c.cl_loc] ;
                  s
               | Cltype (ct, _) ->
                   let s = ct.clt_name in
                   self#add_link buffer#end_iter#offset (String.length s)
                     [LinkLink (E_Class_type s) ; LinkCode ct.clt_loc] ;
                   s
             in
            buffer#insert ~tags:[fixed_bold_font] (real_name^"  ") ;
             (match inh.ic_text with
               None -> ()
             | Some t -> self#put_text t
             )
        );
        buffer#insert "\n"
      in
      buffer#insert ~tags:[bold_font] (Cam_messages.inherits^"\n") ;
      List.iter (f "  ") inher_l ;
      buffer#insert "\n"

    
    (** Display the inherited classes of the given class. *)

    method put_class_inheritance_info cl =
      let rec iter_kind k =
        match k with
          Class_structure ([], _) ->
            ()
        | Class_structure (l, _) ->
            self#put_inheritance_info l
        | Class_constraint (k, ct) ->
            iter_kind k
        | Class_apply _
        | Class_constr _ ->
            ()
      in
      iter_kind cl.cl_kind

    
    (** Display the inherited classes of the given class type. *)

    method put_class_type_inheritance_info clt =
      match clt.clt_kind with
        Class_signature ([], _) ->
          ()
      |        Class_signature (l, _) ->
          self#put_inheritance_info l
      |        Class_type _ ->
          ()

    
    (** Display the given class.*)

    method display_class cl =
      self#clear;
      self#put_keyword "class ";
      (if cl.cl_virtual then self#put_keyword "virtual " else ()) ;
      self#add_link buffer#end_iter#offset (String.length cl.cl_name) [ LinkCode cl.cl_loc ] ;
      self#put_constructor cl.cl_name;
      buffer#insert " : ";
      self#put_class_type_expr (Name.father cl.cl_name) cl.cl_type ;
      buffer#insert "\n" ;
      self#put_info cl.cl_info ;

      (* class inheritance *)
      self#put_class_inheritance_info cl;
      (* parameters *)
      self#put_parameter_list (Name.father cl.cl_name) cl.cl_parameters;

      (* the various elements *)
      List.iter
        (fun element ->
          match element with
            Class_attribute a ->
              self#put_attribute a
          | Class_method m ->
              self#put_method m
          | Class_comment text ->
              self#put_class_comment text
        )
        (Class.class_elements cl)

    
    (** Display the given class type.*)

    method display_class_type clt =
      self#clear;
      self#put_keyword "class type ";
      (if clt.clt_virtual then self#put_keyword "virtual " else ()) ;
      self#add_link buffer#end_iter#offset (String.length clt.clt_name) [ LinkCode clt.clt_loc ] ;
      self#put_constructor clt.clt_name;
      buffer#insert " = ";
      self#put_class_type_expr (Name.father clt.clt_name) clt.clt_type ;
      buffer#insert "\n" ;
      self#put_info clt.clt_info ;

      (* class inheritance *)
      self#put_class_type_inheritance_info clt;

      (* the various elements *)
      List.iter
        (fun element ->
          match element with
            Class_attribute a ->
              self#put_attribute a
          | Class_method m ->
              self#put_method m
          | Class_comment text ->
              self#put_class_comment text
        )
        (Class.class_type_elements clt)


    
    (** Display the given module type. @raise Failure if an error occurs.*)

    method display_module_type mt =
      self#clear;
      self#put_keyword "module type ";
      self#add_link buffer#end_iter#offset (String.length mt.mt_name) [ LinkCode mt.mt_loc ] ;
      self#put_constructor mt.mt_name;
      buffer#insert "\n";
      (match mt.mt_type with
        None -> ()
      |        Some t ->
          buffer#insert " = ";
          self#put_module_type (Name.father mt.mt_name) t
      ) ;
      buffer#insert "\n" ;
      self#put_info mt.mt_info ;

      (* parameters for functors *)
      self#put_module_parameter_list "" (Module.module_type_parameters mt);

      buffer#insert "\n\n";

      (* module elements *)
      List.iter
        (fun ele ->
          match ele with
            Element_module m ->
              self#put_module m
          | Element_module_type mt ->
              self#put_modtype mt
          | Element_included_module im ->
              self#put_included_module im
          | Element_class c ->
              self#put_class c
          | Element_class_type ct ->
              self#put_class_type ct
          | Element_value v ->
              self#put_value v
          | Element_exception e ->
              self#put_exception e
          | Element_type t ->
              self#put_type t
          | Element_module_comment text ->
              self#put_module_comment text
        )
        (Module.module_type_elements mt)

    
    (** Display the given module. @raise Failure if an error occurs.*)

    method display_module modu =
      self#clear;
      self#put_keyword "module ";
      self#add_link buffer#end_iter#offset (String.length modu.m_name) [ LinkCode modu.m_loc ] ;
      self#put_constructor modu.m_name;
      buffer#insert " : ";
      self#put_module_type (Name.father modu.m_name) modu.m_type ;
      buffer#insert "\n" ;
      self#put_info modu.m_info ;

      (* parameters for functors *)
      self#put_module_parameter_list "" (Module.module_parameters modu) ;

      buffer#insert "\n\n";

      (* module elements *)
      List.iter
        (fun ele ->
          match ele with
            Element_module m ->
              self#add_element buffer#end_iter#offset (E_Module m.m_name) ;
              self#put_module m
          | Element_module_type mt ->
              self#put_modtype mt
          | Element_included_module im ->
              self#put_included_module im
          | Element_class c ->
              self#put_class c
          | Element_class_type ct ->
              self#put_class_type ct
          | Element_value v ->
              self#put_value v
          | Element_exception e ->
              self#put_exception e
          | Element_type t ->
              self#put_type t
          | Element_module_comment text ->
              self#put_module_comment text
        )
        (Module.module_elements modu)

    
    (** @raise Not_found if no element is found. *)

    method get_next_element_from_pos p =
      let s, e = fst
          (List.find
             (fun ((st, en), link_kinds) -> p < st)
             links
          )
      in
      (s, (e - s))

    
    (** @raise Not_found if no element is found. *)

    method get_previous_element_from_pos p =
      let s, e = fst
          (List.find
             (fun ((st, en), link_kinds) -> p >= st)
             (List.rev links)
          )
      in
      (s, (e - s))

    method follow_link_by_pos p =
      match self#links_by_pos p with
      | (LinkLink ele) :: _ ->
          self#push ele
      | _ ->
          ()

    method follow_link_by_pos_in_new p =
      match self#links_by_pos p with
      | (LinkLink ele) :: _ ->
          let text_doc = new text_doc doc_modules in
          text_doc#window#show () ;
          text_doc#push ele
      | _ ->
          ()

    method follow_current_position_link =
      let p = buffer_position buffer in
      self#follow_link_by_pos p

    method follow_current_position_link_in_new =
      let p = buffer_position buffer in
      self#follow_link_by_pos_in_new p

    method goto_next_element =
      let pos = buffer_position buffer in
      try
        let (pos, len) = self#get_next_element_from_pos pos in
        self#goto2 pos len;
      with
        Not_found ->
          try
            let (pos, len) = self#get_next_element_from_pos (-1) in
            self#goto2 pos len;
          with Not_found ->
            ()

    method goto_previous_element =
      let pos = buffer_position buffer - 1 in
      try
        let (pos, len) = self#get_previous_element_from_pos pos in
        self#goto2 pos len;
      with
        Not_found ->
          try
            let (pos, len) = self#get_previous_element_from_pos (buffer#end_iter#offset - 1) in
            self#goto2 pos len;
          with Not_found ->
            ()

    method goto_next_string ?(force=false) s =
      last_search := s ;
      let pb = buffer_position buffer in
      let p = pb + (if force then 2 else 1) in
      let p = if p > buffer#end_iter#offset then 0 else p in
(*      prerr_endline (Printf.sprintf "p=%d" p);*)
      let t = buffer#get_text () in
      try
        let i = Str.search_forward (Str.regexp_string s) t p in
        self#goto2 i (String.length s)
      with
        Not_found
      |        Invalid_argument _ ->
          try
            let i = Str.search_forward (Str.regexp_string s) t 0 in
            self#goto2 i (String.length s)
          with
            Not_found ->
              ()

    method goto_previous_string s =
      last_search := s ;
      let p = buffer_position buffer - 1 in
      let t = buffer#get_text ()  in
      try
        let i = Str.search_backward (Str.regexp_string s) t p in
        self#goto2 i (String.length s)
      with
        Not_found
      |        Invalid_argument _ ->
          try
            let i = Str.search_backward (Str.regexp_string s) t buffer#end_iter#offset in
            self#goto2 i (String.length s)
          with
            Not_found ->
              ()

    method popup_contextual_menu pos =
      match self#links_by_pos pos with
        [] -> ()
      | l ->
          let f_edit filename pos () =
            (* A VOIR: l'edition d'un fichier *)
(*
            match Cam_data.data#file_of_string filename with
              None -> ()
            | Some file ->
                Cam_edit.edit Cam_data.data ~char: pos file
*)

            ()
          in
          GToolbox.popup_menu ~button: 3 ~time: Int32.zero
            ~entries: (List.map (fun c -> ` I c)
                         (List.flatten
                            (List.map
                               (fun link ->
                                 match link with
                                   LinkLink ele ->
                                     ["Browse",
                                       (fun () ->
                                         let text_doc = new text_doc doc_modules in
                                         text_doc#window#show () ;
                                         text_doc#push ele ;
                                       )
                                     ]

                                 | LinkCode loc ->
                                     (match loc.Odoc_info.loc_impl with
                                       None -> []
                                     | Some (file, pos) -> [file, f_edit file pos ]) @
                                     (match loc.Odoc_info.loc_inter with
                                       None -> []
                                     | Some (file, pos) -> [file, f_edit file pos ])
                               )
                                           l
                            )
                         )
                      )


    
    (** Search for a text in the current doc navigator window. @action_command search *)

    method action_search () =
      if widget_has_focus we_search then
        (
         if we_search#text = "" then
           we_search#set_text !last_search
         else
           self#goto_next_string ~force: true we_search#text
        )
      else
        (
         let s = !last_search in
         we_search#set_text "";
         last_search := s;
         we_search#misc#grab_focus ()
        )

    
    (** Search for a text backward in the current doc navigator window. @action_command search_backward *)

    method action_search_backward () =
      if widget_has_focus we_search then
        (
         if we_search#text = "" then
           we_search#set_text !last_search;
         self#goto_previous_string we_search#text
        )
      else
        (
         let s = !last_search in
         we_search#set_text "";
         last_search := s;
         we_search#misc#grab_focus ()
        )

    
    (** Add the current element to the doc bookmarks. @action_command add_bookmark *)

    method action_add_bookmark () = self#add_current_to_doc_bookmarks

    
    (** Goto the next element in the current doc navigator window. @action_command next_element *)

    method action_goto_next_element () = self#goto_next_element

   
   (** Goto the previous element in the current doc navigator window. @action_command previous_element *)

    method action_goto_previous_element () = self#goto_previous_element

    
    (** Follow link on the current cursor position. @action_command follow_link *)

    method action_follow_link () = self#follow_current_position_link

    
    (** Follow link on the current cursor position, in a new window. @action_command follow_link_in_new *)

    method action_follow_link_in_new () = self#follow_current_position_link_in_new

    
    (** Go to the top of the current navigator window. @action_command home *)

    method action_home () = self#goto2 0 0

    
    (** Go to the end of the current navigator window. @action_command end *)

    method action_end () = self#goto2 (buffer#end_iter#offset - 1) 0

    
    (** Popup the contextual menu. @action_command menu *)

    method action_menu () =
      self#popup_contextual_menu (buffer_position buffer)

    initializer
      let _ = view#event#connect#button_press ~callback:
          (
           fun ev ->
             GdkEvent.get_type ev = `BUTTON_PRESS &&
             (
              let x = int_of_float (wscroll#hadjustment#value +. (GdkEvent.Button.x ev)) in
              let y = int_of_float (wscroll#vadjustment#value +. (GdkEvent.Button.y ev)) in
(*
                  prerr_endline
                    (Printf.sprintf "wscroll#hadjustment: lower=%f upper=%f value=%f"
                       wscroll#hadjustment#lower wscroll#hadjustment#upper wscroll#hadjustment#value);
                  prerr_endline
                    (Printf.sprintf "wscroll#vadjustment: lower=%f upper=%f value=%f"
                       wscroll#vadjustment#lower wscroll#vadjustment#upper wscroll#vadjustment#value);
                  prerr_endline (Printf.sprintf "x=%d y=%d" x y);
*)

              let pos = (view#get_iter_at_location ~x ~y)#offset in
(*
                  prerr_endline (Printf.sprintf "pos=%d" pos);
*)

              match GdkEvent.Button.button ev with
                3 ->
                  (
                   self#popup_contextual_menu pos ;
                   false
                  )
              |        1 ->
                  (match self#links_by_pos pos with
                  | (LinkLink ele) :: _ ->
                      self#push ele ;
                      false
                  | _ ->
                      false
                  )
              |        _ ->
                  false
             )
          )
      in
      let _ = wb_back#connect#clicked (fun () -> self#pop) in

      (* Keyboard shortcuts *)
      let add = Cam_misc.add_shortcut in
      let module M = Cam_messages in
      let l_actions_window = [
        Cam_doc.com_search, (None, self#action_search) ;
        Cam_doc.com_back, (Some (fun () -> not (widget_has_focus we_search)), wb_back#clicked) ;
        Cam_doc.com_add_bookmark, (None, self#action_add_bookmark) ;
        Cam_doc.com_next_element, (None, self#action_goto_next_element) ;
        Cam_doc.com_prev_element, (None, self#action_goto_previous_element) ;
        Cam_doc.com_close, (None, window#destroy) ;
        Cam_doc.com_follow_link, (None, self#action_follow_link) ;
        Cam_doc.com_follow_link_in_new, (None, self#action_follow_link_in_new) ;
        Cam_doc.com_home, (None, self#action_home) ;
        Cam_doc.com_end, (None, self#action_end) ;
        Cam_doc.com_search_backward, (None, self#action_search_backward) ;
        Cam_doc.com_menu, (None, self#action_menu) ;
      ]
      in
      List.iter (add window l_actions_window) Cam_doc.keymap_doc#get;

      let _ = we_search#connect#changed
          (fun () -> self#goto_next_string we_search#text)
      in
      view#misc#grab_focus ()
  end

(** This function takes an element (result of a research), and display it in a new textdoc. *)

let display_result_element doc_modules element =
  let text_doc = new text_doc doc_modules in
  let _ = text_doc#window#show () in
  let ele =
    match element with
      Odoc_info.Search.Res_module m -> E_Module m.m_name
    | Odoc_info.Search.Res_module_type mt -> E_Module_type mt.mt_name
    | Odoc_info.Search.Res_class c -> E_Class c.cl_name
    | Odoc_info.Search.Res_class_type ct -> E_Class_type ct.clt_name
    | Odoc_info.Search.Res_value v -> E_Value v.val_name
    | Odoc_info.Search.Res_type t -> E_Type t.ty_name
    | Odoc_info.Search.Res_exception e -> E_Exception e.ex_name
    | Odoc_info.Search.Res_attribute a -> E_Attribute a.att_value.val_name
    | Odoc_info.Search.Res_method m -> E_Method m.met_value.val_name
    | Odoc_info.Search.Res_section (s, t) -> E_Section s
  in
  text_doc#push ele


(** The window with the list of available modules. *)

let modules_window = ref (None : (GWindow.window * string GList.clist * GEdit.combo * string list) option)
(** The selected line, if any. *)

let selected_line = ref (None : (int * string) option)

(** Set the function which will be called when a key is pressed in the given wlist. *)

let wlist_key_stroke doc_modules (wlist : string GList.clist) =
  let goto s =
    let l = match !modules_window with None -> [] | Some (_,_,_,l) -> l in
    let rec iter first_opt n = function
        [] -> first_opt
      |        name :: q ->
          if String.length name > 0 then
            if String.uppercase (String.sub name 0 1) = String.uppercase s then
              match !selected_line with
                None -> Some n
              |        Some (m, sel_name) ->
                  if String.length sel_name > 0 then
                    if Char.uppercase name.[0] = Char.uppercase sel_name.[0] then
                      if n <= m then
                        match first_opt with
                          None -> iter (Some n) (n+1) q
                        | Some _ -> iter first_opt (n+1) q
                      else
                        Some n
                    else
                      Some n
                  else
                    Some n
            else
              iter first_opt (n+1) q
          else
            iter first_opt (n+1) q
    in
    match iter None 0 l with
      None -> ()
    | Some line ->
        wlist#moveto line 0 ;
        wlist#select line 0
  in
  let open_selected_module () =
    match !selected_line with
      None -> ()
    | Some (_, name) ->
        let text_doc = new text_doc doc_modules in
        let _ = text_doc#window#show () in
        let ele = E_Module name in
        text_doc#push ele
  in
  let _ = wlist#event#connect#key_press
    ~callback: (fun ev ->
      (if GdkEvent.Key.keyval ev = GdkKeysyms._Return then
        open_selected_module ()
      else
        goto (GdkEvent.Key.string ev));
      true)
  in
  let maybe_double_click (ev : GdkEvent.Button.t) =
    let t = GdkEvent.get_type ev in
    match t with
      `TWO_BUTTON_PRESS -> open_selected_module ()
    | _ -> ()
  in
  ignore (wlist#connect#unselect_row
            (fun ~row -> fun ~column -> fun ~event ->
              selected_line := None ;
              match event with
                None -> ()
              |        Some ev -> maybe_double_click ev
            )
         ) ;
  ignore (wlist#connect#select_row
            (fun ~row -> fun ~column -> fun ~event ->
              let name =
                match !modules_window with
                  None -> ""
                | Some (_,_,_,mods) -> try List.nth mods row with _ -> ""
              in
              selected_line := Some (row, name) ;
              match event with
                None -> ()
              |        Some ev -> maybe_double_click ev
            )
         )


(** Create or update the box with the list of available top modules. *)

let create_or_update_list_window doc_modules =
  let (window, wlist, wcombo) =
    match !modules_window with
      None ->
        let window = GWindow.window ~kind: `TOPLEVEL
            ~title: Cam_messages.doc_box
            ~width: 120
            ~height:
            (
             let n = 80 + 20 * (List.length !doc_modules) in
             let h_limit = (Gdk.Screen.height ()) - 30 in
             if n > h_limit then h_limit else n
            )
            ()
        in
        window#move ~x: 0 ~y: 0;

        let vbox = GPack.vbox ~packing: window#add () in
        (*let hbox_search = GPack.hbox ~packing: (vbox#pack ~expand: false) () in*)
        let wcombo = GEdit.combo
            ~enable_arrow_keys: true
            ~case_sensitive: true
            ~value_in_list: false
            ~allow_empty: true
            ~packing: (vbox#pack ~expand: false)
            ()
        in
        let wb_search = GButton.button
            ~label: Cam_messages.search_exact
            ~packing: (vbox#pack ~expand: false)
            ()
        in
        let wscroll = GBin.scrolled_window
            ~hpolicy: `NEVER
            ~vpolicy: `AUTOMATIC
            ~packing: (vbox#pack ~expand: true)
            ()
        in
        let wlist = GList.clist
            ~titles_show: false
            ~titles: [""]
            ~selection_mode: `SINGLE
            ~packing: wscroll#add
            ()
        in
        wlist_key_stroke doc_modules wlist ;
        let wb_close = GButton.button ~label: Cam_messages.close
            ~packing: (vbox#pack ~expand: false ~padding: 3) ()
        in
        let _ = window#connect#destroy
            (fun () -> modules_window := None)
        in
        ignore (wb_close#connect#clicked window#destroy);
        ignore (wb_search#connect#clicked
                  (fun () ->
                    match wcombo#entry#text with
                      "" -> ()
                    | s -> !f_search_exact doc_modules s
                  ));
        window#show () ;
        (window, wlist, wcombo)
    | Some (win, wlist, wcombo, _) -> (win, wlist, wcombo)
  in
  let _ = wlist#clear () in
  selected_line := None ;
  let _ = List.iter
      (fun m -> let _ = wlist#append [ m.m_name ] in ())
      !doc_modules
  in
  GToolbox.autosize_clist wlist;
  wcombo#set_popdown_strings Cam_doc.doc_bookmarks#get;
  modules_window := Some (window, wlist, wcombo, List.map (fun m -> m.m_name) !doc_modules) ;
  wlist#misc#grab_focus ()



(** Display a list of result elements. When one is selected, it is displayed. *)

let display_result_list doc_modules elements =
  let window = GWindow.window ~kind: `TOPLEVEL
      ~width: 250
      ~height:
      (
       let n = 80 + 20 * (List.length elements) in
       if n > 500 then 500 else n
      )
      ()
  in
  let vbox = GPack.vbox ~packing: window#add () in
  let wscroll = GBin.scrolled_window ~packing: (vbox#pack ~expand: true) () in
  let wlist = GList.clist
      ~titles: [ Cam_messages.kind ; Cam_messages.name ]
      ~titles_show: true
      ~selection_mode: `SINGLE
      ~packing: wscroll#add
      ()
  in
  let wb_close = GButton.button ~label: Cam_messages.close
      ~packing: (vbox#pack ~expand: false ~padding: 3) ()
  in
  List.iter
    (fun ele ->
     let l =
       match ele with
         Odoc_info.Search.Res_module m -> [ "module" ; m.m_name ]
       | Odoc_info.Search.Res_module_type mt -> [ "module type" ; mt.mt_name ]
       | Odoc_info.Search.Res_class c -> [ "class" ; c.cl_name ]
       | Odoc_info.Search.Res_class_type ct -> [ "class type" ; ct.clt_name ]
       | Odoc_info.Search.Res_value v -> [ "value" ; v.val_name ]
       | Odoc_info.Search.Res_type t -> [ "type" ; t.ty_name ]
       | Odoc_info.Search.Res_exception e -> [ "exception" ; e.ex_name ]
       | Odoc_info.Search.Res_attribute a -> [ "attribute" ; a.att_value.val_name ]
       | Odoc_info.Search.Res_method m -> [ "method" ; m.met_value.val_name ]
       | Odoc_info.Search.Res_section (s, t) -> [ "section" ; s ]
     in
     let _ = wlist#append l in
     ()
    )
    elements;
  GToolbox.autosize_clist wlist ;
  let _ = wb_close#connect#clicked window#destroy in
  let f ~row ~column ~event =
    try
      let ele = List.nth elements row in
      display_result_element doc_modules ele
    with
      Not_found -> ()
  in
  let _ = wlist#connect#select_row f in
  window#show ()

(** This function search in loaded modules for the elements with the given exact name. If only one element is found, it is displayed in a textdoc. If more than one element are found, a box is displayed with the list. If no element is found, a message box is displayed.*)

let search_elements_by_exact_names doc_modules s =
  match Odoc_info.Search.search_by_name
      !doc_modules (Str.regexp ("^"^(Str.quote s)^"$"))
  with
    [] ->
      GToolbox.message_box Cam_messages.search_exact
        (Cam_messages.nothing_found s)
  | [ele] ->
      display_result_element doc_modules ele
  | l ->
      display_result_list doc_modules l

(** Make the user type a string and look in the given modules for the elements with that name exactly.*)

let search_exact doc_modules  =
  match GToolbox.input_string ~title:Cam_messages.search_exact "" with
    None -> ()
  | Some s -> search_elements_by_exact_names doc_modules s

(** Make the user type a regexp and look in the given modules for the elements with that name exactly. If only one element is found, it is displayed in a textdoc. If more than one element are found, a box is displayed with the list. If no element is found, a message box is displayed.*)

let search_regexp doc_modules =
  match GToolbox.input_string Cam_messages.search_regexp "" with
    None ->
      ()
  | Some s ->
      match Odoc_info.Search.search_by_name
          !doc_modules (Str.regexp s)
      with
        [] ->
          GToolbox.message_box Cam_messages.search_regexp
            (Cam_messages.nothing_found s)
      |        [ele] ->
          display_result_element doc_modules ele
      |        l ->
          display_result_list doc_modules l

(** Function to call to update the module box, if it is displayed. *)

let update_module_box_if_displayed doc_modules =
  match !modules_window with
    None -> ()
  | Some _ -> create_or_update_list_window doc_modules

let open_element doc_modules ele =
  let text_doc = new text_doc doc_modules in
  ignore (text_doc#window#show ());
  text_doc#push ele

let show_odoc_info_and_code ~title ~info ~code =
  let text_doc = new text_doc (ref []) in
  ignore (text_doc#window#show ());
  text_doc#put_info (Some info);
  text_doc#put_code ~with_pre: true code;
  text_doc#set_title title

(* Initialize global functions. *)

let _ = f_search_exact := search_elements_by_exact_names
let _ = f_update_bookmarks := update_module_box_if_displayed