File: odoc_args.ml

package info (click to toggle)
ocaml 4.05.0-11
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 27,060 kB
  • sloc: ml: 199,255; ansic: 44,187; sh: 5,611; makefile: 4,958; lisp: 4,223; asm: 4,220; awk: 306; perl: 87; fortran: 21; cs: 9; sed: 9
file content (423 lines) | stat: -rw-r--r-- 17,053 bytes parent folder | download | duplicates (2)
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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
(*                                                                        *)
(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

(** Command-line arguments. *)

module M = Odoc_messages

let current_generator = ref (None : Odoc_gen.generator option)

let get_html_generator () =
  match !current_generator with
    None -> (module Odoc_html.Generator : Odoc_html.Html_generator)
  | Some (Odoc_gen.Html m) -> m
  | Some _ -> failwith (M.current_generator_is_not "html")
;;

let get_latex_generator () =
  match !current_generator with
    None -> (module Odoc_latex.Generator : Odoc_latex.Latex_generator)
  | Some (Odoc_gen.Latex m) -> m
  | Some _ -> failwith (M.current_generator_is_not "latex")
;;

let get_texi_generator () =
  match !current_generator with
    None -> (module Odoc_texi.Generator : Odoc_texi.Texi_generator)
  | Some (Odoc_gen.Texi m) -> m
  | Some _ -> failwith (M.current_generator_is_not "texi")
;;

let get_man_generator () =
  match !current_generator with
    None -> (module Odoc_man.Generator : Odoc_man.Man_generator)
  | Some (Odoc_gen.Man m) -> m
  | Some _ -> failwith (M.current_generator_is_not "man")
;;

let get_dot_generator () =
  match !current_generator with
    None -> (module Odoc_dot.Generator : Odoc_dot.Dot_generator)
  | Some (Odoc_gen.Dot m) -> m
  | Some _ -> failwith (M.current_generator_is_not "dot")
;;

let get_base_generator () =
  match !current_generator with
    None -> (module Odoc_gen.Base_generator : Odoc_gen.Base)
  | Some (Odoc_gen.Base m) -> m
  | Some _ -> failwith (M.current_generator_is_not "base")
;;

let extend_html_generator f =
  let current = get_html_generator () in
  let module Current = (val current : Odoc_html.Html_generator) in
  let module F = (val f : Odoc_gen.Html_functor) in
  let module M = F(Current) in
  current_generator := Some (Odoc_gen.Html (module M : Odoc_html.Html_generator))
;;

let extend_latex_generator f =
  let current = get_latex_generator () in
  let module Current = (val current : Odoc_latex.Latex_generator) in
  let module F = (val f : Odoc_gen.Latex_functor) in
  let module M = F(Current) in
  current_generator := Some(Odoc_gen.Latex (module M : Odoc_latex.Latex_generator))
;;

let extend_texi_generator f =
  let current = get_texi_generator () in
  let module Current = (val current : Odoc_texi.Texi_generator) in
  let module F = (val f : Odoc_gen.Texi_functor) in
  let module M = F(Current) in
  current_generator := Some(Odoc_gen.Texi (module M : Odoc_texi.Texi_generator))
;;

let extend_man_generator f =
  let current = get_man_generator () in
  let module Current = (val current : Odoc_man.Man_generator) in
  let module F = (val f : Odoc_gen.Man_functor) in
  let module M = F(Current) in
  current_generator := Some(Odoc_gen.Man (module M : Odoc_man.Man_generator))
;;

let extend_dot_generator f =
  let current = get_dot_generator () in
  let module Current = (val current : Odoc_dot.Dot_generator) in
  let module F = (val f : Odoc_gen.Dot_functor) in
  let module M = F(Current) in
  current_generator := Some (Odoc_gen.Dot (module M : Odoc_dot.Dot_generator))
;;

let extend_base_generator f =
  let current = get_base_generator () in
  let module Current = (val current : Odoc_gen.Base) in
  let module F = (val f : Odoc_gen.Base_functor) in
  let module M = F(Current) in
  current_generator := Some (Odoc_gen.Base (module M : Odoc_gen.Base))
;;

(** Analysis of a string defining options. Return the list of
   options according to the list giving associations between
   [(character, _)] and a list of options. *)
let analyse_option_string l s =
  List.fold_left
    (fun acc -> fun ((c,_), v) ->
      if String.contains s c then
        acc @ v
      else
        acc)
    []
    l

(** Analysis of a string defining the merge options to be used.
   Returns the list of options specified.*)
let analyse_merge_options s =
  let l = [
    (M.merge_description, [Odoc_types.Merge_description]) ;
    (M.merge_author, [Odoc_types.Merge_author]) ;
    (M.merge_version, [Odoc_types.Merge_version]) ;
    (M.merge_see, [Odoc_types.Merge_see]) ;
    (M.merge_since, [Odoc_types.Merge_since]) ;
    (M.merge_before, [Odoc_types.Merge_before]) ;
    (M.merge_deprecated, [Odoc_types.Merge_deprecated]) ;
    (M.merge_param, [Odoc_types.Merge_param]) ;
    (M.merge_raised_exception, [Odoc_types.Merge_raised_exception]) ;
    (M.merge_return_value, [Odoc_types.Merge_return_value]) ;
    (M.merge_custom, [Odoc_types.Merge_custom]) ;
    (M.merge_all, Odoc_types.all_merge_options)
  ]
  in
  analyse_option_string l s


let f_latex_title s =
  try
    let pos = String.index s ',' in
    let n = int_of_string (String.sub s 0 pos) in
    let len = String.length s in
    let command = String.sub s (pos + 1) (len - pos - 1) in
    Odoc_latex.latex_titles := List.remove_assoc n !Odoc_latex.latex_titles ;
    Odoc_latex.latex_titles := (n, command) :: !Odoc_latex.latex_titles
  with
    Not_found
  | Invalid_argument _ ->
      incr Odoc_global.errors ;
      prerr_endline (M.wrong_format s)

let add_hidden_modules s =
  let l = Str.split (Str.regexp ",") s in
  List.iter
    (fun n ->
      let name = Str.global_replace (Str.regexp "[ \n\r\t]+") "" n in
      match name with
        "" -> ()
      | _ ->
          match name.[0] with
            'A'..'Z' -> Odoc_global.hidden_modules := name :: !Odoc_global.hidden_modules
          | _ ->
              incr Odoc_global.errors;
              prerr_endline (M.not_a_module_name name)
    )
    l

let set_generator (g : Odoc_gen.generator) = current_generator := Some g

let anonymous f =
  let sf =
    if Filename.check_suffix f "ml" then
      Odoc_global.Impl_file f
    else
        if Filename.check_suffix f !Config.interface_suffix then
        Odoc_global.Intf_file f
      else
        if Filename.check_suffix f "txt" then
          Odoc_global.Text_file f
        else
          failwith (Odoc_messages.unknown_extension f)
  in
  Odoc_global.files := !Odoc_global.files @ [sf]

module Options = Main_args.Make_ocamldoc_options(struct
  let set r () = r := true
  let unset r () = r := false
  let _absname = set Location.absname
  let _I s = Odoc_global.include_dirs :=
       (Misc.expand_directory Config.standard_library s) :: !Odoc_global.include_dirs
  let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
  let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
  let _intf_suffix s = Config.interface_suffix := s
  let _labels = unset Clflags.classic
  let _alias_deps = unset Clflags.transparent_modules
  let _no_alias_deps = set Clflags.transparent_modules
  let _app_funct = set Clflags.applicative_functors
  let _no_app_funct = unset Clflags.applicative_functors
  let _noassert = set Clflags.noassert
  let _nolabels = set Clflags.classic
  let _nostdlib = set Clflags.no_std_include
  let _open s = Clflags.open_modules := s :: !Clflags.open_modules
  let _pp s = Clflags.preprocessor := Some s
  let _ppx s = Clflags.all_ppx := s :: !Clflags.all_ppx
  let _principal = set Clflags.principal
  let _no_principal = unset Clflags.principal
  let _rectypes = set Clflags.recursive_types
  let _no_rectypes = unset Clflags.recursive_types
  let _safe_string = unset Clflags.unsafe_string
  let _short_paths = unset Clflags.real_paths
  let _strict_sequence = set Clflags.strict_sequence
  let _no_strict_sequence = unset Clflags.strict_sequence
  let _strict_formats = set Clflags.strict_formats
  let _no_strict_formats = unset Clflags.strict_formats
  let _thread = set Clflags.use_threads
  let _vmthread = set Clflags.use_vmthreads
  let _unboxed_types = set Clflags.unboxed_types
  let _no_unboxed_types = unset Clflags.unboxed_types
  let _unsafe () = assert false
  let _unsafe_string = set Clflags.unsafe_string
  let _v () = Compenv.print_version_and_library "documentation generator"
  let _version = Compenv.print_version_string
  let _vnum = Compenv.print_version_string
  let _w = (Warnings.parse_options false)
  let _warn_error _ = assert false
  let _warn_help _ = assert false
  let _where = Compenv.print_standard_library
  let _verbose = set Clflags.verbose
  let _nopervasives = set Clflags.nopervasives
  let _dsource = set Clflags.dump_source
  let _dparsetree = set Clflags.dump_parsetree
  let _dtypedtree = set Clflags.dump_typedtree
  let _drawlambda = set Clflags.dump_rawlambda
  let _dlambda = set Clflags.dump_lambda
  let _dflambda = set Clflags.dump_flambda
  let _dinstr = set Clflags.dump_instr
  let anonymous = anonymous
end)

(** The default option list *)
let default_options = Options.list @
[
  "-text", Arg.String (fun s ->
       Odoc_global.files := !Odoc_global.files @ [Odoc_global.Text_file s]),
    M.option_text ;
  "-warn-error", Arg.Set Odoc_global.warn_error, M.werr ;
  "-show-missed-crossref", Arg.Set Odoc_global.show_missed_crossref,
  M.show_missed_crossref;
  "-hide-warnings", Arg.Clear Odoc_config.print_warnings, M.hide_warnings ;
  "-o", Arg.String (fun s -> Odoc_global.out_file := s), M.out_file ;
  "-d", Arg.String (fun s -> Odoc_global.target_dir := s), M.target_dir ;
  "-sort", Arg.Unit (fun () -> Odoc_global.sort_modules := true), M.sort_modules ;
  "-no-stop", Arg.Set Odoc_global.no_stop, M.no_stop ;
  "-no-custom-tags", Arg.Set Odoc_global.no_custom_tags, M.no_custom_tags ;
  "-stars", Arg.Set Odoc_global.remove_stars, M.remove_stars ;
  "-inv-merge-ml-mli", Arg.Set Odoc_global.inverse_merge_ml_mli, M.inverse_merge_ml_mli ;
  "-no-module-constraint-filter", Arg.Clear Odoc_global.filter_with_module_constraints,
  M.no_filter_with_module_constraints ;

  "-keep-code", Arg.Set Odoc_global.keep_code, M.keep_code^"\n" ;

  "-dump", Arg.String (fun s -> Odoc_global.dump := Some s), M.dump ;
  "-load", Arg.String (fun s -> Odoc_global.load := !Odoc_global.load @ [s]), M.load^"\n" ;

  "-t", Arg.String (fun s -> Odoc_global.title := Some s), M.option_title ;
  "-intro", Arg.String (fun s -> Odoc_global.intro_file := Some s), M.option_intro ;
  "-hide", Arg.String add_hidden_modules, M.hide_modules ;
  "-m", Arg.String (fun s -> Odoc_global.merge_options := !Odoc_global.merge_options @ (analyse_merge_options s)),
  M.merge_options ^
  "\n\n *** choosing a generator ***\n";

(* generators *)
  "-html", Arg.Unit (fun () ->
    match !current_generator with
      Some (Odoc_gen.Html _) -> ()
    | _ -> set_generator
             (Odoc_gen.Html (module Odoc_html.Generator : Odoc_html.Html_generator))),
    M.generate_html ;
  "-latex", Arg.Unit (fun () ->
    match !current_generator with
      Some (Odoc_gen.Latex _) -> ()
    | _ -> set_generator
             (Odoc_gen.Latex (module Odoc_latex.Generator : Odoc_latex.Latex_generator))),
    M.generate_latex ;
  "-texi", Arg.Unit (fun () ->
    match !current_generator with
      Some (Odoc_gen.Texi _) -> ()
    | _ -> set_generator
             (Odoc_gen.Texi (module Odoc_texi.Generator : Odoc_texi.Texi_generator))),
    M.generate_texinfo ;
  "-man", Arg.Unit (fun () ->
    match !current_generator with
      Some (Odoc_gen.Man _) -> ()
    | _ -> set_generator
             (Odoc_gen.Man (module Odoc_man.Generator : Odoc_man.Man_generator))),
    M.generate_man ;
  "-dot", Arg.Unit (fun () ->
    match !current_generator with
      Some (Odoc_gen.Dot _) -> ()
    | _ -> set_generator
             (Odoc_gen.Dot (module Odoc_dot.Generator : Odoc_dot.Dot_generator))),
    M.generate_dot ;
  "-customdir", Arg.Unit (fun () -> Printf.printf "%s\n" Odoc_config.custom_generators_path; exit 0),
  M.display_custom_generators_dir ;
  "-i", Arg.String (fun _ -> ()), M.add_load_dir ;
  "-g", Arg.String (fun _ -> ()), M.load_file ^
  "\n\n *** HTML options ***\n";

(* html only options *)
  "-all-params", Arg.Set Odoc_html.with_parameter_list, M.with_parameter_list ;
  "-css-style", Arg.String (fun s -> Odoc_html.css_style := Some s), M.css_style ;
  "-index-only", Arg.Set Odoc_html.index_only, M.index_only ;
  "-colorize-code", Arg.Set Odoc_html.colorize_code, M.colorize_code ;
  "-short-functors", Arg.Set Odoc_html.html_short_functors, M.html_short_functors ;
  "-charset", Arg.Set_string Odoc_html.charset, (M.charset !Odoc_html.charset)^
  "\n\n *** LaTeX options ***\n";

(* latex only options *)
  "-noheader", Arg.Unit (fun () -> Odoc_global.with_header := false), M.no_header ;
  "-notrailer", Arg.Unit (fun () -> Odoc_global.with_trailer := false), M.no_trailer ;
  "-sepfiles", Arg.Set Odoc_latex.separate_files, M.separate_files ;
  "-latextitle", Arg.String f_latex_title, M.latex_title Odoc_latex.latex_titles ;
  "-latex-value-prefix",
    Arg.String (fun s -> Odoc_latex.latex_value_prefix := s), M.latex_value_prefix ;
  "-latex-type-prefix",
    Arg.String (fun s -> Odoc_latex.latex_type_prefix := s), M.latex_type_prefix ;
  "-latex-exception-prefix",
    Arg.String (fun s -> Odoc_latex.latex_exception_prefix := s), M.latex_exception_prefix ;
  "-latex-attribute-prefix",
    Arg.String (fun s -> Odoc_latex.latex_attribute_prefix := s), M.latex_attribute_prefix ;
  "-latex-method-prefix",
    Arg.String (fun s -> Odoc_latex.latex_method_prefix := s), M.latex_method_prefix ;
  "-latex-module-prefix",
    Arg.String (fun s -> Odoc_latex.latex_module_prefix := s), M.latex_module_prefix ;
  "-latex-module-type-prefix",
    Arg.String (fun s -> Odoc_latex.latex_module_type_prefix := s), M.latex_module_type_prefix ;
  "-latex-class-prefix",
    Arg.String (fun s -> Odoc_latex.latex_class_prefix := s), M.latex_class_prefix ;
  "-latex-class-type-prefix",
    Arg.String (fun s -> Odoc_latex.latex_class_type_prefix := s), M.latex_class_type_prefix ;
  "-notoc", Arg.Unit (fun () -> Odoc_global.with_toc := false), M.no_toc ^
  "\n\n *** texinfo options ***\n";

(* texi only options *)
  "-noindex", Arg.Clear Odoc_global.with_index, M.no_index ;
  "-esc8", Arg.Set Odoc_texi.esc_8bits, M.esc_8bits ;
  "-info-section", Arg.String ((:=) Odoc_texi.info_section), M.info_section ;
  "-info-entry", Arg.String (fun s -> Odoc_texi.info_entry := !Odoc_texi.info_entry @ [ s ]),
  M.info_entry ^
  "\n\n *** dot options ***\n";

(* dot only options *)
  "-dot-colors", Arg.String (fun s -> Odoc_dot.dot_colors := Str.split (Str.regexp_string ",") s), M.dot_colors ;
  "-dot-include-all", Arg.Set Odoc_dot.dot_include_all, M.dot_include_all ;
  "-dot-types", Arg.Set Odoc_dot.dot_types, M.dot_types ;
  "-dot-reduce", Arg.Set Odoc_dot.dot_reduce, M.dot_reduce^
  "\n\n *** man pages options ***\n";

(* man only options *)
  "-man-mini", Arg.Set Odoc_man.man_mini, M.man_mini ;
  "-man-suffix", Arg.String (fun s -> Odoc_man.man_suffix := s), M.man_suffix ;
  "-man-section", Arg.String (fun s -> Odoc_man.man_section := s), M.man_section ;

]

let options = ref default_options

let modified_options () =
  !options != default_options

let append_last_doc suffix =
  match List.rev !options with
  | (key, spec, doc) :: tl ->
      options := List.rev ((key, spec, doc ^ suffix) :: tl)
  | [] -> ()

(** The help option list, overriding the default ones from the Arg module *)
let help_options = ref []
let help_action () =
  let msg =
    Arg.usage_string
      (!options @ !help_options)
      (M.usage ^ M.options_are) in
  print_string msg
let () =
  help_options := [
    "-help", Arg.Unit help_action, M.help ;
    "--help", Arg.Unit help_action, M.help
]

let add_option o =
  if not (modified_options ()) then
    append_last_doc "\n *** custom generator options ***\n";
  let (s,_,_) = o in
  let rec iter = function
      [] -> [o]
    | (s2,f,m) :: q ->
        if s = s2 then
          o :: q
        else
          (s2,f,m) :: (iter q)
  in
  options := iter !options

let parse () =
  if modified_options () then append_last_doc "\n";
  let options = !options @ !help_options in
  Arg.parse (Arg.align ~limit:13 options)
      anonymous
      (M.usage^M.options_are);
  (* we sort the hidden modules by name, to be sure that for example,
     A.B is before A, so we will match against A.B before A in
     Odoc_name.hide_modules.*)
  Odoc_global.hidden_modules :=
    List.sort (fun a -> fun b -> - (compare a b)) !Odoc_global.hidden_modules