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

(*                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                                          *)
(*                                                                               *)
(*********************************************************************************)


(* $Id: cam_bbar.ml 334 2006-10-06 07:34:42Z zoggy $ *)

module O = Config_file

type button = {
    mutable but_label : string ;
    mutable but_pixmap : string ;
    mutable but_command : string ;
  }

let button com label xpm =
  { but_label = label ;
    but_pixmap = xpm ;
    but_command = com ;
  }

(**

Storing

*)


let value_to_button v =
  match v with
    O.Raw.Tuple [O.Raw.String label ; O.Raw.String xpm; O.Raw.String com ] ->
      { but_label = label ;
        but_pixmap = xpm ;
        but_command = com ;
      }
  | _ ->
      prerr_endline "value_to_button";
      raise Not_found

let button_to_value b =
  O.Raw.Tuple [ O.Raw.String b.but_label ;
                O.Raw.String b.but_pixmap;
                O.Raw.String b.but_command ]

let button_cp_wrapper =
  { O.to_raw = button_to_value ;
    O.of_raw = value_to_button ;
  }

let pix f = Filename.concat Cam_installation.pixmaps_dir f

let buttons = new O.list_cp button_cp_wrapper
    ~group: Cam_rc.gui_ini
    ["buttons"]
    [
      button "external topcameleon" "topcameleon" (pix "topcameleon.xpm") ;
    ]
    ""

(**

Configuring the button bar

*)


module C = Configwin

let params_for_button but =
  let param_pixmap = C.filename
      ~f:(fun s -> but.but_pixmap <- Cam_misc.remove_char s ';')
      Cam_messages.icon_file
      but.but_pixmap
  in
  let param_label = C.string
      ~f: (fun s -> but.but_label <- Cam_misc.remove_char s ';')
      Cam_messages.label but.but_label
  in
  let param_command = C.string
      ~f: (fun s -> but.but_command <- Cam_misc.remove_char s ';')
      Cam_messages.command but.but_command
  in
  [ param_pixmap ; param_label ; param_command ]


(** Custom tool bar configuration box. *)

