<commit_before>(*************************************************************************)
(*                                                                       *)
(*                Objective Caml LablTk library                          *)
(*                                                                       *)
(*            <NAME>, Kyoto University RIMS                    *)
(*                                                                       *)
(*   Copyright 1999 Institut National de Recherche en Informatique et    *)
(*   en Automatique and Kyoto University.  All rights reserved.          *)
(*   This file is distributed under the terms of the GNU Library         *)
(*   General Public License, with the special exception on linking       *)
(*   described in file ../../../LICENSE.                                 *)
(*                                                                       *)
(*************************************************************************)

(* $Id$ *)

open StdLabels
module Unix = UnixLabels
open Tk

let _ =
  let path = ref [] in
  let st = ref true in
  Arg.parse
    [ "-I", Arg.String (fun s -> path := s :: !path),
      "<dir>  Add <dir> to the list of include directories";
      "-labels", Arg.Clear Clflags.classic, " <obsolete>";
      "-nolabels", Arg.Set Clflags.classic,
      " Ignore non-optional labels in types";
      "-pp", Arg.String (fun s -> Clflags.preprocessor := Some s),
      "<command>  Pipe sources through preprocessor <command>";
      "-rectypes", Arg.Set Clflags.recursive_types,
      " Allow arbitrary recursive types";
      "-oldui", Arg.Clear st, " Revert back to old UI";
      "-w", Arg.String (fun s -> Shell.warnings := s),
      "<flags>  Enable or disable warnings according to <flags>:\n\
        \032    A/a enable/disable all warnings\n\
        \032    C/c enable/disable suspicious comment\n\
        \032    D/d enable/disable deprecated features\n\
        \032    F/f enable/disable partially applied function\n\
        \032    L/l enable/disable labels omitted in application\n\
        \032    M/m enable/disable overriden method\n\
        \032    P/p enable/disable partial match\n\
        \032    S/s enable/disable non-unit statement\n\
        \032    U/u enable/disable unused match case\n\
        \032    V/v enable/disable hidden instance variable\n\
        \032    X/x enable/disable all other warnings\n\
        \032    default setting is \"Al\" (all warnings but labels enabled)" ]
    (fun name -> raise(Arg.Bad("don't know what to do with " ^ name)))
    "ocamlbrowser :";
  Config.load_path :=
    Sys.getcwd ()
    :: List.rev_map ~f:(Misc.expand_directory Config.standard_library) !path
    @ [Config.standard_library];
  Warnings.parse_options false !Shell.warnings;
  Unix.putenv "TERM" "noterminal";
  begin
    try Searchid.start_env := Env.open_pers_signature "Pervasives" Env.initial
    with Env.Error _ -> ()
  end;
  
  Searchpos.view_defined_ref := (fun s ~env -> Viewer.view_defined s ~env);
  Searchpos.editor_ref := Editor.f;

  let is_win32 = Sys.os_type = "Win32" in
  if is_win32 then
    Format.pp_set_formatter_output_functions Format.err_formatter
      (fun _ _ _ -> ()) (fun _ -> ());

  let top = openTk ~clas:"OCamlBrowser" () in
  Jg_config.init ();

  (* bind top ~events:[`Destroy] ~action:(fun _ -> exit 0); *)
  at_exit Shell.kill_all;
  

  if !st then Viewer.st_viewer ~on:top ()
  else Viewer.f ~on:top ();

  while true do
    try
      if is_win32 then mainLoop ()
      else Printexc.print mainLoop ()
    with Protocol.TkError _ -> ()
  done<commit_msg>report error in Tk window<commit_after>(*************************************************************************)
(*                                                                       *)
(*                Objective Caml LablTk library                          *)
(*                                                                       *)
(*            <NAME>, Kyoto University RIMS                    *)
(*                                                                       *)
(*   Copyright 1999 Institut National de Recherche en Informatique et    *)
(*   en Automatique and Kyoto University.  All rights reserved.          *)
(*   This file is distributed under the terms of the GNU Library         *)
(*   General Public License, with the special exception on linking       *)
(*   described in file ../../../LICENSE.                                 *)
(*                                                                       *)
(*************************************************************************)

(* $Id$ *)

open StdLabels
module Unix = UnixLabels
open Tk

let fatal_error text =
  let top = openTk ~clas:"OCamlBrowser" () in
  let mw = Message.create top ~text ~padx:20 ~pady:10
      ~width:400 ~justify:`Left ~aspect:400 ~anchor:`W
  and b = Button.create top ~text:"OK" ~command:(fun () -> destroy top) in
  pack [mw] ~side:`Top ~fill:`Both;
  pack [b] ~side:`Bottom;
  mainLoop ();
  exit 0

let rec get_incr key = function
    [] -> raise Not_found
  | (k, c, d) :: rem ->
      if k = key then
        match c with Arg.Set _ | Arg.Clear _ -> false | _ -> true
      else get_incr key rem

let check ~spec argv =
  let i = ref 1 in
  while !i < Array.length argv do
    try
      let a = get_incr argv.(!i) spec in
      incr i; if a then incr i
    with Not_found ->
      i := Array.length argv + 1
  done;
  !i = Array.length argv

open Printf

let usage ~spec errmsg =
  let b = Buffer.create 1024 in
  bprintf b "%s\n" errmsg;
  List.iter (function (key, _, doc) -> bprintf b "  %s %s\n" key doc) spec;
  Buffer.contents b

let _ =
  let is_win32 = Sys.os_type = "Win32" in
  if is_win32 then
    Format.pp_set_formatter_output_functions Format.err_formatter
      (fun _ _ _ -> ()) (fun _ -> ());

  let path = ref [] in
  let st = ref true in
  let spec =
    [ "-I", Arg.String (fun s -> path := s :: !path),
      "<dir>  Add <dir> to the list of include directories";
      "-labels", Arg.Clear Clflags.classic, " <obsolete>";
      "-nolabels", Arg.Set Clflags.classic,
      " Ignore non-optional labels in types";
      "-pp", Arg.String (fun s -> Clflags.preprocessor := Some s),
      "<command>  Pipe sources through preprocessor <command>";
      "-rectypes", Arg.Set Clflags.recursive_types,
      " Allow arbitrary recursive types";
      "-oldui", Arg.Clear st, " Revert back to old UI";
      "-w", Arg.String (fun s -> Shell.warnings := s),
      "<flags>  Enable or disable warnings according to <flags>:\n\
        \032    A/a enable/disable all warnings\n\
        \032    C/c enable/disable suspicious comment\n\
        \032    D/d enable/disable deprecated features\n\
        \032    F/f enable/disable partially applied function\n\
        \032    L/l enable/disable labels omitted in application\n\
        \032    M/m enable/disable overriden method\n\
        \032    P/p enable/disable partial match\n\
        \032    S/s enable/disable non-unit statement\n\
        \032    U/u enable/disable unused match case\n\
        \032    V/v enable/disable hidden instance variable\n\
        \032    X/x enable/disable all other warnings\n\
        \032    default setting is \"Al\" (all warnings but labels enabled)" ]
  and errmsg = "Command line: ocamlbrowser <options>" in
  if not (check ~spec Sys.argv) then fatal_error (usage ~spec errmsg);
  Arg.parse spec
    (fun name -> raise(Arg.Bad("don't know what to do with " ^ name)))
    errmsg;
  Config.load_path :=
    Sys.getcwd ()
    :: List.rev_map ~f:(Misc.expand_directory Config.standard_library) !path
    @ [Config.standard_library];
  Warnings.parse_options false !Shell.warnings;
  Unix.putenv "TERM" "noterminal";
  begin
    try Searchid.start_env := Env.open_pers_signature "Pervasives" Env.initial
    with _ ->
      fatal_error
        (Printf.sprintf "%s\nPlease check that %s %s"
           "Couldn't initialize environment."
           (if is_win32 then "%OCAMLLIB%" else "$OCAMLLIB")
           "points to the Objective Caml library.")
  end;
  
  Searchpos.view_defined_ref := (fun s ~env -> Viewer.view_defined s ~env);
  Searchpos.editor_ref := Editor.f;

  let top = openTk ~clas:"OCamlBrowser" () in
  Jg_config.init ();

  (* bind top ~events:[`Destroy] ~action:(fun _ -> exit 0); *)
  at_exit Shell.kill_all;
  

  if !st then Viewer.st_viewer ~on:top ()
  else Viewer.f ~on:top ();

  while true do
    try
      if is_win32 then mainLoop ()
      else Printexc.print mainLoop ()
    with Protocol.TkError _ -> ()
  done
{'fraction_non_alphanumeric': 0.14582119128103507, 'fraction_numerical': 0.013637953141391771, 'mean_word_length': 1.9812369701181376, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 24, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6591133', 'n_tokens_mistral': 2594, 'n_tokens_neox': 2449, 'n_words': 772}