(*********************************************************************************)
(*                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 B = Stk.Textbuffer

type expand_context =
  { buffer : string ;
    mutable pos : int ; (* position by character index *)
    searched_rex : Pcre.regexp ;
    searched_pattern : string ;
    mutable prev_prop : string * int ;
    (* previous proposition, buffer * pos *)
    mutable prev_inserted : string option ;
    (* optional string inserted
       (so that we can remove it when we propose another one *)
    mutable already_proposed : string list ;
  }

let context = ref (None : expand_context option)

let create_context buffer pos pat rex =
  { buffer = buffer ;
    pos = pos ;
    searched_rex = rex ;
    searched_pattern = pat ;
    prev_prop = (buffer, pos) ;
    prev_inserted = None ;
    already_proposed = [];
  }

let search_in_buffer forward (buffer : Sourceview.my_buffer) ~start ~stop rex =
  match buffer#re_search forward ~start ~stop rex with
    None -> raise Not_found
  | Some { start ; size } ->
    let text = buffer#text ~start ~size () in
    (start, text)

let get_next_proposition_in_buffer c buffer =
  let b = (Sourceview.get_buffer_by_name buffer)#buffer in
  let rex = c.searched_rex in
  let (_,prevpos) = c.prev_prop in
  if buffer = c.buffer then
    if prevpos > c.pos then
      search_in_buffer true b ~start:(prevpos+1) ~stop:(B.size b#buffer) rex
    else
      try search_in_buffer false b ~start:0 ~stop:prevpos rex
      with Not_found ->
          search_in_buffer true b ~start:c.pos ~stop:(B.size b#buffer) rex
  else
    search_in_buffer true b ~start:(prevpos+1) ~stop:(B.size b#buffer) rex

let get_next_buffer_in_history b =
  let rec iter = function
    [] | [_] -> None
  | name :: h :: q ->
      if name = b then Some h else iter (h :: q)
  in
  iter !Sourceview.buffer_name_history

let rec get_next_proposition c =
(*
  let msg = Printf.sprintf "get_next_proposition:\nbuffer=%s, pos=%d, searched=%s, prev_prop=(%s, %d)\nalready_proposed=%s"
    c.buffer c.pos c.searched_pattern (fst c.prev_prop) (snd c.prev_prop)
    (String.concat ";" c.already_proposed)
  in
  prerr_endline msg;
*)
  let buf = fst c.prev_prop in
  let res =
    try Some (get_next_proposition_in_buffer c buf)
    with Not_found ->
        None
  in
  match res with
    None ->
      begin
        match get_next_buffer_in_history buf with
        | Some buf ->
            c.prev_prop <- (buf, 0);
            get_next_proposition c
        | None ->
            match c.already_proposed with
              [] -> None
            | l ->
                c.already_proposed <- [List.hd (List.rev l)];
                c.prev_prop <- (c.buffer, c.pos) ;
                Some (true, List.hd (List.rev l))
      end
  | Some (pos, text) ->
     c.prev_prop <- (buf, pos);
     if List.mem text c.already_proposed then
       get_next_proposition c
     else
       begin
         c.already_proposed <- text :: c.already_proposed;
        Some (false, text)
       end

let get_pattern (v : Sourceview.sourceview) stop =
  let sv = v#source_view in
  let c = sv#add_cursor ~offset:stop () in
  let start = sv#backward_to_word_start ~c () in
  sv#remove_cursor c;
  match start with
  | None -> assert false
  | Some start ->
      let word = sv#text ~start ~size:(stop-start) () in
      let qword = Pcre.quote word in
      let re =
        match v#file#mode with
          None -> Sourceview_rc.default_word_re
        | Some m -> m#word_re
      in
      (word, Pcre.regexp (Printf.sprintf "%s%s" qword re))

let expand (v : Sourceview.sourceview) args =
  let f = v#file in
  let sv = v#source_view in
  let stop = sv#cursor_offset sv#insert_cursor in
  let ctx =
    match !context with
      None ->
        let (pat,rex) = get_pattern v stop in
        let c = create_context f#name stop pat rex in
        context := Some c;
        c
    | Some c ->
        if (not (Commands.same_previous_command ())) ||
          c.buffer <> f#name || c.pos <> stop
        then
          (
           let (pat, rex) = get_pattern v stop in
           let c = create_context f#name stop pat rex in
           context := Some c;
           c
          )
        else
          c
  in
  match get_next_proposition ctx with
    None ->
      Misc.warning_message "No expansion found.";
  | Some (cycle, s) ->
      if cycle then
        Misc.warning_message "No more expansion found, restarting from beginning.";
      (* eventually remove the previous string inserted *)
      let pos =
        sv#in_action
          (fun () ->
             let pos =
               let s_to_remove =
                 match ctx.prev_inserted with
                   None -> ctx.searched_pattern
                 | Some s -> s
               in
               (* we're supposed to be at the end of the (previously inserted) text *)
               let len = Stk.Utf8.length s_to_remove in
               let start = max 0 (stop - len) in
               ignore(sv#delete ~start ~size:len ());
               start
             in
             sv#move_cursor ~offset:pos ();
             sv#insert s;
             pos
        )
      in
      ctx.pos <- pos;
      ctx.prev_inserted <- Some s;
;;
Sourceview.register_com
  ~prefix: Sourceview_rc.factory_name "expand" [||] expand;;
      