class bbar_config_box f_update () =
  let hbox = GPack.hbox () in
  let wscroll = GBin.scrolled_window
      ~vpolicy: `AUTOMATIC
      ~hpolicy: `AUTOMATIC
      ~packing: (hbox#pack ~expand: true) ()
  in
  let wlist = GList.clist
      ~titles: [ Cam_messages.icon ;
                 Cam_messages.label ;
                 Cam_messages.command ;
               ]
      ~titles_show: true
      ~selection_mode: `SINGLE
      ~packing: wscroll#add
      ()
  in
  let vbox = GPack.vbox ~packing: (hbox#pack ~expand: false ~padding: 4) () in
  let wb_add = GButton.button ~label: Cam_messages.add
      ~packing: (vbox#pack ~expand: false ~padding: 2) ()
  in
  let wb_edit = GButton.button ~label: Cam_messages.edit
      ~packing: (vbox#pack ~expand: false ~padding: 2) ()
  in
  let wb_up = GButton.button ~label: Cam_messages.up
      ~packing: (vbox#pack ~expand: false ~padding: 2) ()
  in
  let wb_remove = GButton.button ~label: Cam_messages.remove
      ~packing: (vbox#pack ~expand: false ~padding: 2) ()
  in
  object (self)
    val mutable buttons_list = buttons#get
    val mutable selection = (None : button option)

    method set_buttons l = buttons_list <- l

    method box = hbox
    method apply () : unit =
      buttons#set buttons_list;
      Cam_rc.save_gui ();
      f_update ()

    method update =
      wlist#clear () ;
      wlist#freeze () ;
      let f but =
        let _ = wlist#append
            [ but.but_pixmap ;
              but.but_label ;
              but.but_command ;
            ]
        in
        try
          let gdk_pix = GDraw.pixmap_from_xpm
              ~file: but.but_pixmap
              ~colormap: (Gdk.Color.get_system_colormap ())
              ()
          in
          ignore (wlist#set_cell ~pixmap: gdk_pix (wlist#rows -1) 0)
        with
          _ ->
            ignore (wlist#set_row ~foreground: (`NAME "Red") (wlist#rows -1))
      in
      List.iter f buttons_list;
      GToolbox.autosize_clist wlist ;
      wlist#thaw ()

    method up_selected =
      match selection with
        None -> ()
      | Some but ->
          let rec f = function
              ele1 :: ele2 :: q ->
                if ele2 == but then
                  ele2 :: ele1 :: q
                else
                  ele1 :: (f (ele2 :: q))
            | l -> l
          in
          self#set_buttons (f buttons_list) ;
          self#update

    method edit_selected =
      match selection with
        None -> ()
      | Some but ->
          match C.simple_get Cam_messages.edit
              (params_for_button but)
          with
            C.Return_cancel -> ()
          | C.Return_apply -> ()
          | C.Return_ok -> self#update

    method remove_selected =
      match selection with
        None -> ()
      | Some but ->
          self#set_buttons
            (List.filter
               (fun ct2 -> ct2.but_command <> but.but_command)
               buttons_list) ;
          self#update

    method add =
      let but = {
        but_pixmap = "" ;
        but_label = "" ;
        but_command = "" ;
      }
      in
      match C.simple_get Cam_messages.add
          (params_for_button but)
      with
        C.Return_cancel -> ()
      | C.Return_apply -> ()
      | C.Return_ok ->
          self#set_buttons (buttons_list @ [but]) ;
          self#update

    initializer
      (* connect the selection and deselection of items in the clist *)
      let f_select ~row ~column ~event =
        try selection <- Some (List.nth buttons_list row)
        with Failure _ -> selection <- None
      in
      let f_unselect ~row ~column ~event = selection <- None in
      (* connect the select and deselect events *)
      let _ = wlist#connect#select_row f_select in
      let _ = wlist#connect#unselect_row f_unselect in

      let _ = wb_add#connect#clicked (fun () -> self#add) in
      let _ = wb_edit#connect#clicked (fun () -> self#edit_selected) in
      let _ = wb_up#connect#clicked (fun () -> self#up_selected) in
      let _ = wb_remove#connect#clicked (fun () -> self#remove_selected) in

      self#set_buttons buttons#get ;
      self#update
  end


(**

Updating the button bar

*)


let main_bbar = ref None
let update w =
  main_bbar := Some w;
  (match w#children with
    c :: _ -> w#remove c
  | _ -> ());
  let toolbar = GButton.toolbar
      ~border_width: 2
      ~orientation: `HORIZONTAL
      ~style: `ICONS
      ~packing: w#add ()
  in
  List.iter
    (fun b ->
      try
        let gdk_pix = GDraw.pixmap_from_xpm
            ~file: b.but_pixmap
            ~colormap: (Gdk.Color.get_system_colormap ())
            ()
        in
        let pix = GMisc.pixmap gdk_pix () in
        let wb = toolbar#insert_button
            ~text: b.but_label
            ~tooltip: b.but_label
            ~icon: pix#coerce
            ()
        in
        ignore (wb#connect#clicked (fun () -> Cam_commands.eval_command b.but_command))
      with
        _ -> ()
    )
    buttons#get

let _configure_bbar args =
  match !main_bbar with
    None -> ()
  | Some bbar ->
      let box = new bbar_config_box (fun () -> update bbar) () in
      let p = C.custom box#box box#apply true in
      ignore (C.simple_get "Button bar config" [p])

let _ = Cam_commands.register
    { Cam_commands.com_name = Cam_constant.com_configure_bbar ;
      Cam_commands.com_args = [| |] ;
      Cam_commands.com_more_args = None ;
      Cam_commands.com_f = _configure_bbar;
    }