Source file eval.ml

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

(** Evaluating OCaml phrases to control with the editor. *)

open Chamo

let _ = Toploop.set_paths ()
let _ = Toploop.initialize_toplevel_env()

let () = Log.debug (fun m -> m "toploop initialized")

let init_file = Filename.concat Config.rc_dir "chamo_init.ml"
let local_init_file = ".chamo_init.ml"

let prompt_eval_history = Minibuffer.history ()
let prompt_eval args =
  (* FIXME: todo: show the "eval" window *)
  match !Gui.active_window with
    None -> Lwt.return_unit
  | Some w ->
      let f code =
        Commands.launch_command "eval" [| code |]
      in
      let mb = w#minibuffer in
      Misc.input_string
        ~history: prompt_eval_history
        mb ~title: "eval"
        ""
        f

let _ =
  let com = {
      Commands.com_name = "prompt_eval" ;
      com_args = [| |] ;
      com_more_args = None ;
      com_f = prompt_eval ;
    }
  in
  Commands.register com

let eval_file args =
  if Array.length args < 1 then
    match !Gui.active_window with
    | None -> Lwt.return_unit
    | Some w ->
        let f file =
          Commands.launch_command "eval_file" [| file |]
        in
        let mb = w#minibuffer in
        Misc.select_file
          mb ~title: "eval_file"
          ""
          f
  else
    (
     let buf = Buffer.create 256 in
     let fmt = Format.formatter_of_buffer buf in
     Log.debug (fun m -> m "Calling Toploop.use_file on %s" args.(0));
     ignore(Toploop.use_file fmt args.(0));
     Log.debug (fun m -> m "Done");
     Commands.launch_command "print_ocaml_output" [| Buffer.contents buf |]
    )

let _ =
  let com = {
      Commands.com_name = "eval_file" ;
      com_args = [| "File" |];
      com_more_args = None ;
      com_f = eval_file ;
    }
  in
  Commands.register com

let eval_ocaml args =
  Log.debug (fun m ->
    let l = Array.to_list args in
    m "eval_ocaml [| %s |]"
     (String.concat " ; "  (List.map (fun s -> Printf.sprintf "%S" s) l)))
  ;
  let len = Array.length args in
  if len < 1 then
    Commands.async_command "prompt_eval"
  else
    (
     let code = args.(0) in
     (* use a temporary file to use the Toploop.use_file function
        instead of parsing the phrase, then exectuing it, because
        we don't want to depend on whether we have the compiled
        sources of ocaml (the needed modules to analyse the parse
        exceptions are not installed (Errors, ...).
     *)
     let tmp_file = Filename.temp_file Messages.software ".ml" in
     Misc.file_of_string ~file: tmp_file code;
     eval_file [| tmp_file |];
     Misc.safe_remove_file tmp_file;
    )

let _ =
  let com = {
      Commands.com_name = "eval" ;
      com_args = [| "OCaml Code" |];
      com_more_args = None ;
      com_f = (fun args -> eval_ocaml args; Lwt.return_unit) ;
    }
  in
  Commands.register com

let load_file args =
  if Array.length args < 1 then
    match !Gui.active_window with
      None -> Lwt.return_unit
    | Some w ->
        let f file =
          Commands.launch_command "load_file" [| file |]
        in
        let mb = w#minibuffer in
        Misc.select_file
          mb ~title: "load_file"
          ""
          f
  else
    (
     let file = args.(0) in
     let code = Printf.sprintf "#load \"%s\";;" file in
     eval_ocaml [| code |];
     Lwt.return_unit
(* this does not work, because Symtable.Error may be raised
   and we can't print the error message since Bytecomp interface is not
   installed by ocaml
     let buf = Buffer.create 256 in
     let fmt = Format.formatter_of_buffer buf in
     let success = Topdirs.load_file fmt file in
     if success then
       Misc.set_active_action_message
         (Printf.sprintf "Successfully loaded file %s" file)
     else
       Misc.set_active_action_message
         (Printf.sprintf "Failed to load file %s" file)
*)
    )

let _ =
  let com = {
      Commands.com_name = "load_file" ;
      com_args = [| "File" |];
      com_more_args = None ;
      com_f = load_file ;
    }
  in
  Commands.register com

(** {2 Adding command line options} *)

let use file =
  let com = Printf.sprintf "eval_file %s" (Filename.quote file) in
  Args.append_init_command com

let option_use =
  ("--use", Arg.String use, "<file>\n\t\tocaml-evaluate the given file after initialization")

let _ = Args.add_option option_use;;

(** {2 Init} *)

(* FIXME: instead, set Logs reporter after init
(* temporarily replace printing functions, to avoid having the
   initializations displaying messages *)
let (old_m,old_w) =
  (Hooks.get_display_message (), Hooks.get_warning_message ());;
Hooks.set_display_message (fun ?to_utf8 _ -> ());;
Hooks.set_warning_message (fun ?to_utf8 _ -> ());;
*)

let packages =
  [ "fmt" ; "logs" ; "logs.fmt" ; "lwt.unix" ; "lwt_ppx" ;
    "ocf" ; "pcre" ; "re"; "sedlex" ; "str" ; "stk" ; "stk_iconv" ;
    "tsdl" ; "tsdl-image" ; "tsdl-ttf" ; "uutf" ; "xmlm" ;
    "chamo" ; "lwt_ppx" ; "ocf_ppx" ; "ppx_blob" ; "sedlex.ppx"
  ]

let _ =
  let temp_file = Filename.temp_file "chamo" ".txt" in
  let com = Printf.sprintf "%s query -r %s > %s" (Config.ocamlfind())
    (String.concat " " packages) (Filename.quote temp_file)
  in
  match Sys.command com with
  | 0 ->
      let default_dirs = Misc.split_string (Misc.string_of_file temp_file) ['\n'] in
      Misc.safe_remove_file temp_file;
      List.iter
        (fun d -> eval_ocaml [| Printf.sprintf "#directory \"%s\";;" d |])
        default_dirs
  | n ->
      Misc.safe_remove_file temp_file;
      prerr_endline (Printf.sprintf "Command failed: %s" com)
;;

(*
(* Restore the printing functions *)
Hooks.set_display_message old_m;;
Hooks.set_warning_message old_w;;
*)
(** If the init file exists, then add a command to eval it at launch time *)

let _ =
  let init_files = [ init_file ; local_init_file] in
  Log.debug (fun m -> m "Reading init files");
  List.iter
    (fun file -> if Sys.file_exists file then use file)
    init_files
;;