xdialog.ml
(** Author Kévin Séjourné : sejourne_kevin atchoum yahoo.fr *)
(** A small warper for Xdialog http://xdialog.dyns.net/ *)
(** This program is under licence GPL
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
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 General Public License for more details.
*)
let système command f_line =
let cin = Unix.open_process_in command
in
(try while true do f_line (input_line cin);
done with | End_of_file -> ());
Unix.close_process_in cin
;;
let sep s c = Str.split (Str.regexp(Printf.sprintf "%c" c)) s
;;
(**/**)
let run dialog commande options =
let accu = ref [] in
let f line = accu := line :: !accu in
let com = (* command execute in a pipe *)
dialog^" --stdout "^commande^" "^options
in match système com f with
| Unix.WEXITED(code)-> (code,List.rev (!accu))
| Unix.WSIGNALED(code)
| Unix.WSTOPPED(code)-> (127+code,List.rev (!accu))
;;
let xdialog opt commande options = run ("Xdialog "^opt^" ") commande options;;
(**/**)
(*-------------------------------------------------------------*)
(* warper *)
(*-------------------------------------------------------------*)
exception Annule;;
exception Xdialog of string
(**/**)
let text t = Filename.quote t;;
let h = 0 and l = 0 ;;
let error msg = raise (Xdialog msg);;
let dim(h,l)= Printf.sprintf " %d %d " h h
let status_of_bool b = if b then "on" else "off";;
let base m (h,l) = Printf.sprintf " %s %d %d " (text m) h l;;
let get e = function
|0,[msg] -> msg
|1, _ -> raise Annule
| _ -> error e
;;
let get_all e = function
|0,msg -> msg
|1, _ -> raise Annule
| _ -> error e
;;
(**/**)
let yesno ?(hl=(h,l)) ?(opt="") m =
match xdialog opt " --yesno " (base m hl) with
| 0 , _ -> true
| 1 , _ -> false
| _ -> error "yesno"
;;
let msgbox ?(hl=(h,l)) ?(opt="") m =
if fst (xdialog opt " --msgbox " (base m hl)) != 0
then error "msgbox"
;;
let infobox ?(hl=(h,l)) ?(opt="") ?(timeout=0) m =
let timeout = if timeout = 0 then "" else string_of_int timeout in
if fst (xdialog opt " --infobox " ((base m hl)^timeout)) != 0
then error "infobox"
;;
let gauge ?(hl=(h,l)) ?(opt="") ?(percent=0) m =
let percent = string_of_int percent in
if fst (xdialog opt " --gauge " ((base m hl)^percent)) != 0
then error "gauge"
;;
let progress ?(hl=(h,l)) ?(opt="") m maxdots msglen =
let echelon = Printf.sprintf " %d %d "maxdots msglen in
if fst (xdialog opt " --progress " ((base m hl)^echelon)) != 0
then error "progress"
;;
(**/**)
let inputbox1 ?(hl=(h,l)) ?(opt="") ?(init="") m =
let m = if m = "" then "-" else m in
get "inputbox1"
(xdialog opt " --inputbox " ((base m hl)^(text init)))
;;
let inputsbox2 ?(hl=(h,l)) ?(opt="") m l1 i1 l2 i2 =
get "inputsbox2"
(xdialog opt " --2inputsbox "
(String.concat " " [base m hl;text l1;text i1;text l2;text i2]))
;;
let inputsbox3 ?(hl=(h,l)) ?(opt="") m l1 i1 l2 i2 l3 i3 =
get "inputsbox3"
(xdialog opt " --3inputsbox "
(String.concat " "
[base m hl;text l1;text i1;text l2;text i2;text l3;text i3]))
;;
(**/**)
let inputsbox ?(hl=(h,l)) ?(opt="") ?(init="") m = function
[] -> inputbox1 ~hl:hl ~opt:opt ~init:init m
| [l,i] ->
let m = if m = "" then l else m in
let init = if init = "" then i else init in
inputbox1 ~hl:hl ~opt:opt ~init:init m
| [l1,i1;l2,i2] -> inputsbox2 ~hl:hl ~opt:opt m l1 i1 l2 i2
| [l1,i1;l2,i2;l3,i3] -> inputsbox3 ~hl:hl ~opt:opt m l1 i1 l2 i2 l3 i3
| _ -> error "inputsbox Limit to 3"
;;
let combobox ?(hl=(h,l)) ?(opt="") m items =
get "combobox"
(xdialog opt " --combobox " ((base m hl)^(String.concat " " items)))
;;
(**/**)
let rangebox1 ?(hl=(h,l)) ?(opt="") ?(init=0) m min max =
let range = Printf.sprintf " %d %d %d " min max init in
get "rangebox1" (xdialog opt "--rangebox" ((base m hl)^range))
;;
let rangebox2 ?(hl=(h,l)) ?(opt="") ?(init=0) m
l1 min1 max1 def1 l2 min2 max2 def2 =
let range = Printf.sprintf " %s %d %d %d %s %d %d %d "
(text l1) min1 max1 def1 (text l2) min2 max2 def2
in get "rangebox2" (xdialog opt "--2rangesbox" ((base m hl)^range))
;;
let rangebox3 ?(hl=(h,l)) ?(opt="") ?(init=0) m
l1 min1 max1 def1 l2 min2 max2 def2 l3 min3 max3 def3 =
let range = Printf.sprintf " %s %d %d %d %s %d %d %d %s %d %d %d "
(text l1) min1 max1 def1 (text l2) min2 max2 def2 (text l3) min3 max3 def3
in get "rangebox3" (xdialog opt "--3rangesbox" ((base m hl)^range))
;;
(**/**)
let rangesbox ?(hl=(h,l)) ?(opt="") m = function
[] -> rangebox1 ~hl:hl ~opt:opt m 0 100
| [l,min,max,def] ->
let m = if m = "" then l else m in
rangebox1 ~hl:hl ~opt:opt ~init:def m min max
| [l1,min1,max1,def1;l2,min2,max2,def2] ->
rangebox2 ~hl:hl ~opt:opt m
l1 min1 max1 def1 l2 min2 max2 def2
| [l1,min1,max1,def1;l2,min2,max2,def2;l3,min3,max3,def3] ->
rangebox3 ~hl:hl ~opt:opt m
l1 min1 max1 def1 l2 min2 max2 def2 l3 min3 max3 def3
| _ -> error "rangesbox Limit to 3"
;;
let spinsbox ?(hl=(h,l)) ?(opt="") m els=
let els = List.map
(fun(min,max,def,l)->
(String.concat " "
[string_of_int min;string_of_int max;string_of_int def;text l])
)
els
in
get "spinsbox"
(xdialog
opt
(match List.length els with
1 -> "--spinbox"
| 2 -> "--2spinsbox"
| 3 -> "--3spinsbox"
| _ -> error "spinsbox")
((base m hl)^(String.concat " " els))
)
;;
let textbox ?(hl=(h,l)) ?(opt="") file =
if not (Sys.file_exists file)
then error ("textebox: file "^file^" not exist.")
else get "textbox" (xdialog opt " --textebox " (file^" "^(dim hl)))
;;
let editbox ?(hl=(h,l)) ?(opt="") file =
if not (Sys.file_exists file)
then error ("editbox: file "^file^" not exist.")
else
get_all "editbox" (xdialog opt " --editbox " (file^" "^(dim hl)))
;;
let tailbox ?(hl=(h,l)) ?(opt="") file =
if not (Sys.file_exists file)
then error ("tailbox: file "^file^" not exist.")
else get "tailbox" (xdialog opt " --tailbox " (file^" "^(dim hl)))
;;
(**/**)
let machin_list machin ?(hl=(h,l)) ?(opt="") m els =
let infolist =
String.concat " "
((string_of_int (List.length els))
::(List.map
(fun(tag,el,s)->
(String.concat " " [text tag;text el;status_of_bool s])
)
els
)
)
in
get_all machin (xdialog
(opt^" --separator \"\n\" ")
(" --"^machin^" ")
((base m hl)^" "^infolist)
)
;;
(**/**)
let checklist ?(hl=(h,l)) ?(opt="") m els =
machin_list "checklist" ~hl:(h,l) ~opt:"" m els
;;
let radiolist ?(hl=(h,l)) ?(opt="") m els =
machin_list "radiolist" ~hl:(h,l) ~opt:"" m els
;;
let buildlist ?(hl=(h,l)) ?(opt="") m els =
machin_list "buildlist" ~hl:(h,l) ~opt:"" m els
;;
let treeview ?(hl=(h,l)) ?(opt="") m els =
let infolist =
String.concat " "
((string_of_int (List.length els))
::(List.map
(fun(tag,el,s,d)->
(String.concat " "
[text tag;text el;status_of_bool s;string_of_int d;])
)
els
)
)
in
get_all "treeview"
(xdialog
(opt^" --separator \"\n\" ")
(" --treeview ")
((base m hl)^" "^infolist)
)
;;
let fselect ?(hl=(h,l)) ?(opt="") m =
get "fselect" (xdialog opt " --fselect " (base m hl))
;;
let dselect ?(hl=(h,l)) ?(opt="") m =
get "dselect" (xdialog opt " --dselect " (base m hl))
;;
let calendar ?(hl=(h,l)) ?(opt="") ?(day=1) ?(month=1) ?(year=1970) m =
let date = String.concat " " (List.map string_of_int [day;month;year]) in
if fst (xdialog opt " --infobox " ((base m hl)^date)) != 0
then error "infobox"
;;
let timebox ?(hl=(h,l)) ?(opt="") () =
get "tailbox" (xdialog opt " --timebox " (dim hl))
;;

