1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
(*************************************************************************)
(* *)
(* OCaml LablTk library *)
(* *)
(* Jacques Garrigue, 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 _ | Arg.Unit _ -> 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 print_version () =
printf "The OCaml browser, version %s\n" Sys.ocaml_version;
exit 0;
;;
let print_version_num () =
printf "%s\n" Sys.ocaml_version;
exit 0;
;;
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";
"-oldui", Arg.Clear st, " Revert back to old UI";
"-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";
"-version", Arg.Unit print_version,
" Print version and exit";
"-vnum", Arg.Unit print_version_num, " Print version number and exit";
"-w", Arg.String (fun s -> Shell.warnings := s),
"<flags> Enable or disable warnings according to <flags>"; ]
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\nCurrent value is `%s'"
"Couldn't initialize environment."
(if is_win32 then "%OCAMLLIB%" else "$OCAMLLIB")
"points to the OCaml library."
Config.standard_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 _ ->
if not is_win32 then flush stderr
done
|
