(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 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 Library 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 Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library 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                                          *)
(*                                                                               *)
(*********************************************************************************)


(** Editing RSS 2.0 files in Lablgtk2 applications. *)


open Rss
module C = Configwin

let map_opt f = function None -> None | Some v -> Some (f v)

    (*c==v=[String.string_of_opt]=1.0====*)
let string_of_opt = function
  None -> ""
| Some s -> s
    (*/c==v=[String.string_of_opt]=1.0====*)

    (*c==v=[String.opt_of_string]=1.0====*)
let opt_of_string = function
  "" -> None
| s -> Some s
    (*/c==v=[String.opt_of_string]=1.0====*)

let copy_item i = { i with item_title = i.item_title }

let tuple_to_date (d,m,y) =
  { year = y;
    month = m + 1;
    day = d ;
    hour = 12 ;
    minute = 0 ;
    second = 0 ;
    zone = 0;
    week_day = 0 ;
  }

let today = Rss.float_to_date (Unix.time())
let date_to_tuple d = (d.day, d.month - 1, d.year)

let find_first_child store it =
  let p = store#get_path it in
  let res = ref None in
  store#foreach
    (fun _ it ->
       let parent = store#iter_parent it in
       match parent with
         None -> false
       | Some itp ->
           if store#get_path itp = p then (res := Some it; trueelse false
    );
  !res


    
    (**

Main gui boxes

*)


let dir = ref (Sys.getcwd ())

let find_iter_above store it =
  let p = store#get_path it in
  let res = ref None in
  store#foreach
    (fun path it ->
       let rr = store#get_row_reference path in
       store#iter_next it;
       if store#get_path it = p then (res := Some rr; trueelse false
    );
  !res

