diff options
Diffstat (limited to 'ocamldoc')
-rw-r--r-- | ocamldoc/.depend | 34 | ||||
-rw-r--r-- | ocamldoc/Changes.txt | 18 | ||||
-rw-r--r-- | ocamldoc/Makefile | 4 | ||||
-rw-r--r-- | ocamldoc/odoc_analyse.ml | 71 | ||||
-rw-r--r-- | ocamldoc/odoc_args.ml | 15 | ||||
-rw-r--r-- | ocamldoc/odoc_args.mli | 1 | ||||
-rw-r--r-- | ocamldoc/odoc_ast.ml | 2 | ||||
-rw-r--r-- | ocamldoc/odoc_comments.ml | 61 | ||||
-rw-r--r-- | ocamldoc/odoc_comments.mli | 23 | ||||
-rw-r--r-- | ocamldoc/odoc_cross.ml | 169 | ||||
-rw-r--r-- | ocamldoc/odoc_html.ml | 1115 | ||||
-rw-r--r-- | ocamldoc/odoc_info.ml | 49 | ||||
-rw-r--r-- | ocamldoc/odoc_info.mli | 3 | ||||
-rw-r--r-- | ocamldoc/odoc_latex.ml | 692 | ||||
-rw-r--r-- | ocamldoc/odoc_man.ml | 379 | ||||
-rw-r--r-- | ocamldoc/odoc_messages.ml | 5 | ||||
-rw-r--r-- | ocamldoc/odoc_misc.ml | 64 | ||||
-rw-r--r-- | ocamldoc/odoc_misc.mli | 5 | ||||
-rw-r--r-- | ocamldoc/odoc_module.ml | 138 | ||||
-rw-r--r-- | ocamldoc/odoc_search.ml | 119 | ||||
-rw-r--r-- | ocamldoc/odoc_sig.ml | 3 | ||||
-rw-r--r-- | ocamldoc/odoc_texi.ml | 610 | ||||
-rw-r--r-- | ocamldoc/odoc_text.ml | 25 | ||||
-rw-r--r-- | ocamldoc/odoc_text_lexer.mll | 170 | ||||
-rw-r--r-- | ocamldoc/odoc_text_parser.mly | 56 | ||||
-rw-r--r-- | ocamldoc/odoc_types.ml | 1 | ||||
-rw-r--r-- | ocamldoc/odoc_types.mli | 16 |
27 files changed, 2018 insertions, 1830 deletions
diff --git a/ocamldoc/.depend b/ocamldoc/.depend index e1525c8499..65907c7e0e 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -7,10 +7,11 @@ odoc.cmx: ../typing/typedtree.cmx odoc_texi.cmx odoc_messages.cmx \ odoc_dot.cmx odoc_config.cmx odoc_args.cmx odoc_analyse.cmx \ ../utils/misc.cmx ../utils/config.cmx ../utils/clflags.cmx odoc_analyse.cmo: ../utils/warnings.cmi ../typing/typetexp.cmi \ - ../typing/typemod.cmi ../typing/typedtree.cmi ../typing/typedecl.cmi \ - ../typing/typecore.cmi ../typing/typeclass.cmi ../bytecomp/translcore.cmi \ - ../bytecomp/translclass.cmi ../parsing/syntaxerr.cmi ../parsing/parse.cmi \ - odoc_types.cmi odoc_sig.cmi odoc_module.cmo odoc_misc.cmi \ + ../typing/types.cmi ../typing/typemod.cmi ../typing/typedtree.cmi \ + ../typing/typedecl.cmi ../typing/typecore.cmi ../typing/typeclass.cmi \ + ../bytecomp/translcore.cmi ../bytecomp/translclass.cmi \ + ../parsing/syntaxerr.cmi ../parsing/parse.cmi odoc_types.cmi \ + odoc_text.cmi odoc_sig.cmi odoc_module.cmo odoc_misc.cmi \ odoc_messages.cmo odoc_merge.cmi odoc_global.cmi odoc_dep.cmo \ odoc_cross.cmi odoc_comments.cmi odoc_class.cmo odoc_ast.cmi \ odoc_args.cmi ../utils/misc.cmi ../parsing/location.cmi \ @@ -18,10 +19,11 @@ odoc_analyse.cmo: ../utils/warnings.cmi ../typing/typetexp.cmi \ ../typing/ctype.cmi ../utils/config.cmi ../utils/clflags.cmo \ ../utils/ccomp.cmi odoc_analyse.cmi odoc_analyse.cmx: ../utils/warnings.cmx ../typing/typetexp.cmx \ - ../typing/typemod.cmx ../typing/typedtree.cmx ../typing/typedecl.cmx \ - ../typing/typecore.cmx ../typing/typeclass.cmx ../bytecomp/translcore.cmx \ - ../bytecomp/translclass.cmx ../parsing/syntaxerr.cmx ../parsing/parse.cmx \ - odoc_types.cmx odoc_sig.cmx odoc_module.cmx odoc_misc.cmx \ + ../typing/types.cmx ../typing/typemod.cmx ../typing/typedtree.cmx \ + ../typing/typedecl.cmx ../typing/typecore.cmx ../typing/typeclass.cmx \ + ../bytecomp/translcore.cmx ../bytecomp/translclass.cmx \ + ../parsing/syntaxerr.cmx ../parsing/parse.cmx odoc_types.cmx \ + odoc_text.cmx odoc_sig.cmx odoc_module.cmx odoc_misc.cmx \ odoc_messages.cmx odoc_merge.cmx odoc_global.cmx odoc_dep.cmx \ odoc_cross.cmx odoc_comments.cmx odoc_class.cmx odoc_ast.cmx \ odoc_args.cmx ../utils/misc.cmx ../parsing/location.cmx \ @@ -53,11 +55,11 @@ odoc_class.cmo: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_class.cmx: ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_comments.cmo: odoc_types.cmi odoc_text.cmi odoc_see_lexer.cmo \ - odoc_parser.cmi odoc_messages.cmo odoc_lexer.cmo odoc_global.cmi \ - odoc_comments_global.cmi odoc_comments.cmi + odoc_parser.cmi odoc_misc.cmi odoc_messages.cmo odoc_lexer.cmo \ + odoc_global.cmi odoc_comments_global.cmi odoc_comments.cmi odoc_comments.cmx: odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \ - odoc_parser.cmx odoc_messages.cmx odoc_lexer.cmx odoc_global.cmx \ - odoc_comments_global.cmx odoc_comments.cmi + odoc_parser.cmx odoc_misc.cmx odoc_messages.cmx odoc_lexer.cmx \ + odoc_global.cmx odoc_comments_global.cmx odoc_comments.cmi odoc_comments_global.cmo: odoc_comments_global.cmi odoc_comments_global.cmx: odoc_comments_global.cmi odoc_config.cmo: ../utils/config.cmi odoc_config.cmi @@ -87,9 +89,9 @@ odoc_exception.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx odoc_global.cmo: ../utils/clflags.cmo odoc_global.cmi odoc_global.cmx: ../utils/clflags.cmx odoc_global.cmi odoc_html.cmo: odoc_text.cmi odoc_ocamlhtml.cmo odoc_messages.cmo \ - odoc_info.cmi odoc_dag2html.cmi + odoc_info.cmi odoc_dag2html.cmi odoc_args.cmi odoc_html.cmx: odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \ - odoc_info.cmx odoc_dag2html.cmx + odoc_info.cmx odoc_dag2html.cmx odoc_args.cmx odoc_info.cmo: ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_text.cmi odoc_str.cmi odoc_search.cmi odoc_scan.cmo \ odoc_print.cmi odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ @@ -190,8 +192,8 @@ odoc_text.cmo: odoc_types.cmi odoc_text_parser.cmi odoc_text_lexer.cmo \ odoc_text.cmi odoc_text.cmx: odoc_types.cmx odoc_text_parser.cmx odoc_text_lexer.cmx \ odoc_text.cmi -odoc_text_lexer.cmo: odoc_text_parser.cmi -odoc_text_lexer.cmx: odoc_text_parser.cmx +odoc_text_lexer.cmo: odoc_text_parser.cmi odoc_misc.cmi +odoc_text_lexer.cmx: odoc_text_parser.cmx odoc_misc.cmx odoc_text_parser.cmo: odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi odoc_text_parser.cmx: odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi odoc_to_text.cmo: odoc_messages.cmo odoc_info.cmi diff --git a/ocamldoc/Changes.txt b/ocamldoc/Changes.txt index 2863ce7aa0..5f67b0cf44 100644 --- a/ocamldoc/Changes.txt +++ b/ocamldoc/Changes.txt @@ -2,9 +2,25 @@ TODO: - need to fix display of type parameters for inherited classes/class types - latex: types variant polymorphes dépassent de la page quand ils sont trop longs - utilisation nouvelles infos de Xavier: "début de rec", etc. + - xml generator ===== -Next release: +Release 3.09.1: + - fix: remove .TP for generated man pages, use .sp instead + (.TP caused a lot of odd margins) + - fix: html generator now output DOCTYPE and character encoding information. + - add: m_text_only field in Module.t_module, to separate real modules + from text files handled as modules. + - fix: display only text for "text modules" + - extensible {foo } syntax + - user can give .txt files on the command line, containing ocamldoc formatted + text, to be able to include bigger texts out of source files + - -o option is now used by the html generator to indicate the prefix + of generated index files (to avoid conflict when a Index module exists + on case-insensitive file systems). + +===== +Release 3.08.4: - some improvements in html display - better error messages for misplaced variant constructors comments - some fixes in man page generation (escaping characters) diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 1e68f075bf..1d0aafec2d 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -286,7 +286,7 @@ installopt_really: ########### test: dummy $(MKDIR) $@ - $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/ocamldoc.odoc odoc*.ml odoc*.mli + $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/ocamldoc.odoc test.txt test2.txt odoc*.ml odoc*.mli -v test_stdlib: dummy $(MKDIR) $@ @@ -301,7 +301,7 @@ test_framed: dummy test_latex: dummy $(MKDIR) $@ - $(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) odoc*.ml odoc*.mli ../stdlib/*.mli ../otherlibs/unix/unix.mli + $(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) odoc*.ml odoc*.mli test2.txt ../stdlib/*.mli ../otherlibs/unix/unix.mli test_latex_simple: dummy $(MKDIR) $@ diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml index 07b03d643d..28cdf08a52 100644 --- a/ocamldoc/odoc_analyse.ml +++ b/ocamldoc/odoc_analyse.ml @@ -11,7 +11,8 @@ (* $Id$ *) -(** Analysis of source files. This module is strongly inspired from driver/main.ml :-) *) +(** Analysis of source files. This module is strongly inspired from + driver/main.ml :-) *) let print_DEBUG s = print_string s ; print_newline () @@ -152,7 +153,7 @@ module Sig_analyser = Odoc_sig.Analyser (Odoc_comments.Basic_info_retriever) driver/error.ml file. We do this because there are some differences between the possibly raised exceptions in the bytecode (error.ml) and opt (opterros.ml) compilers - and we don't want to take care of this. Besisdes, this + and we don't want to take care of this. Besises, these differences only concern code generation (i believe).*) let process_error exn = let report ppf = function @@ -196,7 +197,11 @@ let process_error exn = let process_file ppf sourcefile = if !Odoc_args.verbose then ( - let f = match sourcefile with Odoc_args.Impl_file f | Odoc_args.Intf_file f -> f in + let f = match sourcefile with + Odoc_args.Impl_file f + | Odoc_args.Intf_file f -> f + | Odoc_args.Text_file f -> f + in print_string (Odoc_messages.analysing f) ; print_newline (); ); @@ -204,20 +209,20 @@ let process_file ppf sourcefile = Odoc_args.Impl_file file -> ( try - let (parsetree_typedtree_opt, input_file) = process_implementation_file ppf file in - match parsetree_typedtree_opt with + let (parsetree_typedtree_opt, input_file) = process_implementation_file ppf file in + match parsetree_typedtree_opt with None -> None - | Some (parsetree, typedtree) -> + | Some (parsetree, typedtree) -> let file_module = Ast_analyser.analyse_typed_tree file - !Location.input_name parsetree typedtree - in + !Location.input_name parsetree typedtree + in file_module.Odoc_module.m_top_deps <- Odoc_dep.impl_dependencies parsetree ; if !Odoc_args.verbose then ( - print_string Odoc_messages.ok; - print_newline () + print_string Odoc_messages.ok; + print_newline () ); remove_preprocessed input_file; Some file_module @@ -237,8 +242,8 @@ let process_file ppf sourcefile = try let (ast, signat, input_file) = process_interface_file ppf file in let file_module = Sig_analyser.analyse_signature file - !Location.input_name ast signat - in + !Location.input_name ast signat + in file_module.Odoc_module.m_top_deps <- Odoc_dep.intf_dependencies ast ; @@ -260,6 +265,45 @@ let process_file ppf sourcefile = incr Odoc_global.errors ; None ) + | Odoc_args.Text_file file -> + try + let mod_name = + String.capitalize (Filename.basename (Filename.chop_extension file)) + in + let txt = + try Odoc_text.Texter.text_of_string (Odoc_misc.input_file_as_string file) + with Odoc_text.Text_syntax (l, c, s) -> + raise (Failure (Odoc_messages.text_parse_error l c s)) + in + let m = + { + Odoc_module.m_name = mod_name ; + Odoc_module.m_type = Types.Tmty_signature [] ; + Odoc_module.m_info = None ; + Odoc_module.m_is_interface = true ; + Odoc_module.m_file = file ; + Odoc_module.m_kind = Odoc_module.Module_struct + [Odoc_module.Element_module_comment txt] ; + Odoc_module.m_loc = + { Odoc_types.loc_impl = None ; + Odoc_types.loc_inter = Some (file, 0) } ; + Odoc_module.m_top_deps = [] ; + Odoc_module.m_code = None ; + Odoc_module.m_code_intf = None ; + Odoc_module.m_text_only = true ; + } + in + Some m + with + | Sys_error s + | Failure s -> + prerr_endline s; + incr Odoc_global.errors ; + None + | e -> + process_error e ; + incr Odoc_global.errors ; + None (** Remove the class elements between the stop special comments. *) let rec remove_class_elements_between_stop keep eles = @@ -480,6 +524,3 @@ let load_modules file = with Sys_error s -> raise (Failure s) - - -(* eof $Id$ *) diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index 05d9e55c11..91122ed688 100644 --- a/ocamldoc/odoc_args.ml +++ b/ocamldoc/odoc_args.ml @@ -20,6 +20,7 @@ module M = Odoc_messages type source_file = Impl_file of string | Intf_file of string + | Text_file of string let include_dirs = Clflags.include_dirs @@ -214,6 +215,7 @@ let options = ref [ "-pp", Arg.String (fun s -> preprocessor := Some s), M.preprocess ; "-impl", Arg.String (fun s -> files := !files @ [Impl_file s]), M.option_impl ; "-intf", Arg.String (fun s -> files := !files @ [Intf_file s]), M.option_intf ; + "-text", Arg.String (fun s -> files := !files @ [Text_file s]), M.option_text ; "-rectypes", Arg.Set recursive_types, M.rectypes ; "-nolabels", Arg.Unit (fun () -> classic := true), M.nolabels ; "-warn-error", Arg.Set Odoc_global.warn_error, M.werr ; @@ -313,12 +315,15 @@ let parse ~html_generator ~latex_generator ~texi_generator ~man_generator ~dot_g let anonymous f = let sf = if Filename.check_suffix f "ml" then - Impl_file f + Impl_file f else - if Filename.check_suffix f "mli" then - Intf_file f - else - failwith (Odoc_messages.unknown_extension f) + if Filename.check_suffix f "mli" then + Intf_file f + else + if Filename.check_suffix f "txt" then + Text_file f + else + failwith (Odoc_messages.unknown_extension f) in files := !files @ [sf] in diff --git a/ocamldoc/odoc_args.mli b/ocamldoc/odoc_args.mli index e7f2dda8b1..242f55659a 100644 --- a/ocamldoc/odoc_args.mli +++ b/ocamldoc/odoc_args.mli @@ -17,6 +17,7 @@ type source_file = Impl_file of string | Intf_file of string + | Text_file of string (** The include_dirs in the OCaml compiler. *) val include_dirs : string list ref diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 6ceb74ebac..f566cdd9c9 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -1424,6 +1424,7 @@ module Analyser = m_top_deps = [] ; m_code = None ; (* code is set by the caller, after the module is created *) m_code_intf = m_code_intf ; + m_text_only = false ; } in match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with @@ -1605,6 +1606,7 @@ module Analyser = m_top_deps = [] ; m_code = (if !Odoc_args.keep_code then Some !file else None) ; m_code_intf = None ; + m_text_only = false ; } end diff --git a/ocamldoc/odoc_comments.ml b/ocamldoc/odoc_comments.ml index 765207ddc8..54650acb51 100644 --- a/ocamldoc/odoc_comments.ml +++ b/ocamldoc/odoc_comments.ml @@ -20,7 +20,7 @@ let print_DEBUG s = print_string s ; print_newline ();; (** This variable contains the regular expression representing a blank but not a '\n'.*) let simple_blank = "[ \013\009\012]" -module type Texter = +module type Texter = sig (** Return a text structure from a string. *) val text_of_string : string -> text @@ -50,7 +50,7 @@ module Info_retriever = (0, None) | Some (desc, remain_opt) -> let mem_nb_chars = !Odoc_comments_global.nb_chars in - let _ = + let _ = match remain_opt with None -> () @@ -59,7 +59,7 @@ module Info_retriever = let lexbuf2 = Lexing.from_string s in Odoc_parser.info_part2 Odoc_lexer.elements lexbuf2 in - (mem_nb_chars, + (mem_nb_chars, Some { i_desc = (match desc with "" -> None | _ -> Some (MyTexter.text_of_string desc)); @@ -67,22 +67,22 @@ module Info_retriever = i_version = !Odoc_comments_global.version; i_sees = (List.map create_see !Odoc_comments_global.sees) ; i_since = !Odoc_comments_global.since; - i_deprecated = - (match !Odoc_comments_global.deprecated with + i_deprecated = + (match !Odoc_comments_global.deprecated with None -> None | Some s -> Some (MyTexter.text_of_string s)); - i_params = - (List.map (fun (n, s) -> + i_params = + (List.map (fun (n, s) -> (n, MyTexter.text_of_string s)) !Odoc_comments_global.params); - i_raised_exceptions = + i_raised_exceptions = (List.map (fun (n, s) -> (n, MyTexter.text_of_string s)) !Odoc_comments_global.raised_exceptions); i_return_value = - (match !Odoc_comments_global.return_value with + (match !Odoc_comments_global.return_value with None -> None | Some s -> Some (MyTexter.text_of_string s)) ; i_custom = (List.map - (fun (tag, s) -> (tag, MyTexter.text_of_string s)) + (fun (tag, s) -> (tag, MyTexter.text_of_string s)) !Odoc_comments_global.customs) - } + } ) with Failure s -> @@ -133,7 +133,7 @@ module Info_retriever = with Not_found -> false - + let retrieve_info_special file (s : string) = retrieve_info Odoc_lexer.main file s @@ -188,7 +188,7 @@ module Info_retriever = let retrieve_last_info_simple file (s : string) = print_DEBUG ("retrieve_last_info_simple:"^s); let rec f cur_len cur_d = - try + try let s2 = String.sub s cur_len ((String.length s) - cur_len) in print_DEBUG ("retrieve_last_info_simple.f:"^s2); match retrieve_info_simple file s2 with @@ -208,7 +208,7 @@ module Info_retriever = let retrieve_last_special_no_blank_after file (s : string) = print_DEBUG ("retrieve_last_special_no_blank_after:"^s); let rec f cur_len cur_d = - try + try let s2 = String.sub s cur_len ((String.length s) - cur_len) in print_DEBUG ("retrieve_last_special_no_blank_after.f:"^s2); match retrieve_info_special file s2 with @@ -257,7 +257,7 @@ module Info_retriever = (* if the special comment is the stop comment (**/**), then we must not associate it. *) let pos = Str.search_forward (Str.regexp_string "(**") s 0 in - if blank_line (String.sub s 0 pos) or + if blank_line (String.sub s 0 pos) or d.Odoc_types.i_desc = Some [Odoc_types.Raw "/*"] then (0, None) @@ -282,7 +282,7 @@ module Info_retriever = (* get the comments *) let (len, special_coms) = all_special file s in (* if there is no blank line after the special comments, and - if the last special comment is not the stop special comment, then the + if the last special comment is not the stop special comment, then the last special comments must be associated to the element. *) match List.rev special_coms with [] -> @@ -312,4 +312,33 @@ module Info_retriever = module Basic_info_retriever = Info_retriever (Odoc_text.Texter) +let info_of_string s = + let dummy = + { + i_desc = None ; + i_authors = [] ; + i_version = None ; + i_sees = [] ; + i_since = None ; + i_deprecated = None ; + i_params = [] ; + i_raised_exceptions = [] ; + i_return_value = None ; + i_custom = [] ; + } + in + let s2 = Printf.sprintf "(** %s *)" s in + let (_, i_opt) = Basic_info_retriever.first_special "-" s2 in + match i_opt with + None -> dummy + | Some i -> i + +let info_of_comment_file f = + try + let s = Odoc_misc.input_file_as_string f in + info_of_string s + with + Sys_error s -> + failwith s + (* eof $Id$ *) diff --git a/ocamldoc/odoc_comments.mli b/ocamldoc/odoc_comments.mli index 0579926a90..b78369d182 100644 --- a/ocamldoc/odoc_comments.mli +++ b/ocamldoc/odoc_comments.mli @@ -16,7 +16,7 @@ val simple_blank : string (** The type of modules in argument to Info_retriever *) -module type Texter = +module type Texter = sig (** Return a text structure from a string. *) val text_of_string : string -> Odoc_types.text @@ -33,21 +33,21 @@ module Basic_info_retriever : val all_special : string -> string -> int * Odoc_types.info list (** [just_after_special file str] return the pair ([length], [info_opt]) - where [info_opt] is the first optional special comment found + where [info_opt] is the first optional special comment found in [str], without any blank line before. [length] is the number of chars from the beginning of [str] to the end of the special comment. *) val just_after_special : string -> string -> int * Odoc_types.info option (** [first_special file str] return the pair ([length], [info_opt]) - where [info_opt] is the first optional special comment found + where [info_opt] is the first optional special comment found in [str]. [length] is the number of chars from the beginning of [str] to the end of the special comment. *) val first_special : string -> string -> int * Odoc_types.info option (** Return a pair [(comment_opt, element_comment_list)], where [comment_opt] is the last special - comment found in the given string and not followed by a blank line, + comment found in the given string and not followed by a blank line, and [element_comment_list] the list of values built from the other special comments found and the given function. *) val get_comments : @@ -55,3 +55,18 @@ module Basic_info_retriever : string -> string -> Odoc_types.info option * 'a list end + +(** [info_of_string s] parses the given string + like a regular ocamldoc comment and return an + {!Odoc_types.info} structure. + @return an empty structure if there was a syntax error. TODO: change this +*) +val info_of_string : string -> Odoc_types.info + +(** [info_of_comment_file file] parses the given file + and return an {!Odoc_types.info} structure. The content of the + file must have the same syntax as the content of a special comment. + @raise Failure is the file could not be opened or there is a + syntax error. +*) +val info_of_comment_file : string -> Odoc_types.info diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index cbe949edee..f589858fa3 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -20,13 +20,13 @@ open Odoc_exception open Odoc_types open Odoc_value open Odoc_type -open Odoc_parameter +open Odoc_parameter -(*** Replacements of aliases : if e1 = e2 and e2 = e3, then replace e2 by e3 to have e1 = e3, +(*** Replacements of aliases : if e1 = e2 and e2 = e3, then replace e2 by e3 to have e1 = e3, in order to associate the element with complete information. *) (** The module used to keep what refs were modified. *) -module S = Set.Make +module S = Set.Make ( struct type t = string * ref_kind option let compare = Pervasives.compare @@ -43,7 +43,7 @@ module P_alias = struct type t = int - let p_module m _ = + let p_module m _ = (true, match m.m_kind with Module_alias _ -> true @@ -86,7 +86,7 @@ let rec build_alias_list = function | (Odoc_search.Res_module m) :: q -> ( match m.m_kind with - Module_alias ma -> + Module_alias ma -> Hashtbl.add module_aliases m.m_name (ma.ma_name, Alias_to_resolve); Hashtbl.add module_and_modtype_aliases m.m_name (ma.ma_name, Alias_to_resolve) | _ -> () @@ -95,8 +95,8 @@ let rec build_alias_list = function | (Odoc_search.Res_module_type mt) :: q -> ( match mt.mt_kind with - Some (Module_type_alias mta) -> - Hashtbl.add module_and_modtype_aliases + Some (Module_type_alias mta) -> + Hashtbl.add module_and_modtype_aliases mt.mt_name (mta.mta_name, Alias_to_resolve) | _ -> () ); @@ -105,22 +105,22 @@ let rec build_alias_list = function ( match e.ex_alias with None -> () - | Some ea -> - Hashtbl.add exception_aliases + | Some ea -> + Hashtbl.add exception_aliases e.ex_name (ea.ea_name,Alias_to_resolve) ); build_alias_list q | _ :: q -> build_alias_list q -(** Retrieve the aliases for modules, module types and exceptions +(** Retrieve the aliases for modules, module types and exceptions and put them in global hash tables. *) let get_alias_names module_list = Hashtbl.clear module_aliases; Hashtbl.clear module_and_modtype_aliases; Hashtbl.clear exception_aliases; build_alias_list (Search_alias.search module_list 0) - + exception Found of string let name_alias = let rec f t name = @@ -153,14 +153,14 @@ let name_alias = module Map_ord = struct - type t = string + type t = string let compare = Pervasives.compare end module Ele_map = Map.Make (Map_ord) let known_elements = ref Ele_map.empty -let add_known_element name k = +let add_known_element name k = try let l = Ele_map.find name !known_elements in let s = Ele_map.remove name !known_elements in @@ -174,7 +174,7 @@ let get_known_elements name = with Not_found -> [] let kind_name_exists kind = - let pred = + let pred = match kind with RK_module -> (fun e -> match e with Odoc_search.Res_module _ -> true | _ -> false) | RK_module_type -> (fun e -> match e with Odoc_search.Res_module_type _ -> true | _ -> false) @@ -203,7 +203,7 @@ let method_exists = kind_name_exists RK_method let lookup_module name = match List.find - (fun k -> match k with Odoc_search.Res_module _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_module _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_module m -> m @@ -211,7 +211,7 @@ let lookup_module name = let lookup_module_type name = match List.find - (fun k -> match k with Odoc_search.Res_module_type _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_module_type _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_module_type m -> m @@ -219,7 +219,7 @@ let lookup_module_type name = let lookup_class name = match List.find - (fun k -> match k with Odoc_search.Res_class _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_class _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_class c -> c @@ -227,7 +227,7 @@ let lookup_class name = let lookup_class_type name = match List.find - (fun k -> match k with Odoc_search.Res_class_type _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_class_type _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_class_type c -> c @@ -235,7 +235,7 @@ let lookup_class_type name = let lookup_exception name = match List.find - (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false) + (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false) (get_known_elements name) with | Odoc_search.Res_exception e -> e @@ -244,9 +244,9 @@ let lookup_exception name = class scan = object inherit Odoc_scan.scanner - method scan_value v = + method scan_value v = add_known_element v.val_name (Odoc_search.Res_value v) - method scan_type t = + method scan_type t = add_known_element t.ty_name (Odoc_search.Res_type t) method scan_exception e = add_known_element e.ex_name (Odoc_search.Res_exception e) @@ -277,7 +277,7 @@ let init_known_elements_map module_list = (** The type to describe the names not found. *) -type not_found_name = +type not_found_name = NF_m of Name.t | NF_mt of Name.t | NF_mmt of Name.t @@ -296,7 +296,7 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ (associate_in_module_element module_list m.m_name) (acc_b, acc_inc, acc_names) elements - + | Module_alias ma -> ( match ma.ma_module with @@ -310,16 +310,16 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ with Not_found -> None in match mmt_opt with - None -> (acc_b, (Name.head m.m_name) :: acc_inc, - (* we don't want to output warning messages for + None -> (acc_b, (Name.head m.m_name) :: acc_inc, + (* we don't want to output warning messages for "sig ... end" or "struct ... end" modules not found *) - (if ma.ma_name = Odoc_messages.struct_end or + (if ma.ma_name = Odoc_messages.struct_end or ma.ma_name = Odoc_messages.sig_end then acc_names else (NF_mmt ma.ma_name) :: acc_names) ) - | Some mmt -> + | Some mmt -> ma.ma_module <- Some mmt ; (true, acc_inc, acc_names) ) @@ -332,7 +332,7 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ { mt_name = "" ; mt_info = None ; mt_type = None ; mt_is_interface = false ; mt_file = ""; mt_kind = Some tk ; mt_loc = Odoc_types.dummy_loc } - + | Module_apply (k1, k2) -> let (acc_b2, acc_inc2, acc_names2) = iter_kind (acc_b, acc_inc, acc_names) k1 in iter_kind (acc_b2, acc_inc2, acc_names2) k2 @@ -345,7 +345,7 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ mt_loc = Odoc_types.dummy_loc } in iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m.m_kind - + and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) mt = let rec iter_kind (acc_b, acc_inc, acc_names) k = match k with @@ -371,28 +371,28 @@ and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module with Not_found -> None in match mt_opt with - None -> (acc_b, (Name.head mt.mt_name) :: acc_inc, - (* we don't want to output warning messages for + None -> (acc_b, (Name.head mt.mt_name) :: acc_inc, + (* we don't want to output warning messages for "sig ... end" or "struct ... end" modules not found *) - (if mta.mta_name = Odoc_messages.struct_end or + (if mta.mta_name = Odoc_messages.struct_end or mta.mta_name = Odoc_messages.sig_end then - acc_names - else + acc_names + else (NF_mt mta.mta_name) :: acc_names) ) - | Some mt -> + | Some mt -> mta.mta_module <- Some mt ; (true, acc_inc, acc_names) in match mt.mt_kind with None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) | Some k -> iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) k - + and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) element = match element with Element_module m -> associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) m | Element_module_type mt -> associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) mt - | Element_included_module im -> + | Element_included_module im -> ( match im.im_module with Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) @@ -404,16 +404,16 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ with Not_found -> None in match mmt_opt with - None -> (acc_b_modif, (Name.head m_name) :: acc_incomplete_top_module_names, - (* we don't want to output warning messages for + None -> (acc_b_modif, (Name.head m_name) :: acc_incomplete_top_module_names, + (* we don't want to output warning messages for "sig ... end" or "struct ... end" modules not found *) - (if im.im_name = Odoc_messages.struct_end or + (if im.im_name = Odoc_messages.struct_end or im.im_name = Odoc_messages.sig_end then acc_names_not_found else (NF_mmt im.im_name) :: acc_names_not_found) ) - | Some mmt -> + | Some mmt -> im.im_module <- Some mmt ; (true, acc_incomplete_top_module_names, acc_names_not_found) ) @@ -426,9 +426,9 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) | Some ea -> match ea.ea_ex with - Some _ -> + Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) - | None -> + | None -> let ex_opt = try Some (lookup_exception ea.ea_name) with Not_found -> None @@ -443,7 +443,7 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ | Element_module_comment _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) c = - let rec iter_kind (acc_b, acc_inc, acc_names) k = + let rec iter_kind (acc_b, acc_inc, acc_names) k = match k with Class_structure (inher_l, _) -> let f (acc_b2, acc_inc2, acc_names2) ic = @@ -460,7 +460,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names None -> (acc_b2, (Name.head c.cl_name) :: acc_inc2, (* we don't want to output warning messages for "object ... end" classes not found *) (if ic.ic_name = Odoc_messages.object_end then acc_names2 else (NF_cct ic.ic_name) :: acc_names2)) - | Some cct -> + | Some cct -> ic.ic_class <- Some cct ; (true, acc_inc2, acc_names2) in @@ -470,13 +470,13 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names ( match capp.capp_class with Some _ -> (acc_b, acc_inc, acc_names) - | None -> + | None -> let cl_opt = try Some (lookup_class capp.capp_name) with Not_found -> None in match cl_opt with - None -> (acc_b, (Name.head c.cl_name) :: acc_inc, + None -> (acc_b, (Name.head c.cl_name) :: acc_inc, (* we don't want to output warning messages for "object ... end" classes not found *) (if capp.capp_name = Odoc_messages.object_end then acc_names else (NF_c capp.capp_name) :: acc_names)) | Some c -> @@ -488,13 +488,13 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names ( match cco.cco_class with Some _ -> (acc_b, acc_inc, acc_names) - | None -> + | None -> let cl_opt = try Some (lookup_class cco.cco_name) with Not_found -> None in match cl_opt with - None -> + None -> ( let clt_opt = try Some (lookup_class_type cco.cco_name) @@ -502,7 +502,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names in match clt_opt with None -> - (acc_b, (Name.head c.cl_name) :: acc_inc, + (acc_b, (Name.head c.cl_name) :: acc_inc, (* we don't want to output warning messages for "object ... end" classes not found *) (if cco.cco_name = Odoc_messages.object_end then acc_names else (NF_cct cco.cco_name) :: acc_names)) | Some ct -> @@ -526,7 +526,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) c.cl_kind and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct = - let rec iter_kind (acc_b, acc_inc, acc_names) k = + let rec iter_kind (acc_b, acc_inc, acc_names) k = match k with Class_signature (inher_l, _) -> let f (acc_b2, acc_inc2, acc_names2) ic = @@ -540,10 +540,10 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ with Not_found -> None in match cct_opt with - None -> (acc_b2, (Name.head ct.clt_name) :: acc_inc2, + None -> (acc_b2, (Name.head ct.clt_name) :: acc_inc2, (* we don't want to output warning messages for "object ... end" class types not found *) (if ic.ic_name = Odoc_messages.object_end then acc_names2 else (NF_cct ic.ic_name) :: acc_names2)) - | Some cct -> + | Some cct -> ic.ic_class <- Some cct ; (true, acc_inc2, acc_names2) in @@ -553,15 +553,15 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ ( match cta.cta_class with Some _ -> (acc_b, acc_inc, acc_names) - | None -> + | None -> let cct_opt = try Some (Cltype (lookup_class_type cta.cta_name, [])) - with Not_found -> + with Not_found -> try Some (Cl (lookup_class cta.cta_name)) with Not_found -> None in match cct_opt with - None -> (acc_b, (Name.head ct.clt_name) :: acc_inc, + None -> (acc_b, (Name.head ct.clt_name) :: acc_inc, (* we don't want to output warning messages for "object ... end" class types not found *) (if cta.cta_name = Odoc_messages.object_end then acc_names else (NF_cct cta.cta_name) :: acc_names)) | Some c -> @@ -574,7 +574,7 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ (*************************************************************) (** Association of types to elements referenced in comments .*) -let ao = Odoc_misc.apply_opt +let ao = Odoc_misc.apply_opt let rec assoc_comments_text_elements module_list t_ele = match t_ele with @@ -615,7 +615,7 @@ let rec assoc_comments_text_elements module_list t_ele = ) | ele :: _ -> (* we look for the first element with this name *) - let kind = + let kind = match ele with Odoc_search.Res_module _ -> RK_module | Odoc_search.Res_module_type _ -> RK_module_type @@ -631,7 +631,7 @@ let rec assoc_comments_text_elements module_list t_ele = add_verified (name, Some kind) ; Ref (name, Some kind) ) - | Ref (name, Some kind) -> + | Ref (name, Some kind) -> ( let v = (name, Some kind) in if was_verified v then @@ -653,7 +653,7 @@ let rec assoc_comments_text_elements module_list t_ele = Ref (name, None) ) | _ -> - let (f,f_mes) = + let (f,f_mes) = match kind with RK_module -> module_exists, Odoc_messages.cross_module_not_found | RK_module_type -> module_type_exists, Odoc_messages.cross_module_type_not_found @@ -677,10 +677,11 @@ let rec assoc_comments_text_elements module_list t_ele = Ref (name, None) ) ) - | Module_list l -> + | Module_list l -> Module_list l | Index_list -> Index_list + | Custom (s,t) -> Custom (s, (assoc_comments_text module_list t)) and assoc_comments_text module_list text = List.map (assoc_comments_text_elements module_list) text @@ -696,8 +697,8 @@ and assoc_comments_info module_list i = i_raised_exceptions = List.map (fun (name, t) -> (name, ft t)) i.i_raised_exceptions; i_return_value = ao ft i.i_return_value ; i_custom = List.map (fun (tag, t) -> (tag, ft t)) i.i_custom ; - } - + } + let rec assoc_comments_module_element module_list m_ele = match m_ele with @@ -719,17 +720,17 @@ and assoc_comments_class_element module_list c_ele = and assoc_comments_module_kind module_list mk = match mk with - | Module_struct eles -> + | Module_struct eles -> Module_struct (List.map (assoc_comments_module_element module_list) eles) - | Module_alias _ - | Module_functor _ -> + | Module_alias _ + | Module_functor _ -> mk - | Module_apply (mk1, mk2) -> + | Module_apply (mk1, mk2) -> Module_apply (assoc_comments_module_kind module_list mk1, assoc_comments_module_kind module_list mk2) - | Module_with (mtk, s) -> + | Module_with (mtk, s) -> Module_with (assoc_comments_module_type_kind module_list mtk, s) - | Module_constraint (mk1, mtk) -> + | Module_constraint (mk1, mtk) -> Module_constraint (assoc_comments_module_kind module_list mk1, assoc_comments_module_type_kind module_list mtk) @@ -737,7 +738,7 @@ and assoc_comments_module_type_kind module_list mtk = match mtk with | Module_type_struct eles -> Module_type_struct (List.map (assoc_comments_module_element module_list) eles) - | Module_type_functor (params, mtk1) -> + | Module_type_functor (params, mtk1) -> Module_type_functor (params, assoc_comments_module_type_kind module_list mtk1) | Module_type_alias _ -> mtk @@ -747,9 +748,9 @@ and assoc_comments_module_type_kind module_list mtk = and assoc_comments_class_kind module_list ck = match ck with Class_structure (inher, eles) -> - let inher2 = - List.map - (fun ic -> { ic with + let inher2 = + List.map + (fun ic -> { ic with ic_text = ao (assoc_comments_text module_list) ic.ic_text }) inher in @@ -764,9 +765,9 @@ and assoc_comments_class_kind module_list ck = and assoc_comments_class_type_kind module_list ctk = match ctk with Class_signature (inher, eles) -> - let inher2 = - List.map - (fun ic -> { ic with + let inher2 = + List.map + (fun ic -> { ic with ic_text = ao (assoc_comments_text module_list) ic.ic_text }) inher in @@ -785,7 +786,7 @@ and assoc_comments_module_type module_list mt = mt.mt_kind <- ao (assoc_comments_module_type_kind module_list) mt.mt_kind ; mt -and assoc_comments_class module_list c = +and assoc_comments_class module_list c = c.cl_info <- ao (assoc_comments_info module_list) c.cl_info ; c.cl_kind <- assoc_comments_class_kind module_list c.cl_kind ; assoc_comments_parameter_list module_list c.cl_parameters; @@ -798,7 +799,7 @@ and assoc_comments_class_type module_list ct = and assoc_comments_parameter module_list p = match p with - Simple_name sn -> + Simple_name sn -> sn.sn_text <- ao (assoc_comments_text module_list) sn.sn_text | Tuple (l, t) -> List.iter (assoc_comments_parameter module_list) l @@ -820,11 +821,11 @@ and assoc_comments_type module_list t = (match t.ty_kind with Type_abstract -> () | Type_variant (vl, _) -> - List.iter + List.iter (fun vc -> vc.vc_text <- ao (assoc_comments_text module_list) vc.vc_text) - vl + vl | Type_record (fl, _) -> - List.iter + List.iter (fun rf -> rf.rf_text <- ao (assoc_comments_text module_list) rf.rf_text) fl ); @@ -856,7 +857,7 @@ let associate module_list = else remove_doubles (h :: acc) q in let rec iter incomplete_modules = - let (b_modif, remaining_inc_modules, acc_names_not_found) = + let (b_modif, remaining_inc_modules, acc_names_not_found) = List.fold_left (associate_in_module module_list) (false, [], []) incomplete_modules in let remaining_no_doubles = remove_doubles [] remaining_inc_modules in @@ -877,7 +878,7 @@ let associate module_list = [] -> () | l -> - List.iter + List.iter (fun nf -> Odoc_messages.pwarning ( @@ -896,6 +897,6 @@ let associate module_list = (* Find a type for each name of element which is referenced in comments. *) ignore (associate_type_of_elements_in_comments module_list) - + (* eof $Id$ *) diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index 3aa73c4a5c..1046958131 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -11,7 +11,7 @@ (* $Id$ *) -(** Generation of html documentation. *) +(** Generation of html documentation.*) let print_DEBUG s = print_string s ; print_newline () @@ -93,8 +93,8 @@ module Naming = let ch c = Buffer.add_char buf c in let st s = Buffer.add_string buf s in for i = 0 to len - 1 do - match name.[i] with - | '|' -> st "_pipe_" + match name.[i] with + | '|' -> st "_pipe_" | '<' -> st "_lt_" | '>' -> st "_gt_" | '@' -> st "_at_" @@ -110,7 +110,7 @@ module Naming = | ':' -> st "_column_" | '~' -> st "_tilde_" | '!' -> st "_bang_" - | c -> ch c + | c -> ch c done; Buffer.contents buf @@ -246,8 +246,11 @@ class virtual text = | Odoc_info.Ref (name, ref_opt) -> self#html_of_Ref b name ref_opt | Odoc_info.Superscript t -> self#html_of_Superscript b t | Odoc_info.Subscript t -> self#html_of_Subscript b t - | Odoc_info.Module_list l -> self#html_of_Module_list b l - | Odoc_info.Index_list -> self#html_of_Index_list b + | Odoc_info.Module_list l -> self#html_of_Module_list b l + | Odoc_info.Index_list -> self#html_of_Index_list b + | Odoc_info.Custom (s,t) -> self#html_of_custom_text b s t + + method html_of_custom_text b s t = () method html_of_Raw b s = bs b (self#escape s) @@ -255,55 +258,55 @@ class virtual text = if !Args.colorize_code then self#html_of_code b ~with_pre: false s else - ( - bs b "<code class=\""; - bs b Odoc_ocamlhtml.code_class ; - bs b "\">"; - bs b (self#escape s); - bs b "</code>" - ) + ( + bs b "<code class=\""; + bs b Odoc_ocamlhtml.code_class ; + bs b "\">"; + bs b (self#escape s); + bs b "</code>" + ) method html_of_CodePre = - let remove_useless_newlines s = - let len = String.length s in - let rec iter_first n = - if n >= len then - None - else - match s.[n] with - | '\n' -> iter_first (n+1) - | _ -> Some n - in - match iter_first 0 with - None -> "" - | Some first -> - let rec iter_last n = - if n <= first then - None - else - match s.[n] with - '\t' -> iter_last (n-1) - | _ -> Some n - in - match iter_last (len-1) with - None -> String.sub s first 1 - | Some last -> String.sub s first ((last-first)+1) - in - fun b s -> + let remove_useless_newlines s = + let len = String.length s in + let rec iter_first n = + if n >= len then + None + else + match s.[n] with + | '\n' -> iter_first (n+1) + | _ -> Some n + in + match iter_first 0 with + None -> "" + | Some first -> + let rec iter_last n = + if n <= first then + None + else + match s.[n] with + '\t' -> iter_last (n-1) + | _ -> Some n + in + match iter_last (len-1) with + None -> String.sub s first 1 + | Some last -> String.sub s first ((last-first)+1) + in + fun b s -> if !Args.colorize_code then - ( + ( bs b "<pre></pre>"; - self#html_of_code b (remove_useless_newlines s); - bs b "<pre></pre>" - ) + self#html_of_code b (remove_useless_newlines s); + bs b "<pre></pre>" + ) else ( - bs b "<pre><code class=\""; - bs b Odoc_ocamlhtml.code_class; - bs b "\">" ; - bs b (self#escape (remove_useless_newlines s)); - bs b "</code></pre>" - ) + bs b "<pre><code class=\""; + bs b Odoc_ocamlhtml.code_class; + bs b "\">" ; + bs b (self#escape (remove_useless_newlines s)); + bs b "</code></pre>" + ) method html_of_Verbatim b s = bs b "<pre>"; @@ -343,15 +346,15 @@ class virtual text = method html_of_List b tl = bs b "<ul>\n"; List.iter - (fun t -> bs b "<li>"; self#html_of_text b t; bs b "</li>\n") - tl; + (fun t -> bs b "<li>"; self#html_of_text b t; bs b "</li>\n") + tl; bs b "</ul>\n" method html_of_Enum b tl = bs b "<OL>\n"; List.iter - (fun t -> bs b "<li>"; self#html_of_text b t; bs b"</li>\n") - tl; + (fun t -> bs b "<li>"; self#html_of_text b t; bs b"</li>\n") + tl; bs b "</OL>\n" method html_of_Newline b = bs b "\n<p>\n" @@ -367,10 +370,10 @@ class virtual text = bs b (Naming.label_target label1); bs b "\"></a>\n"; let (tag_o, tag_c) = - if n > 6 then - (Printf.sprintf "div class=\"h%d\"" n, "div") - else - let t = Printf.sprintf "h%d" n in (t, t) + if n > 6 then + (Printf.sprintf "div class=\"h%d\"" n, "div") + else + let t = Printf.sprintf "h%d" n in (t, t) in bs b "<"; bs b tag_o; @@ -395,7 +398,7 @@ class virtual text = None -> self#html_of_text_element b (Odoc_info.Code name) | Some kind -> - let h name = Odoc_info.Code (Odoc_info.use_hidden_modules name) in + let h name = Odoc_info.Code (Odoc_info.use_hidden_modules name) in let (target, text) = match kind with Odoc_info.RK_module @@ -410,11 +413,11 @@ class virtual text = | Odoc_info.RK_attribute -> (Naming.complete_target Naming.mark_attribute name, h name) | Odoc_info.RK_method -> (Naming.complete_target Naming.mark_method name, h name) | Odoc_info.RK_section t -> (Naming.complete_label_target name, - Odoc_info.Italic [Raw (Odoc_info.string_of_text t)]) + Odoc_info.Italic [Raw (Odoc_info.string_of_text t)]) in bs b ("<a href=\""^target^"\">"); self#html_of_text_element b text; - bs b "</a>" + bs b "</a>" method html_of_Superscript b t = bs b "<sup class=\"superscript\">"; @@ -432,25 +435,25 @@ class virtual text = bs b "<br>\n<table class=\"indextable\">\n"; List.iter (fun name -> - bs b "<tr><td>"; - ( - try - let m = - List.find (fun m -> m.m_name = name) self#list_modules - in - let (html, _) = Naming.html_files m.m_name in - bp b "<a href=\"%s\">%s</a></td>" html m.m_name; - bs b "<td>"; - self#html_of_info_first_sentence b m.m_info; - with - Not_found -> - Odoc_messages.pwarning (Odoc_messages.cross_module_not_found name); - bp b "%s</td><td>" name - ); - bs b "</td></tr>\n" - ) + bs b "<tr><td>"; + ( + try + let m = + List.find (fun m -> m.m_name = name) self#list_modules + in + let (html, _) = Naming.html_files m.m_name in + bp b "<a href=\"%s\">%s</a></td>" html m.m_name; + bs b "<td>"; + self#html_of_info_first_sentence b m.m_info; + with + Not_found -> + Odoc_messages.pwarning (Odoc_messages.cross_module_not_found name); + bp b "%s</td><td>" name + ); + bs b "</td></tr>\n" + ) l; - bs b "</table>\n</body>\n</html>"; + bs b "</table>\n" method html_of_Index_list b = let index_if_not_empty l url m = @@ -506,7 +509,7 @@ class virtual info = [] -> () | _ -> bp b "<b>%s:</b> %s<br>\n" - Odoc_messages.authors + Odoc_messages.authors (String.concat ", " l) (** Print html code for the given optional version information.*) @@ -514,33 +517,33 @@ class virtual info = match v_opt with None -> () | Some v -> - bp b "<b>%s:</b> %s<br>\n" Odoc_messages.version v + bp b "<b>%s:</b> %s<br>\n" Odoc_messages.version v (** Print html code for the given optional since information.*) method html_of_since_opt b s_opt = match s_opt with None -> () | Some s -> - bp b "<b>%s</b> %s<br>\n" Odoc_messages.since s + bp b "<b>%s</b> %s<br>\n" Odoc_messages.since s (** Print html code for the given list of raised exceptions.*) method html_of_raised_exceptions b l = match l with [] -> () | (s, t) :: [] -> - bp b "<b>%s</b> <code>%s</code> " - Odoc_messages.raises - s; - self#html_of_text b t; - bs b "<br>\n" + bp b "<b>%s</b> <code>%s</code> " + Odoc_messages.raises + s; + self#html_of_text b t; + bs b "<br>\n" | _ -> bp b "<b>%s</b><ul>" Odoc_messages.raises; - List.iter + List.iter (fun (ex, desc) -> - bp b "<li><code>%s</code> " ex ; - self#html_of_text b desc; - bs b "</li>\n" - ) + bp b "<li><code>%s</code> " ex ; + self#html_of_text b desc; + bs b "</li>\n" + ) l; bs b "</ul>\n" @@ -559,17 +562,17 @@ class virtual info = match l with [] -> () | see :: [] -> - bp b "<b>%s</b> " Odoc_messages.see_also; - self#html_of_see b see; - bs b "<br>\n" + bp b "<b>%s</b> " Odoc_messages.see_also; + self#html_of_see b see; + bs b "<br>\n" | _ -> bp b "<b>%s</b><ul>" Odoc_messages.see_also; List.iter (fun see -> - bs b "<li>" ; - self#html_of_see b see; - bs b "</li>\n" - ) + bs b "<li>" ; + self#html_of_see b see; + bs b "</li>\n" + ) l; bs b "</ul>\n" @@ -578,9 +581,9 @@ class virtual info = match return_opt with None -> () | Some s -> - bp b "<b>%s</b> " Odoc_messages.returns; - self#html_of_text b s; - bs b "<br>\n" + bp b "<b>%s</b> " Odoc_messages.returns; + self#html_of_text b s; + bs b "<br>\n" (** Print html code for the given list of custom tagged texts. *) method html_of_custom b l = @@ -607,17 +610,17 @@ class virtual info = let module M = Odoc_info in if indent then bs b "<div class=\"info\">\n"; ( - match info.M.i_deprecated with + match info.M.i_deprecated with None -> () | Some d -> bs b "<span class=\"warning\">"; - bs b Odoc_messages.deprecated ; - bs b "</span>" ; - self#html_of_text b d; + bs b Odoc_messages.deprecated ; + bs b "</span>" ; + self#html_of_text b d; bs b "<br>\n" ); ( - match info.M.i_desc with + match info.M.i_desc with None -> () | Some d when d = [Odoc_info.Raw ""] -> () | Some d -> self#html_of_text b d; bs b "<br>\n" @@ -642,14 +645,14 @@ class virtual info = bs b "<div class=\"info\">\n"; if dep then bs b "<font color=\"#CCCCCC\">"; ( - match info.M.i_desc with + match info.M.i_desc with None -> () | Some d when d = [Odoc_info.Raw ""] -> () | Some d -> - self#html_of_text b + self#html_of_text b (Odoc_info.text_no_title_no_list (Odoc_info.first_sentence_of_text d)); - bs b "\n" + bs b "\n" ); if dep then bs b "</font>"; bs b "</div>\n" @@ -665,9 +668,9 @@ let print_concat b sep f = [] -> () | [c] -> f c | c :: q -> - f c; - bs b sep; - iter q + f c; + bs b sep; + iter q in iter @@ -687,6 +690,11 @@ class html = inherit text inherit info + val mutable doctype = + "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n" + val mutable character_encoding = + "<meta content=\"text/html; charset=iso-8859-1\" http-equiv=\"Content-Type\">\n" + (** The default style options. *) val mutable default_style_options = ["a:visited {color : #416DFF; text-decoration : none; }" ; @@ -707,55 +715,55 @@ class html = ".code { color : #465F91 ; }" ; "h1 { font-size : 20pt ; text-align: center; }" ; - "h2 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90BDFF ;"^ - "padding: 2px; }" ; - - "h3 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90DDFF ;"^ - "padding: 2px; }" ; - - "h4 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90EDFF ;"^ - "padding: 2px; }" ; - - "h5 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #90FDFF ;"^ - "padding: 2px; }" ; - - "h6 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #C0FFFF ; "^ - "padding: 2px; }" ; - - "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #E0FFFF ; "^ - "padding: 2px; }" ; - - "div.h8 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #F0FFFF ; "^ - "padding: 2px; }" ; - - "div.h9 { font-size : 20pt ; border: 1px solid #000000; "^ - "margin-top: 5px; margin-bottom: 2px;"^ - "text-align: center; background-color: #FFFFFF ; "^ - "padding: 2px; }" ; - - ".typetable { border-style : hidden }" ; - ".indextable { border-style : hidden }" ; - ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ; + "h2 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90BDFF ;"^ + "padding: 2px; }" ; + + "h3 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90DDFF ;"^ + "padding: 2px; }" ; + + "h4 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90EDFF ;"^ + "padding: 2px; }" ; + + "h5 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #90FDFF ;"^ + "padding: 2px; }" ; + + "h6 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #C0FFFF ; "^ + "padding: 2px; }" ; + + "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #E0FFFF ; "^ + "padding: 2px; }" ; + + "div.h8 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #F0FFFF ; "^ + "padding: 2px; }" ; + + "div.h9 { font-size : 20pt ; border: 1px solid #000000; "^ + "margin-top: 5px; margin-bottom: 2px;"^ + "text-align: center; background-color: #FFFFFF ; "^ + "padding: 2px; }" ; + + ".typetable { border-style : hidden }" ; + ".indextable { border-style : hidden }" ; + ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ; "body { background-color : White }" ; "tr { background-color : White }" ; - "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ; - "pre { margin-bottom: 4px }" ; + "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ; + "pre { margin-bottom: 4px }" ; - "div.sig_block {margin-left: 2em}" ; + "div.sig_block {margin-left: 2em}" ; ] (** The style file for all pages. *) @@ -779,26 +787,35 @@ class html = when printing a module type. *) val mutable known_modules_names = StringSet.empty + method index_prefix = + if !Odoc_args.out_file = Odoc_messages.default_out_file then + "index" + else + Filename.basename !Odoc_args.out_file + (** The main file. *) - method index = "index.html" + method index = + let p = self#index_prefix in + Printf.sprintf "%s.html" p + (** The file for the index of values. *) - method index_values = "index_values.html" + method index_values = Printf.sprintf "%s_values.html" self#index_prefix (** The file for the index of types. *) - method index_types = "index_types.html" + method index_types = Printf.sprintf "%s_types.html" self#index_prefix (** The file for the index of exceptions. *) - method index_exceptions = "index_exceptions.html" + method index_exceptions = Printf.sprintf "%s_exceptions.html" self#index_prefix (** The file for the index of attributes. *) - method index_attributes = "index_attributes.html" + method index_attributes = Printf.sprintf "%s_attributes.html" self#index_prefix (** The file for the index of methods. *) - method index_methods = "index_methods.html" + method index_methods = Printf.sprintf "%s_methods.html" self#index_prefix (** The file for the index of classes. *) - method index_classes = "index_classes.html" + method index_classes = Printf.sprintf "%s_classes.html" self#index_prefix (** The file for the index of class types. *) - method index_class_types = "index_class_types.html" + method index_class_types = Printf.sprintf "%s_class_types.html" self#index_prefix (** The file for the index of modules. *) - method index_modules = "index_modules.html" + method index_modules = Printf.sprintf "%s_modules.html" self#index_prefix (** The file for the index of module types. *) - method index_module_types = "index_module_types.html" + method index_module_types = Printf.sprintf "%s_module_types.html" self#index_prefix (** The list of attributes. Filled in the [generate] method. *) @@ -839,17 +856,17 @@ class html = let default_style = String.concat "\n" default_style_options in ( try - let file = Filename.concat !Args.target_dir style_file in - if Sys.file_exists file then - Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file) - else - ( - let chanout = open_out file in - output_string chanout default_style ; - flush chanout ; - close_out chanout; - Odoc_info.verbose (Odoc_messages.file_generated file) - ) + let file = Filename.concat !Args.target_dir style_file in + if Sys.file_exists file then + Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file) + else + ( + let chanout = open_out file in + output_string chanout default_style ; + flush chanout ; + close_out chanout; + Odoc_info.verbose (Odoc_messages.file_generated file) + ) with Sys_error s -> prerr_endline s ; @@ -878,13 +895,14 @@ class html = match l with [] -> () | _ -> - bp b "<link title=\"%s\" rel=Appendix href=\"%s\">\n" m url + bp b "<link title=\"%s\" rel=Appendix href=\"%s\">\n" m url in bs b "<head>\n"; - bs b style; + bs b style; + bs b character_encoding ; bs b "<link rel=\"Start\" href=\""; - bs b self#index; - bs b "\">\n" ; + bs b self#index; + bs b "\">\n" ; ( match nav with None -> () @@ -893,13 +911,13 @@ class html = None -> () | Some name -> bp b "<link rel=\"previous\" href=\"%s\">\n" - (fst (Naming.html_files name)); + (fst (Naming.html_files name)); ); (match post_opt with None -> () | Some name -> bp b "<link rel=\"next\" href=\"%s\">\n" - (fst (Naming.html_files name)); + (fst (Naming.html_files name)); ); ( let father = Name.father name in @@ -916,16 +934,16 @@ class html = link_if_not_empty self#list_class_types Odoc_messages.index_of_class_types self#index_class_types; link_if_not_empty self#list_modules Odoc_messages.index_of_modules self#index_modules; link_if_not_empty self#list_module_types Odoc_messages.index_of_module_types self#index_module_types; - let print_one m = - let html_file = fst (Naming.html_files m.m_name) in + let print_one m = + let html_file = fst (Naming.html_files m.m_name) in bp b "<link title=\"%s\" rel=\"Chapter\" href=\"%s\">" - m.m_name html_file + m.m_name html_file in - print_concat b "\n" print_one module_list; + print_concat b "\n" print_one module_list; self#html_sections_links b comments; bs b "<title>"; - bs b t ; - bs b "</title>\n</head>\n" + bs b t ; + bs b "</title>\n</head>\n" in header <- f @@ -964,7 +982,7 @@ class html = let s = Odoc_info.string_of_text t in let label = self#create_title_label (n,lopt,t) in bp b "<link title=\"%s\" rel=\"%s\" href=\"#%s\">\n" s s_rel label - ) + ) titles in print_lines "Section" section_titles ; @@ -982,8 +1000,8 @@ class html = None -> () | Some name -> bp b "<a href=\"%s\">%s</a>\n" - (fst (Naming.html_files name)) - Odoc_messages.previous + (fst (Naming.html_files name)) + Odoc_messages.previous ); bs b " "; let father = Name.father name in @@ -995,8 +1013,8 @@ class html = None -> () | Some name -> bp b "<a href=\"%s\">%s</a>\n" - (fst (Naming.html_files name)) - Odoc_messages.next + (fst (Naming.html_files name)) + Odoc_messages.next ); bs b "</div>\n" @@ -1011,13 +1029,13 @@ class html = method private output_code in_title file code = try let chanout = open_out file in - let b = new_buf () in + let b = new_buf () in bs b "<html>"; - self#print_header b (self#inner_title in_title); - bs b"<body>\n"; + self#print_header b (self#inner_title in_title); + bs b"<body>\n"; self#html_of_code b code; bs b "</body></html>"; - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout with Sys_error s -> @@ -1059,8 +1077,8 @@ class html = method create_fully_qualified_module_idents_links m_name s = let f str_t = let match_s = Str.matched_string str_t in - let rel = Name.get_relative m_name match_s in - let s_final = Odoc_info.apply_if_equal + let rel = Name.get_relative m_name match_s in + let s_final = Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel @@ -1132,52 +1150,52 @@ class html = (** Print html code to display the given module kind. *) method html_of_module_kind b father ?modu kind = match kind with - Module_struct eles -> - self#html_of_text b [Code "sig"]; - ( - match modu with - None -> - bs b "<div class=\"sig_block\">"; - List.iter (self#html_of_module_element b father) eles; - bs b "</div>" - | Some m -> - let (html_file, _) = Naming.html_files m.m_name in - bp b " <a href=\"%s\">..</a> " html_file - ); - self#html_of_text b [Code "end"] + Module_struct eles -> + self#html_of_text b [Code "sig"]; + ( + match modu with + None -> + bs b "<div class=\"sig_block\">"; + List.iter (self#html_of_module_element b father) eles; + bs b "</div>" + | Some m -> + let (html_file, _) = Naming.html_files m.m_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] | Module_alias a -> - bs b "<code class=\"type\">"; - bs b (self#create_fully_qualified_module_idents_links father a.ma_name); - bs b "</code>" + bs b "<code class=\"type\">"; + bs b (self#create_fully_qualified_module_idents_links father a.ma_name); + bs b "</code>" | Module_functor (p, k) -> - bs b "<div class=\"sig_block\">"; - self#html_of_module_parameter b father p; - self#html_of_module_kind b father ?modu k; - bs b "</div>" + bs b "<div class=\"sig_block\">"; + self#html_of_module_parameter b father p; + self#html_of_module_kind b father ?modu k; + bs b "</div>" | Module_apply (k1, k2) -> - (* TODO: l'application n'est pas correcte dans un .mli. - Que faire ? -> afficher le module_type du typedtree *) - self#html_of_module_kind b father k1; - self#html_of_text b [Code "("]; - self#html_of_module_kind b father k2; - self#html_of_text b [Code ")"] + (* TODO: l'application n'est pas correcte dans un .mli. + Que faire ? -> afficher le module_type du typedtree *) + self#html_of_module_kind b father k1; + self#html_of_text b [Code "("]; + self#html_of_module_kind b father k2; + self#html_of_text b [Code ")"] | Module_with (k, s) -> - (* TODO: ŕ modifier quand Module_with sera plus détaillé *) - self#html_of_module_type_kind b father ?modu k; - bs b "<code class=\"type\"> "; - bs b (self#create_fully_qualified_module_idents_links father s); - bs b "</code>" + (* TODO: ŕ modifier quand Module_with sera plus détaillé *) + self#html_of_module_type_kind b father ?modu k; + bs b "<code class=\"type\"> "; + bs b (self#create_fully_qualified_module_idents_links father s); + bs b "</code>" | Module_constraint (k, tk) -> - (* TODO: on affiche quoi ? *) - self#html_of_module_kind b father ?modu k + (* TODO: on affiche quoi ? *) + self#html_of_module_kind b father ?modu k method html_of_module_parameter b father p = self#html_of_text b - [ - Code "functor ("; - Code p.mp_name ; - Code " : "; - ] ; + [ + Code "functor ("; + Code p.mp_name ; + Code " : "; + ] ; self#html_of_module_type_kind b father p.mp_kind; self#html_of_text b [ Code ") -> "] @@ -1205,38 +1223,38 @@ class html = (** Print html code to display the given module type kind. *) method html_of_module_type_kind b father ?modu ?mt kind = match kind with - Module_type_struct eles -> - self#html_of_text b [Code "sig"]; - ( - match mt with - None -> - ( - match modu with - None -> - bs b "<div class=\"sig_block\">"; - List.iter (self#html_of_module_element b father) eles; - bs b "</div>" - | Some m -> - let (html_file, _) = Naming.html_files m.m_name in - bp b " <a href=\"%s\">..</a> " html_file - ) - | Some mt -> - let (html_file, _) = Naming.html_files mt.mt_name in - bp b " <a href=\"%s\">..</a> " html_file - ); - self#html_of_text b [Code "end"] + Module_type_struct eles -> + self#html_of_text b [Code "sig"]; + ( + match mt with + None -> + ( + match modu with + None -> + bs b "<div class=\"sig_block\">"; + List.iter (self#html_of_module_element b father) eles; + bs b "</div>" + | Some m -> + let (html_file, _) = Naming.html_files m.m_name in + bp b " <a href=\"%s\">..</a> " html_file + ) + | Some mt -> + let (html_file, _) = Naming.html_files mt.mt_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] | Module_type_functor (p, k) -> - self#html_of_module_parameter b father p; - self#html_of_module_type_kind b father ?modu ?mt k + self#html_of_module_parameter b father p; + self#html_of_module_type_kind b father ?modu ?mt k | Module_type_alias a -> - bs b "<code class=\"type\">"; - bs b (self#create_fully_qualified_module_idents_links father a.mta_name); - bs b "</code>" + bs b "<code class=\"type\">"; + bs b (self#create_fully_qualified_module_idents_links father a.mta_name); + bs b "</code>" | Module_type_with (k, s) -> - self#html_of_module_type_kind b father ?modu ?mt k; - bs b "<code class=\"type\"> "; - bs b (self#create_fully_qualified_module_idents_links father s); - bs b "</code>" + self#html_of_module_type_kind b father ?modu ?mt k; + bs b "<code class=\"type\"> "; + bs b (self#create_fully_qualified_module_idents_links father s); + bs b "</code>" (** Print html code to display the type of a module parameter.. *) method html_of_module_parameter_type b m_name p = @@ -1262,11 +1280,11 @@ class html = bp b "<a name=\"%s\"></a>" (Naming.value_target v); ( match v.val_code with - None -> bs b (Name.simple v.val_name) + None -> bs b (self#escape (Name.simple v.val_name)) | Some c -> let file = Naming.file_code_value_complete_target v in self#output_code v.val_name (Filename.concat !Args.target_dir file) c; - bp b "<a href=\"%s\">%s</a>" file (Name.simple v.val_name) + bp b "<a href=\"%s\">%s</a>" file (self#escape (Name.simple v.val_name)) ); bs b " : "; self#html_of_type_expr b (Name.father v.val_name) v.val_type; @@ -1287,26 +1305,26 @@ class html = bs b " "; (* html mark *) bp b "<a name=\"%s\"></a>%s" - (Naming.exception_target e) - (Name.simple e.ex_name); + (Naming.exception_target e) + (Name.simple e.ex_name); ( match e.ex_args with [] -> () | _ -> bs b (" "^(self#keyword "of")^" "); self#html_of_type_expr_list - ~par: false b (Name.father e.ex_name) " * " e.ex_args + ~par: false b (Name.father e.ex_name) " * " e.ex_args ); ( match e.ex_alias with None -> () | Some ea -> - bs b " = "; + bs b " = "; ( match ea.ea_ex with None -> bs b ea.ea_name | Some e -> - bp b "<a href=\"%s\">%s</a>" (Naming.complete_exception_target e) e.ex_name + bp b "<a href=\"%s\">%s</a>" (Naming.complete_exception_target e) e.ex_name ) ); bs b "</pre>\n"; @@ -1317,14 +1335,14 @@ class html = Odoc_info.reset_type_names (); let father = Name.father t.ty_name in bs b - (match t.ty_manifest, t.ty_kind with - None, Type_abstract -> "<pre>" - | None, Type_variant _ - | None, Type_record _ -> "<br><code>" - | Some _, Type_abstract -> "<pre>" - | Some _, Type_variant _ - | Some _, Type_record _ -> "<pre>" - ); + (match t.ty_manifest, t.ty_kind with + None, Type_abstract -> "<pre>" + | None, Type_variant _ + | None, Type_record _ -> "<br><code>" + | Some _, Type_abstract -> "<pre>" + | Some _, Type_variant _ + | Some _, Type_record _ -> "<pre>" + ); bs b ((self#keyword "type")^" "); (* html mark *) bp b "<a name=\"%s\"></a>" (Naming.type_target t); @@ -1333,82 +1351,82 @@ class html = bs b ((Name.simple t.ty_name)^" "); ( match t.ty_manifest with - None -> () + None -> () | Some typ -> - bs b "= "; - self#html_of_type_expr b father typ; - bs b " " + bs b "= "; + self#html_of_type_expr b father typ; + bs b " " ); (match t.ty_kind with Type_abstract -> bs b "</pre>" | Type_variant (l, priv) -> bs b "= "; - if priv then bs b "private" ; - bs b - ( - match t.ty_manifest with - None -> "</code>" - | Some _ -> "</pre>" - ); + if priv then bs b "private" ; + bs b + ( + match t.ty_manifest with + None -> "</code>" + | Some _ -> "</pre>" + ); bs b "<table class=\"typetable\">\n"; - let print_one constr = + let print_one constr = bs b "<tr>\n<td align=\"left\" valign=\"top\" >\n"; bs b "<code>"; - bs b (self#keyword "|"); + bs b (self#keyword "|"); bs b "</code></td>\n<td align=\"left\" valign=\"top\" >\n"; bs b "<code>"; - bs b (self#constructor constr.vc_name); + bs b (self#constructor constr.vc_name); ( - match constr.vc_args with + match constr.vc_args with [] -> () | l -> - bs b (" " ^ (self#keyword "of") ^ " "); - self#html_of_type_expr_list ~par: false b father " * " l; + bs b (" " ^ (self#keyword "of") ^ " "); + self#html_of_type_expr_list ~par: false b father " * " l; ); bs b "</code></td>\n"; ( - match constr.vc_text with + match constr.vc_text with None -> () | Some t -> - bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; - bs b "<code>"; - bs b "(*"; - bs b "</code></td>"; - bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; - self#html_of_text b t; - bs b "</td>"; - bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"bottom\" >"; - bs b "<code>"; - bs b "*)"; - bs b "</code></td>"; + bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; + bs b "<code>"; + bs b "(*"; + bs b "</code></td>"; + bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; + self#html_of_text b t; + bs b "</td>"; + bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"bottom\" >"; + bs b "<code>"; + bs b "*)"; + bs b "</code></td>"; ); bs b "\n</tr>" - in - print_concat b "\n" print_one l; + in + print_concat b "\n" print_one l; bs b "</table>\n" | Type_record (l, priv) -> bs b "= "; - if priv then bs b "private " ; - bs b "{"; - bs b - ( - match t.ty_manifest with - None -> "</code>" - | Some _ -> "</pre>" - ); + if priv then bs b "private " ; + bs b "{"; + bs b + ( + match t.ty_manifest with + None -> "</code>" + | Some _ -> "</pre>" + ); bs b "<table class=\"typetable\">\n" ; - let print_one r = + let print_one r = bs b "<tr>\n<td align=\"left\" valign=\"top\" >\n"; bs b "<code> </code>"; bs b "</td>\n<td align=\"left\" valign=\"top\" >\n"; bs b "<code>"; - if r.rf_mutable then bs b (self#keyword "mutable ") ; + if r.rf_mutable then bs b (self#keyword "mutable ") ; bs b (r.rf_name ^ " : ") ; - self#html_of_type_expr b father r.rf_type; + self#html_of_type_expr b father r.rf_type; bs b ";</code></td>\n"; ( - match r.rf_text with + match r.rf_text with None -> () | Some t -> bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; @@ -1416,13 +1434,13 @@ class html = bs b "(*"; bs b "</code></td>"; bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; - self#html_of_text b t; + self#html_of_text b t; bs b "</td><td class=\"typefieldcomment\" align=\"left\" valign=\"bottom\" >"; bs b "<code>*)</code></td>"; - ); + ); bs b "\n</tr>" - in - print_concat b "\n" print_one l; + in + print_concat b "\n" print_one l; bs b "</table>\n}\n" ); bs b "\n"; @@ -1439,9 +1457,9 @@ class html = bp b "<a name=\"%s\"></a>" (Naming.attribute_target a); ( if a.att_mutable then - bs b ((self#keyword Odoc_messages.mutab)^ " ") + bs b ((self#keyword Odoc_messages.mutab)^ " ") else - () + () ); ( match a.att_value.val_code with @@ -1480,10 +1498,10 @@ class html = ( if !Args.with_parameter_list then self#html_of_parameter_list b - module_name m.met_value.val_parameters + module_name m.met_value.val_parameters else self#html_of_described_parameter_list b - module_name m.met_value.val_parameters + module_name m.met_value.val_parameters ) (** Print html code for the description of a function parameter. *) @@ -1501,19 +1519,19 @@ class html = | l -> (* A list of names, we display those with a description. *) let l2 = List.filter - (fun n -> (Parameter.desc_by_name p n) <> None) - l - in - let print_one n = - match Parameter.desc_by_name p n with + (fun n -> (Parameter.desc_by_name p n) <> None) + l + in + let print_one n = + match Parameter.desc_by_name p n with None -> () | Some t -> - bs b "<code>"; - bs b n; - bs b "</code> : "; - self#html_of_text b t - in - print_concat b "<br>\n" print_one l2 + bs b "<code>"; + bs b n; + bs b "</code> : "; + self#html_of_text b t + in + print_concat b "<br>\n" print_one l2 (** Print html code for a list of parameters. *) method html_of_parameter_list b m_name l = @@ -1523,25 +1541,25 @@ class html = bs b "<div class=\"param_info\">"; bs b "<table border=\"0\" cellpadding=\"3\" width=\"100%\">\n"; bs b "<tr>\n<td align=\"left\" valign=\"top\" width=\"1%\">"; - bs b "<b>"; - bs b Odoc_messages.parameters; - bs b ": </b></td>\n" ; + bs b "<b>"; + bs b Odoc_messages.parameters; + bs b ": </b></td>\n" ; bs b "<td>\n<table class=\"paramstable\">\n"; - let print_one p = + let print_one p = bs b "<tr>\n<td align=\"center\" valign=\"top\" width=\"15%\" class=\"code\">\n"; bs b - ( - match Parameter.complete_name p with - "" -> "?" + ( + match Parameter.complete_name p with + "" -> "?" | s -> s ); - bs b "</td>\n<td align=\"center\" valign=\"top\">:</td>\n"; + bs b "</td>\n<td align=\"center\" valign=\"top\">:</td>\n"; bs b "<td>"; - self#html_of_type_expr b m_name (Parameter.typ p); - bs b "<br>\n"; + self#html_of_type_expr b m_name (Parameter.typ p); + bs b "<br>\n"; self#html_of_parameter_description b p; - bs b "\n</tr>\n"; - in + bs b "\n</tr>\n"; + in List.iter print_one l; bs b "</table>\n</td>\n</tr>\n</table></div>\n" @@ -1557,10 +1575,10 @@ class html = in let f p = bs b "<div class=\"param_info\"><code class=\"code\">"; - bs b (Parameter.complete_name p); - bs b "</code> : " ; + bs b (Parameter.complete_name p); + bs b "</code> : " ; self#html_of_parameter_description b p; - bs b "</div>\n" + bs b "</div>\n" in List.iter f l2 @@ -1573,28 +1591,28 @@ class html = bs b "<table border=\"0\" cellpadding=\"3\" width=\"100%\">\n"; bs b "<tr>\n"; bs b "<td align=\"left\" valign=\"top\" width=\"1%%\"><b>"; - bs b Odoc_messages.parameters ; - bs b ": </b></td>\n<td>\n"; + bs b Odoc_messages.parameters ; + bs b ": </b></td>\n<td>\n"; bs b "<table class=\"paramstable\">\n"; - List.iter + List.iter (fun (p, desc_opt) -> bs b "<tr>\n"; bs b "<td align=\"center\" valign=\"top\" width=\"15%\">\n<code>" ; - bs b p.mp_name; + bs b p.mp_name; bs b "</code></td>\n" ; bs b "<td align=\"center\" valign=\"top\">:</td>\n"; bs b "<td>" ; - self#html_of_module_parameter_type b m_name p; - bs b "\n"; + self#html_of_module_parameter_type b m_name p; + bs b "\n"; ( - match desc_opt with + match desc_opt with None -> () | Some t -> - bs b "<br>"; - self#html_of_text b t; - bs b "\n</tr>\n" ; + bs b "<br>"; + self#html_of_text b t; + bs b "\n</tr>\n" ; ) - ) + ) l; bs b "</table>\n</td>\n</tr>\n</table>\n" @@ -1615,11 +1633,11 @@ class html = bs b "</pre>"; if info then ( - if complete then - self#html_of_info ~indent: false - else - self#html_of_info_first_sentence - ) b m.m_info + if complete then + self#html_of_info ~indent: false + else + self#html_of_info_first_sentence + ) b m.m_info else () @@ -1638,17 +1656,17 @@ class html = (match mt.mt_kind with None -> () | Some k -> - bs b " = "; - self#html_of_module_type_kind b father ~mt k + bs b " = "; + self#html_of_module_type_kind b father ~mt k ); bs b "</pre>"; if info then ( - if complete then - self#html_of_info ~indent: false - else - self#html_of_info_first_sentence - ) b mt.mt_info + if complete then + self#html_of_info ~indent: false + else + self#html_of_info_first_sentence + ) b mt.mt_info else () @@ -1687,39 +1705,39 @@ class html = method html_of_class_kind b father ?cl kind = match kind with Class_structure (inh, eles) -> - self#html_of_text b [Code "object"]; - ( - match cl with - None -> - bs b "\n"; - ( - match inh with - [] -> () - | _ -> - self#generate_inheritance_info b inh - ); - List.iter (self#html_of_class_element b) eles; - | Some cl -> - let (html_file, _) = Naming.html_files cl.cl_name in - bp b " <a href=\"%s\">..</a> " html_file - ); - self#html_of_text b [Code "end"] + self#html_of_text b [Code "object"]; + ( + match cl with + None -> + bs b "\n"; + ( + match inh with + [] -> () + | _ -> + self#generate_inheritance_info b inh + ); + List.iter (self#html_of_class_element b) eles; + | Some cl -> + let (html_file, _) = Naming.html_files cl.cl_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] | Class_apply capp -> - (* TODO: afficher le type final ŕ partir du typedtree *) - self#html_of_text b [Raw "class application not handled yet"] + (* TODO: afficher le type final ŕ partir du typedtree *) + self#html_of_text b [Raw "class application not handled yet"] | Class_constr cco -> - ( + ( match cco.cco_type_parameters with [] -> () | l -> self#html_of_class_type_param_expr_list b father l; - bs b " " - ); - bs b "<code class=\"type\">"; - bs b (self#create_fully_qualified_idents_links father cco.cco_name); - bs b "</code>" + bs b " " + ); + bs b "<code class=\"type\">"; + bs b (self#create_fully_qualified_idents_links father cco.cco_name); + bs b "</code>" | Class_constraint (ck, ctk) -> self#html_of_text b [Code "( "] ; @@ -1735,30 +1753,30 @@ class html = match cta.cta_type_parameters with [] -> () | l -> - self#html_of_class_type_param_expr_list b father l; - bs b " " + self#html_of_class_type_param_expr_list b father l; + bs b " " ); bs b "<code class=\"type\">"; - bs b (self#create_fully_qualified_idents_links father cta.cta_name); - bs b "</code>" + bs b (self#create_fully_qualified_idents_links father cta.cta_name); + bs b "</code>" | Class_signature (inh, eles) -> - self#html_of_text b [Code "object"]; - ( - match ct with - None -> - bs b "\n"; - ( - match inh with - [] -> () - | _ -> self#generate_inheritance_info b inh - ); - List.iter (self#html_of_class_element b) eles - | Some ct -> - let (html_file, _) = Naming.html_files ct.clt_name in - bp b " <a href=\"%s\">..</a> " html_file - ); - self#html_of_text b [Code "end"] + self#html_of_text b [Code "object"]; + ( + match ct with + None -> + bs b "\n"; + ( + match inh with + [] -> () + | _ -> self#generate_inheritance_info b inh + ); + List.iter (self#html_of_class_element b) eles + | Some ct -> + let (html_file, _) = Naming.html_files ct.clt_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] (** Print html code for a class. *) method html_of_class b ?(complete=true) ?(with_link=true) c = @@ -1775,9 +1793,9 @@ class html = ty_info = None ; ty_parameters = [] ; ty_kind = Type_abstract ; ty_manifest = None ; ty_loc = Odoc_info.dummy_loc ; - ty_code = None ; - } - ); + ty_code = None ; + } + ); print_DEBUG "html#html_of_class : virtual or not" ; if c.cl_virtual then bs b ((self#keyword "virtual")^" "); ( @@ -1785,7 +1803,7 @@ class html = [] -> () | l -> self#html_of_class_type_param_expr_list b father l; - bs b " " + bs b " " ); print_DEBUG "html#html_of_class : with link or not" ; ( @@ -1802,9 +1820,9 @@ class html = print_DEBUG "html#html_of_class : info" ; ( if complete then - self#html_of_info ~indent: false + self#html_of_info ~indent: false else - self#html_of_info_first_sentence + self#html_of_info_first_sentence ) b c.cl_info (** Print html code for a class type. *) @@ -1822,16 +1840,16 @@ class html = ty_info = None ; ty_parameters = [] ; ty_kind = Type_abstract ; ty_manifest = None ; ty_loc = Odoc_info.dummy_loc ; - ty_code = None ; - } - ); + ty_code = None ; + } + ); if ct.clt_virtual then bs b ((self#keyword "virtual")^" "); ( match ct.clt_type_parameters with [] -> () | l -> - self#html_of_class_type_param_expr_list b father l; - bs b " " + self#html_of_class_type_param_expr_list b father l; + bs b " " ); if with_link then @@ -1844,9 +1862,9 @@ class html = bs b "</pre>"; ( if complete then - self#html_of_info ~indent: false + self#html_of_info ~indent: false else - self#html_of_info_first_sentence + self#html_of_info_first_sentence ) b ct.clt_info (** Return html code to represent a dag, represented as in Odoc_dag2html. *) @@ -1953,12 +1971,12 @@ class html = fun elements name info target title simple_file -> try let chanout = open_out (Filename.concat !Args.target_dir simple_file) in - let b = new_buf () in - bs b "<html>\n"; + let b = new_buf () in + bs b "<html>\n"; self#print_header b (self#inner_title title); - bs b "<body>\n<center><h1>"; - bs b title; - bs b "</h1></center>\n" ; + bs b "<body>\n<center><h1>"; + bs b title; + bs b "</h1></center>\n" ; let sorted_elements = List.sort (fun e1 e2 -> compare (Name.simple (name e1)) (Name.simple (name e2))) @@ -1968,12 +1986,12 @@ class html = let f_ele e = let simple_name = Name.simple (name e) in let father_name = Name.father (name e) in - bp b "<tr><td><a href=\"%s\">%s</a> " (target e) simple_name; + bp b "<tr><td><a href=\"%s\">%s</a> " (target e) (self#escape simple_name); if simple_name <> father_name && father_name <> "" then bp b "[<a href=\"%s\">%s</a>]" (fst (Naming.html_files father_name)) father_name; bs b "</td>\n<td>"; - self#html_of_info_first_sentence b (info e); - bs b "</td></tr>\n"; + self#html_of_info_first_sentence b (info e); + bs b "</td></tr>\n"; in let f_group l = match l with @@ -1985,15 +2003,15 @@ class html = | _ -> "" in bs b "<tr><td align=\"left\"><br>"; - bs b s ; - bs b "</td></tr>\n" ; + bs b s ; + bs b "</td></tr>\n" ; List.iter f_ele l in bs b "<table>\n"; List.iter f_group groups ; bs b "</table><br>\n" ; bs b "</body>\n</html>"; - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout with Sys_error s -> @@ -2019,34 +2037,35 @@ class html = let type_file = Naming.file_type_class_complete_target cl.cl_name in try let chanout = open_out (Filename.concat !Args.target_dir html_file) in - let b = new_buf () in + let b = new_buf () in let pre_name = opt (fun c -> c.cl_name) pre in let post_name = opt (fun c -> c.cl_name) post in - bs b "<html>\n"; + bs b doctype ; + bs b "<html>\n"; self#print_header b ~nav: (Some (pre_name, post_name, cl.cl_name)) ~comments: (Class.class_comments cl) (self#inner_title cl.cl_name); - bs b "<body>\n"; + bs b "<body>\n"; self#print_navbar b pre_name post_name cl.cl_name; bs b "<center><h1>"; - bs b (Odoc_messages.clas^" "); + bs b (Odoc_messages.clas^" "); if cl.cl_virtual then bs b "virtual " ; bp b "<a href=\"%s\">%s</a>" type_file cl.cl_name; bs b "</h1></center>\n<br>\n"; self#html_of_class b ~with_link: false cl; (* parameters *) self#html_of_described_parameter_list b - (Name.father cl.cl_name) cl.cl_parameters; + (Name.father cl.cl_name) cl.cl_parameters; (* class inheritance *) - self#generate_class_inheritance_info b cl; + self#generate_class_inheritance_info b cl; (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* the various elements *) List.iter (self#html_of_class_element b) (Class.class_elements ~trans:false cl); bs b "</body></html>"; - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout; (* generate the file with the complete class type *) @@ -2065,10 +2084,11 @@ class html = let type_file = Naming.file_type_class_complete_target clt.clt_name in try let chanout = open_out (Filename.concat !Args.target_dir html_file) in - let b = new_buf () in + let b = new_buf () in let pre_name = opt (fun ct -> ct.clt_name) pre in let post_name = opt (fun ct -> ct.clt_name) post in - bs b "<html>\n"; + bs b doctype ; + bs b "<html>\n"; self#print_header b ~nav: (Some (pre_name, post_name, clt.clt_name)) ~comments: (Class.class_type_comments clt) @@ -2077,7 +2097,7 @@ class html = bs b "<body>\n"; self#print_navbar b pre_name post_name clt.clt_name; bs b "<center><h1>"; - bs b (Odoc_messages.class_type^" "); + bs b (Odoc_messages.class_type^" "); if clt.clt_virtual then bs b "virtual "; bp b "<a href=\"%s\">%s</a>" type_file clt.clt_name; bs b "</h1></center>\n<br>\n"; @@ -2091,7 +2111,7 @@ class html = List.iter (self#html_of_class_element b) (Class.class_type_elements ~trans: false clt); bs b "</body></html>"; - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout; (* generate the file with the complete class type *) @@ -2110,10 +2130,11 @@ class html = let (html_file, _) = Naming.html_files mt.mt_name in let type_file = Naming.file_type_module_complete_target mt.mt_name in let chanout = open_out (Filename.concat !Args.target_dir html_file) in - let b = new_buf () in + let b = new_buf () in let pre_name = opt (fun mt -> mt.mt_name) pre in let post_name = opt (fun mt -> mt.mt_name) post in - bs b "<html>\n"; + bs b doctype ; + bs b "<html>\n"; self#print_header b ~nav: (Some (pre_name, post_name, mt.mt_name)) ~comments: (Module.module_type_comments mt) @@ -2121,9 +2142,9 @@ class html = bs b "<body>\n"; self#print_navbar b pre_name post_name mt.mt_name; bp b "<center><h1>"; - bs b (Odoc_messages.module_type^" "); + bs b (Odoc_messages.module_type^" "); ( - match mt.mt_type with + match mt.mt_type with Some _ -> bp b "<a href=\"%s\">%s</a>" type_file mt.mt_name | None-> bs b mt.mt_name ); @@ -2132,17 +2153,17 @@ class html = (* parameters for functors *) self#html_of_module_parameter_list b - (Name.father mt.mt_name) - (Module.module_type_parameters mt); + (Name.father mt.mt_name) + (Module.module_type_parameters mt); (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* module elements *) List.iter - (self#html_of_module_element b (Name.father mt.mt_name)) + (self#html_of_module_element b (Name.father mt.mt_name)) (Module.module_type_elements mt); bs b "</body></html>"; - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout; (* generate html files for submodules *) @@ -2159,7 +2180,7 @@ class html = match mt.mt_type with None -> () | Some mty -> - self#output_module_type + self#output_module_type mt.mt_name (Filename.concat !Args.target_dir type_file) mty @@ -2177,41 +2198,47 @@ class html = let type_file = Naming.file_type_module_complete_target modu.m_name in let code_file = Naming.file_code_module_complete_target modu.m_name in let chanout = open_out (Filename.concat !Args.target_dir html_file) in - let b = new_buf () in + let b = new_buf () in let pre_name = opt (fun m -> m.m_name) pre in let post_name = opt (fun m -> m.m_name) post in - bs b "<html>\n"; + bs b doctype ; + bs b "<html>\n"; self#print_header b ~nav: (Some (pre_name, post_name, modu.m_name)) ~comments: (Module.module_comments modu) (self#inner_title modu.m_name); - bs b "<body>\n" ; + bs b "<body>\n" ; self#print_navbar b pre_name post_name modu.m_name ; bs b "<center><h1>"; - bs b + if modu.m_text_only then + bs b modu.m_name + else ( - if Module.module_is_functor modu then - Odoc_messages.functo - else - Odoc_messages.modul + bs b + ( + if Module.module_is_functor modu then + Odoc_messages.functo + else + Odoc_messages.modul + ); + bp b " <a href=\"%s\">%s</a>" type_file modu.m_name; + ( + match modu.m_code with + None -> () + | Some _ -> bp b " (<a href=\"%s\">.ml</a>)" code_file + ) ); - bp b " <a href=\"%s\">%s</a>" type_file modu.m_name; - ( - match modu.m_code with - None -> () - | Some _ -> bp b " (<a href=\"%s\">.ml</a>)" code_file - ); bs b "</h1></center>\n<br>\n"; - self#html_of_module b ~with_link: false modu; + if not modu.m_text_only then self#html_of_module b ~with_link: false modu; (* parameters for functors *) self#html_of_module_parameter_list b - (Name.father modu.m_name) - (Module.module_parameters modu); + (Name.father modu.m_name) + (Module.module_parameters modu); (* a horizontal line *) - bs b "<hr width=\"100%\">\n"; + if not modu.m_text_only then bs b "<hr width=\"100%\">\n"; (* module elements *) List.iter @@ -2219,7 +2246,7 @@ class html = (Module.module_elements modu); bs b "</body></html>"; - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout; (* generate html files for submodules *) @@ -2237,43 +2264,45 @@ class html = (Filename.concat !Args.target_dir type_file) modu.m_type; - match modu.m_code with - None -> () - | Some code -> - self#output_code - modu.m_name - (Filename.concat !Args.target_dir code_file) - code + match modu.m_code with + None -> () + | Some code -> + self#output_code + modu.m_name + (Filename.concat !Args.target_dir code_file) + code with Sys_error s -> raise (Failure s) - (** Generate the [index.html] file corresponding to the given module list. + (** Generate the [<index_prefix>.html] file corresponding to the given module list. @raise Failure if an error occurs.*) method generate_index module_list = try let chanout = open_out (Filename.concat !Args.target_dir self#index) in - let b = new_buf () in + let b = new_buf () in let title = match !Args.title with None -> "" | Some t -> self#escape t in - bs b "<html>\n"; + bs b doctype ; + bs b "<html>\n"; self#print_header b self#title; bs b "<body>\n"; bs b "<center><h1>"; - bs b title; - bs b "</h1></center>\n" ; - let info = Odoc_info.apply_opt - Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file - in - ( - match info with - None -> - self#html_of_Index_list b; - bs b "<br/>"; - self#html_of_Module_list b - (List.map (fun m -> m.m_name) module_list) - | Some i -> self#html_of_info ~indent: false b info - ); - Buffer.output_buffer chanout b; + bs b title; + bs b "</h1></center>\n" ; + let info = Odoc_info.apply_opt + Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file + in + ( + match info with + None -> + self#html_of_Index_list b; + bs b "<br/>"; + self#html_of_Module_list b + (List.map (fun m -> m.m_name) module_list); + bs b "</body>\n</html>" + | Some i -> self#html_of_info ~indent: false b info + ); + Buffer.output_buffer chanout b; close_out chanout with Sys_error s -> @@ -2370,7 +2399,7 @@ class html = self#index_module_types (** Generate all the html files from a module list. The main - file is [index.html]. *) + file is [<index_prefix>.html]. *) method generate module_list = (* init the style *) self#init_style ; @@ -2390,36 +2419,36 @@ class html = (* Get the names of all known types. *) let types = Odoc_info.Search.types module_list in known_types_names <- - List.fold_left - (fun acc t -> StringSet.add t.ty_name acc) - known_types_names - types ; + List.fold_left + (fun acc t -> StringSet.add t.ty_name acc) + known_types_names + types ; (* Get the names of all class and class types. *) let classes = Odoc_info.Search.classes module_list in let class_types = Odoc_info.Search.class_types module_list in known_classes_names <- - List.fold_left - (fun acc c -> StringSet.add c.cl_name acc) - known_classes_names - classes ; + List.fold_left + (fun acc c -> StringSet.add c.cl_name acc) + known_classes_names + classes ; known_classes_names <- - List.fold_left - (fun acc ct -> StringSet.add ct.clt_name acc) - known_classes_names - class_types ; + List.fold_left + (fun acc ct -> StringSet.add ct.clt_name acc) + known_classes_names + class_types ; (* Get the names of all known modules and module types. *) let module_types = Odoc_info.Search.module_types module_list in let modules = Odoc_info.Search.modules module_list in known_modules_names <- - List.fold_left - (fun acc m -> StringSet.add m.m_name acc) - known_modules_names - modules ; + List.fold_left + (fun acc m -> StringSet.add m.m_name acc) + known_modules_names + modules ; known_modules_names <- - List.fold_left - (fun acc mt -> StringSet.add mt.mt_name acc) - known_modules_names - module_types ; + List.fold_left + (fun acc mt -> StringSet.add mt.mt_name acc) + known_modules_names + module_types ; (* generate html for each module *) if not !Args.index_only then self#generate_elements self#generate_for_module module_list ; @@ -2443,10 +2472,8 @@ class html = initializer Odoc_ocamlhtml.html_of_comment := (fun s -> - let b = new_buf () in - self#html_of_text b (Odoc_text.Texter.text_of_string s); - Buffer.contents b - ) + let b = new_buf () in + self#html_of_text b (Odoc_text.Texter.text_of_string s); + Buffer.contents b + ) end - -(* eof $Id$ *) diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml index 48801bb969..d7454c1aae 100644 --- a/ocamldoc/odoc_info.ml +++ b/ocamldoc/odoc_info.ml @@ -48,6 +48,7 @@ and text_element = Odoc_types.text_element = | Subscript of text | Module_list of string list | Index_list + | Custom of string * text and text = text_element list @@ -226,8 +227,8 @@ let info_string_of_info i = List.iter (fun (sref, t) -> p b "\n@see %s %s" - (escape_arobas (f_see_ref sref)) - (escape_arobas (text_string_of_text t)) + (escape_arobas (f_see_ref sref)) + (escape_arobas (text_string_of_text t)) ) i.i_sees ); @@ -241,20 +242,20 @@ let info_string_of_info i = None -> () | Some t -> p b "\n@deprecated %s" - (escape_arobas (text_string_of_text t)) + (escape_arobas (text_string_of_text t)) ); List.iter (fun (s, t) -> p b "\n@param %s %s" - (escape_arobas s) - (escape_arobas (text_string_of_text t)) + (escape_arobas s) + (escape_arobas (text_string_of_text t)) ) i.i_params; List.iter (fun (s, t) -> p b "\n@raise %s %s" - (escape_arobas s) - (escape_arobas (text_string_of_text t)) + (escape_arobas s) + (escape_arobas (text_string_of_text t)) ) i.i_raised_exceptions; ( @@ -262,45 +263,19 @@ let info_string_of_info i = None -> () | Some t -> p b "\n@return %s" - (escape_arobas (text_string_of_text t)) + (escape_arobas (text_string_of_text t)) ); List.iter (fun (s, t) -> p b "\n@%s %s" s - (escape_arobas (text_string_of_text t)) + (escape_arobas (text_string_of_text t)) ) i.i_custom; Buffer.contents b -let info_of_string s = - let dummy = - { - i_desc = None ; - i_authors = [] ; - i_version = None ; - i_sees = [] ; - i_since = None ; - i_deprecated = None ; - i_params = [] ; - i_raised_exceptions = [] ; - i_return_value = None ; - i_custom = [] ; - } - in - let s2 = Printf.sprintf "(** %s *)" s in - let (_, i_opt) = Odoc_comments.Basic_info_retriever.first_special "-" s2 in - match i_opt with - None -> dummy - | Some i -> i - -let info_of_comment_file f = - try - let s = Odoc_misc.input_file_as_string f in - info_of_string s - with - Sys_error s -> - failwith s +let info_of_string = Odoc_comments.info_of_string +let info_of_comment_file = Odoc_comments.info_of_comment_file module Search = struct diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index 85d964f93e..ad9538fe32 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -52,6 +52,7 @@ and text_element = Odoc_types.text_element = | Module_list of string list (** The table of the given modules with their abstract. *) | Index_list (** The links to the various indexes (values, types, ...) *) + | Custom of string * text (** to extend \{foo syntax *) (** A text is a list of [text_element]. The order matters. *) and text = text_element list @@ -452,6 +453,7 @@ module Module : mutable m_top_deps : Name.t list ; (** The toplevels module names this module depends on. *) mutable m_code : string option ; (** The whole code of the module *) mutable m_code_intf : string option ; (** The whole code of the interface of the module *) + m_text_only : bool ; (** [true] if the module comes from a text file *) } and module_type_alias = Odoc_module.module_type_alias = @@ -927,6 +929,7 @@ module Args : type source_file = Impl_file of string | Intf_file of string + | Text_file of string (** The class type of documentation generators. *) class type doc_generator = diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml index 09f73dac2e..26dfb667fd 100644 --- a/ocamldoc/odoc_latex.ml +++ b/ocamldoc/odoc_latex.ml @@ -15,12 +15,12 @@ let print_DEBUG s = print_string s ; print_newline () -open Odoc_info +open Odoc_info open Parameter open Value open Type open Exception -open Class +open Class open Module let new_buf () = Buffer.create 1024 @@ -28,7 +28,7 @@ let new_fmt () = let b = new_buf () in let fmt = Format.formatter_of_buffer b in (fmt, - fun () -> + fun () -> Format.pp_print_flush fmt (); let s = Buffer.contents b in Buffer.reset b; @@ -47,9 +47,9 @@ let print_concat fmt sep f = [] -> () | [c] -> f c | c :: q -> - f c; - ps fmt sep; - iter q + f c; + ps fmt sep; + iter q in iter @@ -59,7 +59,7 @@ class text = (** Return latex code to make a sectionning according to the given level, and with the given latex code. *) method section_style level s = - try + try let sec = List.assoc level !Args.latex_titles in "\\"^sec^"{"^s^"}\n" with Not_found -> s @@ -103,15 +103,15 @@ class text = ("\\\\", "MAXENCE"^"XXX") ; ("&", "MAXENCE"^"YYY") ; ("\\$", "MAXENCE"^"ZZZ") - ] + ] - val mutable subst_strings_simple = - [ + val mutable subst_strings_simple = + [ ("MAXENCE"^"XXX", "{\\textbackslash}") ; "}", "\\}" ; "{", "\\{" ; ("\\\\", "MAXENCE"^"XXX") ; - ] + ] val mutable subst_strings_code = [ ("MAXENCE"^"ZZZ", "\\$"); @@ -128,7 +128,7 @@ class text = ("&", "MAXENCE"^"YYY") ; ("\\$", "MAXENCE"^"ZZZ") ; ("\\\\", "MAXENCE"^"XXX") ; - ] + ] method subst l s = List.fold_right @@ -144,7 +144,7 @@ class text = (** Escape some characters for the code style. *) method escape_code s = self#subst subst_strings_code s - + (** Make a correct latex label from a name. *) (* The following characters are forbidden in LaTeX \index: \ { } $ & # ^ _ % ~ ! " @ | (" to close the double quote) @@ -157,14 +157,14 @@ class text = let buf = Buffer.create len in for i = 0 to len - 1 do let (s_no_, s) = - match name.[i] with + match name.[i] with '_' -> ("-underscore", "_") | '~' -> ("-tilde", "~") - | '%' -> ("-percent", "%") + | '%' -> ("-percent", "%") | '@' -> ("-at", "\"@") | '!' -> ("-bang", "\"!") | '|' -> ("-pipe", "\"|") - | '<' -> ("-lt", "<") + | '<' -> ("-lt", "<") | '>' -> ("-gt", ">") | '^' -> ("-exp", "^") | '&' -> ("-ampersand", "&") @@ -176,8 +176,8 @@ class text = | '=' -> ("-equal", "=") | ':' -> ("-colon", ":") | c -> (String.make 1 c, String.make 1 c) - in - Buffer.add_string buf (if no_ then s_no_ else s) + in + Buffer.add_string buf (if no_ then s_no_ else s) done; Buffer.contents buf @@ -215,9 +215,9 @@ class text = method make_ref label = "\\ref{"^label^"}" (** Print the LaTeX code corresponding to the [text] parameter.*) - method latex_of_text fmt t = + method latex_of_text fmt t = List.iter (self#latex_of_text_element fmt) t - + (** Print the LaTeX code for the [text_element] in parameter. *) method latex_of_text_element fmt te = match te with @@ -226,7 +226,7 @@ class text = | Odoc_info.CodePre s -> self#latex_of_CodePre fmt s | Odoc_info.Verbatim s -> self#latex_of_Verbatim fmt s | Odoc_info.Bold t -> self#latex_of_Bold fmt t - | Odoc_info.Italic t -> self#latex_of_Italic fmt t + | Odoc_info.Italic t -> self#latex_of_Italic fmt t | Odoc_info.Emphasize t -> self#latex_of_Emphasize fmt t | Odoc_info.Center t -> self#latex_of_Center fmt t | Odoc_info.Left t -> self#latex_of_Left fmt t @@ -241,13 +241,16 @@ class text = | Odoc_info.Ref (name, ref_opt) -> self#latex_of_Ref fmt name ref_opt | Odoc_info.Superscript t -> self#latex_of_Superscript fmt t | Odoc_info.Subscript t -> self#latex_of_Subscript fmt t - | Odoc_info.Module_list _ -> () - | Odoc_info.Index_list -> () + | Odoc_info.Module_list _ -> () + | Odoc_info.Index_list -> () + | Odoc_info.Custom (s,t) -> self#latex_of_custom_text fmt s t + + method latex_of_custom_text fmt s t = () - method latex_of_Raw fmt s = + method latex_of_Raw fmt s = ps fmt (self#escape s) - method latex_of_Code fmt s = + method latex_of_Code fmt s = let s2 = self#escape_code s in let s3 = Str.global_replace (Str.regexp "\n") ("\\\\\n") s2 in p fmt "{\\tt{%s}}" s3 @@ -257,7 +260,7 @@ class text = ps fmt (self#escape_simple s); ps fmt "\n\\end{ocamldoccode}\n" - method latex_of_Verbatim fmt s = + method latex_of_Verbatim fmt s = ps fmt "\\begin{verbatim}"; ps fmt s; ps fmt "\\end{verbatim}" @@ -267,7 +270,7 @@ class text = self#latex_of_text fmt t; ps fmt "}" - method latex_of_Italic fmt t = + method latex_of_Italic fmt t = ps fmt "{\\it "; self#latex_of_text fmt t; ps fmt "}" @@ -294,24 +297,24 @@ class text = method latex_of_List fmt tl = ps fmt "\\begin{itemize}\n"; - List.iter - (fun t -> - ps fmt "\\item "; - self#latex_of_text fmt t; - ps fmt "\n" - ) - tl; + List.iter + (fun t -> + ps fmt "\\item "; + self#latex_of_text fmt t; + ps fmt "\n" + ) + tl; ps fmt "\\end{itemize}\n" method latex_of_Enum fmt tl = ps fmt "\\begin{enumerate}\n"; - List.iter - (fun t -> - ps fmt "\\item "; - self#latex_of_text fmt t; - ps fmt "\n" - ) - tl; + List.iter + (fun t -> + ps fmt "\\item "; + self#latex_of_text fmt t; + ps fmt "\n" + ) + tl; ps fmt "\\end{enumerate}\n" method latex_of_Newline fmt = ps fmt "\n\n" @@ -330,7 +333,7 @@ class text = match label_opt with None -> () | Some l -> - ps fmt (self#make_label (self#label ~no_: false l)) + ps fmt (self#make_label (self#label ~no_: false l)) ) method latex_of_Latex fmt s = ps fmt s @@ -343,14 +346,14 @@ class text = method latex_of_Ref fmt name ref_opt = match ref_opt with - None -> + None -> self#latex_of_text_element fmt (Odoc_info.Code (Odoc_info.use_hidden_modules name)) - | Some (RK_section _) -> + | Some (RK_section _) -> self#latex_of_text_element fmt (Latex ("["^(self#make_ref (self#label ~no_:false (Name.simple name)))^"]")) | Some kind -> - let f_label = + let f_label = match kind with Odoc_info.RK_module -> self#module_label | Odoc_info.RK_module_type -> self#module_type_label @@ -367,14 +370,14 @@ class text = [ Odoc_info.Code (Odoc_info.use_hidden_modules name) ; Latex ("["^(self#make_ref (f_label name))^"]") - ] + ] - method latex_of_Superscript fmt t = + method latex_of_Superscript fmt t = ps fmt "$^{"; self#latex_of_text fmt t; ps fmt "}$" - method latex_of_Subscript fmt t = + method latex_of_Subscript fmt t = ps fmt "$_{"; self#latex_of_text fmt t; ps fmt "}$" @@ -388,11 +391,11 @@ class virtual info = method virtual latex_of_text : Format.formatter -> Odoc_info.text -> unit (** The method used to get a [text] from an optionel info structure. *) - method virtual text_of_info : ?block: bool -> Odoc_info.info option -> Odoc_info.text + method virtual text_of_info : ?block: bool -> Odoc_info.info option -> Odoc_info.text (** Print LaTeX code for a description, except for the [i_params] field. *) - method latex_of_info fmt ?(block=false) info_opt = - self#latex_of_text fmt + method latex_of_info fmt ?(block=false) info_opt = + self#latex_of_text fmt (self#text_of_info ~block info_opt) end @@ -413,111 +416,111 @@ class latex = method first_and_rest_of_info i_opt = match i_opt with None -> ([], []) - | Some i -> + | Some i -> match i.Odoc_info.i_desc with None -> ([], self#text_of_info ~block: true i_opt) - | Some t -> + | Some t -> let (first,_) = Odoc_info.first_sentence_and_rest_of_text t in let (_, rest) = Odoc_info.first_sentence_and_rest_of_text (self#text_of_info ~block: false i_opt) in (Odoc_info.text_no_title_no_list first, rest) (** Print LaTeX code for a value. *) - method latex_of_value fmt v = + method latex_of_value fmt v = Odoc_info.reset_type_names () ; let label = self#value_label v.val_name in let latex = self#make_label label in self#latex_of_text fmt - ((Latex latex) :: + ((Latex latex) :: (to_text#text_of_value v)) (** Print LaTeX code for a class attribute. *) method latex_of_attribute fmt a = self#latex_of_text fmt - ((Latex (self#make_label (self#attribute_label a.att_value.val_name))) :: + ((Latex (self#make_label (self#attribute_label a.att_value.val_name))) :: (to_text#text_of_attribute a)) (** Print LaTeX code for a class method. *) - method latex_of_method fmt m = + method latex_of_method fmt m = self#latex_of_text fmt - ((Latex (self#make_label (self#method_label m.met_value.val_name))) :: + ((Latex (self#make_label (self#method_label m.met_value.val_name))) :: (to_text#text_of_method m)) (** Print LaTeX code for the parameters of a type. *) method latex_of_type_params fmt m_name t = let print_one (p, co, cn) = - ps fmt (Odoc_info.string_of_variance t (co,cn)); - ps fmt (self#normal_type m_name p) + ps fmt (Odoc_info.string_of_variance t (co,cn)); + ps fmt (self#normal_type m_name p) in match t.ty_parameters with [] -> () | [(p,co,cn)] -> print_one (p, co, cn) - | l -> - ps fmt "("; - print_concat fmt ", " print_one t.ty_parameters; - ps fmt ")" + | l -> + ps fmt "("; + print_concat fmt ", " print_one t.ty_parameters; + ps fmt ")" method latex_of_class_parameter_list fmt father c = - self#latex_of_text fmt - (self#text_of_class_params father c) + self#latex_of_text fmt + (self#text_of_class_params father c) (** Print LaTeX code for a type. *) method latex_of_type fmt t = let s_name = Name.simple t.ty_name in - let text = - let (fmt2, flush2) = new_fmt () in + let text = + let (fmt2, flush2) = new_fmt () in Odoc_info.reset_type_names () ; let mod_name = Name.father t.ty_name in Format.fprintf fmt2 "@[<h 2>type "; - self#latex_of_type_params fmt2 mod_name t; - (match t.ty_parameters with [] -> () | _ -> ps fmt2 " "); + self#latex_of_type_params fmt2 mod_name t; + (match t.ty_parameters with [] -> () | _ -> ps fmt2 " "); ps fmt2 s_name; - ( + ( match t.ty_manifest with None -> () - | Some typ -> + | Some typ -> p fmt2 " = %s" (self#normal_type mod_name typ) - ); - let s_type3 = + ); + let s_type3 = p fmt2 " %s" ( - match t.ty_kind with + match t.ty_kind with Type_abstract -> "" | Type_variant (_, priv) -> "="^(if priv then " private" else "") - | Type_record (_, priv) -> "= "^(if priv then "private " else "")^"{" - ) ; + | Type_record (_, priv) -> "= "^(if priv then "private " else "")^"{" + ) ; flush2 () in - - let defs = + + let defs = match t.ty_kind with Type_abstract -> [] | Type_variant (l, _) -> (List.flatten (List.map (fun constr -> - let s_cons = + let s_cons = p fmt2 "@[<h 6> | %s" constr.vc_name; ( - match constr.vc_args with + match constr.vc_args with [] -> () - | l -> - p fmt2 " %s@ %s" - "of" + | l -> + p fmt2 " %s@ %s" + "of" (self#normal_type_list ~par: false mod_name " * " l) - ); - flush2 () + ); + flush2 () in [ CodePre s_cons ] @ (match constr.vc_text with None -> [] - | Some t -> - let s = - ps fmt2 "\\begin{ocamldoccomment}\n"; - self#latex_of_text fmt2 t; - ps fmt2 "\n\\end{ocamldoccomment}\n"; - flush2 () - in + | Some t -> + let s = + ps fmt2 "\\begin{ocamldoccomment}\n"; + self#latex_of_text fmt2 t; + ps fmt2 "\n\\end{ocamldoccomment}\n"; + flush2 () + in [ Latex s] ) ) @@ -528,24 +531,24 @@ class latex = (List.flatten (List.map (fun r -> - let s_field = + let s_field = p fmt2 - "@[<h 6> %s%s :@ %s ;" + "@[<h 6> %s%s :@ %s ;" (if r.rf_mutable then "mutable " else "") r.rf_name (self#normal_type mod_name r.rf_type); - flush2 () + flush2 () in [ CodePre s_field ] @ (match r.rf_text with None -> [] - | Some t -> - let s = - ps fmt2 "\\begin{ocamldoccomment}\n"; - self#latex_of_text fmt2 t; - ps fmt2 "\n\\end{ocamldoccomment}\n"; - flush2 () - in + | Some t -> + let s = + ps fmt2 "\\begin{ocamldoccomment}\n"; + self#latex_of_text fmt2 t; + ps fmt2 "\n\\end{ocamldoccomment}\n"; + flush2 () + in [ Latex s] ) ) @@ -574,95 +577,95 @@ class latex = method latex_of_exception fmt e = Odoc_info.reset_type_names () ; self#latex_of_text fmt - ((Latex (self#make_label (self#exception_label e.ex_name))) :: + ((Latex (self#make_label (self#exception_label e.ex_name))) :: (to_text#text_of_exception e)) method latex_of_module_parameter fmt m_name p = - self#latex_of_text fmt - [ - Code "functor ("; - Code p.mp_name ; - Code " : "; - ] ; + self#latex_of_text fmt + [ + Code "functor ("; + Code p.mp_name ; + Code " : "; + ] ; self#latex_of_module_type_kind fmt m_name p.mp_kind; self#latex_of_text fmt [ Code ") -> "] method latex_of_module_type_kind fmt father kind = match kind with - Module_type_struct eles -> - self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"]; - List.iter (self#latex_of_module_element fmt father) eles; - self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"] + Module_type_struct eles -> + self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"]; + List.iter (self#latex_of_module_element fmt father) eles; + self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"] | Module_type_functor (p, k) -> - self#latex_of_module_parameter fmt father p; - self#latex_of_module_type_kind fmt father k + self#latex_of_module_parameter fmt father p; + self#latex_of_module_type_kind fmt father k | Module_type_alias a -> - self#latex_of_text fmt - [Code (self#relative_module_idents father a.mta_name)] + self#latex_of_text fmt + [Code (self#relative_module_idents father a.mta_name)] | Module_type_with (k, s) -> - self#latex_of_module_type_kind fmt father k; - self#latex_of_text fmt - [ Code " "; - Code (self#relative_idents father s); - ] - + self#latex_of_module_type_kind fmt father k; + self#latex_of_text fmt + [ Code " "; + Code (self#relative_idents father s); + ] + method latex_of_module_kind fmt father kind = match kind with - Module_struct eles -> - self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"]; - List.iter (self#latex_of_module_element fmt father) eles; - self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"] + Module_struct eles -> + self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"]; + List.iter (self#latex_of_module_element fmt father) eles; + self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"] | Module_alias a -> - self#latex_of_text fmt - [Code (self#relative_module_idents father a.ma_name)] + self#latex_of_text fmt + [Code (self#relative_module_idents father a.ma_name)] | Module_functor (p, k) -> - self#latex_of_module_parameter fmt father p; - self#latex_of_module_kind fmt father k + self#latex_of_module_parameter fmt father p; + self#latex_of_module_kind fmt father k | Module_apply (k1, k2) -> - (* TODO: l'application n'est pas correcte dans un .mli. - Que faire ? -> afficher le module_type du typedtree *) - self#latex_of_module_kind fmt father k1; - self#latex_of_text fmt [Code "("]; - self#latex_of_module_kind fmt father k2; - self#latex_of_text fmt [Code ")"] + (* TODO: l'application n'est pas correcte dans un .mli. + Que faire ? -> afficher le module_type du typedtree *) + self#latex_of_module_kind fmt father k1; + self#latex_of_text fmt [Code "("]; + self#latex_of_module_kind fmt father k2; + self#latex_of_text fmt [Code ")"] | Module_with (k, s) -> - (* TODO: ŕ modifier quand Module_with sera plus détaillé *) - self#latex_of_module_type_kind fmt father k; - self#latex_of_text fmt - [ Code " "; - Code (self#relative_idents father s) ; - ] + (* TODO: ŕ modifier quand Module_with sera plus détaillé *) + self#latex_of_module_type_kind fmt father k; + self#latex_of_text fmt + [ Code " "; + Code (self#relative_idents father s) ; + ] | Module_constraint (k, tk) -> - (* TODO: on affiche quoi ? *) - self#latex_of_module_kind fmt father k + (* TODO: on affiche quoi ? *) + self#latex_of_module_kind fmt father k method latex_of_class_kind fmt father kind = match kind with - Class_structure (inh, eles) -> - self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"]; - self#generate_inheritance_info fmt inh; - List.iter (self#latex_of_class_element fmt father) eles; - self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"] + Class_structure (inh, eles) -> + self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"]; + self#generate_inheritance_info fmt inh; + List.iter (self#latex_of_class_element fmt father) eles; + self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"] | Class_apply capp -> - (* TODO: afficher le type final ŕ partir du typedtree *) - self#latex_of_text fmt [Raw "class application not handled yet"] - + (* TODO: afficher le type final ŕ partir du typedtree *) + self#latex_of_text fmt [Raw "class application not handled yet"] + | Class_constr cco -> - ( + ( match cco.cco_type_parameters with [] -> () - | l -> + | l -> self#latex_of_text fmt - ( - Code "[" :: - (self#text_of_class_type_param_expr_list father l) @ - [Code "] "] - ) - ); - self#latex_of_text fmt - [Code (self#relative_idents father cco.cco_name)] + ( + Code "[" :: + (self#text_of_class_type_param_expr_list father l) @ + [Code "] "] + ) + ); + self#latex_of_text fmt + [Code (self#relative_idents father cco.cco_name)] | Class_constraint (ck, ctk) -> self#latex_of_text fmt [Code "( "] ; @@ -673,41 +676,41 @@ class latex = method latex_of_class_type_kind fmt father kind = match kind with - Class_type cta -> + Class_type cta -> ( match cta.cta_type_parameters with [] -> () - | l -> - self#latex_of_text fmt - (Code "[" :: - (self#text_of_class_type_param_expr_list father l) @ - [Code "] "] - ) + | l -> + self#latex_of_text fmt + (Code "[" :: + (self#text_of_class_type_param_expr_list father l) @ + [Code "] "] + ) ); self#latex_of_text fmt - [Code (self#relative_idents father cta.cta_name)] + [Code (self#relative_idents father cta.cta_name)] - | Class_signature (inh, eles) -> - self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"]; - self#generate_inheritance_info fmt inh; - List.iter (self#latex_of_class_element fmt father) eles; - self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"] + | Class_signature (inh, eles) -> + self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"]; + self#generate_inheritance_info fmt inh; + List.iter (self#latex_of_class_element fmt father) eles; + self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"] method latex_for_module_index fmt m = let s_name = Name.simple m.m_name in - self#latex_of_text fmt - [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ - (self#label ~no_:false s_name)^"`}\n" - ) - ] + self#latex_of_text fmt + [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ + (self#label ~no_:false s_name)^"`}\n" + ) + ] method latex_for_module_type_index fmt mt = let s_name = Name.simple mt.mt_name in - self#latex_of_text fmt - [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ - (self#label ~no_:false (Name.simple s_name))^"`}\n" - ) - ] + self#latex_of_text fmt + [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ + (self#label ~no_:false (Name.simple s_name))^"`}\n" + ) + ] method latex_for_module_label fmt m = ps fmt (self#make_label (self#module_label m.m_name)) @@ -718,19 +721,19 @@ class latex = method latex_for_class_index fmt c = let s_name = Name.simple c.cl_name in - self#latex_of_text fmt - [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ - (self#label ~no_:false s_name)^"`}\n" - ) - ] + self#latex_of_text fmt + [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ + (self#label ~no_:false s_name)^"`}\n" + ) + ] method latex_for_class_type_index fmt ct = let s_name = Name.simple ct.clt_name in - self#latex_of_text fmt - [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ - (self#label ~no_:false s_name)^"`}\n" - ) - ] + self#latex_of_text fmt + [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^ + (self#label ~no_:false s_name)^"`}\n" + ) + ] method latex_for_class_label fmt c = ps fmt (self#make_label (self#class_label c.cl_name)) @@ -741,13 +744,13 @@ class latex = (** Print the LaTeX code for the given module. *) method latex_of_module fmt m = let father = Name.father m.m_name in - let t = + let t = [ - Latex "\\begin{ocamldoccode}\n" ; - Code "module "; - Code (Name.simple m.m_name); + Latex "\\begin{ocamldoccode}\n" ; + Code "module "; + Code (Name.simple m.m_name); Code " : "; - ] + ] in self#latex_of_text fmt t; self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; @@ -757,29 +760,29 @@ class latex = self#latex_of_module_kind fmt father m.m_kind; ( match Module.module_is_functor m with - false -> () + false -> () | true -> - self#latex_of_text fmt [Newline]; - ( - match List.filter (fun (_,d) -> d <> None) - (module_parameters ~trans: false m) - with - [] -> () - | l -> - let t = - [ Bold [Raw "Parameters: "]; - List - (List.map - (fun (p,text_opt) -> - let t = match text_opt with None -> [] | Some t -> t in - ( Raw p.mp_name :: Raw ": " :: t) - ) - l - ) - ] - in - self#latex_of_text fmt t - ); + self#latex_of_text fmt [Newline]; + ( + match List.filter (fun (_,d) -> d <> None) + (module_parameters ~trans: false m) + with + [] -> () + | l -> + let t = + [ Bold [Raw "Parameters: "]; + List + (List.map + (fun (p,text_opt) -> + let t = match text_opt with None -> [] | Some t -> t in + ( Raw p.mp_name :: Raw ": " :: t) + ) + l + ) + ] + in + self#latex_of_text fmt t + ); ); self#latex_of_text fmt [Newline]; self#latex_of_info fmt ~block: true m.m_info; @@ -789,53 +792,53 @@ class latex = (** Print the LaTeX code for the given module type. *) method latex_of_module_type fmt mt = let father = Name.father mt.mt_name in - let t = + let t = [ - Latex "\\begin{ocamldoccode}\n" ; - Code "module type " ; - Code (Name.simple mt.mt_name); - ] + Latex "\\begin{ocamldoccode}\n" ; + Code "module type " ; + Code (Name.simple mt.mt_name); + ] in self#latex_of_text fmt t; ( match mt.mt_type, mt.mt_kind with - | Some mtyp, Some kind -> + | Some mtyp, Some kind -> self#latex_of_text fmt [ Code " = " ]; - self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; - self#latex_for_module_type_label fmt mt; - self#latex_for_module_type_index fmt mt; - p fmt "@[<h 4>"; - self#latex_of_module_type_kind fmt father kind + self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; + self#latex_for_module_type_label fmt mt; + self#latex_for_module_type_index fmt mt; + p fmt "@[<h 4>"; + self#latex_of_module_type_kind fmt father kind | _ -> - self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; - self#latex_for_module_type_index fmt mt; - p fmt "@[<h 4>"; + self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; + self#latex_for_module_type_index fmt mt; + p fmt "@[<h 4>"; ); ( match Module.module_type_is_functor mt with - false -> () + false -> () | true -> - self#latex_of_text fmt [Newline]; - ( - match List.filter (fun (_,d) -> d <> None) - (module_type_parameters ~trans: false mt) - with - [] -> () - | l -> - let t = - [ Bold [Raw "Parameters: "]; - List - (List.map - (fun (p,text_opt) -> - let t = match text_opt with None -> [] | Some t -> t in - ( Raw p.mp_name :: Raw ": " :: t) - ) - l - ) - ] - in - self#latex_of_text fmt t - ); + self#latex_of_text fmt [Newline]; + ( + match List.filter (fun (_,d) -> d <> None) + (module_type_parameters ~trans: false mt) + with + [] -> () + | l -> + let t = + [ Bold [Raw "Parameters: "]; + List + (List.map + (fun (p,text_opt) -> + let t = match text_opt with None -> [] | Some t -> t in + ( Raw p.mp_name :: Raw ": " :: t) + ) + l + ) + ] + in + self#latex_of_text fmt t + ); ); self#latex_of_text fmt [Newline]; self#latex_of_info fmt ~block: true mt.mt_info; @@ -844,14 +847,14 @@ class latex = (** Print the LaTeX code for the given included module. *) method latex_of_included_module fmt im = self#latex_of_text fmt - ((Code "include ") :: - (Code + ((Code "include ") :: + (Code (match im.im_module with None -> im.im_name | Some (Mod m) -> m.m_name | Some (Modtype mt) -> mt.mt_name) - ) :: - (self#text_of_info im.im_info) + ) :: + (self#text_of_info im.im_info) ) (** Print the LaTeX code for the given class. *) @@ -863,34 +866,34 @@ class latex = [] -> "" | l -> (self#normal_class_type_param_list father l)^" " in - let t = - [ - Latex "\\begin{ocamldoccode}\n" ; - Code (Printf.sprintf - "class %s%s%s : " - (if c.cl_virtual then "virtual " else "") - type_params - (Name.simple c.cl_name) - ) - ] + let t = + [ + Latex "\\begin{ocamldoccode}\n" ; + Code (Printf.sprintf + "class %s%s%s : " + (if c.cl_virtual then "virtual " else "") + type_params + (Name.simple c.cl_name) + ) + ] in self#latex_of_text fmt t; self#latex_of_class_parameter_list fmt father c; (* avoid a big gap if the kind is a consrt *) ( match c.cl_kind with - Class.Class_constr _ -> - self#latex_of_class_kind fmt father c.cl_kind + Class.Class_constr _ -> + self#latex_of_class_kind fmt father c.cl_kind | _ -> - () + () ); self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; self#latex_for_class_label fmt c; self#latex_for_class_index fmt c; p fmt "@[<h 4>"; (match c.cl_kind with - Class.Class_constr _ -> () - | _ -> self#latex_of_class_kind fmt father c.cl_kind + Class.Class_constr _ -> () + | _ -> self#latex_of_class_kind fmt father c.cl_kind ); self#latex_of_text fmt [Newline]; self#latex_of_info fmt ~block: true c.cl_info; @@ -905,16 +908,16 @@ class latex = [] -> "" | l -> (self#normal_class_type_param_list father l)^" " in - let t = - [ - Latex "\\begin{ocamldoccode}\n" ; - Code (Printf.sprintf - "class type %s%s%s = " - (if ct.clt_virtual then "virtual " else "") - type_params - (Name.simple ct.clt_name) - ) - ] + let t = + [ + Latex "\\begin{ocamldoccode}\n" ; + Code (Printf.sprintf + "class type %s%s%s = " + (if ct.clt_virtual then "virtual " else "") + type_params + (Name.simple ct.clt_name) + ) + ] in self#latex_of_text fmt t; @@ -958,22 +961,22 @@ class latex = let f inh = match inh.ic_class with None -> (* we can't make the reference *) - Newline :: + Newline :: Code ("inherit "^inh.ic_name) :: (match inh.ic_text with None -> [] | Some t -> Newline :: t ) | Some cct -> - let label = + let label = match cct with Cl _ -> self#class_label inh.ic_name | Cltype _ -> self#class_type_label inh.ic_name in (* we can create the reference *) - Newline :: + Newline :: Odoc_info.Code ("inherit "^inh.ic_name) :: - (Odoc_info.Latex (" ["^(self#make_ref label)^"]")) :: + (Odoc_info.Latex (" ["^(self#make_ref label)^"]")) :: (match inh.ic_text with None -> [] | Some t -> Newline :: t @@ -983,7 +986,7 @@ class latex = (** Generate the LaTeX code for the inherited classes of the given class. *) method generate_class_inheritance_info fmt cl = - let rec iter_kind k = + let rec iter_kind k = match k with Class_structure ([], _) -> () @@ -1010,12 +1013,21 @@ class latex = (** Generate the LaTeX code for the given top module, in the given buffer. *) method generate_for_top_module fmt m = let (first_t, rest_t) = self#first_and_rest_of_info m.m_info in - let text = [ Title (1, None, - [ Raw (Odoc_messages.modul^" ") ; Code m.m_name ] @ - (match first_t with - [] -> [] - | t -> (Raw " : ") :: t)) ; - ] + let text = + if m.m_text_only then + [ Title (1, None, [Raw m.m_name] @ + (match first_t with + [] -> [] + | t -> (Raw " : ") :: t) + ) ; + ] + else + [ Title (1, None, + [ Raw (Odoc_messages.modul^" ") ; Code m.m_name ] @ + (match first_t with + [] -> [] + | t -> (Raw " : ") :: t)) ; + ] in self#latex_of_text fmt text; self#latex_for_module_label fmt m; @@ -1023,12 +1035,12 @@ class latex = self#latex_of_text fmt rest_t ; self#latex_of_text fmt [ Newline ] ; - ps fmt "\\ocamldocvspace{0.5cm}\n\n"; - List.iter - (fun ele -> - self#latex_of_module_element fmt m.m_name ele; - ps fmt "\n\n" - ) + if not m.m_text_only then ps fmt "\\ocamldocvspace{0.5cm}\n\n"; + List.iter + (fun ele -> + self#latex_of_module_element fmt m.m_name ele; + ps fmt "\n\n" + ) (Module.module_elements ~trans: false m) (** Print the header of the TeX document. *) @@ -1040,44 +1052,44 @@ class latex = ps fmt "\\usepackage{url} \n"; ps fmt "\\usepackage{ocamldoc}\n"; ( - match !Args.title with + match !Args.title with None -> () - | Some s -> - ps fmt "\\title{"; - ps fmt (self#escape s); - ps fmt "}\n" + | Some s -> + ps fmt "\\title{"; + ps fmt (self#escape s); + ps fmt "}\n" ); ps fmt "\\begin{document}\n"; - (match !Args.title with - None -> () | - Some _ -> ps fmt "\\maketitle\n" + (match !Args.title with + None -> () | + Some _ -> ps fmt "\\maketitle\n" ); if !Args.with_toc then ps fmt "\\tableofcontents\n"; ( let info = Odoc_info.apply_opt - Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file + Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file in (match info with None -> () | Some _ -> ps fmt "\\vspace{0.2cm}"); self#latex_of_info fmt info; (match info with None -> () | Some _ -> ps fmt "\n\n") ) - + (** Generate the LaTeX style file, if it does not exists. *) method generate_style_file = try - let dir = Filename.dirname !Args.out_file in - let file = Filename.concat dir "ocamldoc.sty" in - if Sys.file_exists file then - Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file) - else - ( - let chanout = open_out file in - output_string chanout Odoc_latex_style.content ; - flush chanout ; - close_out chanout; - Odoc_info.verbose (Odoc_messages.file_generated file) - ) + let dir = Filename.dirname !Args.out_file in + let file = Filename.concat dir "ocamldoc.sty" in + if Sys.file_exists file then + Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file) + else + ( + let chanout = open_out file in + output_string chanout Odoc_latex_style.content ; + flush chanout ; + close_out chanout; + Odoc_info.verbose (Odoc_messages.file_generated file) + ) with Sys_error s -> prerr_endline s ; @@ -1092,40 +1104,40 @@ class latex = ( let f m = try - let chanout = + let chanout = open_out ((Filename.concat dir (Name.simple m.m_name))^".tex") in - let fmt = Format.formatter_of_out_channel chanout in + let fmt = Format.formatter_of_out_channel chanout in self#generate_for_top_module fmt m ; - Format.pp_print_flush fmt (); + Format.pp_print_flush fmt (); close_out chanout with Failure s | Sys_error s -> prerr_endline s ; - incr Odoc_info.errors + incr Odoc_info.errors in List.iter f module_list ); - + try let chanout = open_out main_file in - let fmt = Format.formatter_of_out_channel chanout in + let fmt = Format.formatter_of_out_channel chanout in if !Args.with_header then self#latex_header fmt; - List.iter - (fun m -> - if !Args.separate_files then + List.iter + (fun m -> + if !Args.separate_files then ps fmt ("\\input{"^((Name.simple m.m_name))^".tex}\n") else self#generate_for_top_module fmt m - ) + ) module_list ; if !Args.with_trailer then ps fmt "\\end{document}"; - Format.pp_print_flush fmt (); + Format.pp_print_flush fmt (); close_out chanout with Failure s | Sys_error s -> prerr_endline s ; - incr Odoc_info.errors + incr Odoc_info.errors end diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index 2acff68a13..b77439f6eb 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -42,8 +42,8 @@ class virtual info = [] -> () | _ -> bs b ".B \""; - bs b Odoc_messages.authors; - bs b "\"\n:\n"; + bs b Odoc_messages.authors; + bs b "\"\n:\n"; bs b (String.concat ", " l); bs b "\n.sp\n" @@ -52,47 +52,47 @@ class virtual info = match v_opt with None -> () | Some v -> - bs b ".B \""; - bs b Odoc_messages.version; - bs b "\"\n:\n"; - bs b v; - bs b "\n.sp\n" + bs b ".B \""; + bs b Odoc_messages.version; + bs b "\"\n:\n"; + bs b v; + bs b "\n.sp\n" (** Print groff string for the given optional since information.*) method man_of_since_opt b s_opt = match s_opt with None -> () | Some s -> - bs b ".B \""; - bs b Odoc_messages.since; - bs b "\"\n"; - bs b s; - bs b "\n.sp\n" + bs b ".B \""; + bs b Odoc_messages.since; + bs b "\"\n"; + bs b s; + bs b "\n.sp\n" (** Print groff string for the given list of raised exceptions.*) method man_of_raised_exceptions b l = match l with [] -> () | (s, t) :: [] -> - bs b ".B \""; - bs b Odoc_messages.raises; - bs b (" "^s^"\"\n"); - self#man_of_text b t; - bs b "\n.sp\n" + bs b ".B \""; + bs b Odoc_messages.raises; + bs b (" "^s^"\"\n"); + self#man_of_text b t; + bs b "\n.sp\n" | _ -> bs b ".B \""; - bs b Odoc_messages.raises; - bs b "\"\n"; + bs b Odoc_messages.raises; + bs b "\"\n"; List.iter (fun (ex, desc) -> - bs b ".TP\n.B \""; - bs b ex; - bs b "\"\n"; - self#man_of_text b desc; - bs b "\n" - ) + bs b ".sp\n.B \""; + bs b ex; + bs b "\"\n"; + self#man_of_text b desc; + bs b "\n" + ) l; - bs b "\n.sp\n" + bs b "\n.sp\n" (** Print groff string for the given "see also" reference. *) method man_of_see b (see_ref, t) = @@ -109,21 +109,21 @@ class virtual info = match l with [] -> () | see :: [] -> - bs b ".B \""; - bs b Odoc_messages.see_also; - bs b "\"\n"; - self#man_of_see b see; - bs b "\n.sp\n" + bs b ".B \""; + bs b Odoc_messages.see_also; + bs b "\"\n"; + self#man_of_see b see; + bs b "\n.sp\n" | _ -> bs b ".B \""; - bs b Odoc_messages.see_also; - bs b "\"\n"; - List.iter + bs b Odoc_messages.see_also; + bs b "\"\n"; + List.iter (fun see -> - bs b ".TP\n \"\"\n"; - self#man_of_see b see; - bs b "\n" - ) + bs b ".sp\n"; + self#man_of_see b see; + bs b "\n" + ) l; bs b "\n.sp\n" @@ -132,11 +132,11 @@ class virtual info = match return_opt with None -> () | Some s -> - bs b ".B "; - bs b Odoc_messages.returns; - bs b "\n"; - self#man_of_text b s; - bs b "\n.sp\n" + bs b ".B "; + bs b Odoc_messages.returns; + bs b "\n"; + self#man_of_text b s; + bs b "\n.sp\n" (** Print man code for the given list of custom tagged texts. *) method man_of_custom b l = @@ -159,22 +159,22 @@ class virtual info = | Some info -> let module M = Odoc_info in ( - match info.M.i_deprecated with + match info.M.i_deprecated with None -> () | Some d -> - bs b ".B \""; - bs b Odoc_messages.deprecated; - bs b "\"\n"; - self#man_of_text b d; - bs b "\n.sp\n" - ); + bs b ".B \""; + bs b Odoc_messages.deprecated; + bs b "\"\n"; + self#man_of_text b d; + bs b "\n.sp\n" + ); ( - match info.M.i_desc with + match info.M.i_desc with None -> () | Some d when d = [Odoc_info.Raw ""] -> () | Some d -> - self#man_of_text b d; - bs b "\n.sp\n" + self#man_of_text b d; + bs b "\n.sp\n" ); self#man_of_author_list b info.M.i_authors; self#man_of_version_opt b info.M.i_version; @@ -201,10 +201,10 @@ class man = let len = String.length s in let b = Buffer.create len in for i = 0 to len - 1 do - match s.[i] with - '\\' -> Buffer.add_string b "\\(rs" - | '.' -> Buffer.add_string b "\\&." - | c -> Buffer.add_char b c + match s.[i] with + '\\' -> Buffer.add_string b "\\(rs" + | '.' -> Buffer.add_string b "\\&." + | c -> Buffer.add_char b c done; Buffer.contents b @@ -235,35 +235,35 @@ class man = | Odoc_info.Raw s -> bs b (self#escape s) | Odoc_info.Code s -> bs b "\n.B "; - bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") + bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") | Odoc_info.CodePre s -> bs b "\n.B "; - bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") + bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") | Odoc_info.Verbatim s -> - bs b (self#escape s) + bs b (self#escape s) | Odoc_info.Bold t | Odoc_info.Italic t | Odoc_info.Emphasize t | Odoc_info.Center t | Odoc_info.Left t | Odoc_info.Right t -> - self#man_of_text2 b t + self#man_of_text2 b t | Odoc_info.List tl -> List.iter - (fun t -> bs b ".TP\n \"\"\n"; self#man_of_text2 b t; bs b "\n") + (fun t -> bs b "\n.sp\n \\-"; self#man_of_text2 b t; bs b "\n") tl; bs b "\n" | Odoc_info.Enum tl -> List.iter - (fun t -> bs b ".TP\n \"\"\n"; self#man_of_text2 b t; bs b "\n") + (fun t -> bs b "\n.sp\n \\-"; self#man_of_text2 b t; bs b "\n") tl; bs b "\n" | Odoc_info.Newline -> bs b "\n.sp\n" | Odoc_info.Block t -> bs b "\n.sp\n"; - self#man_of_text2 b t; - bs b "\n.sp\n" + self#man_of_text2 b t; + bs b "\n.sp\n" | Odoc_info.Title (n, l_opt, t) -> self#man_of_text2 b [Odoc_info.Code (Odoc_info.string_of_text t)] | Odoc_info.Latex _ -> @@ -278,10 +278,13 @@ class man = bs b "^{"; self#man_of_text2 b t | Odoc_info.Subscript t -> bs b "_{"; self#man_of_text2 b t - | Odoc_info.Module_list _ -> - () - | Odoc_info.Index_list -> - () + | Odoc_info.Module_list _ -> + () + | Odoc_info.Index_list -> + () + | Odoc_info.Custom (s,t) -> self#man_of_custom_text b s t + + method man_of_custom_text b s t = () (** Print groff string to display code. *) method man_of_code b s = self#man_of_text b [ Code s ] @@ -336,11 +339,11 @@ class man = match t.ty_parameters with [] -> () | l -> - let s = Odoc_str.string_of_type_param_list t in - let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in - bs b "\n.B "; - bs b (self#relative_idents m_name s2); - bs b "\n" + let s = Odoc_str.string_of_type_param_list t in + let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in + bs b "\n.B "; + bs b (self#relative_idents m_name s2); + bs b "\n" (** Print groff string to display a [Types.module_type]. *) method man_of_module_type b m_name t = @@ -375,18 +378,18 @@ class man = | _ -> bs b ".B of "; self#man_of_type_expr_list - ~par: false - b (Name.father e.ex_name) " * " e.ex_args + ~par: false + b (Name.father e.ex_name) " * " e.ex_args ); ( match e.ex_alias with None -> () | Some ea -> - bs b " = "; + bs b " = "; bs b - ( + ( match ea.ea_ex with - None -> ea.ea_name + None -> ea.ea_name | Some e -> e.ex_name ) ); @@ -402,66 +405,66 @@ class man = self#man_of_type_expr_param_list b father t; ( match t.ty_parameters with - [] -> () + [] -> () | _ -> bs b ".I " ); bs b (Name.simple t.ty_name); bs b " \n"; ( match t.ty_manifest with - None -> () + None -> () | Some typ -> - bs b "= "; - self#man_of_type_expr b father typ + bs b "= "; + self#man_of_type_expr b father typ ); ( match t.ty_kind with Type_abstract -> () | Type_variant (l, priv) -> bs b "="; - if priv then bs b " private"; - bs b "\n "; + if priv then bs b " private"; + bs b "\n "; List.iter (fun constr -> bs b ("| "^constr.vc_name); ( - match constr.vc_args, constr.vc_text with + match constr.vc_args, constr.vc_text with [], None -> bs b "\n " | [], (Some t) -> - bs b " (* "; - self#man_of_text b t; - bs b " *)\n " + bs b " (* "; + self#man_of_text b t; + bs b " *)\n " | l, None -> bs b "\n.B of "; - self#man_of_type_expr_list ~par: false b father " * " l; - bs b " " + self#man_of_type_expr_list ~par: false b father " * " l; + bs b " " | l, (Some t) -> bs b "\n.B of "; - self#man_of_type_expr_list ~par: false b father " * " l; + self#man_of_type_expr_list ~par: false b father " * " l; bs b ".I \" \"\n"; bs b "(* "; - self#man_of_text b t; - bs b " *)\n " + self#man_of_text b t; + bs b " *)\n " ) - ) + ) l | Type_record (l, priv) -> bs b "= "; - if priv then bs b "private "; - bs b "{"; + if priv then bs b "private "; + bs b "{"; List.iter (fun r -> bs b (if r.rf_mutable then "\n\n.B mutable \n" else "\n "); bs b (r.rf_name^" : "); - self#man_of_type_expr b father r.rf_type; - bs b ";"; + self#man_of_type_expr b father r.rf_type; + bs b ";"; ( - match r.rf_text with + match r.rf_text with None -> () | Some t -> bs b " (* "; - self#man_of_text b t; - bs b " *) " + self#man_of_text b t; + bs b " *) " ); ) l; @@ -488,7 +491,7 @@ class man = if m.met_virtual then bs b "virtual "; bs b ((Name.simple m.met_value.val_name)^" : "); self#man_of_type_expr b - (Name.father m.met_value.val_name) m.met_value.val_type; + (Name.father m.met_value.val_name) m.met_value.val_type; bs b "\n.sp\n"; self#man_of_info b m.met_value.val_info; bs b "\n.sp\n" @@ -499,18 +502,18 @@ class man = [] -> () | _ -> bs b "\n.B "; - bs b Odoc_messages.parameters; - bs b ": \n"; - List.iter + bs b Odoc_messages.parameters; + bs b ": \n"; + List.iter (fun p -> - bs b ".TP\n"; + bs b ".sp\n"; bs b "\""; - bs b (Parameter.complete_name p); - bs b "\"\n"; + bs b (Parameter.complete_name p); + bs b "\"\n"; self#man_of_type_expr b m_name (Parameter.typ p); - bs b "\n"; + bs b "\n"; self#man_of_parameter_description b p; - bs b "\n" + bs b "\n" ) l; bs b "\n" @@ -528,13 +531,13 @@ class man = ) | l -> (* A list of names, we display those with a description. *) - List.iter + List.iter (fun n -> match Parameter.desc_by_name p n with None -> () | Some t -> - self#man_of_code b (n^" : "); - self#man_of_text b t + self#man_of_code b (n^" : "); + self#man_of_text b t ) l @@ -544,19 +547,19 @@ class man = [] -> () | _ -> bs b ".B \""; - bs b Odoc_messages.parameters; - bs b ":\"\n"; + bs b Odoc_messages.parameters; + bs b ":\"\n"; List.iter (fun (p, desc_opt) -> - bs b ".TP\n"; + bs b ".sp\n"; bs b ("\""^p.mp_name^"\"\n"); self#man_of_module_type b m_name p.mp_type; - bs b "\n"; + bs b "\n"; ( - match desc_opt with + match desc_opt with None -> () | Some t -> self#man_of_text b t - ); + ); bs b "\n" ) l; @@ -572,8 +575,8 @@ class man = match c.cl_type_parameters with [] -> () | l -> - bs b (Odoc_str.string_of_class_type_param_list l); - bs b " " + bs b (Odoc_str.string_of_class_type_param_list l); + bs b " " ); bs b (Name.simple c.cl_name); bs b " : " ; @@ -591,8 +594,8 @@ class man = match ct.clt_type_parameters with [] -> () | l -> - bs b (Odoc_str.string_of_class_type_param_list l); - bs b " " + bs b (Odoc_str.string_of_class_type_param_list l); + bs b " " ); bs b (Name.simple ct.clt_name); bs b " = " ; @@ -619,7 +622,7 @@ class man = (match mt.mt_type with None -> () | Some t -> - self#man_of_module_type b (Name.father mt.mt_name) t + self#man_of_module_type b (Name.father mt.mt_name) t ); bs b "\n.sp\n"; self#man_of_info b mt.mt_info; @@ -662,23 +665,23 @@ class man = let file = self#file_name cl.cl_name in try let chanout = self#open_out file in - let b = new_buf () in - bs b (".TH \""^cl.cl_name^"\" "); + let b = new_buf () in + bs b (".TH \""^cl.cl_name^"\" "); bs b !Odoc_args.man_section ; - bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^"\" "); + bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" "); bs b "OCamldoc "; bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n"); - let abstract = - match cl.cl_info with - None | Some { i_desc = None } -> "no description" - | Some { i_desc = Some t } -> - let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in - self#remove_newlines s - in + let abstract = + match cl.cl_info with + None | Some { i_desc = None } -> "no description" + | Some { i_desc = Some t } -> + let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in + self#remove_newlines s + in - bs b ".SH NAME\n"; - bs b (cl.cl_name^" \\- "^abstract^"\n"); + bs b ".SH NAME\n"; + bs b (cl.cl_name^" \\- "^abstract^"\n"); bs b (".SH "^Odoc_messages.clas^"\n"); bs b (Odoc_messages.clas^" "^cl.cl_name^"\n"); bs b (".SH "^Odoc_messages.documentation^"\n"); @@ -707,7 +710,7 @@ class man = ) (Class.class_elements cl); - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout with Sys_error s -> @@ -721,29 +724,29 @@ class man = let file = self#file_name ct.clt_name in try let chanout = self#open_out file in - let b = new_buf () in - bs b (".TH \""^ct.clt_name^"\" "); + let b = new_buf () in + bs b (".TH \""^ct.clt_name^"\" "); bs b !Odoc_args.man_section ; - bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^"\" "); + bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" "); bs b "OCamldoc "; bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n"); - let abstract = - match ct.clt_info with - None | Some { i_desc = None } -> "no description" - | Some { i_desc = Some t } -> - let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in - self#remove_newlines s - in + let abstract = + match ct.clt_info with + None | Some { i_desc = None } -> "no description" + | Some { i_desc = Some t } -> + let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in + self#remove_newlines s + in bs b ".SH NAME\n"; - bs b (ct.clt_name^" \\- "^abstract^"\n"); + bs b (ct.clt_name^" \\- "^abstract^"\n"); bs b (".SH "^Odoc_messages.class_type^"\n"); bs b (Odoc_messages.class_type^" "^ct.clt_name^"\n"); bs b (".SH "^Odoc_messages.documentation^"\n"); bs b ".sp\n"; - self#man_of_class_type b ct; + self#man_of_class_type b ct; (* a large blank *) bs b "\n.sp\n.sp\n"; @@ -764,7 +767,7 @@ class man = ) (Class.class_type_elements ct); - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout with Sys_error s -> @@ -778,22 +781,22 @@ class man = let file = self#file_name mt.mt_name in try let chanout = self#open_out file in - let b = new_buf () in - bs b (".TH \""^mt.mt_name^"\" "); + let b = new_buf () in + bs b (".TH \""^mt.mt_name^"\" "); bs b !Odoc_args.man_section ; - bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^"\" "); + bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" "); bs b "OCamldoc "; bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n"); - let abstract = - match mt.mt_info with - None | Some { i_desc = None } -> "no description" - | Some { i_desc = Some t } -> - let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in - self#remove_newlines s - in - bs b ".SH NAME\n"; - bs b (mt.mt_name^" \\- "^abstract^"\n"); + let abstract = + match mt.mt_info with + None | Some { i_desc = None } -> "no description" + | Some { i_desc = Some t } -> + let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in + self#remove_newlines s + in + bs b ".SH NAME\n"; + bs b (mt.mt_name^" \\- "^abstract^"\n"); bs b (".SH "^Odoc_messages.module_type^"\n"); bs b (Odoc_messages.module_type^" "^mt.mt_name^"\n"); bs b (".SH "^Odoc_messages.documentation^"\n"); @@ -802,14 +805,14 @@ class man = bs b (".BI \""^(Name.simple mt.mt_name)^"\"\n"); bs b " = "; ( - match mt.mt_type with + match mt.mt_type with None -> () | Some t -> - self#man_of_module_type b (Name.father mt.mt_name) t + self#man_of_module_type b (Name.father mt.mt_name) t ); bs b "\n.sp\n"; self#man_of_info b mt.mt_info; - bs b "\n.sp\n"; + bs b "\n.sp\n"; (* parameters for functors *) self#man_of_module_parameter_list b "" (Module.module_type_parameters mt); @@ -841,7 +844,7 @@ class man = ) (Module.module_type_elements mt); - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout with @@ -856,23 +859,23 @@ class man = let file = self#file_name m.m_name in try let chanout = self#open_out file in - let b = new_buf () in - bs b (".TH \""^m.m_name^"\" "); + let b = new_buf () in + bs b (".TH \""^m.m_name^"\" "); bs b !Odoc_args.man_section ; - bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^"\" "); + bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" "); bs b "OCamldoc "; bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n"); - let abstract = - match m.m_info with - None | Some { i_desc = None } -> "no description" - | Some { i_desc = Some t } -> - let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in - self#remove_newlines s - in + let abstract = + match m.m_info with + None | Some { i_desc = None } -> "no description" + | Some { i_desc = Some t } -> + let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in + self#remove_newlines s + in - bs b ".SH NAME\n"; - bs b (m.m_name^" \\- "^abstract^"\n"); + bs b ".SH NAME\n"; + bs b (m.m_name^" \\- "^abstract^"\n"); bs b (".SH "^Odoc_messages.modul^"\n"); bs b (Odoc_messages.modul^" "^m.m_name^"\n"); bs b (".SH "^Odoc_messages.documentation^"\n"); @@ -880,10 +883,10 @@ class man = bs b (Odoc_messages.modul^"\n"); bs b (".BI \""^(Name.simple m.m_name)^"\"\n"); bs b " : "; - self#man_of_module_type b (Name.father m.m_name) m.m_type; + self#man_of_module_type b (Name.father m.m_name) m.m_type; bs b "\n.sp\n"; self#man_of_info b m.m_info; - bs b "\n.sp\n"; + bs b "\n.sp\n"; (* parameters for functors *) self#man_of_module_parameter_list b "" (Module.module_parameters m); @@ -915,7 +918,7 @@ class man = ) (Module.module_elements m); - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout with @@ -983,14 +986,14 @@ class man = let file = self#file_name name in try let chanout = self#open_out file in - let b = new_buf () in - bs b (".TH \""^name^"\" "); + let b = new_buf () in + bs b (".TH \""^name^"\" "); bs b !Odoc_args.man_section ; - bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^"\" "); + bs b (" "^(Odoc_misc.string_of_date ~hour: false date)^" "); bs b "OCamldoc "; bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n"); - bs b ".SH NAME\n"; - bs b (name^" \\- all "^name^" elements\n\n"); + bs b ".SH NAME\n"; + bs b (name^" \\- all "^name^" elements\n\n"); let f ele = match ele with @@ -1020,7 +1023,7 @@ class man = () in List.iter f l; - Buffer.output_buffer chanout b; + Buffer.output_buffer chanout b; close_out chanout with Sys_error s -> diff --git a/ocamldoc/odoc_messages.ml b/ocamldoc/odoc_messages.ml index 98f6deff02..66c4fa5fd7 100644 --- a/ocamldoc/odoc_messages.ml +++ b/ocamldoc/odoc_messages.ml @@ -38,6 +38,7 @@ let rectypes = "\tAllow arbitrary recursive types" let preprocess = "<command>\tPipe sources through preprocessor <command>" let option_impl ="<file>\tConsider <file> as a .ml file" let option_intf ="<file>\tConsider <file> as a .mli file" +let option_text ="<file>\tConsider <file> as a .txt file" let display_custom_generators_dir = "\tDisplay custom generators standard directory and exit" let add_load_dir = "<dir>\tAdd the given directory to the search path for custom\n"^ "\t\tgenerators "^bytecode_only @@ -62,7 +63,9 @@ let option_not_in_native_code op = "Option "^op^" not available in native code v let default_out_file = "ocamldoc.out" let out_file = "<file>\tSet the ouput file name, used by texi, latex and dot generators\n"^ - "\t\t(default is "^default_out_file^")" + "\t\t(default is "^default_out_file^")\n"^ + "\t\tor the prefix of index files for the HTML generator\n"^ + "\t\t(default is index)" let dot_include_all = "\n\t\tInclude all modules in the dot output, not only the\n"^ diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml index 9b6908dd34..f3ad212ff5 100644 --- a/ocamldoc/odoc_misc.ml +++ b/ocamldoc/odoc_misc.ml @@ -11,6 +11,16 @@ (* $Id$ *) +let no_blanks s = + let len = String.length s in + let buf = Buffer.create len in + for i = 0 to len - 1 do + match s.[i] with + ' ' | '\n' | '\t' | '\r' -> () + | c -> Buffer.add_char buf c + done; + Buffer.contents buf + let input_file_as_string nom = let chanin = open_in_bin nom in let len = 1024 in @@ -38,15 +48,15 @@ let split_string s chars = let rec iter acc pos = if pos >= len then match acc with - "" -> [] - | _ -> [acc] + "" -> [] + | _ -> [acc] else if List.mem s.[pos] chars then - match acc with - "" -> iter "" (pos + 1) - | _ -> acc :: (iter "" (pos + 1)) + match acc with + "" -> iter "" (pos + 1) + | _ -> acc :: (iter "" (pos + 1)) else - iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1) + iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1) in iter "" 0 @@ -115,13 +125,14 @@ let rec string_of_text t = "^{"^(string_of_text t)^"}" | Odoc_types.Subscript t -> "^{"^(string_of_text t)^"}" - | Odoc_types.Module_list l -> - string_of_text - (list_concat (Odoc_types.Raw ", ") - (List.map (fun s -> Odoc_types.Code s) l) - ) - | Odoc_types.Index_list -> - "" + | Odoc_types.Module_list l -> + string_of_text + (list_concat (Odoc_types.Raw ", ") + (List.map (fun s -> Odoc_types.Code s) l) + ) + | Odoc_types.Index_list -> + "" + | Odoc_types.Custom (_, t) -> string_of_text t in String.concat "" (List.map iter t) @@ -256,12 +267,13 @@ let rec text_no_title_no_list t = | Odoc_types.Superscript t -> [Odoc_types.Superscript (text_no_title_no_list t)] | Odoc_types.Subscript t -> [Odoc_types.Subscript (text_no_title_no_list t)] | Odoc_types.Module_list l -> - list_concat (Odoc_types.Raw ", ") - (List.map - (fun s -> Odoc_types.Ref (s, Some Odoc_types.RK_module)) - l - ) + list_concat (Odoc_types.Raw ", ") + (List.map + (fun s -> Odoc_types.Ref (s, Some Odoc_types.RK_module)) + l + ) | Odoc_types.Index_list -> [] + | Odoc_types.Custom (s,t) -> [Odoc_types.Custom (s, text_no_title_no_list t)] in List.flatten (List.map iter t) @@ -291,6 +303,7 @@ let get_titles_in_text t = | Odoc_types.Subscript t -> iter_text t | Odoc_types.Module_list _ -> () | Odoc_types.Index_list -> () + | Odoc_types.Custom (_, t) -> iter_text t and iter_text te = List.iter iter_ele te in @@ -382,6 +395,7 @@ and first_sentence_text_ele text_ele = | Odoc_types.Subscript _ | Odoc_types.Module_list _ | Odoc_types.Index_list -> (false, text_ele, None) + | Odoc_types.Custom _ -> (false, text_ele, None) let first_sentence_of_text t = let (_,t2,_) = first_sentence_text t in @@ -408,12 +422,12 @@ let search_string_backward ~pat = -1 -> raise Not_found | 0 -> if pat = s then 0 else raise Not_found | _ -> - let pos = len - lenp in - let s2 = String.sub s pos lenp in - if s2 = pat then - pos - else - iter (String.sub s 0 pos) + let pos = len - lenp in + let s2 = String.sub s pos lenp in + if s2 = pat then + pos + else + iter (String.sub s 0 pos) in fun ~s -> iter s @@ -468,5 +482,3 @@ let remove_option typ = | Types.Tkonst (_,_) -> t in { typ with Types.desc = iter typ.Types.desc } - -(* eof $Id$ *) diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli index d3037519b9..4fc83fe89b 100644 --- a/ocamldoc/odoc_misc.mli +++ b/ocamldoc/odoc_misc.mli @@ -13,6 +13,11 @@ (** Miscelaneous functions *) +(** [no_blanks s] returns the given string without any blank + characters, i.e. '\n' '\r' ' ' '\t'. +*) +val no_blanks : string -> string + (** This function returns a file in the form of one string.*) val input_file_as_string : string -> string diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml index f2f4572994..756ccf86b6 100644 --- a/ocamldoc/odoc_module.ml +++ b/ocamldoc/odoc_module.ml @@ -38,33 +38,33 @@ and included_module = { im_name : Name.t ; (** the name of the included module *) mutable im_module : mmt option ; (** the included module or module type *) mutable im_info : Odoc_types.info option ; (** comment associated to the includ directive *) - } + } and module_alias = { ma_name : Name.t ; mutable ma_module : mmt option ; (** the real module or module type if we could associate it *) - } + } and module_parameter = { mp_name : string ; (** the name *) mp_type : Types.module_type ; (** the type *) mp_type_code : string ; (** the original code *) mp_kind : module_type_kind ; (** the way the parameter was built *) - } + } (** Different kinds of module. *) and module_kind = - | Module_struct of module_element list + | Module_struct of module_element list | Module_alias of module_alias (** complete name and corresponding module if we found it *) | Module_functor of module_parameter * module_kind | Module_apply of module_kind * module_kind | Module_with of module_type_kind * string | Module_constraint of module_kind * module_type_kind - + (** Representation of a module. *) and t_module = { - m_name : Name.t ; - m_type : Types.module_type ; + m_name : Name.t ; + m_type : Types.module_type ; mutable m_info : Odoc_types.info option ; m_is_interface : bool ; (** true for modules read from interface files *) m_file : string ; (** the file the module is defined in. *) @@ -73,40 +73,41 @@ and t_module = { mutable m_top_deps : Name.t list ; (** The toplevels module names this module depends on. *) mutable m_code : string option ; (** The whole code of the module *) mutable m_code_intf : string option ; (** The whole code of the interface of the module *) - } + m_text_only : bool ; (** [true] if the module comes from a text file *) + } and module_type_alias = { mta_name : Name.t ; mutable mta_module : t_module_type option ; (** the real module type if we could associate it *) - } + } (** Different kinds of module type. *) and module_type_kind = - | Module_type_struct of module_element list + | Module_type_struct of module_element list | Module_type_functor of module_parameter * module_type_kind | Module_type_alias of module_type_alias (** complete name and corresponding module type if we found it *) | Module_type_with of module_type_kind * string (** the module type kind and the code of the with constraint *) (** Representation of a module type. *) and t_module_type = { - mt_name : Name.t ; + mt_name : Name.t ; mutable mt_info : Odoc_types.info option ; mt_type : Types.module_type option ; (** [None] = abstract module type *) mt_is_interface : bool ; (** true for modules read from interface files *) mt_file : string ; (** the file the module type is defined in. *) mutable mt_kind : module_type_kind option ; (** [None] = abstract module type if mt_type = None ; Always [None] when the module type was extracted from the implementation file. *) - mutable mt_loc : Odoc_types.location ; - } + mutable mt_loc : Odoc_types.location ; + } (** {2 Functions} *) (** Returns the list of values from a list of module_element. *) let values l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_value v -> acc @ [v] | _ -> acc ) @@ -115,9 +116,9 @@ let values l = (** Returns the list of types from a list of module_element. *) let types l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_type t -> acc @ [t] | _ -> acc ) @@ -126,9 +127,9 @@ let types l = (** Returns the list of exceptions from a list of module_element. *) let exceptions l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_exception e -> acc @ [e] | _ -> acc ) @@ -137,9 +138,9 @@ let exceptions l = (** Returns the list of classes from a list of module_element. *) let classes l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_class c -> acc @ [c] | _ -> acc ) @@ -148,9 +149,9 @@ let classes l = (** Returns the list of class types from a list of module_element. *) let class_types l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_class_type ct -> acc @ [ct] | _ -> acc ) @@ -159,9 +160,9 @@ let class_types l = (** Returns the list of modules from a list of module_element. *) let modules l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_module m -> acc @ [m] | _ -> acc ) @@ -170,9 +171,9 @@ let modules l = (** Returns the list of module types from a list of module_element. *) let mod_types l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_module_type mt -> acc @ [mt] | _ -> acc ) @@ -181,9 +182,9 @@ let mod_types l = (** Returns the list of module comment from a list of module_element. *) let comments l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_module_comment t -> acc @ [t] | _ -> acc ) @@ -192,23 +193,23 @@ let comments l = (** Returns the list of included modules from a list of module_element. *) let included_modules l = - List.fold_left + List.fold_left (fun acc -> fun ele -> - match ele with + match ele with Element_included_module m -> acc @ [m] | _ -> acc ) [] l -(** Returns the list of elements of a module. +(** Returns the list of elements of a module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let rec module_elements ?(trans=true) m = let rec iter_kind = function - Module_struct l -> + Module_struct l -> print_DEBUG "Odoc_module.module_element: Module_struct"; l - | Module_alias ma -> + | Module_alias ma -> print_DEBUG "Odoc_module.module_element: Module_alias"; if trans then match ma.ma_module with @@ -217,8 +218,8 @@ let rec module_elements ?(trans=true) m = | Some (Modtype mt) -> module_type_elements mt else [] - | Module_functor (_, k) - | Module_apply (k, _) -> + | Module_functor (_, k) + | Module_apply (k, _) -> print_DEBUG "Odoc_module.module_element: Module_functor ou Module_apply"; iter_kind k | Module_with (tk,_) -> @@ -232,14 +233,15 @@ let rec module_elements ?(trans=true) m = print_DEBUG "Odoc_module.module_element: Module_constraint"; (* A VOIR : utiliser k ou tk ? *) module_elements ~trans: trans - { m_name = "" ; - m_info = None ; + { m_name = "" ; + m_info = None ; m_type = Types.Tmty_signature [] ; m_is_interface = false ; m_file = "" ; m_kind = k ; m_loc = Odoc_types.dummy_loc ; m_top_deps = [] ; m_code = None ; m_code_intf = None ; + m_text_only = false ; } (* module_type_elements ~trans: trans @@ -248,9 +250,9 @@ let rec module_elements ?(trans=true) m = mt_loc = Odoc_types.dummy_loc } *) in - iter_kind m.m_kind + iter_kind m.m_kind -(** Returns the list of elements of a module type. +(** Returns the list of elements of a module type. @param trans indicates if, for aliased modules, we must perform a transitive search.*) and module_type_elements ?(trans=true) mt = let rec iter_kind = function @@ -262,7 +264,7 @@ and module_type_elements ?(trans=true) mt = iter_kind (Some k) else [] - | Some (Module_type_alias mta) -> + | Some (Module_type_alias mta) -> if trans then match mta.mta_module with None -> [] @@ -280,21 +282,21 @@ let module_values ?(trans=true) m = values (module_elements ~trans m) @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_functions ?(trans=true) m = List.filter - (fun v -> Odoc_value.is_function v) + (fun v -> Odoc_value.is_function v) (values (module_elements ~trans m)) (** Returns the list of non-functional values of a module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_simple_values ?(trans=true) m = List.filter - (fun v -> not (Odoc_value.is_function v)) + (fun v -> not (Odoc_value.is_function v)) (values (module_elements ~trans m)) - + (** Returns the list of types of a module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_types ?(trans=true) m = types (module_elements ~trans m) -(** Returns the list of excptions of a module. +(** Returns the list of excptions of a module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_exceptions ?(trans=true) m = exceptions (module_elements ~trans m) @@ -306,7 +308,7 @@ let module_classes ?(trans=true) m = classes (module_elements ~trans m) @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_class_types ?(trans=true) m = class_types (module_elements ~trans m) -(** Returns the list of modules of a module. +(** Returns the list of modules of a module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_modules ?(trans=true) m = modules (module_elements ~trans m) @@ -322,12 +324,12 @@ let module_included_modules ?(trans=true) m = included_modules (module_elements @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_comments ?(trans=true) m = comments (module_elements ~trans m) -(** Access to the parameters, for a functor type. +(** Access to the parameters, for a functor type. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let rec module_type_parameters ?(trans=true) mt = let rec iter k = match k with - Some (Module_type_functor (p, k2)) -> + Some (Module_type_functor (p, k2)) -> let param = (* we create the couple (parameter, description opt), using the description of the parameter if we can find it in the comment.*) @@ -358,15 +360,15 @@ let rec module_type_parameters ?(trans=true) mt = [] | None -> [] - in + in iter mt.mt_kind (** Access to the parameters, for a functor. @param trans indicates if, for aliased modules, we must perform a transitive search.*) and module_parameters ?(trans=true) m = let rec iter = function - Module_functor (p, k) -> - let param = + Module_functor (p, k) -> + let param = (* we create the couple (parameter, description opt), using the description of the parameter if we can find it in the comment.*) match m.m_info with @@ -394,8 +396,8 @@ and module_parameters ?(trans=true) m = { mt_name = "" ; mt_info = None ; mt_type = None ; mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ; mt_loc = Odoc_types.dummy_loc } - | Module_struct _ - | Module_apply _ + | Module_struct _ + | Module_apply _ | Module_with _ -> [] in @@ -411,31 +413,31 @@ let rec module_all_submodules ?(trans=true) m = l (** The module type is a functor if is defined as a functor or if it is an alias for a functor. *) -let rec module_type_is_functor mt = +let rec module_type_is_functor mt = let rec iter k = match k with Some (Module_type_functor _) -> true | Some (Module_type_alias mta) -> ( match mta.mta_module with - None -> false + None -> false | Some mtyp -> module_type_is_functor mtyp ) | Some (Module_type_with (k, _)) -> iter (Some k) - | Some (Module_type_struct _) + | Some (Module_type_struct _) | None -> false in iter mt.mt_kind (** The module is a functor if is defined as a functor or if it is an alias for a functor. *) -let module_is_functor m = +let module_is_functor m = let rec iter = function Module_functor _ -> true | Module_alias ma -> ( match ma.ma_module with - None -> false + None -> false | Some (Mod mo) -> iter mo.m_kind | Some (Modtype mt) -> module_type_is_functor mt ) @@ -445,11 +447,11 @@ let module_is_functor m = in iter m.m_kind -(** Returns the list of values of a module type. +(** Returns the list of values of a module type. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_type_values ?(trans=true) m = values (module_type_elements ~trans m) - -(** Returns the list of types of a module. + +(** Returns the list of types of a module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_type_types ?(trans=true) m = types (module_type_elements ~trans m) @@ -477,7 +479,7 @@ let module_type_module_types ?(trans=true) m = mod_types (module_type_elements ~ @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_type_included_modules ?(trans=true) m = included_modules (module_type_elements ~trans m) -(** Returns the list of comments of a module. +(** Returns the list of comments of a module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_type_comments ?(trans=true) m = comments (module_type_elements ~trans m) @@ -485,21 +487,21 @@ let module_type_comments ?(trans=true) m = comments (module_type_elements ~trans @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_type_functions ?(trans=true) mt = List.filter - (fun v -> Odoc_value.is_function v) + (fun v -> Odoc_value.is_function v) (values (module_type_elements ~trans mt)) -(** Returns the list of non-functional values of a module type. +(** Returns the list of non-functional values of a module type. @param trans indicates if, for aliased modules, we must perform a transitive search.*) let module_type_simple_values ?(trans=true) mt = List.filter - (fun v -> not (Odoc_value.is_function v)) + (fun v -> not (Odoc_value.is_function v)) (values (module_type_elements ~trans mt)) (** {2 Functions for modules and module types} *) -(** The list of classes defined in this module and all its modules, functors, .... +(** The list of classes defined in this module and all its modules, functors, .... @param trans indicates if, for aliased modules, we must perform a transitive search.*) -let rec module_all_classes ?(trans=true) m = +let rec module_all_classes ?(trans=true) m = List.fold_left (fun acc -> fun m -> acc @ (module_all_classes ~trans m)) ( @@ -510,7 +512,7 @@ let rec module_all_classes ?(trans=true) m = ) (module_modules ~trans m) -(** The list of classes defined in this module type and all its modules, functors, .... +(** The list of classes defined in this module type and all its modules, functors, .... @param trans indicates if, for aliased modules, we must perform a transitive search.*) and module_type_all_classes ?(trans=true) mt = List.fold_left diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml index d25aee63d5..3329475d5e 100644 --- a/ocamldoc/odoc_search.ml +++ b/ocamldoc/odoc_search.ml @@ -43,7 +43,7 @@ module type Predicates = val p_class : t_class -> t -> bool * bool val p_class_type : t_class_type -> t -> bool * bool val p_value : t_value -> t -> bool - val p_type : t_type -> t -> bool + val p_type : t_type -> t -> bool val p_exception : t_exception -> t -> bool val p_attribute : t_attribute -> t -> bool val p_method : t_method -> t -> bool @@ -65,7 +65,7 @@ module Search = | T.Code _ | T.CodePre _ | T.Latex _ - | T.Verbatim _ + | T.Verbatim _ | T.Ref (_, _) -> [] | T.Bold t | T.Italic t @@ -76,13 +76,14 @@ module Search = | T.Block t | T.Superscript t | T.Subscript t + | T.Custom (_,t) | T.Link (_, t) -> search_text root t v - | T.List l + | T.List l | T.Enum l -> List.flatten (List.map (fun t -> search_text root t v) l) - | T.Newline + | T.Newline | T.Module_list _ | T.Index_list -> [] - | T.Title (n, l_opt, t) -> + | T.Title (n, l_opt, t) -> (match l_opt with None -> [] | Some s -> search_section t (Name.concat root s) v) @ @@ -100,21 +101,21 @@ module Search = let search_class c v = let (go_deeper, ok) = P.p_class c v in - let l = + let l = if go_deeper then - let res_att = + let res_att = List.fold_left (fun acc -> fun att -> acc @ (search_attribute att v)) [] (Odoc_class.class_attributes c) in - let res_met = + let res_met = List.fold_left (fun acc -> fun m -> acc @ (search_method m v)) [] (Odoc_class.class_methods c) in - let res_sec = + let res_sec = List.fold_left (fun acc -> fun t -> acc @ (search_text c.cl_name t v)) [] @@ -132,21 +133,21 @@ module Search = let search_class_type ct v = let (go_deeper, ok) = P.p_class_type ct v in - let l = + let l = if go_deeper then - let res_att = + let res_att = List.fold_left (fun acc -> fun att -> acc @ (search_attribute att v)) [] (Odoc_class.class_type_attributes ct) in - let res_met = + let res_met = List.fold_left (fun acc -> fun m -> acc @ (search_method m v)) [] (Odoc_class.class_type_methods ct) in - let res_sec = + let res_sec = List.fold_left (fun acc -> fun t -> acc @ (search_text ct.clt_name t v)) [] @@ -166,57 +167,57 @@ module Search = let (go_deeper, ok) = P.p_module_type mt v in let l = if go_deeper then - let res_val = + let res_val = List.fold_left (fun acc -> fun va -> acc @ (search_value va v)) [] (Odoc_module.module_type_values mt) in - let res_typ = + let res_typ = List.fold_left (fun acc -> fun t -> acc @ (search_type t v)) [] (Odoc_module.module_type_types mt) in - let res_exc = + let res_exc = List.fold_left (fun acc -> fun e -> acc @ (search_exception e v)) [] (Odoc_module.module_type_exceptions mt) in let res_mod = search (Odoc_module.module_type_modules mt) v in - let res_modtyp = + let res_modtyp = List.fold_left (fun acc -> fun mt -> acc @ (search_module_type mt v)) [] (Odoc_module.module_type_module_types mt) - in - let res_cl = + in + let res_cl = List.fold_left (fun acc -> fun cl -> acc @ (search_class cl v)) [] (Odoc_module.module_type_classes mt) in - let res_cltyp = + let res_cltyp = List.fold_left (fun acc -> fun clt -> acc @ (search_class_type clt v)) [] (Odoc_module.module_type_class_types mt) in - let res_sec = + let res_sec = List.fold_left (fun acc -> fun t -> acc @ (search_text mt.mt_name t v)) [] (Odoc_module.module_type_comments mt) in - let l = res_val @ res_typ @ res_exc @ res_mod @ - res_modtyp @ res_cl @ res_cltyp @ res_sec + let l = res_val @ res_typ @ res_exc @ res_mod @ + res_modtyp @ res_cl @ res_cltyp @ res_sec in l else [] in - if ok then + if ok then (Res_module_type mt) :: l else l @@ -225,64 +226,64 @@ module Search = let (go_deeper, ok) = P.p_module m v in let l = if go_deeper then - let res_val = + let res_val = List.fold_left (fun acc -> fun va -> acc @ (search_value va v)) [] (Odoc_module.module_values m) in - let res_typ = + let res_typ = List.fold_left (fun acc -> fun t -> acc @ (search_type t v)) [] (Odoc_module.module_types m) in - let res_exc = + let res_exc = List.fold_left (fun acc -> fun e -> acc @ (search_exception e v)) [] (Odoc_module.module_exceptions m) in let res_mod = search (Odoc_module.module_modules m) v in - let res_modtyp = + let res_modtyp = List.fold_left (fun acc -> fun mt -> acc @ (search_module_type mt v)) [] (Odoc_module.module_module_types m) in - let res_cl = + let res_cl = List.fold_left (fun acc -> fun cl -> acc @ (search_class cl v)) [] (Odoc_module.module_classes m) in - let res_cltyp = + let res_cltyp = List.fold_left (fun acc -> fun clt -> acc @ (search_class_type clt v)) [] (Odoc_module.module_class_types m) in - let res_sec = + let res_sec = List.fold_left (fun acc -> fun t -> acc @ (search_text m.m_name t v)) [] (Odoc_module.module_comments m) in - let l = res_val @ res_typ @ res_exc @ res_mod @ + let l = res_val @ res_typ @ res_exc @ res_mod @ res_modtyp @ res_cl @ res_cltyp @ res_sec in l else [] in - if ok then + if ok then (Res_module m) :: l else l and search module_list v = List.fold_left - (fun acc -> fun m -> + (fun acc -> fun m -> List.fold_left (fun acc2 -> fun ele -> if List.mem ele acc2 then acc2 else acc2 @ [ele] @@ -294,8 +295,8 @@ module Search = module_list end -module P_name = - struct +module P_name = + struct type t = Str.regexp let (=~) name regexp = Str.string_match regexp name 0 let p_module m r = (true, m.m_name =~ r) @@ -309,11 +310,11 @@ module P_name = let p_method m r = m.met_value.val_name =~ r let p_section s r = s =~ r end - + module Search_by_name = Search ( P_name ) module P_values = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, false) @@ -327,7 +328,7 @@ module P_values = let p_section _ _ = false end module Search_values = Search ( P_values ) -let values l = +let values l = let l_ele = Search_values.search l () in let p v1 v2 = v1.val_name = v2.val_name in let rec iter acc = function @@ -336,9 +337,9 @@ let values l = | [] -> acc in iter [] l_ele - + module P_exceptions = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, false) @@ -352,7 +353,7 @@ module P_exceptions = let p_section _ _ = false end module Search_exceptions = Search ( P_exceptions ) -let exceptions l = +let exceptions l = let l_ele = Search_exceptions.search l () in let p e1 e2 = e1.ex_name = e2.ex_name in let rec iter acc = function @@ -361,9 +362,9 @@ let exceptions l = | [] -> acc in iter [] l_ele - + module P_types = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, false) @@ -377,7 +378,7 @@ module P_types = let p_section _ _ = false end module Search_types = Search ( P_types ) -let types l = +let types l = let l_ele = Search_types.search l () in let p t1 t2 = t1.ty_name = t2.ty_name in let rec iter acc = function @@ -386,9 +387,9 @@ let types l = | [] -> acc in iter [] l_ele - + module P_attributes = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, false) @@ -402,7 +403,7 @@ module P_attributes = let p_section _ _ = false end module Search_attributes = Search ( P_attributes ) -let attributes l = +let attributes l = let l_ele = Search_attributes.search l () in let p a1 a2 = a1.att_value.val_name = a2.att_value.val_name in let rec iter acc = function @@ -413,7 +414,7 @@ let attributes l = iter [] l_ele module P_methods = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, false) @@ -427,7 +428,7 @@ module P_methods = let p_section _ _ = true end module Search_methods = Search ( P_methods ) -let methods l = +let methods l = let l_ele = Search_methods.search l () in let p m1 m2 = m1.met_value.val_name = m2.met_value.val_name in let rec iter acc = function @@ -438,7 +439,7 @@ let methods l = iter [] l_ele module P_classes = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, false) @@ -452,7 +453,7 @@ module P_classes = let p_section _ _ = false end module Search_classes = Search ( P_classes ) -let classes l = +let classes l = let l_ele = Search_classes.search l () in let p c1 c2 = c1.cl_name = c2.cl_name in let rec iter acc = function @@ -463,7 +464,7 @@ let classes l = iter [] l_ele module P_class_types = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, false) @@ -477,7 +478,7 @@ module P_class_types = let p_section _ _ = false end module Search_class_types = Search ( P_class_types ) -let class_types l = +let class_types l = let l_ele = Search_class_types.search l () in let p c1 c2 = c1.clt_name = c2.clt_name in let rec iter acc = function @@ -488,7 +489,7 @@ let class_types l = iter [] l_ele module P_modules = - struct + struct type t = unit let p_module _ _ = (true, true) let p_module_type _ _ = (true, false) @@ -502,7 +503,7 @@ module P_modules = let p_section _ _ = false end module Search_modules = Search ( P_modules ) -let modules l = +let modules l = let l_ele = Search_modules.search l () in let p m1 m2 = m1.m_name = m2.m_name in let rec iter acc = function @@ -513,7 +514,7 @@ let modules l = iter [] l_ele module P_module_types = - struct + struct type t = unit let p_module _ _ = (true, false) let p_module_type _ _ = (true, true) @@ -527,7 +528,7 @@ module P_module_types = let p_section _ _ = false end module Search_module_types = Search ( P_module_types ) -let module_types l = +let module_types l = let l_ele = Search_module_types.search l () in let p m1 m2 = m1.mt_name = m2.mt_name in let rec iter acc = function @@ -620,7 +621,7 @@ let method_exists mods regexp = let find_section mods regexp = let l = Search_by_name.search mods regexp in - match + match List.find (function Res_section _ -> true diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 6510d58149..a71b076104 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -683,6 +683,7 @@ module Analyser = m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; + m_text_only = false ; } in let (maybe_more, info_after_opt) = @@ -773,6 +774,7 @@ module Analyser = m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; + m_text_only = false ; } in let (maybe_more, info_after_opt) = @@ -1318,6 +1320,7 @@ module Analyser = m_top_deps = [] ; m_code = None ; m_code_intf = code_intf ; + m_text_only = false ; } end diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml index b2670a85bf..b934f8576d 100644 --- a/ocamldoc/odoc_texi.ml +++ b/ocamldoc/odoc_texi.ml @@ -12,29 +12,29 @@ (** Generation of Texinfo documentation. *) -open Odoc_info +open Odoc_info open Parameter open Value open Type open Exception -open Class +open Class open Module (** {2 Some small helper functions} *) -let puts_nl chan s = +let puts_nl chan s = output_string chan s ; output_char chan '\n' -let puts chan s = +let puts chan s = output_string chan s -let nl chan = +let nl chan = output_char chan '\n' let is = function | None -> false | Some _ -> true -let pad_to n s = +let pad_to n s = let len = String.length s in if len < n then @@ -42,28 +42,28 @@ let pad_to n s = String.blit s 0 s' 0 len ; s' else s -let indent nb_sp s = +let indent nb_sp s = let c = ref 0 in let len = pred (String.length s) in for i = 0 to len do if s.[i] = '\n' then incr c done ; let s' = String.make (succ len + (succ !c) * nb_sp ) ' ' in c := nb_sp ; - for i = 0 to len do - s'.[!c] <- s.[i] ; + for i = 0 to len do + s'.[!c] <- s.[i] ; if s.[i] = '\n' then c := !c + nb_sp ; incr c done ; s' -type subparts = [ +type subparts = [ | `Module of Odoc_info.Module.t_module | `Module_type of Odoc_info.Module.t_module_type | `Class of Odoc_info.Class.t_class | `Class_type of Odoc_info.Class.t_class_type ] -type menu_data = [ - | subparts +type menu_data = [ + | subparts | `Blank | `Comment of string | `Texi of string @@ -72,22 +72,22 @@ type menu_data = [ let nothing = Verbatim "" -let module_subparts = +let module_subparts = let rec iter acc = function | [] -> List.rev acc - (* skip aliases *) - | Element_module { m_kind = Module_alias _ } :: n -> + (* skip aliases *) + | Element_module { m_kind = Module_alias _ } :: n -> iter acc n - | Element_module_type { mt_kind = Some (Module_type_alias _) } :: n -> + | Element_module_type { mt_kind = Some (Module_type_alias _) } :: n -> iter acc n (* keep modules, module types, classes and class types *) - | Element_module m :: n -> - iter (`Module m :: acc) n - | Element_module_type mt :: n -> + | Element_module m :: n -> + iter (`Module m :: acc) n + | Element_module_type mt :: n -> iter (`Module_type mt :: acc) n - | Element_class c :: n -> + | Element_class c :: n -> iter (`Class c :: acc) n - | Element_class_type ct :: n -> + | Element_class_type ct :: n -> iter (`Class_type ct :: acc) n (* forget the rest *) | _ :: n -> iter acc n @@ -95,14 +95,14 @@ let module_subparts = iter [] type indices = [ - | `Type - | `Exception - | `Value - | `Class_att - | `Method - | `Class - | `Class_type - | `Module + | `Type + | `Exception + | `Value + | `Class_att + | `Method + | `Class + | `Class_type + | `Module | `Module_type ] @@ -130,8 +130,8 @@ let indices_names = [ -(** Module for generating various Texinfo things (menus, xrefs, ...) *) -module Texi = +(** Module for generating various Texinfo things (menus, xrefs, ...) *) +module Texi = struct (** Associations of strings to subsitute in Texinfo code. *) let subst_strings = [ @@ -140,12 +140,12 @@ struct (Str.regexp "}", "@}") ; (Str.regexp "\\.\\.\\.", "@dots{}") ; ] @ - (if !Args.esc_8bits + (if !Args.esc_8bits then [ (Str.regexp "ŕ", "@`a") ; (Str.regexp "â", "@^a") ; (Str.regexp "é", "@'e") ; - (Str.regexp "č", "@`e") ; + (Str.regexp "č", "@`e") ; (Str.regexp "ę", "@^e") ; (Str.regexp "ë", "@\"e") ; (Str.regexp "ç", "@,{c}") ; @@ -163,43 +163,43 @@ struct else []) (** Escape the strings which would clash with Texinfo syntax. *) - let escape s = + let escape s = List.fold_left (fun acc (p, r) -> Str.global_replace p r acc) s subst_strings (** Removes dots (no good for a node name). *) - let fix_nodename s = + let fix_nodename s = Str.global_replace (Str.regexp "\\.") "/" (escape s) (** Generates a Texinfo menu. *) - let generate_menu chan subpart_list = + let generate_menu chan subpart_list = if subpart_list <> [] then begin - let menu_line part_qual name = + let menu_line part_qual name = let sname = Name.simple name in if sname = name then ( - puts chan (pad_to 35 + puts chan (pad_to 35 ("* " ^ sname ^ ":: ")) ; puts_nl chan part_qual ) else ( - puts chan (pad_to 35 + puts chan (pad_to 35 ("* " ^ sname ^ ": " ^ (fix_nodename name) ^ ". " )) ; puts_nl chan part_qual ) in puts_nl chan "@menu" ; List.iter (function - | `Module { m_name = name } -> + | `Module { m_name = name } -> menu_line Odoc_messages.modul name | `Module_type { mt_name = name } -> menu_line Odoc_messages.module_type name | `Class { cl_name = name } -> menu_line Odoc_messages.clas name | `Class_type { clt_name = name } -> - menu_line Odoc_messages.class_type name - | `Blank -> nl chan + menu_line Odoc_messages.class_type name + | `Blank -> nl chan | `Comment c -> puts_nl chan (escape c) | `Texi t -> puts_nl chan t | `Index ind -> Printf.fprintf chan "* %s::\n" ind) @@ -209,22 +209,22 @@ struct (** cross reference to node [name] *) let xref ?xname name = - "@xref{" ^ (fix_nodename name) ^ - (match xname with | None -> "" | Some s -> "," ^ s) ^ + "@xref{" ^ (fix_nodename name) ^ + (match xname with | None -> "" | Some s -> "," ^ s) ^ "}." (** enclose the string between [\@ifinfo] tags *) - let ifinfo s = + let ifinfo s = String.concat "\n" [ "@ifinfo" ; s ; "@end ifinfo" ; "" ] - (** [install-info] informations *) + (** [install-info] informations *) let dirsection sec = "@dircategory " ^ (escape sec) let direntry ent = - [ "@direntry" ] @ - (List.map escape ent) @ + [ "@direntry" ] @ + (List.map escape ent) @ [ "@end direntry" ] end @@ -235,7 +235,7 @@ end (** {2 Generation of Texinfo code} *) (** This class generates Texinfo code from text structures *) -class text = +class text = object(self) (** Associations between a title number and texinfo code. *) @@ -246,7 +246,7 @@ class text = 4, "@subsubsection " ; ] - val fallback_title = + val fallback_title = "@unnumberedsubsubsec " val headings = [ @@ -254,24 +254,24 @@ class text = 2, "@heading " ; 3, "@subheading " ; 4, "@subsubheading " ; - ] - - val fallback_heading = - "@subsubheading " + ] + + val fallback_heading = + "@subsubheading " - method escape = - Texi.escape + method escape = + Texi.escape (** this method is not used here but is virtual in a class we will inherit later *) - method label ?(no_ : bool option) (_ : string) : string = + method label ?(no_ : bool option) (_ : string) : string = failwith "gni" (** Return the Texinfo code corresponding to the [text] parameter.*) method texi_of_text t = String.concat "" (List.map self#texi_of_text_element t) - + (** {3 Conversion methods} [texi_of_????] converts a [text_element] to a Texinfo string. *) @@ -297,36 +297,39 @@ class text = | Ref (name, kind) ->self#texi_of_Ref name kind | Superscript t -> self#texi_of_Superscript t | Subscript t -> self#texi_of_Subscript t - | Odoc_info.Module_list _ -> "" - | Odoc_info.Index_list -> "" + | Odoc_info.Module_list _ -> "" + | Odoc_info.Index_list -> "" + | Odoc_info.Custom (s,t) -> self#texi_of_custom_text s t + + method texi_of_custom_text s t = "" method texi_of_Verbatim s = s method texi_of_Raw s = self#escape s method texi_of_Code s = "@code{" ^ (self#escape s) ^ "}" - method texi_of_CodePre s = + method texi_of_CodePre s = String.concat "\n" [ "" ; "@example" ; self#escape s ; "@end example" ; "" ] method texi_of_Bold t = "@strong{" ^ (self#texi_of_text t) ^ "}" method texi_of_Italic t = "@i{" ^ (self#texi_of_text t) ^ "}" method texi_of_Emphasize t = "@emph{" ^ (self#texi_of_text t) ^ "}" - method texi_of_Center t = + method texi_of_Center t = let sl = Str.split (Str.regexp "\n") (self#texi_of_text t) in String.concat "" ((List.map (fun s -> "\n@center "^s) sl) @ [ "\n" ]) method texi_of_Left t = - String.concat "\n" + String.concat "\n" [ "" ; "@flushleft" ; self#texi_of_text t ; "@end flushleft" ; "" ] - method texi_of_Right t = - String.concat "\n" + method texi_of_Right t = + String.concat "\n" [ "" ; "@flushright" ; self#texi_of_text t ; "@end flushright"; "" ] - method texi_of_List tl = + method texi_of_List tl = String.concat "\n" - ( [ "" ; "@itemize" ] @ + ( [ "" ; "@itemize" ] @ (List.map (fun t -> "@item\n" ^ (self#texi_of_text t)) tl) @ [ "@end itemize"; "" ] ) - method texi_of_Enum tl = + method texi_of_Enum tl = String.concat "\n" - ( [ "" ; "@enumerate" ] @ + ( [ "" ; "@enumerate" ] @ (List.map (fun t -> "@item\n" ^ (self#texi_of_text t)) tl) @ [ "@end enumerate"; "" ] ) method texi_of_Newline = "\n" @@ -334,23 +337,23 @@ class text = String.concat "\n" [ "@format" ; self#texi_of_text t ; "@end format" ; "" ] method texi_of_Title n t = - let t_begin = - try List.assoc n titles + let t_begin = + try List.assoc n titles with Not_found -> fallback_title in t_begin ^ (self#texi_of_text t) ^ "\n" method texi_of_Link s t = String.concat "" [ "@uref{" ; s ; "," ; self#texi_of_text t ; "}" ] method texi_of_Ref name kind = - let xname = + let xname = match kind with - | Some RK_module -> + | Some RK_module -> Odoc_messages.modul ^ " " ^ (Name.simple name) - | Some RK_module_type -> + | Some RK_module_type -> Odoc_messages.module_type ^ " " ^ (Name.simple name) - | Some RK_class -> + | Some RK_class -> Odoc_messages.clas ^ " " ^ (Name.simple name) - | Some RK_class_type -> + | Some RK_class_type -> Odoc_messages.class_type ^ " " ^ (Name.simple name) | _ -> "" in @@ -361,13 +364,13 @@ class text = "_@{" ^ (self#texi_of_text t) ^ "@}" method heading n t = - let f = + let f = try List.assoc n headings with Not_found -> fallback_heading in f ^ (self#texi_of_text t) ^ "\n" - method fixedblock t = + method fixedblock t = Block ( ( Verbatim "@t{" :: t ) @ [ Verbatim "}" ] ) end @@ -396,29 +399,29 @@ class texi = don't do it, just link to the previous one *) val node_tbl = Hashtbl.create 37 - method node depth name = + method node depth name = if Hashtbl.mem node_tbl name then raise Aliased_node ; Hashtbl.add node_tbl name () ; - if depth <= maxdepth + if depth <= maxdepth then Verbatim ("@node " ^ (Texi.fix_nodename name) ^ ",\n") else nothing - method index (ind : indices) ent = - Verbatim - (if !Args.with_index + method index (ind : indices) ent = + Verbatim + (if !Args.with_index then (assert(List.mem ind indices_to_build) ; - String.concat "" - [ "@" ; indices ind ; "index " ; - Texi.escape (Name.simple ent) ; "\n" ]) + String.concat "" + [ "@" ; indices ind ; "index " ; + Texi.escape (Name.simple ent) ; "\n" ]) else "") - + (** Two hacks to fix linebreaks in the descriptions.*) - method private fix_linebreaks = + method private fix_linebreaks = let re = Str.regexp "\n[ \t]*" in fun t -> - List.map + List.map (function | Newline -> Raw "\n" | Raw s -> Raw (Str.global_replace re "\n" s) @@ -426,7 +429,7 @@ class texi = | Enum tel -> Enum (List.map self#fix_linebreaks tel) | te -> te) t - method private soft_fix_linebreaks = + method private soft_fix_linebreaks = let re = Str.regexp "\n[ \t]*" in fun ind t -> let rep = String.make (succ ind) ' ' in @@ -443,16 +446,16 @@ class texi = method text_of_desc = function | None -> [] | Some [ Raw "" ] -> [] - | Some t -> (self#fix_linebreaks t) @ [ Newline ] + | Some t -> (self#fix_linebreaks t) @ [ Newline ] - method text_of_sees_opt see_l = + method text_of_sees_opt see_l = List.concat (List.map (function | (See_url s, t) -> [ linebreak ; Bold [ Raw Odoc_messages.see_also ] ; Raw " " ; Link (s, t) ; Newline ] - | (See_file s, t) + | (See_file s, t) | (See_doc s, t) -> [ linebreak ; Bold [ Raw Odoc_messages.see_also ] ; Raw " " ; Raw s ] @ t @ [ Newline ]) @@ -462,17 +465,17 @@ class texi = List.concat (List.map (fun (s, t) -> - [ linebreak ; + [ linebreak ; Bold [ Raw Odoc_messages.parameters ] ; Raw " " ; Raw s ; Raw ": " ] @ t @ [ Newline ] ) params_list) method text_of_raised_exceptions = function | [] -> [] - | (s, t) :: [] -> + | (s, t) :: [] -> [ linebreak ; Bold [ Raw Odoc_messages.raises ] ; - Raw " " ; Code s ; Raw " " ] + Raw " " ; Code s ; Raw " " ] @ t @ [ Newline ] | l -> [ linebreak ; @@ -481,17 +484,17 @@ class texi = List (List.map (fun (ex, desc) ->(Code ex) :: (Raw " ") :: desc ) l ) ; - Newline ] + Newline ] method text_of_return_opt = function | None -> [] - | Some t -> + | Some t -> (Bold [Raw Odoc_messages.returns ]) :: Raw " " :: t @ [ Newline ] method text_of_custom c_l = - List.flatten - (List.rev - (List.fold_left + List.flatten + (List.rev + (List.fold_left (fun acc -> fun (tag, text) -> try let f = List.assoc tag tag_functions in @@ -504,22 +507,22 @@ class texi = method text_of_info ?(block=false) = function | None -> [] - | Some info -> - let t = + | Some info -> + let t = List.concat [ ( match info.i_deprecated with | None -> [] - | Some t -> - (Raw (Odoc_messages.deprecated ^ " ")) :: - (self#fix_linebreaks t) + | Some t -> + (Raw (Odoc_messages.deprecated ^ " ")) :: + (self#fix_linebreaks t) @ [ Newline ; Newline ] ) ; self#text_of_desc info.i_desc ; - if info.i_authors <> [] + if info.i_authors <> [] then ( linebreak :: self#text_of_author_list info.i_authors ) else [] ; - if is info.i_version - then ( linebreak :: + if is info.i_version + then ( linebreak :: self#text_of_version_opt info.i_version ) else [] ; self#text_of_sees_opt info.i_sees ; @@ -530,38 +533,38 @@ class texi = self#text_of_params info.i_params ; self#text_of_raised_exceptions info.i_raised_exceptions ; if is info.i_return_value - then ( linebreak :: + then ( linebreak :: self#text_of_return_opt info.i_return_value ) else [] ; self#text_of_custom info.i_custom ; ] in - if block - then [ Block t ] + if block + then [ Block t ] else (t @ [ Newline ] ) method texi_of_info i = self#texi_of_text (self#text_of_info i) (** {3 Conversion of [module_elements] into Texinfo strings} - The following functions convert [module_elements] and their + The following functions convert [module_elements] and their description to [text] values then to Texinfo strings using the functions above. *) - method text_el_of_type_expr m_name typ = + method text_el_of_type_expr m_name typ = Raw (indent 5 - (self#relative_idents m_name + (self#relative_idents m_name (Odoc_info.string_of_type_expr typ))) method text_of_short_type_expr m_name typ = [ Raw (self#normal_type m_name typ) ] (** Return Texinfo code for a value. *) - method texi_of_value v = + method texi_of_value v = Odoc_info.reset_type_names () ; - let t = [ self#fixedblock - [ Newline ; minus ; - Raw ("val " ^ (Name.simple v.val_name) ^ " :\n") ; - self#text_el_of_type_expr + let t = [ self#fixedblock + [ Newline ; minus ; + Raw ("val " ^ (Name.simple v.val_name) ^ " :\n") ; + self#text_el_of_type_expr (Name.father v.val_name) v.val_type ] ; self#index `Value v.val_name ; Newline ] @ (self#text_of_info v.val_info) in @@ -572,13 +575,13 @@ class texi = method texi_of_attribute a = Odoc_info.reset_type_names () ; let t = [ self#fixedblock - [ Newline ; minus ; + [ Newline ; minus ; Raw "val " ; Raw (if a.att_mutable then "mutable " else "") ; Raw (Name.simple a.att_value.val_name) ; - Raw " :\n" ; - self#text_el_of_type_expr - (Name.father a.att_value.val_name) + Raw " :\n" ; + self#text_el_of_type_expr + (Name.father a.att_value.val_name) a.att_value.val_type ] ; self#index `Class_att a.att_value.val_name ; Newline ] @ (self#text_of_info a.att_value.val_info) in @@ -586,15 +589,15 @@ class texi = (** Return Texinfo code for a class method. *) - method texi_of_method m = + method texi_of_method m = Odoc_info.reset_type_names () ; let t = [ self#fixedblock [ Newline ; minus ; Raw "method " ; Raw (if m.met_private then "private " else "") ; Raw (if m.met_virtual then "virtual " else "") ; Raw (Name.simple m.met_value.val_name) ; - Raw " :\n" ; - self#text_el_of_type_expr + Raw " :\n" ; + self#text_el_of_type_expr (Name.father m.met_value.val_name) m.met_value.val_type ] ; self#index `Method m.met_value.val_name ; Newline ] @ @@ -602,81 +605,81 @@ class texi = self#texi_of_text t - method string_of_type_parameters t = + method string_of_type_parameters t = let f (tp, co, cn) = - Printf.sprintf "%s%s" - (Odoc_info.string_of_variance t (co, cn)) - (Odoc_info.string_of_type_expr tp) + Printf.sprintf "%s%s" + (Odoc_info.string_of_variance t (co, cn)) + (Odoc_info.string_of_type_expr tp) in match t.ty_parameters with | [] -> "" - | [ (tp, co, cn) ] -> - (f (tp, co, cn))^" " - | l -> - Printf.sprintf "(%s) " - (String.concat ", " (List.map f l)) + | [ (tp, co, cn) ] -> + (f (tp, co, cn))^" " + | l -> + Printf.sprintf "(%s) " + (String.concat ", " (List.map f l)) method string_of_type_args = function | [] -> "" | args -> " of " ^ (Odoc_info.string_of_type_list " * " args) (** Return Texinfo code for a type. *) - method texi_of_type ty = + method texi_of_type ty = Odoc_info.reset_type_names () ; - let t = - [ self#fixedblock ( + let t = + [ self#fixedblock ( [ Newline ; minus ; Raw "type " ; Raw (self#string_of_type_parameters ty) ; Raw (Name.simple ty.ty_name) ] @ ( match ty.ty_manifest with - | None -> [] - | Some typ -> - (Raw " = ") :: (self#text_of_short_type_expr + | None -> [] + | Some typ -> + (Raw " = ") :: (self#text_of_short_type_expr (Name.father ty.ty_name) typ) ) @ - ( - match ty.ty_kind with + ( + match ty.ty_kind with | Type_abstract -> [ Newline ] | Type_variant (l, priv) -> (Raw (" ="^(if priv then " private" else "")^"\n")) :: - (List.flatten - (List.map + (List.flatten + (List.map (fun constr -> (Raw (" | " ^ constr.vc_name)) :: (Raw (self#string_of_type_args constr.vc_args)) :: (match constr.vc_text with | None -> [ Newline ] - | Some t -> - ((Raw (indent 5 "\n(* ")) :: (self#soft_fix_linebreaks 8 t)) @ + | Some t -> + ((Raw (indent 5 "\n(* ")) :: (self#soft_fix_linebreaks 8 t)) @ [ Raw " *)" ; Newline ] ) ) l ) ) | Type_record (l, priv) -> (Raw (" = "^(if priv then "private " else "")^"{\n")) :: - (List.flatten - (List.map - (fun r -> + (List.flatten + (List.map + (fun r -> [ Raw (" " ^ r.rf_name ^ " : ") ] @ - (self#text_of_short_type_expr + (self#text_of_short_type_expr (Name.father r.rf_name) - r.rf_type) @ + r.rf_type) @ [ Raw " ;" ] @ (match r.rf_text with | None -> [ Newline ] - | Some t -> - ((Raw (indent 5 "\n(* ")) :: (self#soft_fix_linebreaks 8 t)) @ - [ Raw " *)" ; Newline ] ) ) + | Some t -> + ((Raw (indent 5 "\n(* ")) :: (self#soft_fix_linebreaks 8 t)) @ + [ Raw " *)" ; Newline ] ) ) l ) ) - @ [ Raw " }" ] - ) ) ; + @ [ Raw " }" ] + ) ) ; self#index `Type ty.ty_name ; Newline ] @ (self#text_of_info ty.ty_info) in self#texi_of_text t (** Return Texinfo code for an exception. *) - method texi_of_exception e = + method texi_of_exception e = Odoc_info.reset_type_names () ; - let t = + let t = [ self#fixedblock - ( [ Newline ; minus ; Raw "exception " ; + ( [ Newline ; minus ; Raw "exception " ; Raw (Name.simple e.ex_name) ; Raw (self#string_of_type_args e.ex_args) ] @ (match e.ex_alias with @@ -702,18 +705,18 @@ class texi = let resolve_alias_name = function | { m_kind = Module_alias { ma_name = name } } -> name | { m_name = name } -> name in - let t = - [ [ self#fixedblock - [ Newline ; minus ; Raw "module " ; + let t = + [ [ self#fixedblock + [ Newline ; minus ; Raw "module " ; Raw (Name.simple m.m_name) ; - Raw (if is_alias m - then " = " ^ (resolve_alias_name m) + Raw (if is_alias m + then " = " ^ (resolve_alias_name m) else "" ) ] ] ; ( if is_alias_there m - then [ Ref (resolve_alias_name m, Some RK_module) ; + then [ Ref (resolve_alias_name m, Some RK_module) ; Newline ; ] else [] ) ; - ( if is_alias m + ( if is_alias m then [ self#index `Module m.m_name ; Newline ] else [ Newline ] ) ; self#text_of_info m.m_info ] @@ -731,15 +734,15 @@ class texi = let resolve_alias_name = function | { mt_kind = Some (Module_type_alias { mta_name = name }) } -> name | { mt_name = name } -> name in - let t = - [ [ self#fixedblock - [ Newline ; minus ; Raw "module type" ; + let t = + [ [ self#fixedblock + [ Newline ; minus ; Raw "module type" ; Raw (Name.simple mt.mt_name) ; Raw (if is_alias mt - then " = " ^ (resolve_alias_name mt) + then " = " ^ (resolve_alias_name mt) else "" ) ] ] ; ( if is_alias_there mt - then [ Ref (resolve_alias_name mt, Some RK_module_type) ; + then [ Ref (resolve_alias_name mt, Some RK_module_type) ; Newline ; ] else [] ) ; ( if is_alias mt @@ -754,28 +757,28 @@ class texi = let t = [ self#fixedblock ( Newline :: minus :: (Raw "include ") :: ( match im.im_module with - | None -> + | None -> [ Raw im.im_name ] - | Some (Mod { m_name = name }) -> - [ Raw name ; Raw "\n " ; + | Some (Mod { m_name = name }) -> + [ Raw name ; Raw "\n " ; Ref (name, Some RK_module) ] | Some (Modtype { mt_name = name }) -> - [ Raw name ; Raw "\n " ; + [ Raw name ; Raw "\n " ; Ref (name, Some RK_module_type) ] - ) @ - [ Newline ] @ - (self#text_of_info im.im_info) - ) - ] + ) @ + [ Newline ] @ + (self#text_of_info im.im_info) + ) + ] in self#texi_of_text t (** Return the Texinfo code for the given class. *) method texi_of_class c = Odoc_info.reset_type_names () ; - let t = [ self#fixedblock - [ Newline ; minus ; Raw "class " ; - Raw (Name.simple c.cl_name) ] ; + let t = [ self#fixedblock + [ Newline ; minus ; Raw "class " ; + Raw (Name.simple c.cl_name) ] ; Ref (c.cl_name, Some RK_class) ; Newline ; Newline ] @ (self#text_of_info c.cl_info) in self#texi_of_text t @@ -783,9 +786,9 @@ class texi = (** Return the Texinfo code for the given class type. *) method texi_of_class_type ct = Odoc_info.reset_type_names () ; - let t = [ self#fixedblock - [ Newline ; minus ; Raw "class type " ; - Raw (Name.simple ct.clt_name) ] ; + let t = [ self#fixedblock + [ Newline ; minus ; Raw "class type " ; + Raw (Name.simple ct.clt_name) ] ; Ref (ct.clt_name, Some RK_class_type) ; Newline ; Newline ] @ (self#text_of_info ct.clt_info) in self#texi_of_text t @@ -808,7 +811,7 @@ class texi = | Element_value v -> self#texi_of_value v | Element_exception e -> self#texi_of_exception e | Element_type t -> self#texi_of_type t - | Element_module_comment t -> + | Element_module_comment t -> self#texi_of_text (Newline :: t @ [Newline]) ) @@ -825,9 +828,9 @@ class texi = | None -> [] | Some t -> Newline :: t) | Some cct -> (* we can create the reference *) - let kind = + let kind = match cct with - | Cl _ -> Some RK_class + | Cl _ -> Some RK_class | Cltype _ -> Some RK_class_type in (Code inh.ic_name) :: (Ref (inh.ic_name, kind)) :: @@ -837,13 +840,13 @@ class texi = in let text = [ Bold [ Raw Odoc_messages.inherits ] ; - List (List.map f inher_l) ; Newline ] + List (List.map f inher_l) ; Newline ] in puts chanout (self#texi_of_text text) - (** Generate the Texinfo code for the inherited classes + (** Generate the Texinfo code for the inherited classes of the given class. *) method generate_class_inheritance_info chanout cl = let rec iter_kind = function @@ -858,7 +861,7 @@ class texi = - (** Generate the Texinfo code for the inherited classes + (** Generate the Texinfo code for the inherited classes of the given class type. *) method generate_class_type_inheritance_info chanout clt = match clt.clt_kind with @@ -869,16 +872,16 @@ class texi = | Class_type _ -> () - (** Generate the Texinfo code for the given class, + (** Generate the Texinfo code for the given class, in the given out channel. *) method generate_for_class chanout c = try Odoc_info.reset_type_names () ; let depth = Name.depth c.cl_name in - let title = [ + let title = [ self#node depth c.cl_name ; Title (depth, None, [ Raw (Odoc_messages.clas ^ " ") ; - Code c.cl_name ]) ; + Code c.cl_name ]) ; self#index `Class c.cl_name ] in puts chanout (self#texi_of_text title) ; @@ -887,10 +890,10 @@ class texi = let descr = [ Title (succ depth, None, [ Raw Odoc_messages.description ]) ] in puts chanout (self#texi_of_text descr) ; - puts chanout (self#texi_of_info c.cl_info) + puts chanout (self#texi_of_info c.cl_info) end ; - - let intf = [ Title (succ depth, None, + + let intf = [ Title (succ depth, None, [ Raw Odoc_messages.interface]) ] in puts chanout (self#texi_of_text intf); self#generate_class_inheritance_info chanout c ; @@ -901,19 +904,19 @@ class texi = with Aliased_node -> () - (** Generate the Texinfo code for the given class type, + (** Generate the Texinfo code for the given class type, in the given out channel. *) method generate_for_class_type chanout ct = try Odoc_info.reset_type_names () ; let depth = Name.depth ct.clt_name in - let title = [ + let title = [ self#node depth ct.clt_name ; - Title (depth, None, [ Raw (Odoc_messages.class_type ^ " ") ; - Code ct.clt_name ]) ; + Title (depth, None, [ Raw (Odoc_messages.class_type ^ " ") ; + Code ct.clt_name ]) ; self#index `Class_type ct.clt_name ] in puts chanout (self#texi_of_text title) ; - + if is ct.clt_info then begin let descr = [ Title (succ depth, None, @@ -922,29 +925,29 @@ class texi = puts chanout (self#texi_of_info ct.clt_info) end ; - let intf = [ Title (succ depth, None, + let intf = [ Title (succ depth, None, [ Raw Odoc_messages.interface ]) ] in puts chanout (self#texi_of_text intf) ; self#generate_class_type_inheritance_info chanout ct; - List.iter + List.iter (fun ele -> puts chanout (self#texi_of_class_element ct.clt_name ele)) (Class.class_type_elements ~trans:false ct) with Aliased_node -> () - (** Generate the Texinfo code for the given module type, + (** Generate the Texinfo code for the given module type, in the given out channel. *) method generate_for_module_type chanout mt = try let depth = Name.depth mt.mt_name in - let title = [ + let title = [ self#node depth mt.mt_name ; - Title (depth, None, [ Raw (Odoc_messages.module_type ^ " ") ; - Code mt.mt_name ]) ; + Title (depth, None, [ Raw (Odoc_messages.module_type ^ " ") ; + Code mt.mt_name ]) ; self#index `Module_type mt.mt_name ; Newline ] in puts chanout (self#texi_of_text title) ; - + if is mt.mt_info then begin let descr = [ Title (succ depth, None, @@ -957,13 +960,13 @@ class texi = let subparts = module_subparts mt_ele in if depth < maxdepth && subparts <> [] then begin - let menu = Texi.ifinfo + let menu = Texi.ifinfo ( self#heading (succ depth) [ Raw "Subparts" ]) in puts chanout menu ; Texi.generate_menu chanout (subparts :> menu_data) end ; - let intf = [ Title (succ depth, None, + let intf = [ Title (succ depth, None, [ Raw Odoc_messages.interface ]) ] in puts chanout (self#texi_of_text intf) ; List.iter @@ -981,19 +984,24 @@ class texi = subparts with Aliased_node -> () - (** Generate the Texinfo code for the given module, + (** Generate the Texinfo code for the given module, in the given out channel. *) method generate_for_module chanout m = try Odoc_info.verbose ("Generate for module " ^ m.m_name) ; let depth = Name.depth m.m_name in - let title = [ + let title = [ self#node depth m.m_name ; - Title (depth, None, [ Raw (Odoc_messages.modul ^ " ") ; - Code m.m_name ]) ; + Title (depth, None, + if m.m_text_only then + [ Raw m.m_name ] + else + [ Raw (Odoc_messages.modul ^ " ") ; + Code m.m_name ] + ) ; self#index `Module m.m_name ; Newline ] in puts chanout (self#texi_of_text title) ; - + if is m.m_info then begin let descr = [ Title (succ depth, None, @@ -1001,18 +1009,18 @@ class texi = puts chanout (self#texi_of_text descr) ; puts chanout (self#texi_of_info m.m_info) end ; - + let m_ele = Module.module_elements ~trans:true m in let subparts = module_subparts m_ele in if depth < maxdepth && subparts <> [] then begin - let menu = Texi.ifinfo + let menu = Texi.ifinfo ( self#heading (succ depth) [ Raw "Subparts" ]) in puts chanout menu ; Texi.generate_menu chanout (subparts :> menu_data) end ; - let intf = [ Title (succ depth, None, + let intf = [ Title (succ depth, None, [ Raw Odoc_messages.interface]) ] in puts chanout (self#texi_of_text intf) ; @@ -1038,47 +1046,47 @@ class texi = | None -> "" | Some s -> self#escape s in let filename = - if texi_filename <> "ocamldoc.texi" - then - let fn = Filename.basename texi_filename in - (if Filename.check_suffix fn ".texi" - then Filename.chop_suffix fn ".texi" - else fn) ^ ".info" - else - if title <> "" - then title ^ ".info" - else "doc.info" + if texi_filename <> "ocamldoc.texi" + then + let fn = Filename.basename texi_filename in + (if Filename.check_suffix fn ".texi" + then Filename.chop_suffix fn ".texi" + else fn) ^ ".info" + else + if title <> "" + then title ^ ".info" + else "doc.info" in (* write a standard Texinfo header *) List.iter (puts_nl chan) - (List.flatten + (List.flatten [ [ "\\input texinfo @c -*-texinfo-*-" ; "@c %**start of header" ; "@setfilename " ^ filename ; "@settitle " ^ title ; "@c %**end of header" ; ] ; - + (if !Args.with_index then - List.map + List.map (fun ind -> "@defcodeindex " ^ (indices ind)) indices_to_build else []) ; - [ Texi.dirsection !Args.info_section ] ; + [ Texi.dirsection !Args.info_section ] ; - Texi.direntry - (if !Args.info_entry <> [] - then !Args.info_entry - else [ Printf.sprintf "* %s: (%s)." - title - (Filename.chop_suffix filename ".info") ]) ; + Texi.direntry + (if !Args.info_entry <> [] + then !Args.info_entry + else [ Printf.sprintf "* %s: (%s)." + title + (Filename.chop_suffix filename ".info") ]) ; [ "@ifinfo" ; "This file was generated by Ocamldoc using the Texinfo generator." ; "@end ifinfo" ; - + "@c no titlepage." ; "@node Top, , , (dir)" ; @@ -1087,53 +1095,53 @@ class texi = (* insert the intro file *) begin - match !Odoc_info.Args.intro_file with - | None when title <> "" -> - puts_nl chan "@ifinfo" ; - puts_nl chan ("Documentation for " ^ title) ; + match !Odoc_info.Args.intro_file with + | None when title <> "" -> + puts_nl chan "@ifinfo" ; + puts_nl chan ("Documentation for " ^ title) ; puts_nl chan "@end ifinfo" - | None -> - puts_nl chan "@c no title given" - | Some f -> - nl chan ; - puts_nl chan - (self#texi_of_info (Some (Odoc_info.info_of_comment_file f))) + | None -> + puts_nl chan "@c no title given" + | Some f -> + nl chan ; + puts_nl chan + (self#texi_of_info (Some (Odoc_info.info_of_comment_file f))) end ; (* write a top menu *) - Texi.generate_menu chan + Texi.generate_menu chan ((List.map (fun m -> `Module m) m_list) @ (if !Args.with_index then - let indices_names_to_build = List.map indices indices_to_build in - List.rev - (List.fold_left - (fun acc -> - function (longname, shortname) - when List.mem shortname indices_names_to_build -> - (`Index (longname ^ " index")) :: acc - | _ -> acc) - [ `Comment "Indices :" ; `Blank ] + let indices_names_to_build = List.map indices indices_to_build in + List.rev + (List.fold_left + (fun acc -> + function (longname, shortname) + when List.mem shortname indices_names_to_build -> + (`Index (longname ^ " index")) :: acc + | _ -> acc) + [ `Comment "Indices :" ; `Blank ] indices_names ) else [] )) - + (** Writes the trailer of the TeXinfo document. *) - method generate_texi_trailer chan = - nl chan ; + method generate_texi_trailer chan = + nl chan ; if !Args.with_index - then - let indices_names_to_build = List.map indices indices_to_build in + then + let indices_names_to_build = List.map indices indices_to_build in List.iter (puts_nl chan) (List.flatten - (List.map + (List.map (fun (longname, shortname) -> - if List.mem shortname indices_names_to_build - then [ "@node " ^ longname ^ " index," ; - "@unnumbered " ^ longname ^ " index" ; - "@printindex " ^ shortname ; ] - else []) + if List.mem shortname indices_names_to_build + then [ "@node " ^ longname ^ " index," ; + "@unnumbered " ^ longname ^ " index" ; + "@printindex " ^ shortname ; ] + else []) indices_names )) ; - if !Args.with_toc + if !Args.with_toc then puts_nl chan "@contents" ; puts_nl chan "@bye" @@ -1141,38 +1149,38 @@ class texi = method do_index it = if not (List.mem it indices_to_build) then indices_to_build <- it :: indices_to_build - + (** Scan the whole module information to know which indices need to be build *) method scan_for_index : subparts -> unit = function | `Module m -> let m_ele = Module.module_elements ~trans:true m in - List.iter self#scan_for_index_in_mod m_ele - | `Module_type mt -> + List.iter self#scan_for_index_in_mod m_ele + | `Module_type mt -> let m_ele = Module.module_type_elements ~trans:true mt in - List.iter self#scan_for_index_in_mod m_ele + List.iter self#scan_for_index_in_mod m_ele | `Class c -> let c_ele = Class.class_elements ~trans:true c in - List.iter self#scan_for_index_in_class c_ele + List.iter self#scan_for_index_in_class c_ele | `Class_type ct -> let c_ele = Class.class_type_elements ~trans:true ct in - List.iter self#scan_for_index_in_class c_ele - + List.iter self#scan_for_index_in_class c_ele + method scan_for_index_in_mod = function - (* no recursion *) + (* no recursion *) | Element_value _ -> self#do_index `Value | Element_exception _ -> self#do_index `Exception | Element_type _ -> self#do_index `Type | Element_included_module _ | Element_module_comment _ -> () - (* recursion *) + (* recursion *) | Element_module m -> self#do_index `Module ; - self#scan_for_index (`Module m) + self#scan_for_index (`Module m) | Element_module_type mt -> self#do_index `Module_type ; - self#scan_for_index (`Module_type mt) + self#scan_for_index (`Module_type mt) | Element_class c -> self#do_index `Class ; - self#scan_for_index (`Class c) + self#scan_for_index (`Class c) | Element_class_type ct -> self#do_index `Class_type ; - self#scan_for_index (`Class_type ct) + self#scan_for_index (`Class_type ct) method scan_for_index_in_class = function | Class_attribute _ -> self#do_index `Class_att @@ -1180,31 +1188,31 @@ class texi = | Class_comment _ -> () - (** Generate the Texinfo file from a module list, + (** Generate the Texinfo file from a module list, in the {!Odoc_info.Args.out_file} file. *) method generate module_list = Hashtbl.clear node_tbl ; - let filename = - if !Args.out_file = Odoc_messages.default_out_file - then "ocamldoc.texi" - else !Args.out_file in + let filename = + if !Args.out_file = Odoc_messages.default_out_file + then "ocamldoc.texi" + else !Args.out_file in if !Args.with_index - then List.iter self#scan_for_index - (List.map (fun m -> `Module m) module_list) ; + then List.iter self#scan_for_index + (List.map (fun m -> `Module m) module_list) ; try - let chanout = open_out + let chanout = open_out (Filename.concat !Args.target_dir filename) in - if !Args.with_header + if !Args.with_header then self#generate_texi_header chanout filename module_list ; - List.iter - (self#generate_for_module chanout) + List.iter + (self#generate_for_module chanout) module_list ; - if !Args.with_trailer + if !Args.with_trailer then self#generate_texi_trailer chanout ; close_out chanout with | Failure s | Sys_error s -> prerr_endline s ; - incr Odoc_info.errors + incr Odoc_info.errors end diff --git a/ocamldoc/odoc_text.ml b/ocamldoc/odoc_text.ml index 85578098b7..656321326d 100644 --- a/ocamldoc/odoc_text.ml +++ b/ocamldoc/odoc_text.ml @@ -25,8 +25,8 @@ module Texter = Odoc_text_parser.main Odoc_text_lexer.main lexbuf with _ -> - raise (Text_syntax (!Odoc_text_lexer.line_number, - !Odoc_text_lexer.char_number, + raise (Text_syntax (!Odoc_text_lexer.line_number, + !Odoc_text_lexer.char_number, s) ) @@ -59,7 +59,7 @@ module Texter = escape_n s '[' (open_brackets - close_brackets) else if close_brackets > open_brackets then - escape_n s ']' (close_brackets - open_brackets) + escape_n s ']' (close_brackets - open_brackets) else s @@ -98,16 +98,16 @@ module Texter = | Right t -> p b "{R " ; p_text b t ; p b "}" | List l -> p b "{ul\n"; p_list b l; p b "}" | Enum l -> p b "{ol\n"; p_list b l; p b "}" - | Newline -> p b "\n" + | Newline -> p b "\n" | Block t -> p_text b t | Title (n, l_opt, t) -> - p b "{%d%s " + p b "{%d%s " n (match l_opt with None -> "" | Some s -> ":"^s ); - p_text b t ; + p_text b t ; p b "}" | Latex s -> p b "{%% %s%%}" s | Link (s,t) -> @@ -130,21 +130,24 @@ module Texter = | RK_method -> "method" | RK_section _ -> "section" in - p b "{!%s:%s}" sk s + p b "{!%s:%s}" sk s ) | Superscript t -> p b "{^" ; p_text b t ; p b "}" | Subscript t -> p b "{_" ; p_text b t ; p b "}" - | Module_list l -> + | Module_list l -> p b "{!modules:"; List.iter (fun s -> p b " %s" s) l; p b "}" | Index_list -> p b "{!indexlist}" - + | Custom (s,t) -> + p b "{%s " s; + p_text b t; + p b "}" + let string_of_text s = let b = Buffer.create 256 in p_text b s; Buffer.contents b - + end - diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll index f0c3738a6f..d7dba4c30d 100644 --- a/ocamldoc/odoc_text_lexer.mll +++ b/ocamldoc/odoc_text_lexer.mll @@ -34,7 +34,7 @@ let ajout_string = Buffer.add_string string_buffer let lecture_string () = Buffer.contents string_buffer -(** the variable which will contain the description string. +(** the variable which will contain the description string. Is initialized when we encounter the start of a special comment. *) let description = ref "" @@ -44,7 +44,7 @@ let blank = "[ \013\009\012]" let print_DEBUG s = print_string s; print_newline () -(** this flag indicates whether we're in a string between begin_code and end_code tokens, to +(** this flag indicates whether we're in a string between begin_code and end_code tokens, to remember the number of open '[' and handle ']' correctly. *) let open_brackets = ref 0 @@ -80,13 +80,13 @@ let incr_cpts lexbuf = let l = Str.split_delim (Str.regexp_string "\n") s in match List.rev l with [] -> () (* should not occur *) - | [s2] -> (* no newline *) + | [s2] -> (* no newline *) char_number := !char_number + (String.length s2) | s2 :: _ -> line_number := !line_number + ((List.length l) - 1) ; char_number := String.length s2 -} +} (** html marks, to use as alternative possible special strings *) @@ -118,15 +118,15 @@ let label = ['a'-'z']+['a'-'z' 'A'-'Z' '0'-'9' '_']* (** special strings *) -let end = "}" - | html_end_bold +let end = "}" + | html_end_bold | html_end_italic - | html_end_title + | html_end_title | html_end_list | html_end_enum | html_end_item | html_end_center -let begin_title = +let begin_title = ("{" ['0'-'9']+(":"label)? blank_nl) | html_title @@ -136,16 +136,16 @@ let begin_center = "{C"blank_nl | html_center let begin_left = "{L"blank_nl let begin_right = "{R"blank_nl let begin_italic = "{i"blank_nl | html_italic -let begin_list = "{ul" | html_list -let begin_enum = "{ol" | html_enum +let begin_list = "{ul"blank_nl? | html_list +let begin_enum = "{ol"blank_nl? | html_enum let begin_item = "{li"blank_nl | "{- " | html_item -let begin_link = "{{:" +let begin_link = "{{:" let begin_latex = "{%"blank_nl let end_latex = "%}" let begin_code = "[" | html_code let end_code = "]" | html_end_code let begin_code_pre = "{[" -let end_code_pre = "]}" +let end_code_pre = "]}" let begin_verb = "{v"blank_nl let end_verb = blank_nl"v}" @@ -162,6 +162,7 @@ let begin_met_ref = "{!method:"blank_nl | "{!method:" let begin_sec_ref = "{!section:"blank_nl | "{!section:" let begin_mod_list_ref = "{!modules:"blank_nl | "{!modules:" let index_list = "{!indexlist}" +let begin_custom = "{"['a'-'z''A'-'Z']['a'-'z''A'-'Z''0'-'9']* let begin_superscript = "{^"blank_nl | "{^" let begin_subscript = "{_"blank_nl | "{_" @@ -170,31 +171,33 @@ let shortcut_enum_item = '\n'blank*"+ " let end_shortcut_list = '\n'(blank*'\n')+ rule main = parse -| "\\{" -| "\\}" -| "\\[" +| "\\{" +| "\\}" +| "\\[" | "\\]" - { + { incr_cpts lexbuf ; let s = Lexing.lexeme lexbuf in - Char (String.sub s 1 1) + Char (String.sub s 1 1) } | end { + print_DEBUG "end"; incr_cpts lexbuf ; - if !verb_mode or !latex_mode or !code_pre_mode or + if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) then Char (Lexing.lexeme lexbuf) else - let _ = + let _ = if !ele_ref_mode then - ele_ref_mode := false + ele_ref_mode := false in END } | begin_title { + print_DEBUG "begin_title"; incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then @@ -210,7 +213,7 @@ rule main = parse else let (n, l) = (1, (String.length s - 2)) in let s2 = String.sub s n l in - try + try let i = String.index s2 ':' in let s_n = String.sub s2 0 i in let s_label = String.sub s2 (i+1) (l-i-1) in @@ -221,34 +224,34 @@ rule main = parse with _ -> Title (1, None) - } + } | begin_bold - { + { incr_cpts lexbuf ; - if !verb_mode or !latex_mode or !code_pre_mode or + if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - BOLD - } + BOLD + } | begin_italic - { + { incr_cpts lexbuf ; - if !verb_mode or !latex_mode or !code_pre_mode or + if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else ITALIC - } + } | begin_link - { + { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - LINK - } + LINK + } | begin_emp { incr_cpts lexbuf ; @@ -256,7 +259,7 @@ rule main = parse (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - EMP + EMP } | begin_superscript { @@ -265,7 +268,7 @@ rule main = parse (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - SUPERSCRIPT + SUPERSCRIPT } | begin_subscript { @@ -274,7 +277,7 @@ rule main = parse (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - SUBSCRIPT + SUBSCRIPT } | begin_center { @@ -297,23 +300,24 @@ rule main = parse | begin_right { incr_cpts lexbuf ; - if !verb_mode or !latex_mode or !code_pre_mode + if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else RIGHT } | begin_list - { + { + print_DEBUG "LIST"; incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - LIST + LIST } | begin_enum - { + { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then @@ -323,12 +327,13 @@ rule main = parse } | begin_item { + print_DEBUG "ITEM"; incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or (!open_brackets >= 1) or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - ITEM + ITEM } | begin_latex { @@ -358,7 +363,7 @@ rule main = parse { incr_cpts lexbuf ; Char (Lexing.lexeme lexbuf) - } + } | begin_code { @@ -369,7 +374,7 @@ rule main = parse if !open_brackets <= 0 then ( open_brackets := 1; - CODE + CODE ) else ( @@ -378,7 +383,7 @@ rule main = parse ) } | end_code - { + { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !ele_ref_mode then Char (Lexing.lexeme lexbuf) @@ -391,7 +396,7 @@ rule main = parse else ( open_brackets := 0; - END_CODE + END_CODE ) } @@ -399,8 +404,8 @@ rule main = parse { incr_cpts lexbuf ; Char (Lexing.lexeme lexbuf) - } - + } + | begin_code_pre { incr_cpts lexbuf ; @@ -421,7 +426,7 @@ rule main = parse if !open_brackets >= 1 then ( lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; - lexbuf.Lexing.lex_curr_p <- + lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with pos_cnum = lexbuf.Lexing.lex_curr_p.pos_cnum - 1 } ; @@ -434,14 +439,14 @@ rule main = parse else ( open_brackets := 0; - END_CODE + END_CODE ) ) else - if !code_pre_mode then + if !code_pre_mode then ( code_pre_mode := false; - END_CODE_PRE + END_CODE_PRE ) else Char (Lexing.lexeme lexbuf) @@ -451,9 +456,9 @@ rule main = parse { incr_cpts lexbuf ; Char (Lexing.lexeme lexbuf) - } + } -| begin_ele_ref +| begin_ele_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -469,9 +474,9 @@ rule main = parse Char (Lexing.lexeme lexbuf) ) } - -| begin_val_ref + +| begin_val_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -488,7 +493,7 @@ rule main = parse ) } -| begin_typ_ref +| begin_typ_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -505,7 +510,7 @@ rule main = parse ) } -| begin_exc_ref +| begin_exc_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -522,7 +527,7 @@ rule main = parse ) } -| begin_mod_ref +| begin_mod_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -539,7 +544,7 @@ rule main = parse ) } -| begin_modt_ref +| begin_modt_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -556,7 +561,7 @@ rule main = parse ) } -| begin_cla_ref +| begin_cla_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -573,7 +578,7 @@ rule main = parse ) } -| begin_clt_ref +| begin_clt_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -590,7 +595,7 @@ rule main = parse ) } -| begin_att_ref +| begin_att_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -607,7 +612,7 @@ rule main = parse ) } -| begin_met_ref +| begin_met_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -624,7 +629,7 @@ rule main = parse ) } -| begin_sec_ref +| begin_sec_ref { incr_cpts lexbuf ; if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then @@ -668,9 +673,9 @@ rule main = parse INDEX_LIST else Char (Lexing.lexeme lexbuf) - } + } -| begin_verb +| begin_verb { incr_cpts lexbuf ; if !latex_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode then @@ -693,7 +698,7 @@ rule main = parse ) } -| shortcut_list_item +| shortcut_list_item { incr_cpts lexbuf ; if !shortcut_list_mode then @@ -722,7 +727,7 @@ rule main = parse { incr_cpts lexbuf ; lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; - lexbuf.Lexing.lex_curr_p <- + lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with pos_cnum = lexbuf.Lexing.lex_curr_p.pos_cnum - 1 ; } ; @@ -730,8 +735,8 @@ rule main = parse if !shortcut_list_mode then ( shortcut_list_mode := false; - (* go back one char to re-use the last '\n', so we can - restart another shortcut-list with a single blank line, + (* go back one char to re-use the last '\n', so we can + restart another shortcut-list with a single blank line, and not two.*) END_SHORTCUT_LIST ) @@ -740,22 +745,33 @@ rule main = parse Char (Lexing.lexeme lexbuf) else BLANK_LINE - } - + } + | eof { EOF } -| "{" - { +| begin_custom + { + print_DEBUG "begin_custom"; + incr_cpts lexbuf ; + if !verb_mode or !latex_mode or !code_pre_mode or + (!open_brackets >= 1) or !ele_ref_mode then + Char (Lexing.lexeme lexbuf) + else + let s = Lexing.lexeme lexbuf in + let tag = Odoc_misc.no_blanks s in + CUSTOM tag + } + +| "{" + { incr_cpts lexbuf ; if !latex_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode then Char (Lexing.lexeme lexbuf) else - ERROR + ERROR } | _ - { + { incr_cpts lexbuf ; Char (Lexing.lexeme lexbuf) } - - diff --git a/ocamldoc/odoc_text_parser.mly b/ocamldoc/odoc_text_parser.mly index 8711ca05fb..41bebea6f2 100644 --- a/ocamldoc/odoc_text_parser.mly +++ b/ocamldoc/odoc_text_parser.mly @@ -14,7 +14,7 @@ open Odoc_types -let identchar = +let identchar = "[A-Z a-z_\192-\214\216-\246\248-\255'0-9]" let blank = "[ \010\013\009\012]" @@ -36,6 +36,7 @@ let print_DEBUG s = print_string s; print_newline () %token LEFT %token RIGHT %token ITALIC +%token <string> CUSTOM %token LIST %token ENUM %token ITEM @@ -78,7 +79,7 @@ let print_DEBUG s = print_string s; print_newline () %token <string> Char /* Start Symbols */ -%start main +%start main %type <Odoc_types.text> main %% @@ -100,6 +101,7 @@ text_element: Title text END { let n, l_opt = $1 in Title (n, l_opt, $2) } | BOLD text END { Bold $2 } | ITALIC text END { Italic $2 } +| CUSTOM text END { Custom ($1, $2) } | EMP text END { Emphasize $2 } | SUPERSCRIPT text END { Superscript $2 } | SUBSCRIPT text END { Subscript $2 } @@ -110,68 +112,68 @@ text_element: | ENUM list END { Enum $2 } | CODE string END_CODE { Code $2 } | CODE_PRE string END_CODE_PRE { CodePre $2 } -| ELE_REF string END { +| ELE_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, None) + Ref (s3, None) } -| VAL_REF string END { +| VAL_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_value) + Ref (s3, Some RK_value) } -| TYP_REF string END { +| TYP_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_type) + Ref (s3, Some RK_type) } -| EXC_REF string END { +| EXC_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_exception) + Ref (s3, Some RK_exception) } -| MOD_REF string END { +| MOD_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_module) + Ref (s3, Some RK_module) } -| MODT_REF string END { +| MODT_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_module_type) + Ref (s3, Some RK_module_type) } -| CLA_REF string END { +| CLA_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_class) + Ref (s3, Some RK_class) } -| CLT_REF string END { +| CLT_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_class_type) + Ref (s3, Some RK_class_type) } -| ATT_REF string END { +| ATT_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_attribute) + Ref (s3, Some RK_attribute) } -| MET_REF string END { +| MET_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in - Ref (s3, Some RK_method) + Ref (s3, Some RK_method) } -| SEC_REF string END { +| SEC_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in Ref (s3, Some (RK_section [])) } -| MOD_LIST_REF string END { +| MOD_LIST_REF string END { let s2 = remove_beginning_blanks $2 in let s3 = remove_trailing_blanks s2 in let l = Odoc_misc.split_with_blanks s3 in Module_list l } -| INDEX_LIST { Index_list } +| INDEX_LIST { Index_list } | VERB string END_VERB { Verbatim $2 } | LATEX string END_LATEX { Latex $2 } | LINK string END text END { Link ($2, $4) } @@ -184,7 +186,7 @@ text_element: ; list: -| string { [] (* A VOIR : un test pour voir qu'il n'y a que des blancs *) } +| string { [] (* A VOIR : un test pour voir qu'il n'y a que des blancs *) } | string list { $2 } | list string { $1 } | item { [ $1 ] } @@ -220,4 +222,4 @@ string: | Char string { $1^$2 } ; -%% +%% diff --git a/ocamldoc/odoc_types.ml b/ocamldoc/odoc_types.ml index 3710a7845c..68b3c4c9ca 100644 --- a/ocamldoc/odoc_types.ml +++ b/ocamldoc/odoc_types.ml @@ -46,6 +46,7 @@ and text_element = | Subscript of text | Module_list of string list | Index_list + | Custom of string * text and text = text_element list diff --git a/ocamldoc/odoc_types.mli b/ocamldoc/odoc_types.mli index 17eee74900..f5b416ae58 100644 --- a/ocamldoc/odoc_types.mli +++ b/ocamldoc/odoc_types.mli @@ -14,7 +14,7 @@ (** Types for the information collected in comments. *) (** The differents kinds of element references. *) -type ref_kind = +type ref_kind = RK_module | RK_module_type | RK_class @@ -26,7 +26,7 @@ type ref_kind = | RK_method | RK_section of text -and text_element = +and text_element = | Raw of string (** Raw text. *) | Code of string (** The string is source code. *) | CodePre of string (** The string is pre-formatted source code. *) @@ -49,15 +49,16 @@ and text_element = (** A reference to an element. Complete name and kind. *) | Superscript of text (** Superscripts. *) | Subscript of text (** Subscripts. *) - | Module_list of string list + | Module_list of string list (** The table of the given modules with their abstract; *) | Index_list (** The links to the various indexes (values, types, ...) *) + | Custom of string * text (** to extend \{foo syntax *) (** [text] is a list of text_elements. The order matters. *) and text = text_element list (** The different forms of references in \@see tags. *) -type see_ref = +type see_ref = See_url of string | See_file of string | See_doc of string @@ -83,7 +84,7 @@ type info = { i_raised_exceptions : raised_exception list; (** The list of raised exceptions. *) i_return_value : text option ; (** The description text of the return value. *) i_custom : (string * text) list ; (** A text associated to a custom @-tag. *) - } + } (** An empty info structure. *) val dummy_info : info @@ -92,7 +93,7 @@ val dummy_info : info type location = { loc_impl : (string * int) option ; (** implementation file name and position *) loc_inter : (string * int) option ; (** interface file name and position *) - } + } (** A dummy location. *) val dummy_loc : location @@ -111,7 +112,7 @@ type merge_option = and all raised exceptions are kept. *) | Merge_return_value (** Information on return value are concatenated. *) | Merge_custom (** Merge custom tags (all pairs (tag, text) are kept). *) - + (** The list with all merge options. *) val all_merge_options : merge_option list @@ -130,4 +131,3 @@ val make_dump : 'a -> 'a dump (** Verify that a dump has the correct magic number and return its content. *) val open_dump : 'a dump -> 'a - |