let map_opt f = function
None -> None
| Some v -> Some (f v)
let rec my_int_of_string s =
let len = String.length s in
if len <= 0 then invalid_arg "my_int_of_string";
match s.[0] with
'+' -> my_int_of_string (String.sub s 1 (len - 1))
| _ -> int_of_string s
let chop_n_char n s =
let len = String.length s in
if len <= n +1 or n < 0 then
s
else
Printf.sprintf "%s..." (String.sub s 0 (n+1))
let list_remove_doubles ?(pred=(=)) l =
List.fold_left
(fun acc e -> if List.exists (pred e) acc then acc else e :: acc)
[]
(List.rev l)
let add_shortcut w l ((mods, k), action) =
try
let (c_opt, f) = List.assoc action l in
Okey.add ?cond: c_opt w ~mods k f
with
Not_found ->
prerr_endline (Cam_messages.error_unknown_action action)
let file_of_string ~file s =
let oc = open_out file in
output_string oc s;
close_out oc
let mOk = "Ok"
let mCancel = "Cancel"
let input_widget ~widget ~event ~get_text ~bind_ok ~expand
~title ?(ok=mOk) ?(cancel=mCancel) message =
let retour = ref None in
let window = GWindow.dialog ~title ~modal:true () in
ignore (window#connect#destroy ~callback: GMain.Main.quit);
let main_box = window#vbox in
let hbox_boutons = window#action_area in
let vbox_saisie = GPack.vbox ~packing: (main_box#pack ~expand: true) () in
let _wl_invite = GMisc.label
~text: message
~packing: (vbox_saisie#pack ~padding: 3)
()
in
vbox_saisie#pack widget ~expand ~padding: 3;
let wb_ok = GButton.button ~label: ok
~packing: (hbox_boutons#pack ~expand: true ~padding: 3) () in
wb_ok#grab_default ();
let wb_cancel = GButton.button ~label: cancel
~packing: (hbox_boutons#pack ~expand: true ~padding: 3) () in
let f_ok () =
retour := Some (get_text ()) ;
window#destroy ()
in
let f_cancel () =
retour := None;
window#destroy ()
in
ignore(wb_ok#connect#clicked f_ok);
ignore(wb_cancel#connect#clicked f_cancel);
event#connect#key_press ~callback:
begin fun ev ->
if GdkEvent.Key.keyval ev = GdkKeysyms._Return && bind_ok then f_ok ();
if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then f_cancel ();
false
end;
widget#misc#grab_focus ();
window#show ();
GMain.Main.main ();
!retour
let select_in_list ?ok ?cancel ?(allow_empty=false) ?(value_in_list=true) ~title ~choices message =
let wc = GEdit.combo
~popdown_strings: choices
~allow_empty
~value_in_list
()
in
input_widget ~widget:wc#coerce ~event:wc#entry#event
~get_text:(fun () -> wc#entry#text) ~bind_ok:true
~expand: false
~title ?ok ?cancel message
let remove_char s c =
if s <> "" then
for i = 0 to (String.length s) - 1 do
if s.[i] = c then s.[i] <- ' '
done;
s
let treat_gtk_events () =
while Glib.Main.pending () do
ignore (Glib.Main.iteration false)
done
let get_wm_window_position_offset () =
let win = GWindow.window ~width: 0 ~height: 0 () in
win#show ();
let (x,y) = Gdk.Window.get_position win#misc#window in
win#move ~x ~y;
treat_gtk_events ();
let (x2,y2) = Gdk.Window.get_position win#misc#window in
win#destroy ();
Cam_dbg.print ~level: 3
(Printf.sprintf "get_wm_window_position_offset: offset: x=%d-%d=%d y=%d-%d=%d"
x2 x (x2-x) y2 y (y2-y));
(x2 - x, y2 - y)
let subdirs path =
let d = Unix.opendir path in
let rec iter acc =
let file =
try Some (Unix.readdir d)
with End_of_file -> Unix.closedir d; None
in
match file with
| None -> List.rev acc
| Some s when
s = Filename.current_dir_name or
s = Filename.parent_dir_name -> iter acc
| Some file ->
let complete_f = Filename.concat path file in
match
try Some (Unix.stat complete_f).Unix.st_kind
with _ -> None
with
Some Unix.S_DIR -> iter (complete_f :: acc)
| None | Some _ -> iter acc
in
iter []
let line_of_char file n =
try
let chanin = open_in file in
let rec iter l m =
let s_opt =
try Some (input_line chanin)
with End_of_file -> None
in
match s_opt with
None -> l
| Some s ->
let new_m = m + ((String.length s) + 1) in
if new_m >= n then
l
else
iter (l + 1) new_m
in
let l = iter 0 0 in
close_in chanin ;
l
with
Sys_error s ->
prerr_endline s ;
0
let replace_in_string ~pat ~subs ~s =
let len_pat = String.length pat in
let len = String.length s in
let b = Buffer.create len in
let rec iter pos =
if pos >= len then
()
else
if pos + len_pat > len then
Buffer.add_string b (String.sub s pos (len - pos))
else
if String.sub s pos len_pat = pat then
(
Buffer.add_string b subs;
iter (pos+len_pat)
)
else
(
Buffer.add_char b s.[pos];
iter (pos+1);
)
in
iter 0;
Buffer.contents b
let escape_menu_label s = replace_in_string ~pat: "_" ~subs: "__" ~s
let utf8_nb_bytes_of_char c =
let n = Char.code c in
if n < 0b10000000 then
1
else if n < 0b11100000 then
2
else if n < 0b11110000 then
3
else
4
let utf8_index_of_char s c =
let cpt = ref 0 in
let current = ref 0 in
let len = String.length s in
while !current < c && !cpt < len do
cpt := !cpt + utf8_nb_bytes_of_char s.[!cpt];
incr current;
done;
if !current = c then
!cpt
else
raise Not_found
let utf8_char_of_index s i =
let len = String.length s in
if i >= len or i < 0 then
invalid_arg "utf8_char_from_index"
else
begin
let char_count = ref (-1) in
let pos = ref 0 in
while !pos <= i && !pos < len do
incr char_count;
pos := !pos + utf8_nb_bytes_of_char s.[!pos]
done;
!char_count
end
let utf8_string_length s =
let len = String.length s in
let rec iter acc n =
if n >= len then
acc
else
iter (acc+1) (n + (utf8_nb_bytes_of_char s.[n]))
in
iter 0 0
let utf8_char_of_code n =
if n < 128 then
String.make 1 (Char.chr n)
else
let z_mask = 0b00111111 in
let z_part = (n land z_mask) in
let z = 0b10000000 lor z_part in
if n <= 0x0007FF then
let y_mask = 0b0000011111000000 in
let y_part = (n land y_mask) lsr 6 in
let y = 0b11000000 lor y_part in
Printf.sprintf "%c%c" (Char.chr y) (Char.chr z)
else
let y_mask = 0b111111000000 in
let y_part = (n land y_mask) lsr 6 in
let y = 0b10000000 lor y_part in
if n <= 0x00FFFF then
let x_mask = 0b1111 lsl 12 in
let x_part = (n land x_mask) lsr 12 in
let x = 0b11100000 lor x_part in
Printf.sprintf "%c%c%c" (Char.chr x) (Char.chr y) (Char.chr z)
else
if n <= 0x10FFFF then
let x_mask = 0b111111 lsl 12 in
let x_part = (n land x_mask) lsr 12 in
let x = 0b10000000 lor x_part in
let w_mask = 0b111 lsl 18 in
let w_part = (n land w_mask) lsr 18 in
let w = 0b11110000 lor w_part in
Printf.sprintf "%c%c%c%c" (Char.chr w) (Char.chr x) (Char.chr y) (Char.chr z)
else
failwith (Printf.sprintf "UTF-8 code out of range: %x" n)