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))
;;

Valid XHTML 1.1!Valid CSS!