(**************************************************************************)
(*                   Cameleon                                             *)
(*                                                                        *)
(*      Copyright (C) 2002 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 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 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                                *)
(**************************************************************************)

(** Interfacing with Xemacs for file edition, through gnuclient. 
   Thanks to Doug Bagley for his help on lisp functions to give to xemacs.*)

open Cam_data
open Cam_types

let print_DEBUG s = print_string s ; print_newline ()

(** Make gnuclient execute the given list function are return the printed line. *)
let eval_function f =
  let temp_file = Filename.temp_file Cam_messages.software "eval_function" in
  let com = "gnuclient -batch -eval '"^f^"' > "^(Filename.quote temp_file) in
  print_DEBUG com;
  let n = Sys.command com in
  if n <> 0 then
    (
     (try Sys.remove temp_file with _ -> ()) ;
     raise (Failure (Cam_messages.error_exec com))
    )
  else
    (
     try
       let chanin = open_in temp_file in
       let s = 
	try input_line chanin
	with _ -> ""
       in
       close_in chanin;
       s
     with
       _ -> ""
    )

(** The false message from xemacs. *)
let lisp_false = "false"

(** The true message from xemacs. *)
let lisp_true = "true"

(** Lisp function : check if a file is edited. *)
let lisp_file_edited f = 
  "(send-string-to-terminal (if (find-buffer-visiting \""^f^"\") \""^lisp_true^"\" \""^lisp_false^"\"))"

(** Lisp function : check if a file is unsaved. *)
let lisp_file_unsaved f =
  "(send-string-to-terminal (if (buffer-modified-p (find-buffer-visiting \""^f^"\")) \""^lisp_true^"\" \""^lisp_false^"\"))"

(** Lisp function : close the given file. *)
let lisp_close_file f =
  "(let ((b (find-buffer-visiting \""^f^"\"))) "^
  "(if (buffer-modified-p b) (with-current-buffer b (basic-save-buffer)))"^
  "(kill-buffer b))"

(** Lisp function : reload the given file. *)
let lisp_reload_file f =
  "(with-current-buffer (find-buffer-visiting \""^f^"\") (revert-buffer t t))"

(** Lisp function : save the given file. *)
let lisp_save_file f =
  "(with-current-buffer (find-buffer-visiting \""^f^"\") (basic-save-buffer))"

(** The list of files open in xemacs. *)
let xemacs_files = ref ([] : (Cam_types.file * Cam_data.data) list)

(** Remove a file fomr the list of files opened in xemacs. *)
let remove_xemacs_file file =
  xemacs_files := List.filter (fun (f,_) -> file.f_abs_name <> f.f_abs_name) !xemacs_files

(** Check if a file is still opended in xemacs. *)
let file_edited file =
  print_DEBUG ("file_edited "^file.f_abs_name);
  try
    let s = eval_function (lisp_file_edited file.f_name) in
    s = lisp_true
  with
    Failure s ->
      prerr_endline s;
      false

(** Check the files opended in xemacs. The ones that aren't 
   any more are removed from the list of files opended in xemacs. *)
let check_xemacs_files () =
  List.iter 
    (fun (file, data) ->
      if file_edited file then
	(
	 print_DEBUG ("file "^file.f_abs_name^" still open");
	 ()
	)
      else
	(
	 print_DEBUG ("file "^file.f_abs_name^" was closed");
	 data#close_file file ;
	 remove_xemacs_file file
	)
    )
    !xemacs_files

(** A class to represent the interface with xemacs for a file. *)
class xemacs file =
  object
    method close = 
      try ignore (eval_function (lisp_close_file file.f_name))
      with Failure s -> GToolbox.message_box Cam_messages.error s

    method reload =
      try ignore (eval_function (lisp_reload_file file.f_name))
      with Failure s -> GToolbox.message_box Cam_messages.error s

    method save =
      try ignore (eval_function (lisp_save_file file.f_name))
      with Failure s -> GToolbox.message_box Cam_messages.error s

    method changed = 
      try
	let s = eval_function (lisp_file_unsaved file.f_name) in
	s = lisp_true
      with
	Failure s ->
	  GToolbox.message_box Cam_messages.error s ;
	  false
  end

(** Open the given file in xemacs and get an interface to this file in xemacs. 
   @raise Failure if the file could not be opened.*)
let edit ?char file =
  let com =
    Printf.sprintf "gnuclient -q -batch -eval '(find-file \"%s\") %s'"
      file.Cam_types.f_name
      (
       match char with
	 None -> ""
       | Some c ->
	   let line = (Cam_misc.line_of_char file.Cam_types.f_name c) + 1 in
           (* + 1 because xemacs start line numbers at 1 *)
	   "(goto-line "^(string_of_int line)^")"
      )
  in
  let n = Sys.command com in
  if n = 0 then
    (
     xemacs_files := (file, data) :: !xemacs_files ;
     new xemacs file
    )
  else 
    raise (Failure (Cam_messages.error_exec com))