let find_iter_below store it =
  if store#iter_next it then
    Some (store#get_row_reference (store#get_path it))
  else
    None

let clipboard = ref (None : Rss.item option)

let to_u8 s = 
  try Glib.Convert.locale_to_utf8 s
  with Glib.Convert.Error (_,err) ->
    prerr_endline err;
    s
let of_u8 = Glib.Convert.locale_from_utf8

let params_for_channel ch =
  let ptitle = C.string
    ~help: "Mandatory title"
      ~f: (fun s -> ch.ch_title <- of_u8 s)
      "Title:" (to_u8 ch.ch_title)
  in
  let plink = C.string
    ~help: "Mandatory link"
      ~f: (fun s -> ch.ch_link <- of_u8 s)
      "Link:" (to_u8 ch.ch_link)
  in
  let pdesc = C.text
    ~help: "Mandatory description"
      ~f: (fun s -> ch.ch_desc <- of_u8 s)
      "Description:" (to_u8 ch.ch_desc)
  in
  let plang = C.string
    ~f: (fun s -> ch.ch_language <- opt_of_string (of_u8 s))
      "Language:" (to_u8 (string_of_opt ch.ch_language))
  in
  let pcopyr = C.text
    ~help: "Optional copyright note"
      ~f: (fun s -> ch.ch_copyright <- opt_of_string (of_u8 s))
      "Copyright:" (to_u8 (string_of_opt ch.ch_copyright))
  in
  let pmngedit = C.string
    ~help: "Optional email of managing editor"
      ~f: (fun s -> ch.ch_managing_editor <- opt_of_string (of_u8 s))
      "Managing editor:" (to_u8 (string_of_opt ch.ch_managing_editor))
  in
  let pwebmaster = C.string
    ~help: "Optional email of webmaster"
      ~f: (fun s -> ch.ch_webmaster <- opt_of_string (of_u8 s))
      "Webmaster" (to_u8 (string_of_opt ch.ch_managing_editor))
  in
  let ppubdate = C.date
    ~help: "Publication date of the channel"
      ~f: (fun d -> ch.ch_pubdate <- Some (tuple_to_date d))
      "Pubdate:"
      (match ch.ch_pubdate with
         None -> date_to_tuple today
       | Some d -> date_to_tuple d
      )
  in
  let pdocs = C.string
    ~help: "An optional url to a RSS reference"
      ~f: (fun s -> ch.ch_docs <- opt_of_string (of_u8 s))
      "Docs:" (to_u8 (string_of_opt ch.ch_docs))
  in
  let pttl = C.string
    ~help: "Time to live, in minutes"
      ~f: (fun s -> ch.ch_ttl <- try map_opt int_of_string (opt_of_string (of_u8 s)) with _ -> ch.ch_ttl)
      "Time to live:" (to_u8 (string_of_opt (map_opt string_of_int ch.ch_ttl)))
  in
  [ C.Section ("Mandatory information",
     [ ptitle ; plink ; pdesc ;]) ;
    C.Section ("Other information",
     [
       plang ;
       pcopyr ;
       pmngedit ;
       pwebmaster ;
       ppubdate ;
       pdocs ;
       pttl ;
     ] );
  ]

let software = "OCaml-RSS / RSSgui"
let software_author = "Maxence Guesdon"
let software_author_mail = "Maxence.Guesdon@inria.fr"
let software_copyright =
  "Copyright 2004 Institut National de Recherche en \n"^
    "Informatique et en Automatique. All rights reserved.\n"^
    "This software is distributed under the terms of the\n"^
    "GNU General Public License version2.\n"^
    "(see file LICENSE in the distribution)"

let software_about =
  software^" version "^Cam_installation.software_version^"\n\n"^
    software_author^"\n"^
    software_author_mail^"\n\n"^
    software_copyright

let glade_file = Filename.concat Cam_installation.glade_dir "rssgui.glade"

class file wlabel filename_opt =
  let cols = new GTree.column_list in
  let col_date = cols#add Gobject.Data.string in
  let col_title = cols#add Gobject.Data.string in
  let col_author = cols#add Gobject.Data.string in
  let (col_data: Rss.item GTree.column) = cols#add Gobject.Data.caml in
  let store = GTree.list_store cols in
  object(self)
    inherit Rss_gui_base.file ~file: glade_file ()

    val mutable filename = filename_opt

    val mutable channel =
      Rss.channel ~title: "Title" ~link: "http://foo.fr" ~desc: "Description" []

    method filename = filename
    method save () =
      match filename with
        None -> self#save_as ()
      | Some f ->
          let channel = self#build_channel () in
          try Rss.print_file f channel
          with
            Sys_error s
          | Failure s ->
              GToolbox.message_box "Error" s;
              self#save_as ()

    method save_as () =
      match GToolbox.select_file ~title: "Open file" ~dir () with
        None -> ()
      | Some f ->
          filename <- Some f;
          wlabel#set_text (Filename.basename f);
          self#save ()

    method close () = true

    method delete ?(cut=false) () =
      match self#selected_rr with
        None -> ()
      | Some rr ->
          let row = rr#iter in
          let item = copy_item (store#get ~row ~column: col_data) in
          if cut then clipboard := Some item;
          ignore (store#remove rr#iter) ;
          tv#selection#unselect_all ()

    method copy () =
      match self#selected_rr with
        None -> ()
      | Some rr ->
          let row = rr#iter in
          let item = copy_item (store#get ~row ~column: col_data) in
          clipboard := Some item

    method paste () =
      match !clipboard with
        None -> ()
      | Some item ->
          self#insert_item (copy_item item) ;
          tv#selection#unselect_all ()

    method move_up () =
      match self#selected_rr with
        None -> ()
      | Some rr ->
          let row = rr#iter in
          match find_iter_above store row with
            None -> ()
          | Some rr2 ->
              let it1 = store#get_iter rr#path in
              let it2 = rr2#iter in
              ignore (store#swap it1 it2)

    method move_down () =
      match self#selected_rr with
        None -> ()
      | Some rr ->
          let row = rr#iter in
          match find_iter_below store row with
            None -> ()
          | Some rr2 ->
              let it1 = store#get_iter rr#path in
              let it2 = rr2#iter in
              ignore (store#swap it1 it2)

    method selected_rr =
      match tv#selection#get_selected_rows with
      | [] -> None
      | path :: _ -> Some (store#get_row_reference path)

    method private params_for_item item =
      let param_title = C.string
        ~f: (fun s -> item.item_title <- opt_of_string (of_u8 s))
          "Title:" (to_u8 (string_of_opt item.item_title))
      in
      let param_link = C.string
        ~f: (fun s -> item.item_link <- opt_of_string (of_u8 s))
          "Link:" (to_u8 (string_of_opt item.item_link))
      in
      let param_author = C.string
        ~f: (fun s -> item.item_author <- opt_of_string (of_u8 s))
          "Author's mail:" (to_u8 (string_of_opt item.item_author))
      in
      let param_pubdate = C.date
        ~f: (fun d -> item.item_pubdate <- Some (tuple_to_date d))
          "Pubdate:"
          (match item.item_pubdate with
             None -> date_to_tuple today
           | Some d -> date_to_tuple d
          )
      in
      let param_desc = C.text
        ~f: (fun s -> item.item_desc <- opt_of_string (of_u8 s))
          "Description" (to_u8 (string_of_opt item.item_desc))
      in
      let param_comments = C.string
        ~help: "Url of comments about this item"
          ~f: (fun s -> item.item_comments <- opt_of_string (of_u8 s))
          "Comments:" (to_u8 (string_of_opt item.item_comments))
      in
      [param_title ; param_link ; param_author ; param_pubdate ; param_desc ; param_comments ]

    method add_item () =
      let i = Rss.item ~pubdate: today () in
      match C.simple_get ~width: 500 "Add item"
        (self#params_for_item i)
      with
        C.Return_ok -> self#insert_item i
      | _ -> ()

    method edit_selected () =
      match self#selected_rr with
        None -> ()
      | Some rr ->
          let row = rr#iter in
          let item = store#get ~row ~column: col_data in
          let params = self#params_for_item item in
          match C.simple_get ~width: 500 "Edit item" params with
            C.Return_ok -> self#display_item row item
          | _ -> ()

    method edit_channel () =
      let sections = params_for_channel channel in
      ignore (C.edit "Edit channel" ~height: 400 ~width: 500 sections)

    method display_item row item =
      let sdate =
        match item.item_pubdate with
          None -> "" |
            Some d -> Rss.string_of_date d
      in
      store#set ~row ~column: col_date (to_u8 sdate);
      store#set ~row ~column: col_title (to_u8 (string_of_opt item.item_title));
      store#set ~row ~column: col_author (to_u8 (string_of_opt item.item_author))

    method insert_item item =
      let row = store#append () in
      store#set ~row ~column: col_data item;
      self#display_item row item

    method show_channel ch =
      store#clear ();
      channel <- ch;
      List.iter self#insert_item ch.ch_items

    method build_channel () =
      { channel with
        ch_items = self#build_item_list ();
      }

    method get_children (it_opt : Gtk.tree_iter option) =
      let first =
        match it_opt with
          None -> store#get_iter_first
        | Some it ->
            if store#iter_has_child it then
              find_first_child store it
            else
              None
      in
      match first with
        None -> []
      | Some it ->
          let rr it = store#get_row_reference (store#get_path it) in
          let rec f acc it =
            if store#iter_next it then
              f (rr it :: acc) it
            else
              List.rev acc
          in
          f [rr it] it

    method build_item_list () =
      let rec build rr =
        let it = rr#iter in
        copy_item (store#get ~row: it ~column: col_data)
      in
      List.map build (self#get_children None)

    method load file =
      try
        channel <- Rss.channel_of_file file ;
        self#show_channel channel
      with
        Failure s ->
          GToolbox.message_box ~title: "Error" s
      |        Xml.File_not_found _ ->
          self#edit_channel ();
          self#show_channel channel
      |        Xml.Error e ->
          failwith (Printf.sprintf "Error while loading %s:\n%s" file
           (Xml.error e))

    initializer
      tv#set_model (Some (store :> GTree.model));
      let col = GTree.view_column () ~title: "Pubdate"
        ~renderer:(GTree.cell_renderer_text [], ["text", col_date]) in
      ignore (tv#append_column col);
      let col = GTree.view_column () ~title: "Title"
        ~renderer:(GTree.cell_renderer_text [], ["text", col_title]) in
      ignore (tv#append_column col);
      let col = GTree.view_column () ~title: "Author's mail"
        ~renderer:(GTree.cell_renderer_text [], ["text", col_author]) in
      ignore (tv#append_column col);

      match filename_opt with
        None -> ()
      | Some filename ->
          try self#load filename
          with e ->
              toplevel#destroy ();
              raise e
  end


class gui ?(quit_on_destroy=true)
  ?on_close_file
    ?(default_file=true) files =
    object(self)
      inherit Rss_gui_base.gui ~file: glade_file ()

      val mutable file_boxes = []

      method add_file_box f_opt =
        let title =
          match f_opt with
            None -> "<no name>"
          | Some s -> Filename.basename s
        in
        try
          let label = GMisc.label ~text: title () in
          let fb = new file label f_opt in
          let eb = GBin.event_box () in
          fb#reparent eb#coerce;
          ignore(notebook#append_page ~tab_label: label#coerce eb#coerce);
          file_boxes <- file_boxes @ [fb];
          notebook#goto_page ((List.length file_boxes) - 1);
          match f_opt with
            None -> fb#edit_channel ()
          | Some _ -> ()
        with
          e ->
            prerr_endline (Printf.sprintf "Error while adding file %s" title);
            raise e

      method active_file =
        try
          let n = notebook#current_page in
          Some (List.nth file_boxes n)
        with
          _ -> None

      method quit = toplevel#destroy
      method about () =
        GToolbox.message_box
          "About RSSgui"
          software_about

      method new_file () = self#add_file_box None

      method close_current () =
        match self#active_file with
          None -> ()
        | Some fb ->
            if fb#close () then
              (
               ignore (notebook#remove_page notebook#current_page);
               match fb#filename, on_close_file with
                 None, _
               | _, None -> ()
               | Some name, Some f -> f name
              )

      method open_file () =
        match GToolbox.select_file ~title: "Open file" ~dir () with
          None -> ()
        | Some f -> self#add_file_box (Some f)

      method on_current f () =
        match self#active_file with
          None -> ()
        | Some fb -> f fb

      initializer
        (
         match files with
           [] when default_file ->
             begin
               try self#add_file_box None
               with
                 Failure s ->
                   GToolbox.message_box "Error" s
               | e ->
                   GToolbox.message_box "Error" (Printexc.to_string e)
             end
         | [] -> ()
         | _ ->
             List.iter
               (fun s ->
                  prerr_endline s;
                  try self#add_file_box (Some s)
                  with
                    Failure s ->
                      GToolbox.message_box "Error" s
                  | e ->
                      GToolbox.message_box "Error"
                        (Printf.sprintf "Error while opening %s:\n%s"
                         s
                           (Printexc.to_string e)
                        )
               )
               files
        );
        let handlers =
          [ "on_quit_activate"`Simple self#quit;
            "on_about_activate",`Simple self#about;
            "on_new_activate"`Simple self#new_file;
            "on_open_activate"`Simple self#open_file;
            "on_save_activate"`Simple (self#on_current (fun fb -> fb#save ())) ;
            "on_save_as_activate"`Simple (self#on_current (fun fb -> fb#save_as ())) ;
            "on_close_activate"`Simple self#close_current ;
            "on_edit_channel_activate"`Simple (self#on_current (fun fb -> fb#edit_channel ())) ;
            "on_add_item_activate"`Simple (self#on_current (fun fb -> fb#add_item ())) ;
            "on_edit_selected_item_activate"`Simple (self#on_current (fun fb -> fb#edit_selected ())) ;
            "on_cut_activate"`Simple (self#on_current (fun fb -> fb#delete ~cut: true ())) ;
            "on_copy_activate"`Simple (self#on_current (fun fb -> fb#copy ())) ;
            "on_paste_activate"`Simple (self#on_current (fun fb -> fb#paste ())) ;
            "on_delete_activate"`Simple (self#on_current (fun fb -> fb#delete ~cut: false ())) ;
            "on_move_up_activate"`Simple (self#on_current (fun fb -> fb#move_up ())) ;
            "on_move_down_activate"`Simple (self#on_current (fun fb -> fb#move_down ())) ;
          ]
        in
        (* Finalize GUI *)
        Glade.bind_handlers ~extra:handlers ~warn:true self#xml;
        if quit_on_destroy then
          ignore(gui#connect#destroy GMain.Main.quit)

    end