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
let f_search_exact = ref (fun (_:Odoc_info.Module.t_module list ref) (_ : string) -> ())
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
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 ()
val mutable elements = ([] : (element * int) list)
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
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 -> []
method get_section_pos name =
let simple = Name.simple name in
snd (List.find
(fun (e, _) -> e = E_Section simple)
elements)
method put_keyword s = buffer#insert
~tags: [fixed_font ; keyword_color]
s
method put_constructor s = buffer#insert
~tags: [fixed_font ;constructor_color]
s
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
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
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
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
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
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
method put_code ?(with_pre=false) code =
buffer#insert ~tags:[fixed_font; code_color] code
method put_text_ele bold fixed e =
match e with
| Odoc_info.Raw s ->
(
match bold, fixed with
true, true -> buffer#insert ~tags: [fixed_bold_font] s
| true, false -> buffer#insert ~tags: [bold_font] s
| false, true -> buffer#insert ~tags:[fixed_font] s
| false, false -> 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 _ ->
()
| 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 ->
()
| _ ->
()
method put_text ?(bold=false) ?(fixed=false) t =
List.iter (self#put_text_ele bold fixed) t
method put_author_list l =
match l with
[] ->
()
| _ ->
buffer#insert ~tags: [bold_font] (Cam_messages.authors^": ") ;
buffer#insert ((String.concat ", " l)^"\n")
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")
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")
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"
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
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"
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"
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"
method put_parameter_description p =
match Parameter.names p with
[] ->
buffer#insert "\n"
| name :: [] ->
(
match Parameter.desc_by_name p name with
None -> ()
| Some t -> self#put_text t ;
);
buffer#insert "\n"
| l ->
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
method put_described_parameter_list father l =
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"
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
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
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 ;
buffer#insert ~tags:[fixed_font] " "
| l ->
self#put_type_expr_list father ", "
(List.map (fun (t,_,_) -> t) l) ;
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
method put_attribute a =
self#put_keyword "val " ;
(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
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
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
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
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
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
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"
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
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
method put_class_comment text = self#put_module_comment text
method put_module_comment text = self#put_text (text @ [Newline ; Newline])
method put_inheritance_info inher_l =
let f tab inh =
buffer#insert ~tags:[fixed_font] tab;
(
match inh.ic_class with
None ->
buffer#insert ~tags:[fixed_bold_font] (inh.ic_name^" ") ;
(match inh.ic_text with
None -> ()
| Some t -> self#put_text t
)
| Some cct ->
let real_name =
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"
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
method put_class_type_inheritance_info clt =
match clt.clt_kind with
Class_signature ([], _) ->
()
| Class_signature (l, _) ->
self#put_inheritance_info l
| Class_type _ ->
()
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 ;
self#put_class_inheritance_info cl;
self#put_parameter_list (Name.father cl.cl_name) cl.cl_parameters;
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)
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 ;
self#put_class_type_inheritance_info clt;
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)
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 ;
self#put_module_parameter_list "" (Module.module_type_parameters mt);
buffer#insert "\n\n";
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)
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 ;
self#put_module_parameter_list "" (Module.module_parameters modu) ;
buffer#insert "\n\n";
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)
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))
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
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 () =
()
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
)
)
)
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 ()
)
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 ()
)
method action_add_bookmark () = self#add_current_to_doc_bookmarks
method action_goto_next_element () = self#goto_next_element
method action_goto_previous_element () = self#goto_previous_element
method action_follow_link () = self#follow_current_position_link
method action_follow_link_in_new () = self#follow_current_position_link_in_new
method action_home () = self#goto2 0 0
method action_end () = self#goto2 (buffer#end_iter#offset - 1) 0
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
let pos = (view#get_iter_at_location ~x ~y)#offset in
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
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
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
let modules_window = ref (None : (GWindow.window * string GList.clist * GEdit.combo * string list) option)
let selected_line = ref (None : (int * string) option)
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
)
)
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 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 ()
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 ()
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
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
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
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
let _ = f_search_exact := search_elements_by_exact_names
let _ = f_update_bookmarks := update_module_box_if_displayed