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

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


(** OCaml sourceview mode. *)


let _ = Ed_mode_ocaml_rc.read ()
let _ = Ed_mode_ocaml_rc.write ()

let mode_name = Ed_mode_ocaml_rc.mode_name

let remove_first_blanks s =
  let len = String.length s in
  try
    let rec first_no_blank p =
      if p < len then
        match s.[p] with
          ' ' | '\t' -> first_no_blank (p+1)
        | _ -> p
      else
        raise Not_found
    in
    let p = first_no_blank 0 in
    String.sub s p (len - p)
  with
    Not_found -> ""

let indent_line (v : Ed_sourceview.sourceview) args =
  let line = v#current_line in
  let b = v#file#buffer in
  let pos = b#get_iter `INSERT in
  let cnum = pos#line_offset in
  let bol = b#get_iter (`LINE line) in
  let eol = bol#forward_to_line_end in

  let code =
    v#file#of_utf8
      (v#file#mode_from_display
       (b#get_text ~start: b#start_iter ~stop: eol ()))
  in
  let indentations =
    match Ed_ocaml_lexer.get_lines_indentation code with
      `Failure (e,(start,stop),l) ->
        let err = Printf.sprintf "chars %d-%d: %s"
            start stop (Ed_ocaml_lexer.report_error e) in
        Ed_misc.set_active_action_message (Ed_misc.to_utf8 err);
        l
    | `Success l ->
        l
  in
  if List.length indentations <= line then
    ()
  else
    match List.rev indentations with
      [] -> ()
    | None :: _ -> ()
    | (Some n) :: _ ->
        let codeline = v#file#of_utf8
          (b#get_text ~start: bol ~stop: eol ())
        in
        let len = String.length codeline in
        let new_codeline = remove_first_blanks codeline in
        let len2 = String.length new_codeline in
        let user_pos =
          let beg = len - len2 in
          if cnum < beg then 0 else cnum - beg
        in
        let new_codeline = Printf.sprintf "%s%s"
            (String.make n ' ')
            new_codeline
        in
        if new_codeline <> codeline then
          begin
            b#delete ~start: bol ~stop: eol;
            let pos = b#get_iter (`LINE line) in
            v#place_cursor pos;
            b#insert (v#file#mode_to_display (v#file#to_utf8 new_codeline));
            let pos = b#get_iter (`LINECHAR (line,n+user_pos)) in
            v#place_cursor pos
          end
        else
          ()

let indent_buffer (v : Ed_sourceview.sourceview) args =
  let current_line = v#current_line in
  let b = v#file#buffer in
  let code = v#file#of_utf8
    (v#file#mode_from_display
     (b#get_text ~start: b#start_iter ~stop: b#end_iter ()))
  in
  match Ed_ocaml_lexer.get_lines_indentation code with
    `Failure (e,(start,stop),_) ->
      let err = Printf.sprintf "chars %d-%d: %s"
          start stop (Ed_ocaml_lexer.report_error e) in
      Ed_misc.set_active_action_message (Ed_misc.to_utf8 err)
  | `Success indentations ->
      let lines = Ed_misc.split_string ~keep_empty: true code ['\n'in
      let nb_lines = List.length lines in
      let nb_indentations = List.length indentations in
      let indentations =
        if nb_indentations < nb_lines then
          indentations @
          (Ed_misc.make_list (nb_lines - nb_indentations) None)
        else
          indentations
      in
      b#delete ~start: b#start_iter ~stop: b#end_iter;
      v#place_cursor b#start_iter;
      List.iter2
        (fun line nopt ->
          let line =
            match nopt with
              None -> line^"\n"
            | Some n ->
                let s = remove_first_blanks line in
                Printf.sprintf "%s%s\n" (String.make n ' ') s
          in
          b#insert (v#file#mode_to_display (v#file#to_utf8 line))
        )
        lines
        indentations;
      v#place_cursor (b#get_iter (`LINE current_line));
      let message =
        Printf.sprintf "%d lines indented / %d lines in buffer"
          nb_indentations nb_lines
      in
      Ed_misc.set_active_action_message (Ed_misc.to_utf8 message)

let switch_file (v:Ed_sourceview.sourceview) args =
  let f = v#file#filename in
  try
    let filename2 =
      let ext =
        if Filename.check_suffix f ".ml" then
          "mli"
        else if Filename.check_suffix f ".mli" then
          "ml"
        else
          raise Not_found
      in
      Printf.sprintf "%s.%s" (Filename.chop_extension f) ext
    in
    let com = Printf.sprintf "open_file %s" (Filename.quote filename2) in
    Cam_commands.eval_command com
  with
    Not_found -> ()

let __alpha__ = 1;;

let display_type_annot (v:Ed_sourceview.sourceview) args =
  let f = v#file#filename in
  try
    let annot_file =
      try
        if Filename.check_suffix f ".ml" then
          (Filename.chop_extension f)^".annot"
        else
          raise Not_found
      with _ -> failwith "File has no .ml extension"
    in
    match Ed_misc.date_of_file f, Ed_misc.date_of_file annot_file with
      None, _ -> failwith ("Could not access "^f)
    | Some _, None -> failwith ("Could not access "^annot_file)
    | Some d1, Some d2 ->
        if d1 > d2 then
          failwith
            (Printf.sprintf "Source was modified since %s was created" annot_file)
        else
          begin
            let loc_start =
              let (start,_) = v#file#buffer#selection_bounds in
              (* beware of the possible offset between file contents and display *)
              Cam_misc.utf8_string_length
                (v#file#mode_from_display
                 (v#file#buffer#get_text ~start: v#file#buffer#start_iter ~stop: start ()))
            in
            let annot_string = Ed_misc.string_of_file annot_file in
            match Dtypes.build_tree annot_string with
              None -> failwith "No tree built"
            | Some t ->
                match Dtypes.search_in_tree loc_start t with
                  None -> failwith "No type annot found"
                | Some (left,right,start,stop) ->
                    let from_display =
                      v#file#mode_from_display
                        (v#file#buffer#get_text ())
                    in
                    let (left, right) =
                      let left =
                        Cam_misc.utf8_string_length
                          (v#file#mode_to_display
                           (String.sub from_display 0 left))
                      in
                      let right =
                        Cam_misc.utf8_string_length
                          (v#file#mode_to_display
                           (String.sub from_display 0 right))
                      in
                      (left, right)
                    in
                    let s = String.sub annot_string start (stop-start) in
                    let start = v#file#buffer#get_iter (`OFFSET left) in
                    let stop = v#file#buffer#get_iter (`OFFSET right) in
                    v#file#buffer#select_range start stop;
                    Ed_misc.set_active_action_message (Ed_misc.to_utf8 s);
          end
  with
    Not_found ->
      ()
  | Failure s
  | Sys_error s ->
      Ed_misc.set_active_action_message s

let coms = [
    "indent_line", [| |], None, indent_line ;
    "indent_buffer", [| |], None, indent_buffer ;
    "switch_file", [| |], None, switch_file ;
    "display_type_annot", [| |], None, display_type_annot ;
]

let _ = List.iter
    (fun (name, args, more, f) ->
      Ed_sourceview.register_com
        ~prefix: mode_name name args ?more f)
    coms

class mode =
  object
    inherit Ed_sourceview.empty_mode
    method name = mode_name
    method key_bindings : (Okey.keyhit_state * string) list =
      Ed_mode_ocaml_rc.key_bindings#get
    method menus : (string * GToolbox.menu_entry list) list =
      [
        "OCaml",
          [ `I ("Switch file"fun () -> Cam_commands.eval_command "ocaml_switch_file") ;
            `S ;
            `I ("Indent line"fun () -> Cam_commands.eval_command "ocaml_indent_line") ;
            `I ("Indent buffer"fun () -> Cam_commands.eval_command "ocaml_indent_buffer") ;
            `S ;
            `I ("Display type from .annot file"fun () -> Cam_commands.eval_command "ocaml_display_type_annot") ;
          ]
      ]
  end

let mode = new mode
let _ = Ed_sourceview.register_mode mode