let rec update ~reload doc_modules f_create f_search_exact f_search_regexp menu =
List.iter (fun item -> menu#remove item ; item#destroy ()) menu#children;
try
if reload then
doc_modules := load_doc_files
(List.map (fun ds -> ds.ds_file) doc_sources#get);
let len = List.length !doc_modules in
let nb_levels =
let rec iter acc n =
let new_acc = acc * max_menu_length in
if new_acc >= len then n
else iter new_acc (n+1)
in
iter 1 1
in
let nb_items_by_menu =
if nb_levels = 0 then
float_of_int max_menu_length
else
let fnb_levels = float_of_int nb_levels in
let n_racine = (float_of_int len) ** ( 1. /. fnb_levels) in
ceil n_racine
in
let rec create_menu menu level mods =
let len = List.length mods in
if len <= (int_of_float nb_items_by_menu) then
let _ =
List.fold_left
(fun (previous, acc) -> fun m ->
let item = GMenu.menu_item ~label: m.Odoc_info.Module.m_name ~packing: menu#add () in
let f m = f_create doc_modules (E_Module m.Odoc_info.Module.m_name) in
let _ = item#connect#activate (fun () -> f m) in
(m.Odoc_info.Module.m_name, acc)
)
("", [])
mods
in
()
else
let rec iter l =
match l with
[] ->
()
| _ ->
let n = int_of_float ((nb_items_by_menu) ** (float_of_int level)) in
let (first, remain) = get_n_first_ele n l in
let ele_1 = List.hd first in
let ele_last = List.hd (List.rev first) in
let item = GMenu.menu_item
~label: (ele_1.Odoc_info.Module.m_name^" .. "^ele_last.Odoc_info.Module.m_name)
~packing: menu#add
()
in
let submenu = GMenu.menu () in
let _ = item#set_submenu submenu in
create_menu submenu (level - 1)first ;
iter remain
in
iter mods
in
create_menu menu (nb_levels - 1) !doc_modules ;
let _ = GMenu.menu_item ~packing: menu#add () in
let item_exact_search =
GMenu.menu_item ~label: Cam_messages.search_exact
~packing: menu#add
()
in
let _ = item_exact_search#connect#activate
(fun () -> f_search_exact doc_modules)
in
let item_exact_regexp =
GMenu.menu_item ~label: Cam_messages.search_regexp
~packing: menu#add
()
in
let _ = item_exact_regexp#connect#activate
(fun () -> f_search_regexp doc_modules)
in
let _ = GMenu.menu_item ~packing: menu#add () in
List.iter
(fun ds ->
match ds.ds_label_com with
None -> ()
| Some (name, command) ->
let item = GMenu.menu_item
~label: name ~packing: menu#add ()
in
let f () =
Cam_hooks.display_message (Cam_messages.running_com command);
let n = Sys.command command in
if n <> 0 then
GToolbox.message_box Cam_messages.error
(Cam_messages.error_exec command) ;
Cam_hooks.display_message "";
update ~reload: true doc_modules f_create f_search_exact f_search_regexp menu
in
let _ = item#connect#activate f in
()
)
doc_sources#get
with
Failure s ->
GToolbox.message_box Cam_messages.error s;
()