(**************************************************************************)
(*                   Cameleon                                             *)
(*                                                                        *)
(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
(*      en Automatique. All rights reserved.                              *)
(*                                                                        *)
(*      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 of the License, or  *)
(*      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.                      *)
(*                                                                        *)
(*      You should have received a copy of the GNU General Public License  *)
(*      along with this program; if not, write to the Free Software       *)
(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
(*      02111-1307  USA                                                   *)
(*                                                                        *)
(*      Contact: Maxence.Guesdon@inria.fr                                *)
(**************************************************************************)

(** Convenient functions. *)


(** Read a string from a channel until the end of the file. 
   @return the read string or an empty string if [Sys_error] 
   or [Sys_blocked_io] were raised (typically for "bad file descriptor" 
   dark reasons...) .
*)
let read_from_channel inch =
  try
    let len = 1024 in
    let s = String.create len in
    let buf = Buffer.create len in
    let rec iter () =
      try
	let n = input inch s 0 len in
	if n = 0 then
          ()
	else
          (
           Buffer.add_substring buf s 0 n;
           iter ()
          )
      with
	End_of_file -> ()
    in
    iter ();
    Buffer.contents buf
  with
    Sys_error s ->
      prerr_endline s;
      ""
  | Sys_blocked_io -> ""

(** Get the line number in a file from a character number. *)
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 (* + 1 is for '\n' *)
	  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

(** From the CDK String2 module. *)
let split s c =
  let len = String.length s in
  let rec iter pos =
    try
      if pos = len then [""] else
      let pos2 = String.index_from s pos c in
      (String.sub s pos (pos2-pos)) :: (iter (pos2+1))
    with _ -> [String.sub s pos (len-pos)]
  in
  iter 0

(** From the CDK String2 module. *)
let rec unsplit l c =
  match l with
    [] -> ""
  | [x] -> x
  | x :: ((y :: l) as tail) ->
      Printf.sprintf "%s%c%s" x c (unsplit tail c)

(** From the CDK Filename2 module. Get a filename without
   [".."], ["."], or ["//"]. *)
let normalize filename =
  let l = split filename '/' in
  let is_absolute = match l with
      "" :: _ -> true
    | _ -> false
  in
  let rec iter l =
    match l with
      [] -> [], false
    | "" :: l -> iter l
    | "." :: l -> iter l
    | ".." :: l -> let l,_ = iter l in ("..":: l), false
    | x :: ".." :: l -> 
        let l,_ = iter l in l, true
    | x :: l -> 
        let l, redo = iter l in if redo then iter (x :: l) else (x :: l), false
  in
  let l, _ = iter l in
  let l = 
    if is_absolute then
      let rec iter_abs l =
        match l with
          ".." :: l -> iter_abs l
        | _ -> l
      in
      "" :: (iter_abs l)
    else l
  in
  match l with
    [] -> "."
  | [""] -> "/"
  | _ -> unsplit l '/'

(** Return the absolute name of the given file name,
   by prefixing it by the current working directory,
   if the given file name is not already absolute. *)
let absolute_name name =
  let abs_name = 
    if Filename.is_relative name then
      Filename.concat (Unix.getcwd ()) name
    else
      name
  in
  normalize abs_name

(** Return the given list without doubles. *)
let remove_doubles l =
  let rec iter acc = function
      [] -> acc
    | h :: q ->
	if List.mem h acc then
	  iter acc q
	else
	  iter (h :: acc) q
  in
  List.rev (iter [] l)

(** {2 Execution of Cameleon commands or shell commands} *)

let string_of_char c = String.make 1 c
let concat char string =
  string_of_char char ^ string

let rec parse_squote = parser
    | [< ''\'' >] -> ""
    | [< ''\\'; 'c; word = parse_squote >] ->
        concat c word
    | [< 'c; word = parse_squote >] ->
        concat c word
    | [< >] -> failwith "squote"

let rec parse_dquote = parser
    | [< ''"' >] -> ""
    | [< ''\\'; 'c; word = parse_dquote >] ->
        concat c word
    | [< 'c; word = parse_dquote >] ->
        concat c word
    | [< >] -> failwith "dquote"

let rec parse_noquote = parser
  | [< '' ' >] -> ""
  | [< ''\\'; 'c; word = parse_noquote >] ->
      concat c word
  | [< ''"'; subword = parse_dquote; word = parse_noquote >] ->
      subword ^ word
  | [< ''\''; subword = parse_squote; word = parse_noquote >] ->
      subword ^ word
  | [< 'c; word = parse_noquote >] ->
      concat c word
  | [< >] -> ""


let rec parse_words = parser
    [< '' '; words = parse_words >] ->
      words
  | [< ''"'; word = parse_dquote; words = parse_words >] ->
      word :: words
  | [< ''\''; word = parse_squote; words = parse_words >] ->
      word :: words
  | [< ''\\'; 'c; word = parse_noquote; words = parse_words >] ->
      concat c word :: words
  | [< 'c; word = parse_noquote; words = parse_words >] ->
      concat c word :: words
    | [< >] -> []


let list_of_string s =
  parse_words (Stream.of_string s)

(** Get a pair (command name, arguments) from a string. *)
let get_com_and_args s =
  match list_of_string s with
    [] -> (s, [])
  | com :: args -> (com, args)

(** This function returns the list of selected file.
   It is initialized in [caml.ml].*)
let files () =
  List.map (fun f -> f.Cam_types.f_name) (!Cam_global.selected_files ())

(** This function returns the selected directory, 
   if any. It is initialized in [caml.ml].*)
let dir () = !Cam_global.selected_dir ()

(** Execute the given command. *)
let shell_execute com = 
  !Cam_global.display_message (Cam_messages.running_com com);
  (
   match Sys.command com with
     0 -> ()
   | n -> GToolbox.message_box Cam_messages.error (Cam_messages.error_exec com)
  );
  !Cam_global.display_message ""

(** Substitution of [%f] and [%F] tags with the selected file.
   @return [None] if there is a [%f] or [%F] tag and no file 
   is selected.*)
let subst_files s =
  let f, f_list = 
    match files () with
     h::q -> 
       (Filename.quote h,
	String.concat " " (List.map Filename.quote (h::q)))
    | [] -> "", ""
  in
  let s2 = Str.global_replace 
      (Str.regexp_string "%f") 
      f
      s
  in
  let s3 = Str.global_replace
      (Str.regexp_string "%F") 
      f_list
      s2
  in
  if s <> s3 && f = "" then 
    None 
  else
    Some s3

(** Substitution of [%s] tags. Makes the user type in a 
   string for each [%s] encoutered.
   @return [None] if there is a [%s] and the user canceled 
   the substitution.*)
let subst_strings s =
  let cpt = ref 0 in
  let f_cpt _ = incr cpt ; "" in
  ignore (Str.global_substitute 
	    (Str.regexp_string "%s")
	    f_cpt s);
  let pairs = ref [] in
  let params = ref [] in
  let rec f () =
    if !cpt > 0 then
      (
       let sref = ref "" in
       pairs := (!cpt, sref) :: !pairs;
       params := 
	 (Configwin.string ~f: (fun s -> sref := s) (string_of_int !cpt) "")
	 :: !params;
       decr cpt;
       f ()
      )
    else
      ()
  in
  f ();
  match !pairs with
    [] -> Some s
  | _ ->
      match Configwin.simple_get s !params with
	Configwin.Return_cancel -> None
      | Configwin.Return_ok 
      | Configwin.Return_apply -> 
	  cpt := 0;
	  let f_sub _ =
	    incr cpt;
	    try !(List.assoc !cpt !pairs)
	    with Not_found -> "%s"
	  in
	  Some (Str.global_substitute 
		  (Str.regexp_string "%s")
		  f_sub s)

(** Substitution of [%d] tags with the selected file.
   @return [None] if there is a [%d] tag and no file 
   is selected.*)
let subst_dir s =
  let d = 
    match dir () with
      Some d -> (Filename.quote d)
    | None -> ""
  in
  let s2 = Str.global_replace (Str.regexp_string "%d") d s in
  if s <> s2 && d = "" then 
    None 
  else
    Some s2

(** Substitution of %tags with values. *)
let substitute com =
  let l = [ subst_strings ; subst_dir ; subst_files] in
  List.fold_left 
    (fun acc -> fun f -> 
      match acc with
	None -> None
      |	Some s -> f s)
    (Some com)
    l

(** Execute a command. It is a shell command if it starts with a [#]
   or else if it a Cameleon command. *)
let execute_command com () =
  let len = String.length com in
  if len > 0 then
    match com.[0] with
      '#' -> 
	(
	 match substitute (String.sub com 1 (len - 1)) with
	   None -> ()
	 | Some s -> shell_execute (s^" &")
	)
    | _ -> 
	let (com_name, args) = get_com_and_args com in
	Cam_global.exec com_name args ()
  else
    ()

(** Return [true] if the given command is an internal command. *)
let is_internal com =
  let len = String.length com in
  len > 0 && com.[0] <> '#'

open Cam_menus

let rec create_menu_item menu mi =
  let item = 
    match mi with
      Command mii ->
	let i = GMenu.menu_item ~label: mii.mii_label () in
	(
	 try 
	   if is_internal mii.mii_command then
	     (
	      let (com,_) = get_com_and_args mii.mii_command in
	      ignore (Hashtbl.find Cam_global.commands com)
	     );
	   ignore (i#connect#activate (execute_command mii.mii_command))
	 with
	   Not_found ->
	     i#misc#set_sensitive false
	);
	i
    | Submenu mn ->
	let i = GMenu.menu_item ~label: mn.mn_label () in
	let m = GMenu.menu () in
	i#set_submenu m;
	List.iter (create_menu_item m) mn.mn_children;
	if mn.mn_doc then Cam_menus.doc_menu := m;
	i
    | Separator _ ->
	let i = GMenu.menu_item () in
	i
  in
  menu#append item

let create_menu menubar m =
  let menu = GMenu.menu () in
  let item = GMenu.menu_item ~label: m.mn_label ~packing: menubar#add () in
  item#set_submenu menu;
  List.iter (create_menu_item menu) m.mn_children;
  if m.mn_doc then doc_menu := menu


let remove_blanks str =
  let len = String.length str in
  let buf = Buffer.create len in
  for i = 0 to len - 1 do
    match str.[i] with
      '\000' | ' ' | '\t' | '\r' | '\n' -> ()
    | c -> Buffer.add_char buf c
  done;
  Buffer.contents buf

class ['a] display_list 
    ?(destroy_on_close=true) 
    title 
    ?(width=300) ?(height=600) 
    ?(titles=[""]) 
    ?(on_double_click=(fun _ -> ()))
    f =
  let window = GWindow.window ~title ~width ~height () in
  let vbox = GPack.vbox ~packing: window#add () in
  let wb_close = GButton.button ~label: Cam_messages.close () in
  object(self)
    inherit ['a] Gpattern.plist `SINGLE titles (titles<>[""]) as plist

    method show = window#show ()
    method destroy = window#destroy ()
    method hide = window#misc#hide ()

    method content ele = f ele
    method compare ele = compare ele

    method update_data l = plist#update_data l

    method on_double_click ele = on_double_click ele

    initializer
      vbox#pack ~expand: true ~padding: 2 plist#box;
      vbox#pack ~expand: false ~padding: 2 wb_close#coerce ;
      ignore (wb_close#connect#clicked
		(if destroy_on_close then window#destroy else window#misc#hide));
      ignore (window#event#connect#delete 
		(fun _ -> 
		  if destroy_on_close 
		  then false
		  else (self#hide ; true)));
  end
      
