(*********************************************************************************)
(*                Chamo                                                          *)
(*                                                                               *)
(*    Copyright (C) 2003-2021 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 Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    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                                          *)
(*                                                                               *)
(*********************************************************************************)

module L = Log
open Stk.Misc
open Stk
module Log = L

let () = Minibuffer_rc.read ()
let () = Minibuffer_rc.write ()

class minibuffer_history () =
  let history_size = Ocf.get Gui_rc.minibuffer_history_size in
  let t = Array.make history_size "" in
  object
    val mutable len = 0
    val mutable pos = 0
    val mutable insert_pos = 0

    method init_pos = pos <- insert_pos

    method get_next =
      if len > 0 then
        if pos + 1 >= len then
          None
        else
          (pos <- pos + 1; Some t.(pos))
      else
        None

    method get_previous =
      if len > 0 then
        let new_pos = pos - 1 in
        if new_pos >= 0 && new_pos < len then
          (pos <- new_pos; Some t.(pos))
        else
          None
      else
        None

    method add s =
      let insert =
        (
         if len > 0 then
           let p = insert_pos - 1 in
           let p = if p < 0 then len - 1 else p in
           t.(p) <> s
         else
           true
        )
      in
      if insert then
        (
         t.(insert_pos) <- s;
         if len >= history_size then () else len <- len + 1;
         insert_pos <- (insert_pos + 1) mod history_size
        )
      else
        ()
  end

let history () = new minibuffer_history ()

let max_size = 25

