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