1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
6(*                                                                        *)
7(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*                                                                        *)
10(*   All rights reserved.  This file is distributed under the terms of    *)
11(*   the GNU Lesser General Public License version 2.1, with the          *)
12(*   special exception on linking described in the file LICENSE.          *)
13(*                                                                        *)
14(**************************************************************************)
15
16(** Command-line arguments. *)
17
18module M = Odoc_messages
19
20let current_generator = ref (None : Odoc_gen.generator option)
21
22let get_html_generator () =
23  match !current_generator with
24    None -> (module Odoc_html.Generator : Odoc_html.Html_generator)
25  | Some (Odoc_gen.Html m) -> m
26  | Some _ -> failwith (M.current_generator_is_not "html")
27;;
28
29let get_latex_generator () =
30  match !current_generator with
31    None -> (module Odoc_latex.Generator : Odoc_latex.Latex_generator)
32  | Some (Odoc_gen.Latex m) -> m
33  | Some _ -> failwith (M.current_generator_is_not "latex")
34;;
35
36let get_texi_generator () =
37  match !current_generator with
38    None -> (module Odoc_texi.Generator : Odoc_texi.Texi_generator)
39  | Some (Odoc_gen.Texi m) -> m
40  | Some _ -> failwith (M.current_generator_is_not "texi")
41;;
42
43let get_man_generator () =
44  match !current_generator with
45    None -> (module Odoc_man.Generator : Odoc_man.Man_generator)
46  | Some (Odoc_gen.Man m) -> m
47  | Some _ -> failwith (M.current_generator_is_not "man")
48;;
49
50let get_dot_generator () =
51  match !current_generator with
52    None -> (module Odoc_dot.Generator : Odoc_dot.Dot_generator)
53  | Some (Odoc_gen.Dot m) -> m
54  | Some _ -> failwith (M.current_generator_is_not "dot")
55;;
56
57let get_base_generator () =
58  match !current_generator with
59    None -> (module Odoc_gen.Base_generator : Odoc_gen.Base)
60  | Some (Odoc_gen.Base m) -> m
61  | Some _ -> failwith (M.current_generator_is_not "base")
62;;
63
64let extend_html_generator f =
65  let current = get_html_generator () in
66  let module Current = (val current : Odoc_html.Html_generator) in
67  let module F = (val f : Odoc_gen.Html_functor) in
68  let module M = F(Current) in
69  current_generator := Some (Odoc_gen.Html (module M : Odoc_html.Html_generator))
70;;
71
72let extend_latex_generator f =
73  let current = get_latex_generator () in
74  let module Current = (val current : Odoc_latex.Latex_generator) in
75  let module F = (val f : Odoc_gen.Latex_functor) in
76  let module M = F(Current) in
77  current_generator := Some(Odoc_gen.Latex (module M : Odoc_latex.Latex_generator))
78;;
79
80let extend_texi_generator f =
81  let current = get_texi_generator () in
82  let module Current = (val current : Odoc_texi.Texi_generator) in
83  let module F = (val f : Odoc_gen.Texi_functor) in
84  let module M = F(Current) in
85  current_generator := Some(Odoc_gen.Texi (module M : Odoc_texi.Texi_generator))
86;;
87
88let extend_man_generator f =
89  let current = get_man_generator () in
90  let module Current = (val current : Odoc_man.Man_generator) in
91  let module F = (val f : Odoc_gen.Man_functor) in
92  let module M = F(Current) in
93  current_generator := Some(Odoc_gen.Man (module M : Odoc_man.Man_generator))
94;;
95
96let extend_dot_generator f =
97  let current = get_dot_generator () in
98  let module Current = (val current : Odoc_dot.Dot_generator) in
99  let module F = (val f : Odoc_gen.Dot_functor) in
100  let module M = F(Current) in
101  current_generator := Some (Odoc_gen.Dot (module M : Odoc_dot.Dot_generator))
102;;
103
104let extend_base_generator f =
105  let current = get_base_generator () in
106  let module Current = (val current : Odoc_gen.Base) in
107  let module F = (val f : Odoc_gen.Base_functor) in
108  let module M = F(Current) in
109  current_generator := Some (Odoc_gen.Base (module M : Odoc_gen.Base))
110;;
111
112(** Analysis of a string defining options. Return the list of
113   options according to the list giving associations between
114   [(character, _)] and a list of options. *)
115let analyse_option_string l s =
116  List.fold_left
117    (fun acc -> fun ((c,_), v) ->
118      if String.contains s c then
119        acc @ v
120      else
121        acc)
122    []
123    l
124
125(** Analysis of a string defining the merge options to be used.
126   Returns the list of options specified.*)
127let analyse_merge_options s =
128  let l = [
129    (M.merge_description, [Odoc_types.Merge_description]) ;
130    (M.merge_author, [Odoc_types.Merge_author]) ;
131    (M.merge_version, [Odoc_types.Merge_version]) ;
132    (M.merge_see, [Odoc_types.Merge_see]) ;
133    (M.merge_since, [Odoc_types.Merge_since]) ;
134    (M.merge_before, [Odoc_types.Merge_before]) ;
135    (M.merge_deprecated, [Odoc_types.Merge_deprecated]) ;
136    (M.merge_param, [Odoc_types.Merge_param]) ;
137    (M.merge_raised_exception, [Odoc_types.Merge_raised_exception]) ;
138    (M.merge_return_value, [Odoc_types.Merge_return_value]) ;
139    (M.merge_custom, [Odoc_types.Merge_custom]) ;
140    (M.merge_all, Odoc_types.all_merge_options)
141  ]
142  in
143  analyse_option_string l s
144
145
146let f_latex_title s =
147  try
148    let pos = String.index s ',' in
149    let n = int_of_string (String.sub s 0 pos) in
150    let len = String.length s in
151    let command = String.sub s (pos + 1) (len - pos - 1) in
152    Odoc_latex.latex_titles := List.remove_assoc n !Odoc_latex.latex_titles ;
153    Odoc_latex.latex_titles := (n, command) :: !Odoc_latex.latex_titles
154  with
155    Not_found
156  | Invalid_argument _ ->
157      incr Odoc_global.errors ;
158      prerr_endline (M.wrong_format s)
159
160let add_hidden_modules s =
161  let l = Str.split (Str.regexp ",") s in
162  List.iter
163    (fun n ->
164      let name = Str.global_replace (Str.regexp "[ \n\r\t]+") "" n in
165      match name with
166        "" -> ()
167      | _ ->
168          match name.[0] with
169            'A'..'Z' -> Odoc_global.hidden_modules := name :: !Odoc_global.hidden_modules
170          | _ ->
171              incr Odoc_global.errors;
172              prerr_endline (M.not_a_module_name name)
173    )
174    l
175
176let set_generator (g : Odoc_gen.generator) = current_generator := Some g
177
178let anonymous f =
179  let sf =
180    if Filename.check_suffix f "ml" then
181      Odoc_global.Impl_file f
182    else
183        if Filename.check_suffix f !Config.interface_suffix then
184        Odoc_global.Intf_file f
185      else
186        if Filename.check_suffix f "txt" then
187          Odoc_global.Text_file f
188        else
189          failwith (Odoc_messages.unknown_extension f)
190  in
191  Odoc_global.files := !Odoc_global.files @ [sf]
192
193module Options = Main_args.Make_ocamldoc_options(struct
194  let set r () = r := true
195  let unset r () = r := false
196  let _absname = set Location.absname
197  let _I s = Odoc_global.include_dirs :=
198       (Misc.expand_directory Config.standard_library s) :: !Odoc_global.include_dirs
199  let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
200  let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
201  let _intf_suffix s = Config.interface_suffix := s
202  let _labels = unset Clflags.classic
203  let _alias_deps = unset Clflags.transparent_modules
204  let _no_alias_deps = set Clflags.transparent_modules
205  let _app_funct = set Clflags.applicative_functors
206  let _no_app_funct = unset Clflags.applicative_functors
207  let _noassert = set Clflags.noassert
208  let _nolabels = set Clflags.classic
209  let _nostdlib = set Clflags.no_std_include
210  let _open s = Clflags.open_modules := s :: !Clflags.open_modules
211  let _pp s = Clflags.preprocessor := Some s
212  let _ppx s = Clflags.all_ppx := s :: !Clflags.all_ppx
213  let _principal = set Clflags.principal
214  let _no_principal = unset Clflags.principal
215  let _rectypes = set Clflags.recursive_types
216  let _no_rectypes = unset Clflags.recursive_types
217  let _safe_string = unset Clflags.unsafe_string
218  let _short_paths = unset Clflags.real_paths
219  let _strict_sequence = set Clflags.strict_sequence
220  let _no_strict_sequence = unset Clflags.strict_sequence
221  let _strict_formats = set Clflags.strict_formats
222  let _no_strict_formats = unset Clflags.strict_formats
223  let _thread = set Clflags.use_threads
224  let _vmthread = set Clflags.use_vmthreads
225  let _unboxed_types = set Clflags.unboxed_types
226  let _no_unboxed_types = unset Clflags.unboxed_types
227  let _unsafe () = assert false
228  let _unsafe_string = set Clflags.unsafe_string
229  let _v () = Compenv.print_version_and_library "documentation generator"
230  let _version = Compenv.print_version_string
231  let _vnum = Compenv.print_version_string
232  let _w = (Warnings.parse_options false)
233  let _warn_error _ = assert false
234  let _warn_help _ = assert false
235  let _where = Compenv.print_standard_library
236  let _verbose = set Clflags.verbose
237  let _nopervasives = set Clflags.nopervasives
238  let _dsource = set Clflags.dump_source
239  let _dparsetree = set Clflags.dump_parsetree
240  let _dtypedtree = set Clflags.dump_typedtree
241  let _drawlambda = set Clflags.dump_rawlambda
242  let _dlambda = set Clflags.dump_lambda
243  let _dflambda = set Clflags.dump_flambda
244  let _dinstr = set Clflags.dump_instr
245  let anonymous = anonymous
246end)
247
248(** The default option list *)
249let default_options = Options.list @
250[
251  "-text", Arg.String (fun s ->
252       Odoc_global.files := !Odoc_global.files @ [Odoc_global.Text_file s]),
253    M.option_text ;
254  "-warn-error", Arg.Set Odoc_global.warn_error, M.werr ;
255  "-show-missed-crossref", Arg.Set Odoc_global.show_missed_crossref,
256  M.show_missed_crossref;
257  "-hide-warnings", Arg.Clear Odoc_config.print_warnings, M.hide_warnings ;
258  "-o", Arg.String (fun s -> Odoc_global.out_file := s), M.out_file ;
259  "-d", Arg.String (fun s -> Odoc_global.target_dir := s), M.target_dir ;
260  "-sort", Arg.Unit (fun () -> Odoc_global.sort_modules := true), M.sort_modules ;
261  "-no-stop", Arg.Set Odoc_global.no_stop, M.no_stop ;
262  "-no-custom-tags", Arg.Set Odoc_global.no_custom_tags, M.no_custom_tags ;
263  "-stars", Arg.Set Odoc_global.remove_stars, M.remove_stars ;
264  "-inv-merge-ml-mli", Arg.Set Odoc_global.inverse_merge_ml_mli, M.inverse_merge_ml_mli ;
265  "-no-module-constraint-filter", Arg.Clear Odoc_global.filter_with_module_constraints,
266  M.no_filter_with_module_constraints ;
267
268  "-keep-code", Arg.Set Odoc_global.keep_code, M.keep_code^"\n" ;
269
270  "-dump", Arg.String (fun s -> Odoc_global.dump := Some s), M.dump ;
271  "-load", Arg.String (fun s -> Odoc_global.load := !Odoc_global.load @ [s]), M.load^"\n" ;
272
273  "-t", Arg.String (fun s -> Odoc_global.title := Some s), M.option_title ;
274  "-intro", Arg.String (fun s -> Odoc_global.intro_file := Some s), M.option_intro ;
275  "-hide", Arg.String add_hidden_modules, M.hide_modules ;
276  "-m", Arg.String (fun s -> Odoc_global.merge_options := !Odoc_global.merge_options @ (analyse_merge_options s)),
277  M.merge_options ^
278  "\n\n *** choosing a generator ***\n";
279
280(* generators *)
281  "-html", Arg.Unit (fun () ->
282    match !current_generator with
283      Some (Odoc_gen.Html _) -> ()
284    | _ -> set_generator
285             (Odoc_gen.Html (module Odoc_html.Generator : Odoc_html.Html_generator))),
286    M.generate_html ;
287  "-latex", Arg.Unit (fun () ->
288    match !current_generator with
289      Some (Odoc_gen.Latex _) -> ()
290    | _ -> set_generator
291             (Odoc_gen.Latex (module Odoc_latex.Generator : Odoc_latex.Latex_generator))),
292    M.generate_latex ;
293  "-texi", Arg.Unit (fun () ->
294    match !current_generator with
295      Some (Odoc_gen.Texi _) -> ()
296    | _ -> set_generator
297             (Odoc_gen.Texi (module Odoc_texi.Generator : Odoc_texi.Texi_generator))),
298    M.generate_texinfo ;
299  "-man", Arg.Unit (fun () ->
300    match !current_generator with
301      Some (Odoc_gen.Man _) -> ()
302    | _ -> set_generator
303             (Odoc_gen.Man (module Odoc_man.Generator : Odoc_man.Man_generator))),
304    M.generate_man ;
305  "-dot", Arg.Unit (fun () ->
306    match !current_generator with
307      Some (Odoc_gen.Dot _) -> ()
308    | _ -> set_generator
309             (Odoc_gen.Dot (module Odoc_dot.Generator : Odoc_dot.Dot_generator))),
310    M.generate_dot ;
311  "-customdir", Arg.Unit (fun () -> Printf.printf "%s\n" Odoc_config.custom_generators_path; exit 0),
312  M.display_custom_generators_dir ;
313  "-i", Arg.String (fun _ -> ()), M.add_load_dir ;
314  "-g", Arg.String (fun _ -> ()), M.load_file ^
315  "\n\n *** HTML options ***\n";
316
317(* html only options *)
318  "-all-params", Arg.Set Odoc_html.with_parameter_list, M.with_parameter_list ;
319  "-css-style", Arg.String (fun s -> Odoc_html.css_style := Some s), M.css_style ;
320  "-index-only", Arg.Set Odoc_html.index_only, M.index_only ;
321  "-colorize-code", Arg.Set Odoc_html.colorize_code, M.colorize_code ;
322  "-short-functors", Arg.Set Odoc_html.html_short_functors, M.html_short_functors ;
323  "-charset", Arg.Set_string Odoc_html.charset, (M.charset !Odoc_html.charset)^
324  "\n\n *** LaTeX options ***\n";
325
326(* latex only options *)
327  "-noheader", Arg.Unit (fun () -> Odoc_global.with_header := false), M.no_header ;
328  "-notrailer", Arg.Unit (fun () -> Odoc_global.with_trailer := false), M.no_trailer ;
329  "-sepfiles", Arg.Set Odoc_latex.separate_files, M.separate_files ;
330  "-latextitle", Arg.String f_latex_title, M.latex_title Odoc_latex.latex_titles ;
331  "-latex-value-prefix",
332    Arg.String (fun s -> Odoc_latex.latex_value_prefix := s), M.latex_value_prefix ;
333  "-latex-type-prefix",
334    Arg.String (fun s -> Odoc_latex.latex_type_prefix := s), M.latex_type_prefix ;
335  "-latex-exception-prefix",
336    Arg.String (fun s -> Odoc_latex.latex_exception_prefix := s), M.latex_exception_prefix ;
337  "-latex-attribute-prefix",
338    Arg.String (fun s -> Odoc_latex.latex_attribute_prefix := s), M.latex_attribute_prefix ;
339  "-latex-method-prefix",
340    Arg.String (fun s -> Odoc_latex.latex_method_prefix := s), M.latex_method_prefix ;
341  "-latex-module-prefix",
342    Arg.String (fun s -> Odoc_latex.latex_module_prefix := s), M.latex_module_prefix ;
343  "-latex-module-type-prefix",
344    Arg.String (fun s -> Odoc_latex.latex_module_type_prefix := s), M.latex_module_type_prefix ;
345  "-latex-class-prefix",
346    Arg.String (fun s -> Odoc_latex.latex_class_prefix := s), M.latex_class_prefix ;
347  "-latex-class-type-prefix",
348    Arg.String (fun s -> Odoc_latex.latex_class_type_prefix := s), M.latex_class_type_prefix ;
349  "-notoc", Arg.Unit (fun () -> Odoc_global.with_toc := false), M.no_toc ^
350  "\n\n *** texinfo options ***\n";
351
352(* texi only options *)
353  "-noindex", Arg.Clear Odoc_global.with_index, M.no_index ;
354  "-esc8", Arg.Set Odoc_texi.esc_8bits, M.esc_8bits ;
355  "-info-section", Arg.String ((:=) Odoc_texi.info_section), M.info_section ;
356  "-info-entry", Arg.String (fun s -> Odoc_texi.info_entry := !Odoc_texi.info_entry @ [ s ]),
357  M.info_entry ^
358  "\n\n *** dot options ***\n";
359
360(* dot only options *)
361  "-dot-colors", Arg.String (fun s -> Odoc_dot.dot_colors := Str.split (Str.regexp_string ",") s), M.dot_colors ;
362  "-dot-include-all", Arg.Set Odoc_dot.dot_include_all, M.dot_include_all ;
363  "-dot-types", Arg.Set Odoc_dot.dot_types, M.dot_types ;
364  "-dot-reduce", Arg.Set Odoc_dot.dot_reduce, M.dot_reduce^
365  "\n\n *** man pages options ***\n";
366
367(* man only options *)
368  "-man-mini", Arg.Set Odoc_man.man_mini, M.man_mini ;
369  "-man-suffix", Arg.String (fun s -> Odoc_man.man_suffix := s), M.man_suffix ;
370  "-man-section", Arg.String (fun s -> Odoc_man.man_section := s), M.man_section ;
371
372]
373
374let options = ref default_options
375
376let modified_options () =
377  !options != default_options
378
379let append_last_doc suffix =
380  match List.rev !options with
381  | (key, spec, doc) :: tl ->
382      options := List.rev ((key, spec, doc ^ suffix) :: tl)
383  | [] -> ()
384
385(** The help option list, overriding the default ones from the Arg module *)
386let help_options = ref []
387let help_action () =
388  let msg =
389    Arg.usage_string
390      (!options @ !help_options)
391      (M.usage ^ M.options_are) in
392  print_string msg
393let () =
394  help_options := [
395    "-help", Arg.Unit help_action, M.help ;
396    "--help", Arg.Unit help_action, M.help
397]
398
399let add_option o =
400  if not (modified_options ()) then
401    append_last_doc "\n *** custom generator options ***\n";
402  let (s,_,_) = o in
403  let rec iter = function
404      [] -> [o]
405    | (s2,f,m) :: q ->
406        if s = s2 then
407          o :: q
408        else
409          (s2,f,m) :: (iter q)
410  in
411  options := iter !options
412
413let parse () =
414  if modified_options () then append_last_doc "\n";
415  let options = !options @ !help_options in
416  Arg.parse (Arg.align ~limit:13 options)
417      anonymous
418      (M.usage^M.options_are);
419  (* we sort the hidden modules by name, to be sure that for example,
420     A.B is before A, so we will match against A.B before A in
421     Odoc_name.hide_modules.*)
422  Odoc_global.hidden_modules :=
423    List.sort (fun a -> fun b -> - (compare a b)) !Odoc_global.hidden_modules
424