let get_size_chars (w : Stk.Widget.widget) =
  let font = Stk.Props.(get_font w#props) in
  let h = Tsdl_ttf.Ttf.font_height font in
  let> (w,_) = Tsdl_ttf.Ttf.size_utf8 font "A" in
  (w, h)

let fill_string size s =
  let m = size - Utf8.length s in
  Printf.sprintf "%s%s" s (String.make m ' ')

(* remove the combinations of keys used to exit which could mask the given list of
       key bindings. *)
let remove_used_exiting_keys l =
  let rec pred0 l1 l2 =
    match l1, l2 with
    | [], _ -> true
    | _, [] -> false
    | h1 :: q1, h2 ::q2 -> pred0 q1 q2
  in
  let pred def =
    List.for_all
      (fun (state,_) -> pred0 def state)
      l
  in
  List.filter pred (Ocf.get Minibuffer_rc.exiting_keys)

class minibuffer () =
  let fixed = Bin.fixed_size () in
  let scr = Bin.scrollbox ~name:"minibuffer_vp" ~pack:fixed#set_child () in
  let view = Textview.textview ~name:"minibuffer" ~pack:scr#set_child () in
(*  let _ = Gtksv_utils.register_source_buffer buffer in
  let _ = Gtksv_utils.register_source_view view in
  let _ = Gtksv_utils.apply_sourceview_props view
      (Gtksv_utils.read_sourceview_props ())
  in*)
  let tag_ro = Texttag.T.create "minibuffer-readonly" in
  let tag_choices = Texttag.T.create "minibuffer-choices" in
  object(self)
    method box = fixed#coerce

    val mutable waiter = (None: (unit Lwt.t * unit Lwt.u) option)
    method wait =
      match waiter with
      | None ->
          let x = Lwt.wait () in
          waiter <- Some x;
          fst x
      | Some (t,_) -> t

    method private wakeup =
      match waiter with
      | None -> ()
      | Some (_,u) -> waiter <- None; Lwt.wakeup u ()

    method private exn e =
      match waiter with
      | None -> Log.err (fun m -> m "%s" (Printexc.to_string e))
      | Some (_,u) -> waiter <- None; Lwt.wakeup_exn u e

    val mutable on_complete = fun () -> ()
    method set_on_complete f = on_complete <- f
    method complete = on_complete ()

    val mutable ignore_text_changed = false
    val mutable on_text_changed = fun () -> ()
    method set_on_text_changed f = on_text_changed <- f
    method on_text_changed =
      if ignore_text_changed then
        ()
      else
        on_text_changed ()

    val mutable more_key_bindings =
      ([] : (Stk.Key.keystate list * (unit -> unit)) list)
    method set_more_key_bindings l =
      more_key_bindings <- l
    method more_key_bindings =
      List.map
        (fun (ks, _) ->
           let com = Printf.sprintf "%s_eval_custom_key_binding %S"
             Minibuffer_rc.base_name (Key.string_of_keystate_list ks)
           in
           (ks, com)
        )
        more_key_bindings

    method eval_custom_key_binding s =
      try
        let (_,f) = List.find
          (fun (ks, _) -> Key.string_of_keystate_list ks = s)
          more_key_bindings
        in
        f ()
      with Not_found -> ()

    val mutable history = (None : minibuffer_history option)
    method set_history h =
      history <- Some h;
      h#init_pos

    val mutable on_eval = fun () -> Lwt.return_unit
    method eval =
      let () =
        match history with
          None -> ()
        | Some h ->
            let s = self#get_user_text in
            h#add s
      in
      on_eval ()

    method set_on_eval f = on_eval <- f

    val mutable on_active_change = fun (_ : bool) -> ()
    method set_on_active_change f = on_active_change <- f

    val mutable active = false
    method active = active

    (** Change the active state. If the new state is [true],
       [on_active_change] is called, else it is called only
       if the new state is different from the current state
       (i.e. we switch from "active" to "not active").
       This is so because of the [set_active_view] method
       of [Gui.gui_window] which sets the minibuffer state
       to "not active" when a view get the focus, and the
       function called when the minibuffer's state changes
       make the last view get the focus when the minibuffer
       is not active.
    *)
    method set_active b =
      Log.warn (fun m -> m "minibuffer#set_active %s %b" view#me b);
      if b || (active <> b) then
        begin
          view#set_sensitive b;
          view#set_editable b ;
          view#set_show_cursors b ;
          active <- b;
          let active =
            if b then
              (let grabbed = view#grab_focus () in
              Log.warn (fun m -> m "minibuffer %s grabbed focus: %b" view#me grabbed);
              grabbed)
            else
              (self#clear ; self#wakeup; false)
          in
          on_active_change active
        end
      else
        ()

    method clear =
      on_eval <- (fun () -> Lwt.return_unit);
      on_complete <- (fun () -> ());
      on_text_changed <- (fun () -> ());
      more_key_bindings <- [];
      history <- None;
      self#set_text ""

    (* position from which the text is editable *)
    val mutable editable_from = 0

    method set_size =
      let h =
        if view#char_count <= 0 then
          0
        else
          let vh = view#min_height in
          let scrh = scr#min_height in
          let h = vh + scrh in
          let h_max =
            let (_, char_height) = get_size_chars view#coerce in
            let lines = view#line_count in
            let p = view#padding in
            let b = view#border_width in
            vh + p.top + p.bottom + b.top + b.bottom +
            (min max_size lines) * char_height
          in
          min h h_max
      in
      fixed#set_height h

    method string_of_list l =
      let l = List.sort compare l in
      let (w,_) = get_size_chars view#coerce in
      let w = view#geometry.G.w / w in
      let max = List.fold_left
          (fun acc s -> max acc (Utf8.length s))
          0
          l
      in
      let max = max + 3 in
      let nb = w / max in
      let nb = if nb <= 0 then 1 else nb in
      let b = Buffer.create 256 in
      let rec iter m = function
          [] ->
            if m <> 0 then Buffer.add_char b '\n';
            Buffer.contents b
        | s :: q ->
            Buffer.add_string b (fill_string max s);
            let m = (m + 1) mod nb in
            if m = 0 then Buffer.add_char b '\n';
            iter m q
      in
      (iter 0 l)

    method set_text ?(list=[]) ?(fixed="") (s:string) =
      ignore_text_changed <- true;
      if not (view#char_count = 0) then ignore(view#delete ());
      let str = self#string_of_list list in
      view#insert_at ~tags:[tag_choices] 0 str ;
      view#insert ~tags:[tag_ro] fixed ;
      let nb_chars = view#char_count in
      editable_from <- nb_chars;
      view#insert s ;
      self#set_size ;
      ignore_text_changed <- false;
      self#on_text_changed

    method set_user_text s =
      ignore_text_changed <- true;
      let _ = view#delete ~start:editable_from () in
      let c = view#char_count in
      view#insert_at c s ;
      ignore_text_changed <- false;
      self#set_size ;
      self#on_text_changed

    method get_user_text = view#text ~start:editable_from ()

    method history_key_bindings =
      match history with
        None -> []
      | Some _ -> Ocf.get Minibuffer_rc.history_key_bindings

    method history_previous =
      match history with
        None -> ()
      | Some h ->
          match h#get_previous with
            None -> ()
          | Some s -> self#set_user_text s

    method history_next =
      match history with
        None -> ()
      | Some h ->
          match h#get_next with
            None -> ()
          | Some s -> self#set_user_text s

    method insert s_utf8 =
      if active then
        let p = view#cursor_offset view#insert_cursor in
        if p >= editable_from then
          view#insert s_utf8
        else
          ()
      else
        ()

    method exit () = self#set_active false

    method key_bindings : (Key.keystate list * string) list =
      let l =
        Ocf.get Minibuffer_rc.key_bindings @
          self#more_key_bindings @
          self#history_key_bindings
      in
      let exiting_keys = remove_used_exiting_keys l in
      let exiting_key_bindings =
        List.map (fun combs -> (combs,Minibuffer_rc.base_name ^"_exit")) exiting_keys
      in
      l @ exiting_key_bindings

    method private on_theme_changed =
      let theme = view#theme in
      Texttag.Theme.(
       set_tag_prop theme tag_ro Props.editable false ;
       set_tag_prop theme tag_ro Props.bold true ;
       set_tag_prop theme tag_choices Props.editable false ;
       set_tag_prop theme tag_choices Props.bold false ;
      )

    initializer
      fixed#set_child scr#coerce ;
      view#set_editable false ;
      view#set_show_cursors false ;
      view#set_highlight_current_line false ;
      view#set_wrap_mode Textview.Wrap_char ;
      view#set_sensitive false;
      fixed#set_height 0;
      scr#set_child view#as_widget ;
      let _ = view#connect (Object.Prop_changed Texttag.Theme.prop)
        (fun ~prev ~now -> self#on_theme_changed)
      in
      self#on_theme_changed ;
      let _ = Textbuffer.(connect view#buffer Delete_range
         (fun range -> self#on_text_changed))
      in
      let _ = Textbuffer.(connect view#buffer Insert_text
         (fun _ -> self#on_text_changed))
      in
      ()

      (*ignore(buffer#connect#changed (fun () -> self#on_text_changed));*)
      (*ignore(view#connect#destroy (fun () -> Gtksv_utils.unregister_source_buffer buffer));*)
(*      ignore(view#event#connect#after#focus_out (fun _ -> self#exit (); false));*)
  end
