diff options
Diffstat (limited to 'ocamldoc')
36 files changed, 1979 insertions, 1373 deletions
diff --git a/ocamldoc/.depend b/ocamldoc/.depend index d3a3951da1..46b98481ef 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -56,11 +56,11 @@ odoc_config.cmo: ../utils/config.cmi odoc_config.cmi odoc_config.cmx: ../utils/config.cmx odoc_config.cmi odoc_cross.cmo: odoc_class.cmo odoc_exception.cmo odoc_messages.cmo \ odoc_misc.cmi odoc_module.cmo odoc_name.cmi odoc_parameter.cmo \ - odoc_search.cmi odoc_type.cmo odoc_types.cmi odoc_value.cmo \ + odoc_scan.cmo odoc_search.cmi odoc_type.cmo odoc_types.cmi odoc_value.cmo \ odoc_cross.cmi odoc_cross.cmx: odoc_class.cmx odoc_exception.cmx odoc_messages.cmx \ odoc_misc.cmx odoc_module.cmx odoc_name.cmx odoc_parameter.cmx \ - odoc_search.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \ + odoc_scan.cmx odoc_search.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \ odoc_cross.cmi odoc_dag2html.cmo: odoc_info.cmi odoc_dag2html.cmi odoc_dag2html.cmx: odoc_info.cmx odoc_dag2html.cmi @@ -104,8 +104,10 @@ odoc_lexer.cmo: odoc_args.cmi odoc_comments_global.cmi odoc_messages.cmo \ odoc_parser.cmi odoc_lexer.cmx: odoc_args.cmx odoc_comments_global.cmx odoc_messages.cmx \ odoc_parser.cmx -odoc_man.cmo: odoc_info.cmi odoc_messages.cmo odoc_misc.cmi odoc_str.cmi -odoc_man.cmx: odoc_info.cmx odoc_messages.cmx odoc_misc.cmx odoc_str.cmx +odoc_man.cmo: odoc_info.cmi odoc_messages.cmo odoc_misc.cmi odoc_print.cmi \ + odoc_str.cmi +odoc_man.cmx: odoc_info.cmx odoc_messages.cmx odoc_misc.cmx odoc_print.cmx \ + odoc_str.cmx odoc_merge.cmo: odoc_args.cmi odoc_class.cmo odoc_exception.cmo \ odoc_messages.cmo odoc_module.cmo odoc_name.cmi odoc_parameter.cmo \ odoc_type.cmo odoc_types.cmi odoc_value.cmo odoc_merge.cmi @@ -121,19 +123,17 @@ odoc_misc.cmx: ../typing/btype.cmx ../typing/ctype.cmx ../typing/ident.cmx \ ../parsing/longident.cmx odoc_messages.cmx odoc_types.cmx \ ../typing/path.cmx ../typing/types.cmx odoc_misc.cmi odoc.cmo: ../utils/clflags.cmo ../utils/config.cmi ../utils/misc.cmi \ - odoc_analyse.cmi odoc_args.cmi odoc_config.cmi odoc_crc.cmo odoc_dot.cmo \ + odoc_analyse.cmi odoc_args.cmi odoc_config.cmi odoc_dot.cmo \ odoc_global.cmi odoc_html.cmo odoc_info.cmi odoc_latex.cmo odoc_man.cmo \ odoc_messages.cmo odoc_texi.cmo ../typing/typedtree.cmi odoc.cmx: ../utils/clflags.cmx ../utils/config.cmx ../utils/misc.cmx \ - odoc_analyse.cmx odoc_args.cmx odoc_config.cmx odoc_crc.cmx odoc_dot.cmx \ + odoc_analyse.cmx odoc_args.cmx odoc_config.cmx odoc_dot.cmx \ odoc_global.cmx odoc_html.cmx odoc_info.cmx odoc_latex.cmx odoc_man.cmx \ odoc_messages.cmx odoc_texi.cmx ../typing/typedtree.cmx odoc_module.cmo: odoc_class.cmo odoc_exception.cmo odoc_name.cmi \ - odoc_parameter.cmo odoc_type.cmo odoc_types.cmi odoc_value.cmo \ - ../typing/types.cmi + odoc_type.cmo odoc_types.cmi odoc_value.cmo ../typing/types.cmi odoc_module.cmx: odoc_class.cmx odoc_exception.cmx odoc_name.cmx \ - odoc_parameter.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \ - ../typing/types.cmx + odoc_type.cmx odoc_types.cmx odoc_value.cmx ../typing/types.cmx odoc_name.cmo: ../typing/ident.cmi ../parsing/longident.cmi \ ../typing/path.cmi odoc_name.cmi odoc_name.cmx: ../typing/ident.cmx ../parsing/longident.cmx \ @@ -168,16 +168,16 @@ odoc_sig.cmo: ../parsing/asttypes.cmi ../typing/btype.cmi \ ../parsing/location.cmi ../utils/misc.cmi odoc_args.cmi odoc_class.cmo \ odoc_env.cmi odoc_exception.cmo odoc_global.cmi odoc_merge.cmi \ odoc_messages.cmo odoc_misc.cmi odoc_module.cmo odoc_name.cmi \ - odoc_parameter.cmo odoc_type.cmo odoc_types.cmi odoc_value.cmo \ - ../parsing/parsetree.cmi ../typing/path.cmi ../typing/typedtree.cmi \ - ../typing/types.cmi odoc_sig.cmi + odoc_parameter.cmo odoc_print.cmi odoc_type.cmo odoc_types.cmi \ + odoc_value.cmo ../parsing/parsetree.cmi ../typing/path.cmi \ + ../typing/typedtree.cmi ../typing/types.cmi odoc_sig.cmi odoc_sig.cmx: ../parsing/asttypes.cmi ../typing/btype.cmx \ ../parsing/location.cmx ../utils/misc.cmx odoc_args.cmx odoc_class.cmx \ odoc_env.cmx odoc_exception.cmx odoc_global.cmx odoc_merge.cmx \ odoc_messages.cmx odoc_misc.cmx odoc_module.cmx odoc_name.cmx \ - odoc_parameter.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \ - ../parsing/parsetree.cmi ../typing/path.cmx ../typing/typedtree.cmx \ - ../typing/types.cmx odoc_sig.cmi + odoc_parameter.cmx odoc_print.cmx odoc_type.cmx odoc_types.cmx \ + odoc_value.cmx ../parsing/parsetree.cmi ../typing/path.cmx \ + ../typing/typedtree.cmx ../typing/types.cmx odoc_sig.cmi odoc_str.cmo: odoc_exception.cmo odoc_messages.cmo odoc_misc.cmi \ odoc_name.cmi odoc_print.cmi odoc_type.cmo odoc_value.cmo \ ../typing/printtyp.cmi ../typing/types.cmi odoc_str.cmi diff --git a/ocamldoc/Changes.txt b/ocamldoc/Changes.txt index f1ba418fcb..1f9a41d05e 100644 --- a/ocamldoc/Changes.txt +++ b/ocamldoc/Changes.txt @@ -1,5 +1,38 @@ Current : -OK - add: new option -customdir +OK - latex: style latex pour indenter dans les module kind et les class kind +OK - latex: il manque la génération des paramètres de classe +OK - parse des {!modules: } et {!indexlist} +OK - gestion des Module_list et Index_list +OK - no need to Dynlink.add_available_units any more +OK - generate html from module_kind rather than from module_type +OK + same for classes and class types +OK - add the kind to module parameters (the way the parameter was build in the parsetree) +OK - fix: the generated ocamldoc.sty is more robust for paragraphs in + ocamldocdescription environment +OK - fix: when generating separated files in latex, generate them in + the same directory than the main file, (the one specified by -o) +OK - mod: one section per to module in latex output + improve latex output +OK - mod: odoc_latex: use buffers instead of string concatenation +OK - add: new ocamldoc man page, thanks to Samuel Mimram +OK - fix: useless parenthesis around agruments of arguments of a type constructor in + type definitions, and aournd arguments of exceptions in exception definitions. +OK - fix: blank lines in verbatim, latex, code pre, code and ele ref modes + are now accepted +OK - fix: html generator: included module names were displayed with their simple + name rather than their fully qualified name +OK - fix: use a formatter from a buffer rather Format.str_formatter in + Odoc_mist.sting_of_module_type, to avoid too much blanks +OK - new module odoc_print, will work when Format.pp_print_flush is fixed +OK - odoc_html: use buffers instead of string concatenation +OK - odoc_man: use buffers instead of string concatenation +OK - odoc_cross.ml: use hash tables modified on the fly to resolve + (module | module type | exception) name aliases +OK - odoc_html: replace some calls to Str. by specific functions on strings +OK - odoc_cross.ml: use a Map to associate a complete name to + the known elements with this name, instead of searching each time + through the whole list of modules -> a gain of more than 90% in speed + for cross-referencing (Odoc_cross.associate) +OK - fix: Odoc_name.cut printed a '(' instead of a '.' OK - add: new option -customdir OK - add: new option -i (to add a path to the directory where to look for custom generators) OK - add: add odoc_config.ml{,i} @@ -20,16 +53,13 @@ OK - add: field m_code for modules, to keep the code of top modules OK - fix: display "include Foo" instead of "include module Foo" in Latex, Man, Texi OK - fix: not display comments associated to include directives OK - fix: bad display of type parameters for class and class types -- need to fix display of type parameters for inherited classes/class types -OK - fix: html generator: included module names were displayed with their simple - name rather than their fully qualified name -OK - fix: use a formatter from a buffer rather Format.str_formatter in - Odoc_mist.sting_of_module_type, to avoid too much blanks -OK - new module odoc_print, will work when Format.pp_print_flush is fixed - - odoc_html: use buffers instead of string concatenation -OK - odoc_man: use buffers instead of string concatenation - - odoc_latex: use buffers instead of string concatenation +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 + - ajout à la doc de Module_list et Index_list (utilisé dans le html seulement) + - ajout ds la doc: fichier de l'option -intro utilisé pour l'index en html + - utilisation nouvelles infos de Xavier: "début de rec", etc. ====== @@ -116,4 +146,4 @@ Rep-release 2 : their navigation bar (for example, mozilla 0.9.5 is compliant) - '{bone}' doesn't work any more ; a space is required as in '{b one}'. Same for {e, {i, and some others marks. Check the manual -- bug fixes
\ No newline at end of file +- bug fixes diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index e968beb514..77b93237e2 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -23,7 +23,6 @@ OCAMLLEX = $(CAMLRUN) ../boot/ocamllex OCAMLYACC= ../boot/ocamlyacc OCAMLLIB = $(LIBDIR) OCAMLBIN = $(BINDIR) -EXTRAC_CRC = $(CAMLRUN) ../otherlibs/dynlink/extract_crc OCAMLPP=-pp './remove_DEBUG' @@ -102,10 +101,10 @@ CMOFILES= odoc_config.cmo \ odoc_control.cmo\ odoc_inherit.cmo\ odoc_search.cmo\ + odoc_scan.cmo\ odoc_cross.cmo\ odoc_dep.cmo\ odoc_analyse.cmo\ - odoc_scan.cmo\ odoc_info.cmo @@ -198,8 +197,8 @@ libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) debug: make OCAMLPP="" -$(OCAMLDOC): $(EXECMOFILES) odoc_crc.cmo odoc.cmo - $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc_crc.cmo odoc.cmo +$(OCAMLDOC): $(EXECMOFILES) odoc.cmo + $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc.cmo $(OCAMLDOC_OPT): $(EXECMXFILES) odoc_opt.cmx $(OCAMLOPT) -o $@ unix.cmxa str.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) odoc_opt.cmx @@ -210,34 +209,6 @@ $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES) manpages: stdlib_man/Pervasives.3o -odoc_crc.ml: $(CMIFILES) - $(EXTRAC_CRC) $(INCLUDES) \ - Arg Arith_status Array Big_int Buffer Callback Char Digest Dynlink \ - Filename Format Gc Genlex Hashtbl \ - Lazy Lexing List Map Marshal Nat Nativeint \ - Num Obj CamlinternalOO Outcometree Parsing Pervasives Printexc \ - Printf Profiling Queue Random Ratio \ - Set Sort Stack Std_exit Str Stream \ - String Sys Topdirs Toploop Unix Weak \ - Printast Ident Tbl Misc Config Clflags Warnings Ccomp \ - Linenum Location Longident Syntaxerr Parser Lexer Parse \ - Types Path Btype Predef Datarepr Subst Env Ctype Primitive \ - Oprint Printtyp Includecore Typetexp Parmatch Typedtree Typecore \ - Includeclass Typedecl Typeclass Mtype Includemod Typemod \ - Lambda Typeopt Printlambda Switch Matching Translobj Translcore \ - Bytesections Runtimedef Symtable Opcodes Bytelink Bytelibrarian \ - Translclass Errors Main_args Asttypes Depend \ - Odoc_global Odoc_args Odoc_info Odoc_messages Odoc_types \ - Odoc_misc Odoc_text_parser Odoc_text_lexer \ - Odoc_text Odoc_comments_global Odoc_parser \ - Odoc_lexer Odoc_comments Odoc_name Odoc_parameter \ - Odoc_value Odoc_type Odoc_exception Odoc_class \ - Odoc_module Odoc_str Odoc_args Odoc_env \ - Odoc_sig Odoc_ast Odoc_control Odoc_inherit \ - Odoc_search Odoc_cross Odoc_merge Odoc_analyse \ - Odoc_dag2html Odoc_ocamlhtml Odoc_html Odoc_to_text \ - Odoc_latex_style Odoc_latex Odoc_man Odoc_texi Odoc_scan > $@ - # Parsers and lexers dependencies : ################################### odoc_text_parser.ml: odoc_text_parser.mly @@ -285,7 +256,7 @@ install: dummy if test -d $(INSTALL_LIBDIR); then : ; else $(MKDIR) $(INSTALL_LIBDIR); fi if test -d $(INSTALL_CUSTOMDIR); then : ; else $(MKDIR) $(INSTALL_CUSTOMDIR); fi $(CP) $(OCAMLDOC)$(EXE) $(INSTALL_BINDIR)/$(OCAMLDOC)$(EXE) - $(CP) ocamldoc.hva *.cmi $(GENERATORS) $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR) + $(CP) ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR) $(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR) if test -d $(INSTALL_MANODIR); then : ; else $(MKDIR) $(INSTALL_MANODIR); fi $(CP) stdlib_man/* $(INSTALL_MANODIR) @@ -321,6 +292,15 @@ test_latex: dummy $(MKDIR) $@ $(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) odoc*.ml odoc*.mli ../stdlib/*.mli ../otherlibs/unix/unix.mli +test_latex_simple: dummy + $(MKDIR) $@ + $(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) \ + -latextitle 6,subsection -latextitle 7,subsubection \ + ../stdlib/hashtbl.mli \ + ../stdlib/arg.mli \ + ../otherlibs/unix/unix.mli \ + ../stdlib/map.mli + test_man: dummy $(MKDIR) $@ $(OCAMLDOC_RUN) -man -sort -d $@ $(INCLUDES) odoc*.ml odoc*.mli @@ -351,7 +331,7 @@ clean:: dummy @rm -f $(OCAMLDOC)$(EXE) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.a *.o @rm -f odoc_parser.output odoc_text_parser.output @rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml - @rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli odoc_crc.ml + @rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli @rm -rf stdlib_man depend:: diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt index ad50ac90f8..3a5a4ba24f 100644 --- a/ocamldoc/Makefile.nt +++ b/ocamldoc/Makefile.nt @@ -21,7 +21,6 @@ OCAMLYACC=../boot/ocamlyacc OCAMLLIB = $(LIBDIR) OCAMLBIN = $(BINDIR) -EXTRAC_CRC = $(CAMLRUN) ../otherlibs/dynlink/extract_crc OCAMLPP=-pp "grep -v DEBUG" @@ -96,10 +95,10 @@ CMOFILES= odoc_config.cmo \ odoc_control.cmo\ odoc_inherit.cmo\ odoc_search.cmo\ + odoc_scan.cmo\ odoc_cross.cmo\ odoc_dep.cmo\ odoc_analyse.cmo\ - odoc_scan.cmo\ odoc_info.cmo @@ -187,8 +186,8 @@ libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) debug: make OCAMLPP="" -$(OCAMLDOC): $(EXECMOFILES) odoc_crc.cmo odoc.cmo - $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc_crc.cmo odoc.cmo +$(OCAMLDOC): $(EXECMOFILES) odoc.cmo + $(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc.cmo $(OCAMLDOC_OPT): $(EXECMXFILES) odoc_opt.cmx $(OCAMLOPT) -o $@ unix.cmxa str.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) odoc_opt.cmx @@ -197,81 +196,6 @@ $(OCAMLDOC_LIBCMA): $(LIBCMOFILES) $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES) $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLCMXFILES) $(LIBCMXFILES) -odoc_crc.ml: $(CMIFILES) - $(EXTRAC_CRC) $(INCLUDES)\ - Arg Arith_status Array Big_int Buffer Callback Char Digest Dynlink \ - Filename Format Gc Genlex Hashtbl \ - Lazy Lexing List Map Marshal Nat Nativeint\ - Num Obj CamlinternalOO Outcometree Parsing Pervasives Printexc\ - Printf Profiling Queue Random Ratio\ - Set Sort Stack Std_exit Str Stream\ - String Sys Topdirs Toploop Unix Weak\ - Printast \ - Ident \ - Tbl \ - Misc \ - Config \ - Clflags \ - Warnings \ - Ccomp \ - Linenum\ - Location\ - Longident \ - Syntaxerr \ - Parser \ - Lexer \ - Parse \ - Types \ - Path \ - Btype \ - Predef \ - Datarepr \ - Subst \ - Env \ - Ctype \ - Primitive \ - Oprint \ - Printtyp \ - Includecore \ - Typetexp \ - Parmatch \ - Typedtree \ - Typecore \ - Includeclass \ - Typedecl \ - Typeclass \ - Mtype \ - Includemod \ - Typemod \ - Lambda \ - Typeopt \ - Printlambda \ - Switch \ - Matching \ - Translobj \ - Translcore \ - Bytesections \ - Runtimedef \ - Symtable \ - Opcodes \ - Bytelink \ - Bytelibrarian \ - Translclass \ - Errors \ - Main_args \ - Asttypes \ - Depend \ - Odoc_global Odoc_args Odoc_info Odoc_messages Odoc_types\ - Odoc_misc Odoc_text_parser Odoc_text_lexer\ - Odoc_text Odoc_comments_global Odoc_parser\ - Odoc_lexer Odoc_comments Odoc_name Odoc_parameter\ - Odoc_value Odoc_type Odoc_exception Odoc_class\ - Odoc_module Odoc_str Odoc_args Odoc_env\ - Odoc_sig Odoc_ast Odoc_control Odoc_inherit\ - Odoc_search Odoc_cross Odoc_merge Odoc_analyse\ - Odoc_dag2html Odoc_ocamlhtml Odoc_html Odoc_to_text \ - Odoc_latex_style Odoc_latex Odoc_man Odoc_texi Odoc_scan > $@ - # generic rules : ################# @@ -310,7 +234,7 @@ install: dummy $(MKDIR) -p $(INSTALL_BINDIR) $(MKDIR) -p $(INSTALL_LIBDIR) $(CP) $(OCAMLDOC) $(INSTALL_BINDIR)/$(OCAMLDOC).exe - $(CP) ocamldoc.hva *.cmi $(GENERATORS) $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR) + $(CP) ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR) $(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR) installopt: @@ -332,7 +256,7 @@ clean:: dummy @rm -f $(OCAMLDOC) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.$(A) *.$(O) @rm -f odoc_parser.output odoc_text_parser.output @rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml - @rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli odoc_crc.ml + @rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli depend:: rm -f .depend diff --git a/ocamldoc/odoc.ml b/ocamldoc/odoc.ml index b1b6477ef9..f4970bfd53 100644 --- a/ocamldoc/odoc.ml +++ b/ocamldoc/odoc.ml @@ -71,7 +71,6 @@ let _ = Dynlink.init (); Dynlink.allow_unsafe_modules true; try - Dynlink.add_available_units Odoc_crc.crc_unit_list ; let real_file = get_real_filename file in ignore(Dynlink.loadfile real_file) with diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 054ab2038e..fda03a08d8 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -423,7 +423,7 @@ module Analyser = | l -> match l with [] -> - (* cas impossible, on l'a filtr avant *) + (* cas impossible, on l'a filtré avant *) assert false | (pattern_param, exp) :: second_ele :: q -> (* implicit pattern matching -> anonymous parameter *) @@ -1162,6 +1162,8 @@ module Analyser = ) | Parsetree.Pstr_recmodule mods -> + (* A VOIR ICI ca merde avec /work/tmp/graph.ml: pas de lien avec les module type + dans les contraintes sur les modules *) let new_env = List.fold_left (fun acc_env (name, _, mod_exp) -> @@ -1383,11 +1385,23 @@ module Analyser = let complete_name = Name.concat current_module_name module_name in let pos_start = p_module_expr.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in let pos_end = p_module_expr.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in - let modtype = tt_module_expr.Typedtree.mod_type in + let modtype = + (* A VOIR : Odoc_env.subst_module_type env ? *) + tt_module_expr.Typedtree.mod_type + in + let m_code_intf = + match p_module_expr.Parsetree.pmod_desc with + Parsetree.Pmod_constraint (_, pmodule_type) -> + let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + Some (get_string_of_file loc_start loc_end) + | _ -> + None + in let m_base = { m_name = complete_name ; - m_type = tt_module_expr.Typedtree.mod_type ; + m_type = modtype ; m_info = comment_opt ; m_is_interface = false ; m_file = !file_name ; @@ -1395,7 +1409,7 @@ module Analyser = m_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ; m_top_deps = [] ; m_code = None ; (* code is set by the caller, after the module is created *) - m_code_intf = None ; + m_code_intf = m_code_intf ; } in match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with @@ -1411,30 +1425,37 @@ module Analyser = let elements2 = replace_dummy_included_modules elements included_modules_from_tt in { m_base with m_kind = Module_struct elements2 } - | (Parsetree.Pmod_functor (_, _, p_module_expr2), + | (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2), Typedtree.Tmod_functor (ident, mtyp, tt_module_expr2)) -> - let param = - { - mp_name = Name.from_ident ident ; - mp_type = Odoc_env.subst_module_type env mtyp ; - } - in - let dummy_complete_name = Name.concat "__" param.mp_name in - let new_env = Odoc_env.add_module env dummy_complete_name in - let m_base2 = analyse_module - new_env - current_module_name - module_name - None - p_module_expr2 - tt_module_expr2 - in - let kind = - match m_base2.m_kind with - Module_functor (params, k) -> Module_functor (param :: params, m_base2.m_kind) - | k -> Module_functor ([param], k) - in - { m_base with m_kind = kind } + let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let mp_type_code = get_string_of_file loc_start loc_end in + print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); + let mp_name = Name.from_ident ident in + let mp_kind = Sig.analyse_module_type_kind env + current_module_name pmodule_type mtyp + in + let param = + { + mp_name = mp_name ; + mp_type = Odoc_env.subst_module_type env mtyp ; + mp_type_code = mp_type_code ; + mp_kind = mp_kind ; + } + in + let dummy_complete_name = (*Name.concat "__"*) param.mp_name in + (* TODO: A VOIR CE __ *) + let new_env = Odoc_env.add_module env dummy_complete_name in + let m_base2 = analyse_module + new_env + current_module_name + module_name + None + p_module_expr2 + tt_module_expr2 + in + let kind = m_base2.m_kind in + { m_base with m_kind = Module_functor (param, kind) } | (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2), Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _)) @@ -1463,6 +1484,8 @@ module Analyser = | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype), Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _)) -> + print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name); + (* we create the module with p_module_expr2 and tt_module_expr2 but we change its type according to the constraint. A VOIR : est-ce que c'est bien ? @@ -1482,7 +1505,7 @@ module Analyser = in { m_base with - m_type = tt_modtype ; + m_type = Odoc_env.subst_module_type env tt_modtype ; m_kind = Module_constraint (m_base2.m_kind, mtkind) @@ -1497,11 +1520,16 @@ module Analyser = tt_modtype, _) ) -> (* needed for recursive modules *) + + print_DEBUG ("Odoc_ast: case Parsetree.Pmod_structure + Typedtree.Tmod_constraint "^module_name); let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in (* we must complete the included modules *) let included_modules_from_tt = tt_get_included_module_list tt_structure in let elements2 = replace_dummy_included_modules elements included_modules_from_tt in - { m_base with m_kind = Module_struct elements2 } + { m_base with + m_type = Odoc_env.subst_module_type env tt_modtype ; + m_kind = Module_struct elements2 ; + } | (parsetree, typedtree) -> let s_parse = @@ -1552,21 +1580,18 @@ module Analyser = let included_modules_from_tt = tt_get_included_module_list tree_structure in let elements2 = replace_dummy_included_modules elements included_modules_from_tt in let kind = Module_struct elements2 in - let m = - { - m_name = mod_name ; - m_type = Types.Tmty_signature [] ; - m_info = info_opt ; - m_is_interface = false ; - m_file = !file_name ; - m_kind = kind ; - m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ; - m_top_deps = [] ; - m_code = (if !Odoc_args.keep_code then Some !file else None) ; - m_code_intf = None ; - } - in - m + { + m_name = mod_name ; + m_type = Types.Tmty_signature [] ; + m_info = info_opt ; + m_is_interface = false ; + m_file = !file_name ; + m_kind = kind ; + m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ; + m_top_deps = [] ; + m_code = (if !Odoc_args.keep_code then Some !file else None) ; + m_code_intf = None ; + } end diff --git a/ocamldoc/odoc_class.ml b/ocamldoc/odoc_class.ml index aea0748bfb..803aa0ba98 100644 --- a/ocamldoc/odoc_class.ml +++ b/ocamldoc/odoc_class.ml @@ -36,7 +36,7 @@ and class_apply = { capp_name : Name.t ; (** The complete name of the applied class *) mutable capp_class : t_class option; (** The associated t_class if we found it *) capp_params : Types.type_expr list; (** The type of expressions the class is applied to *) - capp_params_code : string list ; (** The code of these exprssions *) + capp_params_code : string list ; (** The code of these expressions *) } and class_constr = { diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index 4134ea84b8..cbe949edee 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -68,139 +68,213 @@ module P_alias = (** The module used to get the aliased elements. *) module Search_alias = Odoc_search.Search (P_alias) -let rec build_alias_list (acc_m, acc_mt, acc_ex) = function - [] -> - (acc_m, acc_mt, acc_ex) - | (Odoc_search.Res_module m) :: q -> - let new_acc_m = - match m.m_kind with - Module_alias ma -> (m.m_name, ma.ma_name) :: acc_m - | _ -> acc_m - in - build_alias_list (new_acc_m, acc_mt, acc_ex) q - | (Odoc_search.Res_module_type mt) :: q -> - let new_acc_mt = - match mt.mt_kind with - Some (Module_type_alias mta) -> (mt.mt_name, mta.mta_name) :: acc_mt - | _ -> acc_mt - in - build_alias_list (acc_m, new_acc_mt, acc_ex) q - | (Odoc_search.Res_exception e) :: q -> - let new_acc_ex = - match e.ex_alias with - None -> acc_ex - | Some ea -> (e.ex_name, ea.ea_name) :: acc_ex - in - build_alias_list (acc_m, acc_mt, new_acc_ex) q - | _ :: q -> - build_alias_list (acc_m, acc_mt, acc_ex) q - - +type alias_state = + Alias_resolved + | Alias_to_resolve (** Couples of module name aliases. *) -let module_aliases = ref [] ;; +let (module_aliases : (Name.t, Name.t * alias_state) Hashtbl.t) = Hashtbl.create 13 ;; -(** Couples of module type name aliases. *) -let module_type_aliases = ref [] ;; +(** Couples of module or module type name aliases. *) +let module_and_modtype_aliases = Hashtbl.create 13;; (** Couples of exception name aliases. *) -let exception_aliases = ref [] ;; +let exception_aliases = Hashtbl.create 13;; -(** Retrieve the aliases for modules, module types and exceptions and put them in global variables. *) +let rec build_alias_list = function + [] -> () + | (Odoc_search.Res_module m) :: q -> + ( + match m.m_kind with + 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) + | _ -> () + ); + build_alias_list q + | (Odoc_search.Res_module_type mt) :: q -> + ( + match mt.mt_kind with + Some (Module_type_alias mta) -> + Hashtbl.add module_and_modtype_aliases + mt.mt_name (mta.mta_name, Alias_to_resolve) + | _ -> () + ); + build_alias_list q + | (Odoc_search.Res_exception e) :: q -> + ( + match e.ex_alias with + None -> () + | 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 + and put them in global hash tables. *) let get_alias_names module_list = - let (alias_m, alias_mt, alias_ex) = - build_alias_list - ([], [], []) - (Search_alias.search module_list 0) - in - module_aliases := alias_m ; - module_type_aliases := alias_mt ; - exception_aliases := alias_ex + 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 = + try + match Hashtbl.find t name with + (s, Alias_resolved) -> s + | (s, Alias_to_resolve) -> f t s + with + Not_found -> + try + Hashtbl.iter + (fun n2 (n3, _) -> + if Name.prefix n2 name then + let ln2 = String.length n2 in + let s = n3^(String.sub name ln2 ((String.length name) - ln2)) in + raise (Found s) + ) + t ; + Hashtbl.replace t name (name, Alias_resolved); + name + with + Found s -> + let s2 = f t s in + Hashtbl.replace t s2 (s2, Alias_resolved); + s2 + in + fun name alias_tbl -> + f alias_tbl name -(** The module with lookup predicates. *) -module P_lookup = + +module Map_ord = struct - type t = Name.t - let p_module m name = (Name.prefix m.m_name name, m.m_name = (Name.name_alias name !module_aliases)) - let p_module_type mt name = (Name.prefix mt.mt_name name, mt.mt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases))) - let p_class c name = (false, c.cl_name = (Name.name_alias name (!module_aliases @ !module_type_aliases))) - let p_class_type ct name = (false, ct.clt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases))) - let p_value v name = false - let p_type t name = false - let p_exception e name = e.ex_name = (Name.name_alias name !exception_aliases) - let p_attribute a name = false - let p_method m name = false - let p_section s name = false + type t = string + let compare = Pervasives.compare end -(** The module used to search by a complete name.*) -module Search_by_complete_name = Odoc_search.Search (P_lookup) - -let rec lookup_module module_list name = - let l = List.filter - (fun res -> - match res with - Odoc_search.Res_module _ -> true - | _ -> false - ) - (Search_by_complete_name.search module_list name) - in - match l with - (Odoc_search.Res_module m) :: _ -> m - | _ -> raise Not_found - -let rec lookup_module_type module_list name = - let l = List.filter - (fun res -> - match res with - Odoc_search.Res_module_type _ -> true - | _ -> false - ) - (Search_by_complete_name.search module_list name) - in - match l with - (Odoc_search.Res_module_type mt) :: _ -> mt - | _ -> raise Not_found - -let rec lookup_class module_list name = - let l = List.filter - (fun res -> - match res with - Odoc_search.Res_class _ -> true - | _ -> false - ) - (Search_by_complete_name.search module_list name) - in - match l with - (Odoc_search.Res_class c) :: _ -> c - | _ -> raise Not_found - -let rec lookup_class_type module_list name = - let l = List.filter - (fun res -> - match res with - Odoc_search.Res_class_type _ -> true - | _ -> false - ) - (Search_by_complete_name.search module_list name) +module Ele_map = Map.Make (Map_ord) + +let known_elements = ref Ele_map.empty +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 + known_elements := Ele_map.add name (k::l) s + with + Not_found -> + known_elements := Ele_map.add name [k] !known_elements + +let get_known_elements name = + try Ele_map.find name !known_elements + with Not_found -> [] + +let kind_name_exists kind = + 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) + | RK_class -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false) + | RK_class_type -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false) + | RK_value -> (fun e -> match e with Odoc_search.Res_value _ -> true | _ -> false) + | RK_type -> (fun e -> match e with Odoc_search.Res_type _ -> true | _ -> false) + | RK_exception -> (fun e -> match e with Odoc_search.Res_exception _ -> true | _ -> false) + | RK_attribute -> (fun e -> match e with Odoc_search.Res_attribute _ -> true | _ -> false) + | RK_method -> (fun e -> match e with Odoc_search.Res_method _ -> true | _ -> false) + | RK_section _ -> assert false in - match l with - (Odoc_search.Res_class_type ct) :: _ -> ct - | _ -> raise Not_found - -let rec lookup_exception module_list name = - let l = List.filter - (fun res -> - match res with - Odoc_search.Res_exception _ -> true - | _ -> false - ) - (Search_by_complete_name.search module_list name) - in - match l with - (Odoc_search.Res_exception e) :: _ -> e - | _ -> raise Not_found + fun name -> + try List.exists pred (get_known_elements name) + with Not_found -> false + +let module_exists = kind_name_exists RK_module +let module_type_exists = kind_name_exists RK_module_type +let class_exists = kind_name_exists RK_class +let class_type_exists = kind_name_exists RK_class_type +let value_exists = kind_name_exists RK_value +let type_exists = kind_name_exists RK_type +let exception_exists = kind_name_exists RK_exception +let attribute_exists = kind_name_exists RK_attribute +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) + (get_known_elements name) + with + | Odoc_search.Res_module m -> m + | _ -> assert false + +let lookup_module_type name = + match List.find + (fun k -> match k with Odoc_search.Res_module_type _ -> true | _ -> false) + (get_known_elements name) + with + | Odoc_search.Res_module_type m -> m + | _ -> assert false + +let lookup_class name = + match List.find + (fun k -> match k with Odoc_search.Res_class _ -> true | _ -> false) + (get_known_elements name) + with + | Odoc_search.Res_class c -> c + | _ -> assert false + +let lookup_class_type name = + match List.find + (fun k -> match k with Odoc_search.Res_class_type _ -> true | _ -> false) + (get_known_elements name) + with + | Odoc_search.Res_class_type c -> c + | _ -> assert false + +let lookup_exception name = + match List.find + (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false) + (get_known_elements name) + with + | Odoc_search.Res_exception e -> e + | _ -> assert false + +class scan = + object + inherit Odoc_scan.scanner + method scan_value v = + add_known_element v.val_name (Odoc_search.Res_value v) + 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) + method scan_attribute a = + add_known_element a.att_value.val_name + (Odoc_search.Res_attribute a) + method scan_method m = + add_known_element m.met_value.val_name + (Odoc_search.Res_method m) + method scan_class_pre c = + add_known_element c.cl_name (Odoc_search.Res_class c); + true + method scan_class_type_pre c = + add_known_element c.clt_name (Odoc_search.Res_class_type c); + true + method scan_module_pre m = + add_known_element m.m_name (Odoc_search.Res_module m); + true + method scan_module_type_pre m = + add_known_element m.mt_name (Odoc_search.Res_module_type m); + true + + end + +let init_known_elements_map module_list = + let c = new scan in + c#scan_module_list module_list + (** The type to describe the names not found. *) type not_found_name = @@ -230,9 +304,9 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_ (acc_b, acc_inc, acc_names) | None -> let mmt_opt = - try Some (Mod (lookup_module module_list ma.ma_name)) + try Some (Mod (lookup_module ma.ma_name)) with Not_found -> - try Some (Modtype (lookup_module_type module_list ma.ma_name)) + try Some (Modtype (lookup_module_type ma.ma_name)) with Not_found -> None in match mmt_opt with @@ -293,7 +367,7 @@ and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module (acc_b, acc_inc, acc_names) | None -> let mt_opt = - try Some (lookup_module_type module_list mta.mta_name) + try Some (lookup_module_type mta.mta_name) with Not_found -> None in match mt_opt with @@ -324,9 +398,9 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) | None -> let mmt_opt = - try Some (Mod (lookup_module module_list im.im_name)) + try Some (Mod (lookup_module im.im_name)) with Not_found -> - try Some (Modtype (lookup_module_type module_list im.im_name)) + try Some (Modtype (lookup_module_type im.im_name)) with Not_found -> None in match mmt_opt with @@ -356,7 +430,7 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_ (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) | None -> let ex_opt = - try Some (lookup_exception module_list ea.ea_name) + try Some (lookup_exception ea.ea_name) with Not_found -> None in match ex_opt with @@ -377,9 +451,9 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names Some _ -> (acc_b2, acc_inc2, acc_names2) | None -> let cct_opt = - try Some (Cl (lookup_class module_list ic.ic_name)) + try Some (Cl (lookup_class ic.ic_name)) with Not_found -> - try Some (Cltype (lookup_class_type module_list ic.ic_name, [])) + try Some (Cltype (lookup_class_type ic.ic_name, [])) with Not_found -> None in match cct_opt with @@ -398,7 +472,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names Some _ -> (acc_b, acc_inc, acc_names) | None -> let cl_opt = - try Some (lookup_class module_list capp.capp_name) + try Some (lookup_class capp.capp_name) with Not_found -> None in match cl_opt with @@ -416,14 +490,14 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names Some _ -> (acc_b, acc_inc, acc_names) | None -> let cl_opt = - try Some (lookup_class module_list cco.cco_name) + try Some (lookup_class cco.cco_name) with Not_found -> None in match cl_opt with None -> ( let clt_opt = - try Some (lookup_class_type module_list cco.cco_name) + try Some (lookup_class_type cco.cco_name) with Not_found -> None in match clt_opt with @@ -460,9 +534,9 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ Some _ -> (acc_b2, acc_inc2, acc_names2) | None -> let cct_opt = - try Some (Cltype (lookup_class_type module_list ic.ic_name, [])) + try Some (Cltype (lookup_class_type ic.ic_name, [])) with Not_found -> - try Some (Cl (lookup_class module_list ic.ic_name)) + try Some (Cl (lookup_class ic.ic_name)) with Not_found -> None in match cct_opt with @@ -481,9 +555,9 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_ Some _ -> (acc_b, acc_inc, acc_names) | None -> let cct_opt = - try Some (Cltype (lookup_class_type module_list cta.cta_name, [])) + try Some (Cltype (lookup_class_type cta.cta_name, [])) with Not_found -> - try Some (Cl (lookup_class module_list cta.cta_name)) + try Some (Cl (lookup_class cta.cta_name)) with Not_found -> None in match cct_opt with @@ -504,97 +578,109 @@ let ao = Odoc_misc.apply_opt let rec assoc_comments_text_elements module_list t_ele = match t_ele with - | Raw _ - | Code _ - | CodePre _ - | Latex _ - | Verbatim _ -> t_ele - | Bold t -> Bold (assoc_comments_text module_list t) - | Italic t -> Italic (assoc_comments_text module_list t) - | Center t -> Center (assoc_comments_text module_list t) - | Left t -> Left (assoc_comments_text module_list t) - | Right t -> Right (assoc_comments_text module_list t) - | Emphasize t -> Emphasize (assoc_comments_text module_list t) - | List l -> List (List.map (assoc_comments_text module_list) l) - | Enum l -> Enum (List.map (assoc_comments_text module_list) l) - | Newline -> Newline - | Block t -> Block (assoc_comments_text module_list t) - | Superscript t -> Superscript (assoc_comments_text module_list t) - | Subscript t -> Subscript (assoc_comments_text module_list t) - | Title (n, l_opt, t) -> Title (n, l_opt, (assoc_comments_text module_list t)) - | Link (s, t) -> Link (s, (assoc_comments_text module_list t)) - | Ref (name, None) -> - ( - (* we look for the first element with this name *) - let re = Str.regexp ("^"^(Str.quote name)^"$") in - let res = Odoc_search.Search_by_name.search module_list re in - match res with - [] -> - Odoc_messages.pwarning (Odoc_messages.cross_element_not_found name); - t_ele - | ele :: _ -> - let kind = - match ele with - Odoc_search.Res_module _ -> RK_module - | Odoc_search.Res_module_type _ -> RK_module_type - | Odoc_search.Res_class _ -> RK_class - | Odoc_search.Res_class_type _ -> RK_class_type - | Odoc_search.Res_value _ -> RK_value - | Odoc_search.Res_type _ -> RK_type - | Odoc_search.Res_exception _ -> RK_exception - | Odoc_search.Res_attribute _ -> RK_attribute - | Odoc_search.Res_method _ -> RK_method - | Odoc_search.Res_section (_ ,t)-> RK_section t - in - add_verified (name, Some kind) ; - Ref (name, Some kind) - ) - | Ref (name, Some kind) -> - let v = (name, Some kind) in - (** we just verify that we find an element of this kind with this name *) - let re = Str.regexp ("^"^(Str.quote name)^"$") in - let res = Odoc_search.Search_by_name.search module_list re in - if was_verified v then - Ref (name, Some kind) - else - match kind with - | RK_section _ -> - ( - try - let t = Odoc_search.find_section module_list re in - let v2 = (name, Some (RK_section t)) in - add_verified v2 ; - Ref (name, Some (RK_section t)) - with - Not_found -> - Odoc_messages.pwarning (Odoc_messages.cross_section_not_found name); - Ref (name, None) - ) - | _ -> - let (f,f_mes) = - match kind with - RK_module -> Odoc_search.module_exists, Odoc_messages.cross_module_not_found - | RK_module_type -> Odoc_search.module_type_exists, Odoc_messages.cross_module_type_not_found - | RK_class -> Odoc_search.class_exists, Odoc_messages.cross_class_not_found - | RK_class_type -> Odoc_search.class_type_exists, Odoc_messages.cross_class_type_not_found - | RK_value -> Odoc_search.value_exists, Odoc_messages.cross_value_not_found - | RK_type -> Odoc_search.type_exists, Odoc_messages.cross_type_not_found - | RK_exception -> Odoc_search.exception_exists, Odoc_messages.cross_exception_not_found - | RK_attribute -> Odoc_search.attribute_exists, Odoc_messages.cross_attribute_not_found - | RK_method -> Odoc_search.method_exists, Odoc_messages.cross_method_not_found - | RK_section _ -> assert false - in - if f module_list re then - ( - add_verified v ; - Ref (name, Some kind) - ) - else - ( - Odoc_messages.pwarning (f_mes name); - Ref (name, None) - ) - + | Raw _ + | Code _ + | CodePre _ + | Latex _ + | Verbatim _ -> t_ele + | Bold t -> Bold (assoc_comments_text module_list t) + | Italic t -> Italic (assoc_comments_text module_list t) + | Center t -> Center (assoc_comments_text module_list t) + | Left t -> Left (assoc_comments_text module_list t) + | Right t -> Right (assoc_comments_text module_list t) + | Emphasize t -> Emphasize (assoc_comments_text module_list t) + | List l -> List (List.map (assoc_comments_text module_list) l) + | Enum l -> Enum (List.map (assoc_comments_text module_list) l) + | Newline -> Newline + | Block t -> Block (assoc_comments_text module_list t) + | Superscript t -> Superscript (assoc_comments_text module_list t) + | Subscript t -> Subscript (assoc_comments_text module_list t) + | Title (n, l_opt, t) -> Title (n, l_opt, (assoc_comments_text module_list t)) + | Link (s, t) -> Link (s, (assoc_comments_text module_list t)) + | Ref (name, None) -> + ( + match get_known_elements name with + [] -> + ( + try + let re = Str.regexp ("^"^(Str.quote name)^"$") in + let t = Odoc_search.find_section module_list re in + let v2 = (name, Some (RK_section t)) in + add_verified v2 ; + Ref (name, Some (RK_section t)) + with + Not_found -> + Odoc_messages.pwarning (Odoc_messages.cross_element_not_found name); + Ref (name, None) + ) + | ele :: _ -> + (* we look for the first element with this name *) + let kind = + match ele with + Odoc_search.Res_module _ -> RK_module + | Odoc_search.Res_module_type _ -> RK_module_type + | Odoc_search.Res_class _ -> RK_class + | Odoc_search.Res_class_type _ -> RK_class_type + | Odoc_search.Res_value _ -> RK_value + | Odoc_search.Res_type _ -> RK_type + | Odoc_search.Res_exception _ -> RK_exception + | Odoc_search.Res_attribute _ -> RK_attribute + | Odoc_search.Res_method _ -> RK_method + | Odoc_search.Res_section (_ ,t)-> assert false + in + add_verified (name, Some kind) ; + Ref (name, Some kind) + ) + | Ref (name, Some kind) -> + ( + let v = (name, Some kind) in + if was_verified v then + Ref (name, Some kind) + else + match kind with + | RK_section _ -> + ( + (** we just verify that we find an element of this kind with this name *) + try + let re = Str.regexp ("^"^(Str.quote name)^"$") in + let t = Odoc_search.find_section module_list re in + let v2 = (name, Some (RK_section t)) in + add_verified v2 ; + Ref (name, Some (RK_section t)) + with + Not_found -> + Odoc_messages.pwarning (Odoc_messages.cross_section_not_found name); + Ref (name, None) + ) + | _ -> + 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 + | RK_class -> class_exists, Odoc_messages.cross_class_not_found + | RK_class_type -> class_type_exists, Odoc_messages.cross_class_type_not_found + | RK_value -> value_exists, Odoc_messages.cross_value_not_found + | RK_type -> type_exists, Odoc_messages.cross_type_not_found + | RK_exception -> exception_exists, Odoc_messages.cross_exception_not_found + | RK_attribute -> attribute_exists, Odoc_messages.cross_attribute_not_found + | RK_method -> method_exists, Odoc_messages.cross_method_not_found + | RK_section _ -> assert false + in + if f name then + ( + add_verified v ; + Ref (name, Some kind) + ) + else + ( + Odoc_messages.pwarning (f_mes name); + Ref (name, None) + ) + ) + | Module_list l -> + Module_list l + | Index_list -> + Index_list and assoc_comments_text module_list text = List.map (assoc_comments_text_elements module_list) text @@ -762,6 +848,7 @@ let associate_type_of_elements_in_comments module_list = (** The function which performs all the cross referencing. *) let associate module_list = get_alias_names module_list ; + init_known_elements_map module_list; let rec remove_doubles acc = function [] -> acc | h :: q -> @@ -781,7 +868,7 @@ let associate module_list = (* we may be able to associate something else *) iter remaining_modules else - (* nothing changed, we won' be able to associate any more *) + (* nothing changed, we won't be able to associate any more *) acc_names_not_found in let names_not_found = iter module_list in @@ -808,8 +895,7 @@ let associate module_list = ) ; (* Find a type for each name of element which is referenced in comments. *) - let _ = associate_type_of_elements_in_comments module_list in - () + ignore (associate_type_of_elements_in_comments module_list) (* eof $Id$ *) diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml index ab0fff272b..252c4f0109 100644 --- a/ocamldoc/odoc_env.ml +++ b/ocamldoc/odoc_env.ml @@ -52,9 +52,9 @@ let rec add_signature env root ?rel signat = let f env item = match item with Types.Tsig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values } - | Types.Tsig_type (ident,_ ) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types } + | Types.Tsig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types } | Types.Tsig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions } - | Types.Tsig_module (ident, modtype) -> + | Types.Tsig_module (ident, modtype, _) -> let env2 = match modtype with (* A VOIR : le cas où c'est un identificateur, dans ce cas on n'a pas de signature *) Types.Tmty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s @@ -73,8 +73,8 @@ let rec add_signature env root ?rel signat = | _ -> env in { env2 with env_module_types = (rel_name ident, qualify ident) :: env2.env_module_types } - | Types.Tsig_class (ident, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes } - | Types.Tsig_cltype (ident, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types } + | Types.Tsig_class (ident, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes } + | Types.Tsig_cltype (ident, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types } in List.fold_left f env signat diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index ffaf4cf2de..cbba5228f6 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -169,6 +169,8 @@ module Naming = f end +module StringSet = Set.Make (struct type t = string let compare = compare end) + (** A class with a method to colorize a string which represents OCaml code. *) class ocaml_code = object(self) @@ -182,7 +184,7 @@ let bs = Buffer.add_string (** Generation of html code from text structures. *) -class text = +class virtual text = object (self) (** We want to display colorized code. *) inherit ocaml_code @@ -244,6 +246,8 @@ class 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 method html_of_Raw b s = bs b (self#escape s) @@ -356,7 +360,7 @@ class text = method html_of_Link b s t = bs b "<a href=\""; bs b s ; - bs b ">"; + bs b "\">"; self#html_of_text b t; bs b "</a>" @@ -396,6 +400,65 @@ class text = self#html_of_text b t; bs b "</sub>" + method html_of_Module_list b l = + 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" + ) + l; + bs b "</table>\n</body>\n</html>"; + + method html_of_Index_list b = + let index_if_not_empty l url m = + match l with + [] -> () + | _ -> bp b "<a href=\"%s\">%s</a><br>\n" url m + in + index_if_not_empty self#list_types self#index_types Odoc_messages.index_of_types; + index_if_not_empty self#list_exceptions self#index_exceptions Odoc_messages.index_of_exceptions; + index_if_not_empty self#list_values self#index_values Odoc_messages.index_of_values; + index_if_not_empty self#list_attributes self#index_attributes Odoc_messages.index_of_attributes; + index_if_not_empty self#list_methods self#index_methods Odoc_messages.index_of_methods; + index_if_not_empty self#list_classes self#index_classes Odoc_messages.index_of_classes; + index_if_not_empty self#list_class_types self#index_class_types Odoc_messages.index_of_class_types; + index_if_not_empty self#list_modules self#index_modules Odoc_messages.index_of_modules; + index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types + + method virtual list_types : Odoc_info.Type.t_type list + method virtual index_types : string + method virtual list_exceptions : Odoc_info.Exception.t_exception list + method virtual index_exceptions : string + method virtual list_values : Odoc_info.Value.t_value list + method virtual index_values : string + method virtual list_attributes : Odoc_info.Value.t_attribute list + method virtual index_attributes : string + method virtual list_methods : Odoc_info.Value.t_method list + method virtual index_methods : string + method virtual list_classes : Odoc_info.Class.t_class list + method virtual index_classes : string + method virtual list_class_types : Odoc_info.Class.t_class_type list + method virtual index_class_types : string + method virtual list_modules : Odoc_info.Module.t_module list + method virtual index_modules : string + method virtual list_module_types : Odoc_info.Module.t_module_type list + method virtual index_module_types : string + end (** A class used to generate html code for info structures. *) @@ -504,14 +567,17 @@ class virtual info = ) l - (** Print html code for a description, except for the [i_params] field. *) - method html_of_info b info_opt = + (** Print html code for a description, except for the [i_params] field. + @param indent can be specified not to use the style of info comments; + default is [true]. + *) + method html_of_info ?(indent=true) b info_opt = match info_opt with None -> () | Some info -> let module M = Odoc_info in - bs b "<div class=\"info\">\n"; + if indent then bs b "<div class=\"info\">\n"; ( match info.M.i_deprecated with None -> () @@ -535,7 +601,7 @@ class virtual info = self#html_of_return_opt b info.M.i_return_value; self#html_of_sees b info.M.i_sees; self#html_of_custom b info.M.i_custom; - bs b "</div>\n" + if indent then bs b "</div>\n" (** Print html code for the first sentence of a description. The titles and lists in this first sentence has been removed.*) @@ -577,6 +643,25 @@ let print_concat b sep f = in iter +let newline_to_indented_br s = + let len = String.length s in + let b = Buffer.create len in + for i = 0 to len - 1 do + match s.[i] with + '\n' -> Buffer.add_string b "<br> " + | c -> Buffer.add_char b c + done; + Buffer.contents b + +let remove_last_newline s = + let len = String.length s in + if len <= 0 then + s + else + match s.[len-1] with + '\n' -> String.sub s 0 (len-1) + | _ -> s + (** This class is used to create objects which can generate a simple html documentation. *) class html = object (self) @@ -649,6 +734,8 @@ class html = "tr { background-color : White }" ; "td.typefieldcomment { background-color : #FFFFFF }" ; "pre { margin-bottom: 4px }" ; + + "div.sig_block {margin-left: 2em}" ; ] (** The style file for all pages. *) @@ -660,58 +747,67 @@ class html = (** The known types names. Used to know if we must create a link to a type when printing a type. *) - val mutable known_types_names = [] + val mutable known_types_names = StringSet.empty (** The known class and class type names. Used to know if we must create a link to a class or class type or not when printing a type. *) - val mutable known_classes_names = [] + val mutable known_classes_names = StringSet.empty (** The known modules and module types names. Used to know if we must create a link to a type or not when printing a module type. *) - val mutable known_modules_names = [] + val mutable known_modules_names = StringSet.empty (** The main file. *) - val mutable index = "index.html" + method index = "index.html" (** The file for the index of values. *) - val mutable index_values = "index_values.html" + method index_values = "index_values.html" (** The file for the index of types. *) - val mutable index_types = "index_types.html" + method index_types = "index_types.html" (** The file for the index of exceptions. *) - val mutable index_exceptions = "index_exceptions.html" + method index_exceptions = "index_exceptions.html" (** The file for the index of attributes. *) - val mutable index_attributes = "index_attributes.html" + method index_attributes = "index_attributes.html" (** The file for the index of methods. *) - val mutable index_methods = "index_methods.html" + method index_methods = "index_methods.html" (** The file for the index of classes. *) - val mutable index_classes = "index_classes.html" + method index_classes = "index_classes.html" (** The file for the index of class types. *) - val mutable index_class_types = "index_class_types.html" + method index_class_types = "index_class_types.html" (** The file for the index of modules. *) - val mutable index_modules = "index_modules.html" + method index_modules = "index_modules.html" (** The file for the index of module types. *) - val mutable index_module_types = "index_module_types.html" + method index_module_types = "index_module_types.html" (** The list of attributes. Filled in the [generate] method. *) val mutable list_attributes = [] + method list_attributes = list_attributes (** The list of methods. Filled in the [generate] method. *) val mutable list_methods = [] + method list_methods = list_methods (** The list of values. Filled in the [generate] method. *) val mutable list_values = [] + method list_values = list_values (** The list of exceptions. Filled in the [generate] method. *) val mutable list_exceptions = [] + method list_exceptions = list_exceptions (** The list of types. Filled in the [generate] method. *) val mutable list_types = [] + method list_types = list_types (** The list of modules. Filled in the [generate] method. *) val mutable list_modules = [] + method list_modules = list_modules (** The list of module types. Filled in the [generate] method. *) val mutable list_module_types = [] + method list_module_types = list_module_types (** The list of classes. Filled in the [generate] method. *) val mutable list_classes = [] + method list_classes = list_classes (** The list of class types. Filled in the [generate] method. *) val mutable list_class_types = [] + method list_class_types = list_class_types (** The header of pages. Must be prepared by the [prepare_header] method.*) val mutable header = fun b -> fun ?(nav=None) -> fun ?(comments=[]) -> fun _ -> () @@ -767,7 +863,7 @@ class html = bs b "<head>\n"; bs b style; bs b "<link rel=\"Start\" href=\""; - bs b index; + bs b self#index; bs b "\">\n" ; ( match nav with @@ -787,19 +883,19 @@ class html = ); ( let father = Name.father name in - let href = if father = "" then index else fst (Naming.html_files father) in + let href = if father = "" then self#index else fst (Naming.html_files father) in bp b "<link rel=\"Up\" href=\"%s\">\n" href ) ); - link_if_not_empty list_types Odoc_messages.index_of_types index_types; - link_if_not_empty list_exceptions Odoc_messages.index_of_exceptions index_exceptions; - link_if_not_empty list_values Odoc_messages.index_of_values index_values; - link_if_not_empty list_attributes Odoc_messages.index_of_attributes index_attributes; - link_if_not_empty list_methods Odoc_messages.index_of_methods index_methods; - link_if_not_empty list_classes Odoc_messages.index_of_classes index_classes; - link_if_not_empty list_class_types Odoc_messages.index_of_class_types index_class_types; - link_if_not_empty list_modules Odoc_messages.index_of_modules index_modules; - link_if_not_empty list_module_types Odoc_messages.index_of_module_types index_module_types; + link_if_not_empty self#list_types Odoc_messages.index_of_types self#index_types; + link_if_not_empty self#list_exceptions Odoc_messages.index_of_exceptions self#index_exceptions; + link_if_not_empty self#list_values Odoc_messages.index_of_values self#index_values; + link_if_not_empty self#list_attributes Odoc_messages.index_of_attributes self#index_attributes; + link_if_not_empty self#list_methods Odoc_messages.index_of_methods self#index_methods; + link_if_not_empty self#list_classes Odoc_messages.index_of_classes self#index_classes; + 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 bp b "<link title=\"%s\" rel=\"Chapter\" href=\"%s\">" @@ -854,6 +950,7 @@ class html = print_lines "Section" section_titles ; print_lines "Subsection" subsection_titles + (** Html code for navigation bar. @param pre optional name for optional previous module/class @param post optional name for optional next module/class @@ -870,7 +967,7 @@ class html = ); bs b " "; let father = Name.father name in - let href = if father = "" then index else fst (Naming.html_files father) in + let href = if father = "" then self#index else fst (Naming.html_files father) in bp b "<a href=\"%s\">%s</a>\n" href Odoc_messages.up; bs b " "; ( @@ -919,12 +1016,12 @@ class html = match_s rel in - if List.mem match_s known_types_names then + if StringSet.mem match_s known_types_names then "<a href=\""^(Naming.complete_target Naming.mark_type match_s)^"\">"^ s_final^ "</a>" else - if List.mem match_s known_classes_names then + if StringSet.mem match_s known_classes_names then let (html_file, _) = Naming.html_files match_s in "<a href=\""^html_file^"\">"^s_final^"</a>" else @@ -942,11 +1039,17 @@ 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 - if List.mem match_s known_modules_names then + 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 + in + if StringSet.mem match_s known_modules_names then let (html_file, _) = Naming.html_files match_s in - "<a href=\""^html_file^"\">"^(Name.get_relative m_name match_s)^"</a>" + "<a href=\""^html_file^"\">"^s_final^"</a>" else - match_s + s_final in let s2 = Str.global_substitute (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)") @@ -957,30 +1060,18 @@ class html = (** Print html code to display a [Types.type_expr]. *) method html_of_type_expr b m_name t = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_type_expr t)) - in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in - bs b "<code class=\"type\">"; - bs b (self#create_fully_qualified_idents_links m_name s2); - bs b "</code>" - - (** Print html code to display a [Types.class_type].*) - method html_of_class_type_expr b m_name t = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type t)) - in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in + let s = remove_last_newline (Odoc_info.string_of_type_expr t) in + let s2 = newline_to_indented_br s in bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_idents_links m_name s2); bs b "</code>" (** Print html code to display a [Types.type_expr list]. *) - method html_of_type_expr_list b m_name sep l = + method html_of_type_expr_list ?par b m_name sep l = print_DEBUG "html#html_of_type_expr_list"; - let s = Odoc_info.string_of_type_list sep l in + let s = Odoc_info.string_of_type_list ?par sep l in print_DEBUG "html#html_of_type_expr_list: 1"; - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in + let s2 = newline_to_indented_br s in print_DEBUG "html#html_of_type_expr_list: 2"; bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_idents_links m_name s2); @@ -990,43 +1081,149 @@ class html = of a class of class type. *) method html_of_class_type_param_expr_list b m_name l = let s = Odoc_info.string_of_class_type_param_list l in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in - bs b "<code class=\"type\">"; + let s2 = newline_to_indented_br s in + bs b "<code class=\"type\">["; bs b (self#create_fully_qualified_idents_links m_name s2); - bs b "</code>" + bs b "]</code>" (** Print html code to display a list of type parameters for the given type.*) method html_of_type_expr_param_list b m_name t = let s = Odoc_info.string_of_type_param_list t in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in + let s2 = newline_to_indented_br s in bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_idents_links m_name s2); bs b "</code>" (** Print html code to display a [Types.module_type]. *) - method html_of_module_type b m_name t = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t)) - in + method html_of_module_type b ?code m_name t = + let s = remove_last_newline (Odoc_info.string_of_module_type ?code t) in bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_module_idents_links m_name s); bs b "</code>" - + + (** 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_alias a -> + 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>" + | 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 ")"] + | 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>" + | Module_constraint (k, tk) -> + (* 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 " : "; + ] ; + self#html_of_module_type_kind b father p.mp_kind; + self#html_of_text b [ Code ") -> "] + + method html_of_module_element b father ele = + match ele with + Element_module m -> + self#html_of_module b ~complete: false m + | Element_module_type mt -> + self#html_of_modtype b ~complete: false mt + | Element_included_module im -> + self#html_of_included_module b im + | Element_class c -> + self#html_of_class b ~complete: false c + | Element_class_type ct -> + self#html_of_class_type b ~complete: false ct + | Element_value v -> + self#html_of_value b v + | Element_exception e -> + self#html_of_exception b e + | Element_type t -> + self#html_of_type b t + | Element_module_comment text -> + self#html_of_module_comment b text + + (** 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_functor (p, 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>" + | 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>" + + (** Print html code to display the type of a module parameter.. *) + method html_of_module_parameter_type b m_name p = + self#html_of_module_type b m_name ~code: p.mp_type_code p.mp_type + (** Generate a file containing the module type in the given file name. *) method output_module_type in_title file mtyp = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type ~complete: true mtyp)) - in + let s = remove_last_newline (Odoc_info.string_of_module_type ~complete: true mtyp) in self#output_code in_title file s (** Generate a file containing the class type in the given file name. *) method output_class_type in_title file ctyp = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type ~complete: true ctyp)) - in + let s = remove_last_newline(Odoc_info.string_of_class_type ~complete: true ctyp) in self#output_code in_title file s - (** Print html code for a value. *) method html_of_value b v = Odoc_info.reset_type_names (); @@ -1069,7 +1266,8 @@ class html = [] -> () | _ -> bs b (" "^(self#keyword "of")^" "); - self#html_of_type_expr_list b (Name.father e.ex_name) " * " e.ex_args + self#html_of_type_expr_list + ~par: false b (Name.father e.ex_name) " * " e.ex_args ); ( match e.ex_alias with @@ -1137,7 +1335,7 @@ class html = [] -> () | l -> bs b (" " ^ (self#keyword "of") ^ " "); - self#html_of_type_expr_list b father " * " l; + self#html_of_type_expr_list ~par: false b father " * " l; ); bs b "</code></td>\n"; ( @@ -1365,7 +1563,7 @@ class html = bs b "</code></td>\n" ; bs b "<td align=\"center\" valign=\"top\">:</td>\n"; bs b "<td>" ; - self#html_of_module_type b m_name p.mp_type; + self#html_of_module_parameter_type b m_name p; bs b "\n"; ( match desc_opt with @@ -1392,12 +1590,12 @@ class html = bs b (Name.simple m.m_name) ); bs b ": "; - self#html_of_module_type b father m.m_type; + self#html_of_module_kind b father ~modu: m m.m_kind; bs b "</pre>"; if info then ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b m.m_info @@ -1416,17 +1614,17 @@ class html = else bs b (Name.simple mt.mt_name) ); - (match mt.mt_type with + (match mt.mt_kind with None -> () - | Some mtyp -> + | Some k -> bs b " = "; - self#html_of_module_type b father mtyp + self#html_of_module_type_kind b father ~mt k ); bs b "</pre>"; if info then ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b mt.mt_info @@ -1456,6 +1654,99 @@ class html = bs b "</pre>\n"; self#html_of_info b im.im_info + method html_of_class_element b element = + match element with + Class_attribute a -> + self#html_of_attribute b a + | Class_method m -> + self#html_of_method b m + | Class_comment t -> + self#html_of_class_comment b t + + 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"] + + | Class_apply capp -> + (* 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 " " + ); + self#html_of_text b + [Code (self#create_fully_qualified_idents_links father cco.cco_name)] + + | Class_constraint (ck, ctk) -> + self#html_of_text b [Code "( "] ; + self#html_of_class_kind b father ck; + self#html_of_text b [Code " : "] ; + self#html_of_class_type_kind b father ctk; + self#html_of_text b [Code " )"] + + method html_of_class_type_kind b father ?ct kind = + match kind with + Class_type cta -> + ( + match cta.cta_type_parameters with + [] -> () + | l -> + self#html_of_class_type_param_expr_list b father l; + bs b " " + ); + self#html_of_text b + [Code (self#create_fully_qualified_idents_links father cta.cta_name)] + + | 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"] + + method html_of_class_parameter b father p = + self#html_of_type_expr b father (Parameter.typ p) + + method html_of_class_parameter_list b father params = + List.iter + (fun p -> + self#html_of_class_parameter b father p; + bs b " -> ") + params + (** Print html code for a class. *) method html_of_class b ?(complete=true) ?(with_link=true) c = let father = Name.father c.cl_name in @@ -1492,12 +1783,13 @@ class html = ); bs b " : " ; - self#html_of_class_type_expr b father c.cl_type; + self#html_of_class_parameter_list b father c.cl_parameters ; + self#html_of_class_kind b father ~cl: c c.cl_kind; bs b "</pre>" ; print_DEBUG "html#html_of_class : info" ; ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b c.cl_info @@ -1535,11 +1827,11 @@ class html = bs b (Name.simple ct.clt_name); bs b " = "; - self#html_of_class_type_expr b father ct.clt_type; + self#html_of_class_type_kind b father ~ct ct.clt_kind; bs b "</pre>"; ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b ct.clt_info @@ -1738,16 +2030,7 @@ class html = (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* the various elements *) - List.iter - (fun element -> - match element with - Class_attribute a -> - self#html_of_attribute b a - | Class_method m -> - self#html_of_method b m - | Class_comment t -> - self#html_of_class_comment b t - ) + List.iter (self#html_of_class_element b) (Class.class_elements ~trans:false cl); bs b "</body></html>"; Buffer.output_buffer chanout b; @@ -1792,16 +2075,7 @@ class html = (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* the various elements *) - List.iter - (fun element -> - match element with - Class_attribute a -> - self#html_of_attribute b a - | Class_method m -> - self#html_of_method b m - | Class_comment t -> - self#html_of_class_comment b t - ) + List.iter (self#html_of_class_element b) (Class.class_type_elements ~trans: false clt); bs b "</body></html>"; Buffer.output_buffer chanout b; @@ -1844,32 +2118,14 @@ class html = self#html_of_modtype b ~with_link: false mt; (* parameters for functors *) - self#html_of_module_parameter_list b "" (Module.module_type_parameters mt); + self#html_of_module_parameter_list b + (Name.father mt.mt_name) + (Module.module_type_parameters mt); (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* module elements *) - List.iter - (fun ele -> - match ele with - Element_module m -> - self#html_of_module b ~complete: false m - | Element_module_type mt -> - self#html_of_modtype b ~complete: false mt - | Element_included_module im -> - self#html_of_included_module b im - | Element_class c -> - self#html_of_class b ~complete: false c - | Element_class_type ct -> - self#html_of_class_type b ~complete: false ct - | Element_value v -> - self#html_of_value b v - | Element_exception e -> - self#html_of_exception b e - | Element_type t -> - self#html_of_type b t - | Element_module_comment text -> - self#html_of_module_comment b text - ) + List.iter + (self#html_of_module_element b (Name.father mt.mt_name)) (Module.module_type_elements mt); bs b "</body></html>"; @@ -1937,35 +2193,16 @@ class html = self#html_of_module b ~with_link: false modu; (* parameters for functors *) - self#html_of_module_parameter_list b "" (Module.module_parameters modu); + self#html_of_module_parameter_list b + (Name.father modu.m_name) + (Module.module_parameters modu); (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* module elements *) List.iter - (fun ele -> - print_DEBUG "html#generate_for_module : ele ->"; - match ele with - Element_module m -> - self#html_of_module b ~complete: false m - | Element_module_type mt -> - self#html_of_modtype b ~complete: false mt - | Element_included_module im -> - self#html_of_included_module b im - | Element_class c -> - self#html_of_class b ~complete: false c - | Element_class_type ct -> - self#html_of_class_type b ~complete: false ct - | Element_value v -> - self#html_of_value b v - | Element_exception e -> - self#html_of_exception b e - | Element_type t -> - self#html_of_type b t - | Element_module_comment text -> - self#html_of_module_comment b text - ) + (self#html_of_module_element b (Name.father modu.m_name)) (Module.module_elements modu); bs b "</body></html>"; @@ -2002,14 +2239,9 @@ class html = @raise Failure if an error occurs.*) method generate_index module_list = try - let chanout = open_out (Filename.concat !Args.target_dir index) in + let chanout = open_out (Filename.concat !Args.target_dir self#index) in let b = new_buf () in let title = match !Args.title with None -> "" | Some t -> self#escape t in - let index_if_not_empty l url m = - match l with - [] -> () - | _ -> bp b "<a href=\"%s\">%s</a><br>\n" url m - in bs b "<html>\n"; self#print_header b self#title; bs b "<body>\n"; @@ -2019,28 +2251,15 @@ class html = let info = Odoc_info.apply_opt Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file in - self#html_of_info b info; - (match info with None -> () | Some _ -> bs b "<br/>"); - index_if_not_empty list_types index_types Odoc_messages.index_of_types; - index_if_not_empty list_exceptions index_exceptions Odoc_messages.index_of_exceptions; - index_if_not_empty list_values index_values Odoc_messages.index_of_values; - index_if_not_empty list_attributes index_attributes Odoc_messages.index_of_attributes; - index_if_not_empty list_methods index_methods Odoc_messages.index_of_methods; - index_if_not_empty list_classes index_classes Odoc_messages.index_of_classes; - index_if_not_empty list_class_types index_class_types Odoc_messages.index_of_class_types; - index_if_not_empty list_modules index_modules Odoc_messages.index_of_modules; - index_if_not_empty list_module_types index_module_types Odoc_messages.index_of_module_types; - bs b "<br>\n<table class=\"indextable\">\n"; - List.iter - (fun m -> - let (html, _) = Naming.html_files m.m_name in - bp b "<tr><td><a href=\"%s\">%s</a></td>" html m.m_name; - bs b "<td>"; - self#html_of_info_first_sentence b m.m_info; - bs b "</td></tr>\n" - ) - module_list; - bs b "</table>\n</body>\n</html>"; + ( + 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; close_out chanout with @@ -2050,93 +2269,93 @@ class html = (** Generate the values index in the file [index_values.html]. *) method generate_values_index module_list = self#generate_elements_index - list_values + self#list_values (fun v -> v.val_name) (fun v -> v.val_info) Naming.complete_value_target Odoc_messages.index_of_values - index_values + self#index_values (** Generate the exceptions index in the file [index_exceptions.html]. *) method generate_exceptions_index module_list = self#generate_elements_index - list_exceptions + self#list_exceptions (fun e -> e.ex_name) (fun e -> e.ex_info) Naming.complete_exception_target Odoc_messages.index_of_exceptions - index_exceptions + self#index_exceptions (** Generate the types index in the file [index_types.html]. *) method generate_types_index module_list = self#generate_elements_index - list_types + self#list_types (fun t -> t.ty_name) (fun t -> t.ty_info) Naming.complete_type_target Odoc_messages.index_of_types - index_types + self#index_types (** Generate the attributes index in the file [index_attributes.html]. *) method generate_attributes_index module_list = self#generate_elements_index - list_attributes + self#list_attributes (fun a -> a.att_value.val_name) (fun a -> a.att_value.val_info) Naming.complete_attribute_target Odoc_messages.index_of_attributes - index_attributes + self#index_attributes (** Generate the methods index in the file [index_methods.html]. *) method generate_methods_index module_list = self#generate_elements_index - list_methods + self#list_methods (fun m -> m.met_value.val_name) (fun m -> m.met_value.val_info) Naming.complete_method_target Odoc_messages.index_of_methods - index_methods + self#index_methods (** Generate the classes index in the file [index_classes.html]. *) method generate_classes_index module_list = self#generate_elements_index - list_classes + self#list_classes (fun c -> c.cl_name) (fun c -> c.cl_info) (fun c -> fst (Naming.html_files c.cl_name)) Odoc_messages.index_of_classes - index_classes + self#index_classes (** Generate the class types index in the file [index_class_types.html]. *) method generate_class_types_index module_list = self#generate_elements_index - list_class_types + self#list_class_types (fun ct -> ct.clt_name) (fun ct -> ct.clt_info) (fun ct -> fst (Naming.html_files ct.clt_name)) Odoc_messages.index_of_class_types - index_class_types + self#index_class_types (** Generate the modules index in the file [index_modules.html]. *) method generate_modules_index module_list = self#generate_elements_index - list_modules + self#list_modules (fun m -> m.m_name) (fun m -> m.m_info) (fun m -> fst (Naming.html_files m.m_name)) Odoc_messages.index_of_modules - index_modules + self#index_modules (** Generate the module types index in the file [index_module_types.html]. *) method generate_module_types_index module_list = let module_types = Odoc_info.Search.module_types module_list in self#generate_elements_index - list_module_types + self#list_module_types (fun mt -> mt.mt_name) (fun mt -> mt.mt_info) (fun mt -> fst (Naming.html_files mt.mt_name)) Odoc_messages.index_of_module_types - index_module_types + self#index_module_types (** Generate all the html files from a module list. The main file is [index.html]. *) @@ -2158,20 +2377,38 @@ class html = self#prepare_header module_list ; (* Get the names of all known types. *) let types = Odoc_info.Search.types module_list in - let type_names = List.map (fun t -> t.ty_name) types in - known_types_names <- type_names ; + known_types_names <- + 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 - let class_names = List.map (fun c -> c.cl_name) classes in - let class_type_names = List.map (fun ct -> ct.clt_name) class_types in - known_classes_names <- class_names @ class_type_names ; + known_classes_names <- + 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 ; (* 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 - let module_type_names = List.map (fun mt -> mt.mt_name) module_types in - let module_names = List.map (fun m -> m.m_name) modules in - known_modules_names <- module_type_names @ module_names ; + known_modules_names <- + 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 ; + (* generate html for each module *) if not !Args.index_only then self#generate_elements self#generate_for_module module_list ; diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml index 83bcb527b6..97dc7b2b01 100644 --- a/ocamldoc/odoc_info.ml +++ b/ocamldoc/odoc_info.ml @@ -46,7 +46,8 @@ and text_element = Odoc_types.text_element = | Ref of string * ref_kind option | Superscript of text | Subscript of text - + | Module_list of string list + | Index_list and text = text_element list @@ -117,7 +118,7 @@ let string_of_variance t (co,cn) = Odoc_str.string_of_variance t (co, cn) let string_of_type_expr t = Odoc_print.string_of_type_expr t -let string_of_type_list sep type_list = Odoc_str.string_of_type_list sep type_list +let string_of_type_list ?par sep type_list = Odoc_str.string_of_type_list ?par sep type_list let string_of_type_param_list t = Odoc_str.string_of_type_param_list t diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index 209ee4d83a..1c724dd459 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -49,6 +49,9 @@ and text_element = Odoc_types.text_element = (** A reference to an element. Complete name and kind. *) | Superscript of text (** Superscripts. *) | Subscript of text (** Subscripts. *) + | Module_list of string list + (** The table of the given modules with their abstract. *) + | Index_list (** The links to the various indexes (values, types, ...) *) (** A text is a list of [text_element]. The order matters. *) and text = text_element list @@ -138,13 +141,6 @@ module Parameter : (** A parameter is just a param_info.*) type parameter = param_info - (** A module parameter is just a name and a module type.*) - type module_parameter = Odoc_parameter.module_parameter = - { - mp_name : string ; - mp_type : Types.module_type ; - } - (** {3 Functions} *) (** Acces to the name as a string. For tuples, parenthesis and commas are added. *) val complete_name : parameter -> string @@ -422,12 +418,19 @@ module Module : mutable ma_module : mmt option ; (** The real module or module type if we could associate it. *) } + and module_parameter = Odoc_module.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 a module. *) and module_kind = Odoc_module.module_kind = | Module_struct of module_element list (** A complete module structure. *) | Module_alias of module_alias (** Complete name and corresponding module if we found it *) - | Module_functor of (Parameter.module_parameter list) * module_kind - (** A functor, with {e all} its parameters and the rest of its definition *) + | Module_functor of module_parameter * module_kind + (** A functor, with its parameter and the rest of its definition *) | Module_apply of module_kind * module_kind (** A module defined by application of a functor. *) | Module_with of module_type_kind * string @@ -460,8 +463,8 @@ module Module : (** Different kinds of module type. *) and module_type_kind = Odoc_module.module_type_kind = | Module_type_struct of module_element list (** A complete module signature. *) - | Module_type_functor of (Odoc_parameter.module_parameter list) * module_type_kind - (** A functor, with {e all} its parameters and the rest of its definition *) + | Module_type_functor of module_parameter * module_type_kind + (** A functor, with its parameter and the rest of its definition *) | Module_type_alias of module_type_alias (** Complete alias name and corresponding module type if we found it. *) | Module_type_with of module_type_kind * string @@ -524,7 +527,7 @@ module Module : val module_is_functor : t_module -> bool (** The list of couples (module parameter, optional description). *) - val module_parameters : ?trans:bool-> t_module -> (Parameter.module_parameter * text option) list + val module_parameters : ?trans:bool-> t_module -> (module_parameter * text option) list (** The list of module comments. *) val module_comments : ?trans:bool-> t_module -> text list @@ -571,7 +574,7 @@ module Module : val module_type_is_functor : t_module_type -> bool (** The list of couples (module parameter, optional description). *) - val module_type_parameters : ?trans:bool-> t_module_type -> (Parameter.module_parameter * text option) list + val module_type_parameters : ?trans:bool-> t_module_type -> (module_parameter * text option) list (** The list of module comments. *) val module_type_comments : ?trans:bool-> t_module_type -> text list @@ -618,7 +621,7 @@ val string_of_type_expr : Types.type_expr -> string (** This function returns a string to represent the given list of types, with a given separator. *) -val string_of_type_list : string -> Types.type_expr list -> string +val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string (** This function returns a string to represent the list of type parameters for the given type. *) @@ -626,14 +629,16 @@ val string_of_type_param_list : Type.t_type -> string (** This function returns a string to represent the given list of type parameters of a class or class type, - with a given separator. It writes in and flushes [Format.str_formatter].*) + with a given separator. *) val string_of_class_type_param_list : Types.type_expr list -> string (** This function returns a string representing a [Types.module_type]. @param complete indicates if we must print complete signatures or just [sig end]. Default if [false]. + @param code if [complete = false] and the type contains something else + than identificators and functors, then the given code is used. *) -val string_of_module_type : ?complete: bool -> Types.module_type -> string +val string_of_module_type : ?code: string -> ?complete: bool -> Types.module_type -> string (** This function returns a string representing a [Types.class_type]. @param complete indicates if we must print complete signatures diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml index 7da4d23891..757b837971 100644 --- a/ocamldoc/odoc_latex.ml +++ b/ocamldoc/odoc_latex.ml @@ -23,6 +23,35 @@ open Exception open Class open Module +let new_buf () = Buffer.create 1024 +let new_fmt () = + let b = new_buf () in + let fmt = Format.formatter_of_buffer b in + (fmt, + fun () -> + Format.pp_print_flush fmt (); + let s = Buffer.contents b in + Buffer.reset b; + s + ) + +let p = Format.fprintf +let ps f s = Format.fprintf f "%s" s + + +let bp = Printf.bprintf +let bs = Buffer.add_string + +let print_concat fmt sep f = + let rec iter = function + [] -> () + | [c] -> f c + | c :: q -> + f c; + ps fmt sep; + iter q + in + iter (** Generation of LaTeX code from text structures. *) class text = @@ -185,109 +214,140 @@ class text = (** Return latex code for the ref to a given label. *) method make_ref label = "\\ref{"^label^"}" - (** Return the LaTeX code corresponding to the [text] parameter.*) - method latex_of_text t = String.concat "" (List.map self#latex_of_text_element t) + (** Print the LaTeX code corresponding to the [text] parameter.*) + method latex_of_text fmt t = + List.iter (self#latex_of_text_element fmt) t - (** Return the LaTeX code for the [text_element] in parameter. *) - method latex_of_text_element te = + (** Print the LaTeX code for the [text_element] in parameter. *) + method latex_of_text_element fmt te = match te with - | Odoc_info.Raw s -> self#latex_of_Raw s - | Odoc_info.Code s -> self#latex_of_Code s - | Odoc_info.CodePre s -> self#latex_of_CodePre s - | Odoc_info.Verbatim s -> self#latex_of_Verbatim s - | Odoc_info.Bold t -> self#latex_of_Bold t - | Odoc_info.Italic t -> self#latex_of_Italic t - | Odoc_info.Emphasize t -> self#latex_of_Emphasize t - | Odoc_info.Center t -> self#latex_of_Center t - | Odoc_info.Left t -> self#latex_of_Left t - | Odoc_info.Right t -> self#latex_of_Right t - | Odoc_info.List tl -> self#latex_of_List tl - | Odoc_info.Enum tl -> self#latex_of_Enum tl - | Odoc_info.Newline -> self#latex_of_Newline - | Odoc_info.Block t -> self#latex_of_Block t - | Odoc_info.Title (n, l_opt, t) -> self#latex_of_Title n l_opt t - | Odoc_info.Latex s -> self#latex_of_Latex s - | Odoc_info.Link (s, t) -> self#latex_of_Link s t - | Odoc_info.Ref (name, ref_opt) -> self#latex_of_Ref name ref_opt - | Odoc_info.Superscript t -> self#latex_of_Superscript t - | Odoc_info.Subscript t -> self#latex_of_Subscript t - - method latex_of_Raw s = self#escape s - - method latex_of_Code s = + | Odoc_info.Raw s -> self#latex_of_Raw fmt s + | Odoc_info.Code s -> self#latex_of_Code fmt s + | 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.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 + | Odoc_info.Right t -> self#latex_of_Right fmt t + | Odoc_info.List tl -> self#latex_of_List fmt tl + | Odoc_info.Enum tl -> self#latex_of_Enum fmt tl + | Odoc_info.Newline -> self#latex_of_Newline fmt + | Odoc_info.Block t -> self#latex_of_Block fmt t + | Odoc_info.Title (n, l_opt, t) -> self#latex_of_Title fmt n l_opt t + | Odoc_info.Latex s -> self#latex_of_Latex fmt s + | Odoc_info.Link (s, t) -> self#latex_of_Link fmt s t + | 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 -> () + + method latex_of_Raw fmt s = + ps fmt (self#escape 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 - "{\\tt{"^s3^"}}" - - method latex_of_CodePre s = - "\\begin{ocamldoccode}\n"^(self#escape_simple s)^"\n\\end{ocamldoccode}\n" - - method latex_of_Verbatim s = "\\begin{verbatim}"^s^"\\end{verbatim}" - - method latex_of_Bold t = - let s = self#latex_of_text t in - "{\\bf "^s^"}" - - method latex_of_Italic t = - let s = self#latex_of_text t in - "{\\it "^s^"}" - - method latex_of_Emphasize t = - let s = self#latex_of_text t in - "{\\em "^s^"}" - - method latex_of_Center t = - let s = self#latex_of_text t in - "\\begin{center}\n"^s^"\\end{center}\n" - - method latex_of_Left t = - let s = self#latex_of_text t in - "\\begin{flushleft}\n"^s^"\\end{flushleft}\n" - - method latex_of_Right t = - let s = self#latex_of_text t in - "\\begin{flushright}\n"^s^"\\end{flushright}\n" - - method latex_of_List tl = - "\\begin{itemize}"^ - (String.concat "" - (List.map (fun t -> "\\item "^(self#latex_of_text t)^"\n") tl))^ - "\\end{itemize}\n" - - method latex_of_Enum tl = - "\\begin{enumerate}"^ - (String.concat "" - (List.map (fun t -> "\\item "^(self#latex_of_text t)^"\n") tl))^ - "\\end{enumerate}\n" - - method latex_of_Newline = "\n\n" - - method latex_of_Block t = - let s = self#latex_of_text t in - "\\begin{ocamldocdescription}\n"^s^"\n\\end{ocamldocdescription}\n" - - method latex_of_Title n label_opt t = - let s_title = self#latex_of_text t in - let s_title2 = self#section_style n s_title in - s_title2^ - (match label_opt with - None -> "" - | Some l -> self#make_label (self#label ~no_: false l)) + p fmt "{\\tt{%s}}" s3 + + method latex_of_CodePre fmt s = + ps fmt "\\begin{ocamldoccode}\n"; + ps fmt (self#escape_simple s); + ps fmt "\n\\end{ocamldoccode}\n" + + method latex_of_Verbatim fmt s = + ps fmt "\\begin{verbatim}"; + ps fmt s; + ps fmt "\\end{verbatim}" + + method latex_of_Bold fmt t = + ps fmt "{\\bf "; + self#latex_of_text fmt t; + ps fmt "}" + + method latex_of_Italic fmt t = + ps fmt "{\\it "; + self#latex_of_text fmt t; + ps fmt "}" + + method latex_of_Emphasize fmt t = + ps fmt "{\\em "; + self#latex_of_text fmt t; + ps fmt "}" + + method latex_of_Center fmt t = + ps fmt "\\begin{center}\n"; + self#latex_of_text fmt t; + ps fmt "\\end{center}\n" + + method latex_of_Left fmt t = + ps fmt "\\begin{flushleft}\n"; + self#latex_of_text fmt t; + ps fmt "\\end{flushleft}\n" + + method latex_of_Right fmt t = + ps fmt "\\begin{flushright}\n"; + self#latex_of_text fmt t; + ps fmt "\\end{flushright}\n" + + 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; + 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; + ps fmt "\\end{enumerate}\n" + + method latex_of_Newline fmt = ps fmt "\n\n" + + method latex_of_Block fmt t = + ps fmt "\\begin{ocamldocdescription}\n"; + self#latex_of_text fmt t; + ps fmt "\n\\end{ocamldocdescription}\n" + + method latex_of_Title fmt n label_opt t = + let (fmt2, flush) = new_fmt () in + self#latex_of_text fmt2 t; + let s_title2 = self#section_style n (flush ()) in + ps fmt s_title2; + ( + match label_opt with + None -> () + | Some l -> + ps fmt (self#make_label (self#label ~no_: false l)) + ) - method latex_of_Latex s = s + method latex_of_Latex fmt s = ps fmt s - method latex_of_Link s t = - let s1 = self#latex_of_text t in - let s2 = "[\\url{"^s^"}]" in - s1^s2 + method latex_of_Link fmt s t = + self#latex_of_text fmt t ; + ps fmt "[\\url{"; + ps fmt s ; + ps fmt "}]" - method latex_of_Ref name ref_opt = + method latex_of_Ref fmt name ref_opt = match ref_opt with None -> - self#latex_of_text_element + self#latex_of_text_element fmt (Odoc_info.Code (Odoc_info.use_hidden_modules name)) | Some (RK_section _) -> - self#latex_of_text_element + self#latex_of_text_element fmt (Latex ("["^(self#make_ref (self#label ~no_:false (Name.simple name)))^"]")) | Some kind -> let f_label = @@ -303,16 +363,21 @@ class text = | Odoc_info.RK_method -> self#method_label | Odoc_info.RK_section _ -> assert false in - (self#latex_of_text - [ - Odoc_info.Code (Odoc_info.use_hidden_modules name) ; - Latex ("["^(self#make_ref (f_label name))^"]") - ] - ) - - method latex_of_Superscript t = "$^{"^(self#latex_of_text t)^"}$" - - method latex_of_Subscript t = "$_{"^(self#latex_of_text t)^"}$" + self#latex_of_text fmt + [ + Odoc_info.Code (Odoc_info.use_hidden_modules name) ; + Latex ("["^(self#make_ref (f_label name))^"]") + ] + + method latex_of_Superscript fmt t = + ps fmt "$^{"; + self#latex_of_text fmt t; + ps fmt "}$" + + method latex_of_Subscript fmt t = + ps fmt "$_{"; + self#latex_of_text fmt t; + ps fmt "}$" end @@ -320,15 +385,15 @@ class text = class virtual info = object (self) (** The method used to get LaTeX code from a [text]. *) - method virtual latex_of_text : Odoc_info.text -> string + 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 - (** Return LaTeX code for a description, except for the [i_params] field. *) - method latex_of_info info_opt = - self#latex_of_text - (self#text_of_info ~block: false info_opt) + (** 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 + (self#text_of_info ~block info_opt) end (** This class is used to create objects which can generate a simple LaTeX documentation. *) @@ -356,78 +421,68 @@ class latex = 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) - (** Return LaTeX code for a value. *) - method latex_of_value v = + (** Print LaTeX code for a value. *) + method latex_of_value fmt v = Odoc_info.reset_type_names () ; - self#latex_of_text - ((Latex (self#make_label (self#value_label v.val_name))) :: + let label = self#value_label v.val_name in + let latex = self#make_label label in + self#latex_of_text fmt + ((Latex latex) :: (to_text#text_of_value v)) - (** Return LaTeX code for a class attribute. *) - method latex_of_attribute a = - self#latex_of_text + (** 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))) :: (to_text#text_of_attribute a)) - (** Return LaTeX code for a class method. *) - method latex_of_method m = - self#latex_of_text + (** Print LaTeX code for a class method. *) + method latex_of_method fmt m = + self#latex_of_text fmt ((Latex (self#make_label (self#method_label m.met_value.val_name))) :: (to_text#text_of_method m)) - (** Return LaTeX code for the parameters of a type. *) - method latex_of_type_params m_name t = - let f (p, co, cn) = - Printf.sprintf "%s%s" - (Odoc_info.string_of_variance t (co,cn)) - (self#normal_type m_name p) + (** 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) in match t.ty_parameters with - [] -> "" - | [(p,co,cn)] -> f (p, co, cn) + [] -> () + | [(p,co,cn)] -> print_one (p, co, cn) | l -> - Printf.sprintf "(%s)" - (String.concat ", " (List.map f t.ty_parameters)) + ps fmt "("; + print_concat fmt ", " print_one t.ty_parameters; + ps fmt ")" - (** Return LaTeX code for a type. *) - method latex_of_type t = + (** 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 Odoc_info.reset_type_names () ; let mod_name = Name.father t.ty_name in - let s_type1 = - Format.fprintf Format.str_formatter "@[<hov 2>type "; - Format.fprintf Format.str_formatter "%s%s" - (self#latex_of_type_params mod_name t) - (match t.ty_parameters with [] -> "" | _ -> " "); - Format.flush_str_formatter () - in - Format.fprintf Format.str_formatter - ("@[<hov 2>%s %s") - s_type1 - s_name; - let s_type2 = - ( - match t.ty_manifest with - None -> () - | Some typ -> - Format.fprintf Format.str_formatter - " = %s" - (self#normal_type mod_name typ) - ); - Format.flush_str_formatter () - in + Format.fprintf fmt2 "@[<h 2>type "; + 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 -> + p fmt2 " = %s" (self#normal_type mod_name typ) + ); let s_type3 = - Format.fprintf Format.str_formatter - ("%s %s") - s_type2 + p fmt2 + " %s" ( match t.ty_kind with Type_abstract -> "" | Type_variant (_, priv) -> "="^(if priv then " private" else "") | Type_record (_, priv) -> "= "^(if priv then "private " else "")^"{" ) ; - Format.flush_str_formatter () + flush2 () in let defs = @@ -438,28 +493,28 @@ class latex = (List.map (fun constr -> let s_cons = - Format.fprintf Format.str_formatter - "@[<hov 6> | %s" - constr.vc_name; + p fmt2 "@[<h 6> | %s" constr.vc_name; ( match constr.vc_args with [] -> () | l -> - Format.fprintf Format.str_formatter " %s@ %s" + p fmt2 " %s@ %s" "of" - (self#normal_type_list mod_name " * " l) + (self#normal_type_list ~par: false mod_name " * " l) ); - Format.flush_str_formatter () + flush2 () in [ CodePre s_cons ] @ (match constr.vc_text with None -> [] | Some t -> - [ Latex - ("\\begin{ocamldoccomment}\n"^ - (self#latex_of_text t)^ - "\n\\end{ocamldoccomment}\n") - ] + let s = + ps fmt2 "\\begin{ocamldoccomment}\n"; + self#latex_of_text fmt2 t; + ps fmt2 "\n\\end{ocamldoccomment}\n"; + flush2 () + in + [ Latex s] ) ) l @@ -470,22 +525,24 @@ class latex = (List.map (fun r -> let s_field = - Format.fprintf Format.str_formatter - "@[<hov 6> %s%s :@ %s ;" + p fmt2 + "@[<h 6> %s%s :@ %s ;" (if r.rf_mutable then "mutable " else "") r.rf_name (self#normal_type mod_name r.rf_type); - Format.flush_str_formatter () + flush2 () in [ CodePre s_field ] @ (match r.rf_text with None -> [] | Some t -> - [ Latex - ("\\begin{ocamldoccomment}\n"^ - (self#latex_of_text t)^ - "\n\\end{ocamldoccomment}\n") - ] + let s = + ps fmt2 "\\begin{ocamldoccomment}\n"; + self#latex_of_text fmt2 t; + ps fmt2 "\n\\end{ocamldoccomment}\n"; + flush2 () + in + [ Latex s] ) ) l @@ -506,193 +563,394 @@ class latex = [Latex ("\\index{"^(self#type_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @ (self#text_of_info t.ty_info) in - self#latex_of_text + self#latex_of_text fmt ((Latex (self#make_label (self#type_label t.ty_name))) :: text) - (** Return LaTeX code for an exception. *) - method latex_of_exception e = + (** Print LaTeX code for an exception. *) + method latex_of_exception fmt e = Odoc_info.reset_type_names () ; - self#latex_of_text + self#latex_of_text fmt ((Latex (self#make_label (self#exception_label e.ex_name))) :: (to_text#text_of_exception e)) - (** Return the LaTeX code for the given module. - @param for_detail indicate if we must print the type ([false]) or just ["sig"] ([true]).*) - method latex_of_module ?(for_detail=false) ?(with_link=true) m = - let buf = Buffer.create 32 in - let f = Format.formatter_of_buffer buf in + method latex_of_module_parameter fmt m_name p = + 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_functor (p, 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)] + | 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); + ] + + 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_alias a -> + 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 + | 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 ")"] + | 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) ; + ] + | Module_constraint (k, tk) -> + (* TODO: on affiche quoi ? *) + self#latex_of_module_kind fmt father k + + method latex_of_class_parameter fmt father p = + ps fmt (self#normal_type father (Parameter.typ p)) + + method latex_of_class_parameter_list fmt father params = + List.iter + (fun p -> + self#latex_of_class_parameter fmt father p; + ps fmt " -> ") + params + + 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_apply capp -> + (* 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 -> + 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)] + + | Class_constraint (ck, ctk) -> + self#latex_of_text fmt [Code "( "] ; + self#latex_of_class_kind fmt father ck; + self#latex_of_text fmt [Code " : "] ; + self#latex_of_class_type_kind fmt father ctk; + self#latex_of_text fmt [Code " )"] + + method latex_of_class_type_kind fmt father kind = + match kind with + 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 "] "] + ) + ); + self#latex_of_text fmt + [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"] + + method latex_for_module_index fmt m = + self#latex_of_text fmt + [Latex ("\\index{"^(self#module_label m.m_name)^"@\\verb`"^ + (self#label ~no_:false m.m_name)^"`}\n" + ) + ] + + method latex_for_module_type_index fmt mt = + self#latex_of_text fmt + [Latex ("\\index{"^(self#module_type_label mt.mt_name)^"@\\verb`"^ + (self#label ~no_:false mt.mt_name)^"`}\n" + ) + ] + + method latex_for_module_label fmt m = + ps fmt (self#make_label (self#module_label m.m_name)) + + method latex_for_module_type_label fmt mt = + ps fmt (self#make_label (self#module_type_label mt.mt_name)) + + + method latex_for_class_index fmt c = + self#latex_of_text fmt + [Latex ("\\index{"^(self#class_label c.cl_name)^"@\\verb`"^ + (self#label ~no_:false c.cl_name)^"`}\n" + ) + ] + + method latex_for_class_type_index fmt ct = + self#latex_of_text fmt + [Latex ("\\index{"^(self#class_type_label ct.clt_name)^"@\\verb`"^ + (self#label ~no_:false ct.clt_name)^"`}\n" + ) + ] + + method latex_for_class_label fmt c = + ps fmt (self#make_label (self#class_label c.cl_name)) + + method latex_for_class_type_label fmt ct = + ps fmt (self#make_label (self#class_type_label ct.clt_name)) + + (** Print the LaTeX code for the given module. *) + method latex_of_module fmt m = let father = Name.father m.m_name in let t = - Format.fprintf f "module %s" (Name.simple m.m_name); - Format.fprintf f " : %s" - ( - if for_detail - then "sig" - else (self#normal_module_type father m.m_type) - ); - - Format.pp_print_flush f (); - - (CodePre (Buffer.contents buf)) :: - ( - if with_link - then [Odoc_info.Latex ("\\\n["^(self#make_ref (self#module_label m.m_name))^"]")] - else [] - ) + [ + Latex "\\begin{ocamldoccode}\n" ; + Code "module "; + Code (Name.simple m.m_name); + Code " : "; + ] in - self#latex_of_text t - - (** Return the LaTeX code for the given module type. - @param for_detail indicate if we must print the type ([false]) or just ["sig"] ([true]).*) - method latex_of_module_type ?(for_detail=false) ?(with_link=true) mt = - let buf = Buffer.create 32 in - let f = Format.formatter_of_buffer buf in + self#latex_of_text fmt t; + self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; + self#latex_for_module_label fmt m; + self#latex_for_module_index fmt m; + p fmt "@[<h 4>"; + self#latex_of_module_kind fmt father m.m_kind; + ( + match Module.module_is_functor m with + 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]; + self#latex_of_info fmt ~block: true m.m_info; + p fmt "@]"; + + + (** 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 = - Format.fprintf f "module type %s" (Name.simple mt.mt_name); - (match mt.mt_type with - None -> () - | Some mtyp -> - Format.fprintf f " = %s" - ( - if for_detail - then "sig" - else (self#normal_module_type father mtyp) - ) - ); - - Format.pp_print_flush f (); - - (CodePre (Buffer.contents buf)) :: - ( - if with_link - then [Odoc_info.Latex ("\\\n["^(self#make_ref (self#module_type_label mt.mt_name))^"]")] - else [] - ) + [ + Latex "\\begin{ocamldoccode}\n" ; + Code "module type " ; + Code (Name.simple mt.mt_name); + ] in - self#latex_of_text t - - (** Return the LaTeX code for the given included module. *) - method latex_of_included_module im = - (self#latex_of_text ((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#latex_of_text fmt t; + ( + match mt.mt_type, mt.mt_kind with + | 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_index fmt mt; + p fmt "@[<h 4>"; + ); + ( + match Module.module_type_is_functor mt with + 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]; + self#latex_of_info fmt ~block: true mt.mt_info; + p fmt "@]"; + + (** Print the LaTeX code for the given included module. *) + method latex_of_included_module fmt im = + self#latex_of_text fmt + ((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) + ) - (** Return the LaTeX code for the given class. - @param for_detail indicate if we must print the type ([false]) or just ["object"] ([true]).*) - method latex_of_class ?(for_detail=false) ?(with_link=true) c = + (** Print the LaTeX code for the given class. *) + method latex_of_class fmt c = Odoc_info.reset_type_names () ; - let buf = Buffer.create 32 in - let f = Format.formatter_of_buffer buf in let father = Name.father c.cl_name in + let type_params = + match c.cl_type_parameters with + [] -> "" + | l -> (self#normal_class_type_param_list father l)^" " + in let t = - Format.fprintf f "class %s" - (if c.cl_virtual then "virtual " else ""); - ( - match c.cl_type_parameters with - [] -> () - | l -> - let s1 = self#normal_class_type_param_list father l in - Format.fprintf f "%s " s1 - ); - Format.fprintf f "%s : %s" - (Name.simple c.cl_name) - ( - if for_detail then - "object" - else - self#normal_class_type father c.cl_type - ); - - Format.pp_print_flush f (); - - (CodePre (Buffer.contents buf)) :: - ( - if with_link - then [Odoc_info.Latex (" ["^(self#make_ref (self#class_label c.cl_name))^"]")] - else [] - ) + [ + 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 t - - (** Return the LaTeX code for the given class type. - @param for_detail indicate if we must print the type ([false]) or just ["object"] ([true]).*) - method latex_of_class_type ?(for_detail=false) ?(with_link=true) ct = + self#latex_of_text fmt t; + self#latex_of_class_parameter_list fmt father c.cl_parameters; + 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>"; + 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; + p fmt "@]" + + (** Print the LaTeX code for the given class type. *) + method latex_of_class_type fmt ct = Odoc_info.reset_type_names () ; - let buf = Buffer.create 32 in - let f = Format.formatter_of_buffer buf in let father = Name.father ct.clt_name in + let type_params = + match ct.clt_type_parameters with + [] -> "" + | l -> (self#normal_class_type_param_list father l)^" " + in let t = - Format.fprintf f "class type %s" - (if ct.clt_virtual then "virtual " else ""); - ( - match ct.clt_type_parameters with - [] -> () - | l -> - let s1 = self#normal_class_type_param_list father l in - Format.fprintf f "%s " s1 - ); - Format.fprintf f "%s = %s" - (Name.simple ct.clt_name) - (if for_detail then - "object" - else - self#normal_class_type father ct.clt_type - ); - - Format.pp_print_flush f (); - (CodePre (Buffer.contents buf)) :: - ( - if with_link - then [Odoc_info.Latex (" ["^(self#make_ref (self#class_type_label ct.clt_name))^"]")] - else [] - ) + [ + 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 t - - (** Return the LaTeX code for the given class element. *) - method latex_of_class_element class_name class_ele = - (self#latex_of_text [Newline])^ - ( - match class_ele with - Class_attribute att -> self#latex_of_attribute att - | Class_method met -> self#latex_of_method met - | Class_comment t -> - match t with - | [] -> "" - | (Title (_,_,_)) :: _ -> self#latex_of_text t - | _ -> self#latex_of_text [ Title ((Name.depth class_name) + 2, None, t) ] - ) - - (** Return the LaTeX code for the given module element. *) - method latex_of_module_element module_name module_ele = - (self#latex_of_text [Newline])^ - ( - match module_ele with - Element_module m -> self#latex_of_module m - | Element_module_type mt -> self#latex_of_module_type mt - | Element_included_module im -> self#latex_of_included_module im - | Element_class c -> self#latex_of_class c - | Element_class_type ct -> self#latex_of_class_type ct - | Element_value v -> self#latex_of_value v - | Element_exception e -> self#latex_of_exception e - | Element_type t -> self#latex_of_type t - | Element_module_comment t -> self#latex_of_text t - ) + self#latex_of_text fmt t; + + self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ]; + self#latex_for_class_type_label fmt ct; + self#latex_for_class_type_index fmt ct; + p fmt "@[<h 4>"; + self#latex_of_class_type_kind fmt father ct.clt_kind; + self#latex_of_text fmt [Newline]; + self#latex_of_info fmt ~block: true ct.clt_info; + p fmt "@]" + + (** Print the LaTeX code for the given class element. *) + method latex_of_class_element fmt class_name class_ele = + self#latex_of_text fmt [Newline]; + match class_ele with + Class_attribute att -> self#latex_of_attribute fmt att + | Class_method met -> self#latex_of_method fmt met + | Class_comment t -> + match t with + | [] -> () + | (Title (_,_,_)) :: _ -> self#latex_of_text fmt t + | _ -> self#latex_of_text fmt [ Title ((Name.depth class_name) + 2, None, t) ] + + (** Print the LaTeX code for the given module element. *) + method latex_of_module_element fmt module_name module_ele = + self#latex_of_text fmt [Newline]; + match module_ele with + Element_module m -> self#latex_of_module fmt m + | Element_module_type mt -> self#latex_of_module_type fmt mt + | Element_included_module im -> self#latex_of_included_module fmt im + | Element_class c -> self#latex_of_class fmt c + | Element_class_type ct -> self#latex_of_class_type fmt ct + | Element_value v -> self#latex_of_value fmt v + | Element_exception e -> self#latex_of_exception fmt e + | Element_type t -> self#latex_of_type fmt t + | Element_module_comment t -> self#latex_of_text fmt t (** Generate the LaTeX code for the given list of inherited classes.*) - method generate_inheritance_info chanout inher_l = + method generate_inheritance_info fmt inher_l = let f inh = match inh.ic_class with None -> (* we can't make the reference *) - (Odoc_info.Code inh.ic_name) :: + Newline :: + Code ("inherit "^inh.ic_name) :: (match inh.ic_text with None -> [] | Some t -> Newline :: t @@ -704,29 +962,24 @@ class latex = | Cltype _ -> self#class_type_label inh.ic_name in (* we can create the reference *) - (Odoc_info.Code inh.ic_name) :: + Newline :: + Odoc_info.Code ("inherit "^inh.ic_name) :: (Odoc_info.Latex (" ["^(self#make_ref label)^"]")) :: (match inh.ic_text with None -> [] | Some t -> Newline :: t ) in - let text = [ - Odoc_info.Bold [Odoc_info.Raw Odoc_messages.inherits ]; - Odoc_info.List (List.map f inher_l) - ] - in - let s = self#latex_of_text text in - output_string chanout s + List.iter (self#latex_of_text fmt) (List.map f inher_l) (** Generate the LaTeX code for the inherited classes of the given class. *) - method generate_class_inheritance_info chanout cl = + method generate_class_inheritance_info fmt cl = let rec iter_kind k = match k with Class_structure ([], _) -> () | Class_structure (l, _) -> - self#generate_inheritance_info chanout l + self#generate_inheritance_info fmt l | Class_constraint (k, _) -> iter_kind k | Class_apply _ @@ -736,190 +989,68 @@ class latex = iter_kind cl.cl_kind (** Generate the LaTeX code for the inherited classes of the given class type. *) - method generate_class_type_inheritance_info chanout clt = + method generate_class_type_inheritance_info fmt clt = match clt.clt_kind with Class_signature ([], _) -> () | Class_signature (l, _) -> - self#generate_inheritance_info chanout l + self#generate_inheritance_info fmt l | Class_type _ -> () - (** Generate the LaTeX code for the given class, in the given out channel. *) - method generate_for_class chanout c = - Odoc_info.reset_type_names () ; - let depth = Name.depth c.cl_name in - let (first_t, rest_t) = self#first_and_rest_of_info c.cl_info in - let text = [ Title (depth, None, [ Raw (Odoc_messages.clas^" ") ; Code c.cl_name ] @ - (match first_t with - [] -> [] - | t -> (Raw " : ") :: t)) ; - Latex (self#make_label (self#class_label c.cl_name)) ; - ] - in - output_string chanout (self#latex_of_text text); - output_string chanout ((self#latex_of_class ~for_detail: true ~with_link: false c)^"\n\n") ; - let s_name = Name.simple c.cl_name in - output_string chanout - (self#latex_of_text [Latex ("\\index{"^(self#class_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]); - output_string chanout (self#latex_of_text rest_t) ; - (* parameters *) - output_string chanout - (self#latex_of_text (self#text_of_parameter_list (Name.father c.cl_name) c.cl_parameters)); - - output_string chanout (self#latex_of_text [ Newline ] ); - output_string chanout ("\\ocamldocvspace{0.5cm}\n\n"); - self#generate_class_inheritance_info chanout c; - - List.iter - (fun ele -> output_string chanout ((self#latex_of_class_element c.cl_name ele)^"\n\n")) - (Class.class_elements ~trans: false c); - - output_string chanout (self#latex_of_text [ CodePre "end"]) - - (** Generate the LaTeX code for the given class type, in the given out channel. *) - method generate_for_class_type chanout ct = - Odoc_info.reset_type_names () ; - let depth = Name.depth ct.clt_name in - let (first_t, rest_t) = self#first_and_rest_of_info ct.clt_info in - let text = [ Title (depth, None, [ Raw (Odoc_messages.class_type^" ") ; Code ct.clt_name ] @ - (match first_t with - [] -> [] - | t -> (Raw " : ") :: t)) ; - Latex (self#make_label (self#class_type_label ct.clt_name)) ; - ] - in - - output_string chanout (self#latex_of_text text); - output_string chanout ((self#latex_of_class_type ~for_detail: true ~with_link: false ct)^"\n\n") ; - let s_name = Name.simple ct.clt_name in - output_string chanout - (self#latex_of_text [Latex ("\\index{"^(self#class_type_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]); - output_string chanout ((self#latex_of_text rest_t)) ; - output_string chanout (self#latex_of_text [ Newline]) ; - output_string chanout ("\\ocamldocvspace{0.5cm}\n\n"); - self#generate_class_type_inheritance_info chanout ct; - - List.iter - (fun ele -> output_string chanout ((self#latex_of_class_element ct.clt_name ele)^"\n\n")) - (Class.class_type_elements ~trans: false ct); - - output_string chanout (self#latex_of_text [ CodePre "end"]) - - (** Generate the LaTeX code for the given module type, in the given out channel. *) - method generate_for_module_type chanout mt = - let depth = Name.depth mt.mt_name in - let (first_t, rest_t) = self#first_and_rest_of_info mt.mt_info in - let text = [ Title (depth, None, - [ Raw (Odoc_messages.module_type^" ") ; Code mt.mt_name ] @ - (match first_t with - [] -> [] - | t -> (Raw " : ") :: t)) ; - Latex (self#make_label (self#module_type_label mt.mt_name)) ; - ] - in - output_string chanout (self#latex_of_text text); - if depth > 1 then - output_string chanout ((self#latex_of_module_type ~for_detail: true ~with_link: false mt)^"\n\n"); - let s_name = Name.simple mt.mt_name in - output_string chanout - (self#latex_of_text [Latex ("\\index{"^(self#module_type_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]); - output_string chanout (self#latex_of_text rest_t) ; - (* parameters *) - output_string chanout - (self#latex_of_text - (self#text_of_module_parameter_list - (Module.module_type_parameters mt))); - - output_string chanout (self#latex_of_text [ Newline ] ); - output_string chanout ("\\ocamldocvspace{0.5cm}\n\n"); - List.iter - (fun ele -> output_string chanout ((self#latex_of_module_element mt.mt_name ele)^"\n\n")) - (Module.module_type_elements ~trans: false mt); - - if depth > 1 then - output_string chanout (self#latex_of_text [ CodePre "end"]); - - (* create sub parts for modules, module types, classes and class types *) - let rec iter ele = - match ele with - Element_module m -> self#generate_for_module chanout m - | Element_module_type mt -> self#generate_for_module_type chanout mt - | Element_class c -> self#generate_for_class chanout c - | Element_class_type ct -> self#generate_for_class_type chanout ct - | _ -> () - in - List.iter iter (Module.module_type_elements ~trans: false mt) - - (** Generate the LaTeX code for the given module, in the given out channel. *) - method generate_for_module chanout m = - let depth = Name.depth m.m_name in + (** 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 (depth, None, + let text = [ Title (1, None, [ Raw (Odoc_messages.modul^" ") ; Code m.m_name ] @ (match first_t with [] -> [] | t -> (Raw " : ") :: t)) ; - Latex (self#make_label (self#module_label m.m_name)) ; ] in - output_string chanout (self#latex_of_text text); - if depth > 1 then - output_string chanout ((self#latex_of_module ~for_detail:true ~with_link: false m)^"\n\n"); - let s_name = Name.simple m.m_name in - output_string chanout - (self#latex_of_text [Latex ("\\index{"^(self#module_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]); - output_string chanout (self#latex_of_text rest_t) ; - (* parameters *) - output_string chanout - (self#latex_of_text - (self#text_of_module_parameter_list - (Module.module_parameters m))); - - output_string chanout (self#latex_of_text [ Newline ]) ; - output_string chanout ("\\ocamldocvspace{0.5cm}\n\n"); + self#latex_of_text fmt text; + self#latex_for_module_label fmt m; + self#latex_for_module_index fmt m; + self#latex_of_text fmt rest_t ; + + self#latex_of_text fmt [ Newline ] ; + ps fmt "\\ocamldocvspace{0.5cm}\n\n"; List.iter - (fun ele -> output_string chanout ((self#latex_of_module_element m.m_name ele)^"\n\n")) - (Module.module_elements ~trans: false m); - - if depth > 1 then - output_string chanout (self#latex_of_text [ CodePre "end"]); - - (* create sub parts for modules, module types, classes and class types *) - let rec iter ele = - match ele with - Element_module m -> self#generate_for_module chanout m - | Element_module_type mt -> self#generate_for_module_type chanout mt - | Element_class c -> self#generate_for_class chanout c - | Element_class_type ct -> self#generate_for_class_type chanout ct - | _ -> () - in - List.iter iter (Module.module_elements ~trans: false m) - - (** Return the header of the TeX document. *) - method latex_header = - "\\documentclass[11pt]{article} \n"^ - "\\usepackage[latin1]{inputenc} \n"^ - "\\usepackage[T1]{fontenc} \n"^ - "\\usepackage{fullpage} \n"^ - "\\usepackage{url} \n"^ - "\\usepackage{ocamldoc}\n"^ + (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. *) + method latex_header fmt = + ps fmt "\\documentclass[11pt]{article} \n"; + ps fmt "\\usepackage[latin1]{inputenc} \n"; + ps fmt "\\usepackage[T1]{fontenc} \n"; + ps fmt "\\usepackage{fullpage} \n"; + ps fmt "\\usepackage{url} \n"; + ps fmt "\\usepackage{ocamldoc}\n"; ( match !Args.title with - None -> "" - | Some s -> "\\title{"^(self#escape s)^"}\n" - )^ - "\\begin{document}\n"^ - (match !Args.title with None -> "" | Some _ -> "\\maketitle\n")^ - (if !Args.with_toc then "\\tableofcontents\n" else "")^ + None -> () + | 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" + ); + 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 in - Printf.sprintf "%s%s%s" - (match info with None -> "" | Some _ -> "\\vspace{0.2cm}") - (self#latex_of_info info) - (match info with None -> "" | Some _ -> "\n\n") + (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") ) @@ -946,14 +1077,18 @@ class latex = (** Generate the LaTeX file from a module list, in the {!Odoc_info.Args.out_file} file. *) method generate module_list = self#generate_style_file ; + let main_file = !Args.out_file in + let dir = Filename.dirname main_file in if !Args.separate_files then ( let f m = try let chanout = - open_out ((Filename.concat !Args.target_dir (Name.simple m.m_name))^".tex") + open_out ((Filename.concat dir (Name.simple m.m_name))^".tex") in - self#generate_for_module chanout m ; + let fmt = Format.formatter_of_out_channel chanout in + self#generate_for_top_module fmt m ; + Format.pp_print_flush fmt (); close_out chanout with Failure s @@ -965,16 +1100,19 @@ class latex = ); try - let chanout = open_out !Args.out_file in - let _ = if !Args.with_header then output_string chanout self#latex_header else () in + let chanout = open_out main_file 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 - output_string chanout ("\\input{"^((Name.simple m.m_name))^".tex}\n") - else - self#generate_for_module chanout m + (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 ; - let _ = if !Args.with_trailer then output_string chanout "\\end{document}" else () in + if !Args.with_trailer then ps fmt "\\end{document}"; + Format.pp_print_flush fmt (); close_out chanout with Failure s diff --git a/ocamldoc/odoc_latex_style.ml b/ocamldoc/odoc_latex_style.ml index 1e557f55f0..5c0ed9bbee 100644 --- a/ocamldoc/odoc_latex_style.ml +++ b/ocamldoc/odoc_latex_style.ml @@ -63,14 +63,30 @@ let content =" } \\newenvironment{ocamldocdescription} -{\\list{}{\\rightmargin0pt \\topsep0pt}\\raggedright\\item\\relax} +{\\list{}{\\rightmargin0pt \\topsep0pt}\\raggedright\\item\\noindent\\relax\\ignorespaces} {\\endlist\\medskip} \\newenvironment{ocamldoccomment} -{\\list{}{\\leftmargin 2\\leftmargini \\rightmargin0pt \\topsep0pt}\\raggedright\\item\\relax} +{\\list{}{\\leftmargin 2\\leftmargini \\rightmargin0pt \\topsep0pt}\\raggedright\\item\\noindent\\relax} {\\endlist} +\\let \\ocamldocparagraph \\paragraph +\\def \\paragraph #1{\\ocamldocparagraph {#1}\\noindent} +\\let \\ocamldocsubparagraph \\subparagraph +\\def \\subparagraph #1{\\ocamldocsubparagraph {#1}\\noindent} + \\let\\ocamldocvspace\\vspace + +\\newenvironment{ocamldocindent}{\\list{}{}\\item\\relax}{\\endlist} +\\newenvironment{ocamldocsigend} + {\\noindent\\quad\\texttt{sig}\\ocamldocindent} + {\\endocamldocindent\\vskip -\\lastskip + \\noindent\\quad\\texttt{end}\\medskip} +\\newenvironment{ocamldocobjectend} + {\\noindent\\quad\\texttt{object}\\ocamldocindent} + {\\endocamldocindent\\vskip -\\lastskip + \\noindent\\quad\\texttt{end}\\medskip} + \\endinput " diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index 66232db589..12dc054a94 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -269,6 +269,10 @@ 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 -> + () (** Print groff string to display code. *) method man_of_code b s = self#man_of_text b [ Code s ] @@ -311,8 +315,8 @@ class man = bs b "\n" (** Print groff string to display a [Types.type_expr list].*) - method man_of_type_expr_list b m_name sep l = - let s = Odoc_str.string_of_type_list sep l in + method man_of_type_expr_list ?par b m_name sep l = + let s = Odoc_str.string_of_type_list ?par sep l 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); @@ -361,7 +365,9 @@ class man = [] -> () | _ -> bs b ".B of "; - self#man_of_type_expr_list b (Name.father e.ex_name) " * " e.ex_args + self#man_of_type_expr_list + ~par: false + b (Name.father e.ex_name) " * " e.ex_args ); ( match e.ex_alias with @@ -418,11 +424,11 @@ class man = bs b " *)\n " | l, None -> bs b "\n.B of "; - self#man_of_type_expr_list b father " * " l; + 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 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; diff --git a/ocamldoc/odoc_messages.ml b/ocamldoc/odoc_messages.ml index 0143098e94..bac8df08fa 100644 --- a/ocamldoc/odoc_messages.ml +++ b/ocamldoc/odoc_messages.ml @@ -15,9 +15,9 @@ let ok = "Ok" let software = "OCamldoc" -let version = Config.version -let magic = version^"" -let message_version = software^" "^version +let config_version = Config.version +let magic = config_version^"" +let message_version = software^" "^config_version (** Messages for command line *) diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml index fe535a6180..f0868afbab 100644 --- a/ocamldoc/odoc_misc.ml +++ b/ocamldoc/odoc_misc.ml @@ -33,6 +33,33 @@ let input_file_as_string nom = close_in chanin; Buffer.contents buf +let split_string s chars = + let len = String.length s in + let rec iter acc pos = + if pos >= len then + match acc with + "" -> [] + | _ -> [acc] + else + if List.mem s.[pos] chars then + match acc with + "" -> iter "" (pos + 1) + | _ -> acc :: (iter "" (pos + 1)) + else + iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1) + in + iter "" 0 + +let split_with_blanks s = split_string s [' ' ; '\n' ; '\r' ; '\t' ] + +let list_concat sep = + let rec iter = function + [] -> [] + | [h] -> [h] + | h :: q -> h :: sep :: q + in + iter + let string_of_longident li = String.concat "." (Longident.flatten li) let get_fields type_expr = @@ -88,6 +115,13 @@ 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 -> + "" in String.concat "" (List.map iter t) @@ -221,6 +255,13 @@ let rec text_no_title_no_list t = | Odoc_types.Link (s, t) -> [Odoc_types.Link (s, (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 + ) + | Odoc_types.Index_list -> [] in List.flatten (List.map iter t) @@ -248,6 +289,8 @@ let get_titles_in_text t = | Odoc_types.Link (_, t) | Odoc_types.Superscript t | Odoc_types.Subscript t -> iter_text t + | Odoc_types.Module_list _ -> () + | Odoc_types.Index_list -> () and iter_text te = List.iter iter_ele te in @@ -329,8 +372,9 @@ and first_sentence_text_ele text_ele = | Odoc_types.Link _ | Odoc_types.Ref _ | Odoc_types.Superscript _ - | Odoc_types.Subscript _ -> (false, text_ele, None) - + | Odoc_types.Subscript _ + | Odoc_types.Module_list _ + | Odoc_types.Index_list -> (false, text_ele, None) let first_sentence_of_text t = let (_,t2,_) = first_sentence_text t in diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli index 4b211b3737..982def9db7 100644 --- a/ocamldoc/odoc_misc.mli +++ b/ocamldoc/odoc_misc.mli @@ -16,6 +16,9 @@ (** This function returns a file in the form of one string.*) val input_file_as_string : string -> string +(** [split_with_blanks s] splits the given string [s] according to blanks. *) +val split_with_blanks : string -> string list + (** This function creates a string from a Longident.t .*) val string_of_longident : Longident.t -> string diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml index 4714672ca8..a12545b236 100644 --- a/ocamldoc/odoc_module.ml +++ b/ocamldoc/odoc_module.ml @@ -45,11 +45,18 @@ and module_alias = { 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_alias of module_alias (** complete name and corresponding module if we found it *) - | Module_functor of (Odoc_parameter.module_parameter list) * module_kind + | 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 @@ -76,7 +83,7 @@ and module_type_alias = { (** Different kinds of module type. *) and module_type_kind = | Module_type_struct of module_element list - | Module_type_functor of (Odoc_parameter.module_parameter list) * module_type_kind + | 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 *) @@ -313,25 +320,21 @@ let module_comments ?(trans=true) m = comments (module_elements ~trans m) let rec module_type_parameters ?(trans=true) mt = let rec iter k = match k with - Some (Module_type_functor (params, _)) -> - ( - (* we create the couple (parameter, description opt), using - the description of the parameter if we can find it in the comment.*) - match mt.mt_info with - None -> - List.map (fun p -> (p, None)) params - | Some i -> - List.map - (fun p -> - try - let d = List.assoc p.Odoc_parameter.mp_name i.Odoc_types.i_params in - (p, Some d) - with - Not_found -> - (p, None) - ) - params - ) + 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.*) + match mt.mt_info with + None -> (p, None) + | Some i -> + try + let d = List.assoc p.mp_name i.Odoc_types.i_params in + (p, Some d) + with + Not_found -> + (p, None) + in + param :: (iter (Some k2)) | Some (Module_type_alias mta) -> if trans then match mta.mta_module with @@ -352,45 +355,44 @@ let rec module_type_parameters ?(trans=true) mt = iter mt.mt_kind (** Access to the parameters, for a functor. - @param trans indicates if, for aliased modules, we must perform a transitive search.*) + @param trans indicates if, for aliased modules, we must perform a transitive search.*) and module_parameters ?(trans=true) m = - match m.m_kind with - Module_functor (params, _) -> - ( - (* 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 - None -> - List.map (fun p -> (p, None)) params - | Some i -> - List.map - (fun p -> - try - let d = List.assoc p.Odoc_parameter.mp_name i.Odoc_types.i_params in - (p, Some d) + let rec iter = function + 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 + None ->(p, None) + | Some i -> + try + let d = List.assoc p.mp_name i.Odoc_types.i_params in + (p, Some d) with - Not_found -> + Not_found -> (p, None) - ) - params - ) - | Module_alias ma -> - if trans then - match ma.ma_module with - None -> [] - | Some (Mod m) -> module_parameters ~trans m - | Some (Modtype mt) -> module_type_parameters ~trans mt - else - [] - | Module_constraint (k, tk) -> - module_type_parameters ~trans: trans - { 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_with _ -> - [] + in + param :: (iter k) + + | Module_alias ma -> + if trans then + match ma.ma_module with + None -> [] + | Some (Mod m) -> module_parameters ~trans m + | Some (Modtype mt) -> module_type_parameters ~trans mt + else + [] + | Module_constraint (k, tk) -> + module_type_parameters ~trans: trans + { 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_with _ -> + [] + in + iter m.m_kind (** access to all submodules and sudmobules of submodules ... of the given module. @param trans indicates if, for aliased modules, we must perform a transitive search.*) @@ -420,18 +422,21 @@ let rec module_type_is_functor mt = 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 rec module_is_functor m = - match m.m_kind with - Module_functor _ -> true - | Module_alias ma -> - ( - match ma.ma_module with - None -> false - | Some (Mod mo) -> module_is_functor mo - | Some (Modtype mt) -> module_type_is_functor mt - ) - | _ -> false - +let module_is_functor m = + let rec iter = function + Module_functor _ -> true + | Module_alias ma -> + ( + match ma.ma_module with + None -> false + | Some (Mod mo) -> iter mo.m_kind + | Some (Modtype mt) -> module_type_is_functor mt + ) + | Module_constraint (k, _) -> + iter k + | _ -> false + in + iter m.m_kind (** Returns the list of values of a module type. @param trans indicates if, for aliased modules, we must perform a transitive search.*) diff --git a/ocamldoc/odoc_name.ml b/ocamldoc/odoc_name.ml index ef01ec4a3f..e518d57cf6 100644 --- a/ocamldoc/odoc_name.ml +++ b/ocamldoc/odoc_name.ml @@ -60,7 +60,7 @@ let cut name = '(' -> j := 1 | _ -> - Buffer.add_char buf.(!j) '(' + Buffer.add_char buf.(!j) '.' else Buffer.add_char buf.(!j) s.[i] | c -> @@ -79,10 +79,28 @@ let father name = fst (cut name) let concat n1 n2 = n1^"."^n2 -let head n = - match Str.split (Str.regexp "\\.") n with - [] -> n - | h :: _ -> h +let head_and_tail n = + try + let pos = String.index n '.' in + if pos > 0 then + let h = String.sub n 0 pos in + try + ignore (String.index h '('); + (n, "") + with + Not_found -> + let len = String.length n in + if pos >= (len - 1) then + (h, "") + else + (h, String.sub n (pos + 1) (len - pos - 1)) + else + (n, "") + with + Not_found -> (n, "") + +let head n = fst (head_and_tail n) +let tail n = snd (head_and_tail n) let depth name = try @@ -98,6 +116,20 @@ let prefix n1 n2 = (n2.[len1] = '.') with _ -> false) +let rec get_relative_raw n1 n2 = + let (f1,s1) = head_and_tail n1 in + let (f2,s2) = head_and_tail n2 in + if f1 = f2 then + if f2 = s2 or s2 = "" then + s2 + else + if f1 = s1 or s1 = "" then + s2 + else + get_relative_raw s1 s2 + else + n2 + let get_relative n1 n2 = if prefix n1 n2 then let len1 = String.length n1 in @@ -142,21 +174,3 @@ let to_path n = let from_longident longident = String.concat "." (Longident.flatten longident) -let name_alias name cpl_aliases = - let rec f n1 = function - [] -> raise Not_found - | (n2, n3) :: q -> - if n2 = n1 then - n3 - else - if prefix n2 n1 then - let ln2 = String.length n2 in - n3^(String.sub n1 ln2 ((String.length n1) - ln2)) - else - f n1 q - in - let rec iter n = - try iter (f n cpl_aliases) - with Not_found -> n - in - iter name diff --git a/ocamldoc/odoc_name.mli b/ocamldoc/odoc_name.mli index b0a5d55440..33b661f937 100644 --- a/ocamldoc/odoc_name.mli +++ b/ocamldoc/odoc_name.mli @@ -41,9 +41,12 @@ val prefix : t -> t -> bool (** Take two names n1 and n2 = n3.n4 and return n4 if n3=n1 or else n2. *) val get_relative : t -> t -> t +(** Take two names n1=n3.n4 and n2 = n5.n6 and return n6 if n3=n5 or else n2. *) +val get_relative_raw : t -> t -> t + (** Take a list of module names to hide and a name, and return the name when the module name (or part of it) - was removedn, according to the list of module names to hide.*) + was removed, according to the list of module names to hide.*) val hide_given_modules : t list -> t -> t (** Indicate if a name if qualified or not. *) @@ -61,6 +64,3 @@ val to_path : t -> Path.t (** Get a name from a [Longident.t].*) val from_longident : Longident.t -> t -(** This function takes a name and a list of name aliases and returns the name - after substitution using the aliases. *) -val name_alias : t -> (t * t) list -> t diff --git a/ocamldoc/odoc_parameter.ml b/ocamldoc/odoc_parameter.ml index 790250fc82..ba7ff1de30 100644 --- a/ocamldoc/odoc_parameter.ml +++ b/ocamldoc/odoc_parameter.ml @@ -11,8 +11,7 @@ (* $Id$ *) -(** Representation and manipulation of method / function / class parameters, - and module parameters.*) +(** Representation and manipulation of method / function / class parameters. *) let print_DEBUG s = print_string s ; print_newline () @@ -34,13 +33,6 @@ type param_info = (** A parameter is just a param_info.*) type parameter = param_info -(** A module parameter is just a name and a module type.*) -type module_parameter = { - mp_name : string ; - mp_type : Types.module_type ; - } - - (** Functions *) (** acces to the name as a string. For tuples, parenthesis and commas are added. *) diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml index 409e0523ce..1aa9a5dcec 100644 --- a/ocamldoc/odoc_print.ml +++ b/ocamldoc/odoc_print.ml @@ -44,22 +44,36 @@ let string_of_type_expr t = Printtyp.type_scheme_max ~b_reset_names: false type_fmt t; flush_type_fmt () +exception Use_code of string + (** Return the given module type where methods and vals have been removed - from the signatures. Used when we don't want to print a too long module type.*) -let simpl_module_type t = + from the signatures. Used when we don't want to print a too long module type. + @param code when the code is given, we raise the [Use_code] exception is we + encouter a signature, to that the calling function can use the code rather + than the "emptied" type. +*) +let simpl_module_type ?code t = let rec iter t = match t with Types.Tmty_ident p -> t - | Types.Tmty_signature _ -> Types.Tmty_signature [] + | Types.Tmty_signature _ -> + ( + match code with + None -> Types.Tmty_signature [] + | Some s -> raise (Use_code s) + ) | Types.Tmty_functor (id, mt1, mt2) -> Types.Tmty_functor (id, iter mt1, iter mt2) in iter t -let string_of_module_type ?(complete=false) t = - let t2 = if complete then t else simpl_module_type t in - Printtyp.modtype modtype_fmt t2; - flush_modtype_fmt () +let string_of_module_type ?code ?(complete=false) t = + try + let t2 = if complete then t else simpl_module_type ?code t in + Printtyp.modtype modtype_fmt t2; + flush_modtype_fmt () + with + Use_code s -> s (** Return the given class type where methods and vals have been removed from the signatures. Used when we don't want to print a too long class type.*) @@ -75,6 +89,7 @@ let simpl_class_type t = Types.desc = Types.Tobject (tnil, ref None) }; Types.cty_vars = Types.Vars.empty ; Types.cty_concr = Types.Concr.empty ; + Types.cty_inher = [] } | Types.Tcty_fun (l, texp, ct) -> let new_ct = iter ct in diff --git a/ocamldoc/odoc_print.mli b/ocamldoc/odoc_print.mli index 0e7cc2f9d8..b0b11997d1 100644 --- a/ocamldoc/odoc_print.mli +++ b/ocamldoc/odoc_print.mli @@ -20,8 +20,10 @@ val string_of_type_expr : Types.type_expr -> string (** This function returns a string representing a [Types.module_type]. @param complete indicates if we must print complete signatures or just [sig end]. Default if [false]. + @param code if [complete = false] and the type contains something else + than identificators and functors, then the given code is used. *) -val string_of_module_type : ?complete: bool -> Types.module_type -> string +val string_of_module_type : ?code: string -> ?complete: bool -> Types.module_type -> string (** This function returns a string representing a [Types.class_type]. @param complete indicates if we must print complete signatures diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml index 990930d695..d25aee63d5 100644 --- a/ocamldoc/odoc_search.ml +++ b/ocamldoc/odoc_search.ml @@ -79,7 +79,9 @@ module Search = | T.Link (_, t) -> search_text root t v | 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) -> (match l_opt with None -> [] diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index cb025f22d1..20ee0ed693 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -51,13 +51,13 @@ module Signature_search = Hashtbl.add table (V (Name.from_ident ident)) signat | Types.Tsig_exception (ident, _) -> Hashtbl.add table (E (Name.from_ident ident)) signat - | Types.Tsig_type (ident, _) -> + | Types.Tsig_type (ident, _, _) -> Hashtbl.add table (T (Name.from_ident ident)) signat - | Types.Tsig_class (ident,_) -> + | Types.Tsig_class (ident, _, _) -> Hashtbl.add table (C (Name.from_ident ident)) signat - | Types.Tsig_cltype (ident, _) -> + | Types.Tsig_cltype (ident, _, _) -> Hashtbl.add table (CT (Name.from_ident ident)) signat - | Types.Tsig_module (ident, _) -> + | Types.Tsig_module (ident, _, _) -> Hashtbl.add table (M (Name.from_ident ident)) signat | Types.Tsig_modtype (ident,_) -> Hashtbl.add table (MT (Name.from_ident ident)) signat @@ -80,22 +80,22 @@ module Signature_search = let search_type table name = match Hashtbl.find table (T name) with - | (Types.Tsig_type (_, type_decl)) -> type_decl + | (Types.Tsig_type (_, type_decl, _)) -> type_decl | _ -> assert false let search_class table name = match Hashtbl.find table (C name) with - | (Types.Tsig_class (_, class_decl)) -> class_decl + | (Types.Tsig_class (_, class_decl, _)) -> class_decl | _ -> assert false let search_class_type table name = match Hashtbl.find table (CT name) with - | (Types.Tsig_cltype (_, cltype_decl)) -> cltype_decl + | (Types.Tsig_cltype (_, cltype_decl, _)) -> cltype_decl | _ -> assert false let search_module table name = match Hashtbl.find table (M name) with - | (Types.Tsig_module (ident, module_type)) -> module_type + | (Types.Tsig_module (ident, module_type, _)) -> module_type | _ -> assert false let search_module_type table name = @@ -285,7 +285,7 @@ module Analyser = let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in Types.Vars.iter f_DEBUG class_signature.Types.cty_vars; print_DEBUG ("Type de la classe "^current_class_name^" : "); - print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self); + print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self); let get_pos_limit2 q = match q with [] -> pos_limit @@ -1077,23 +1077,31 @@ module Analyser = raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat") ) - | Parsetree.Pmty_functor (_,_, module_type2) -> + | Parsetree.Pmty_functor (_,pmodule_type2, module_type2) -> ( + let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let mp_type_code = get_string_of_file loc_start loc_end in + print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); match sig_module_type with Types.Tmty_functor (ident, param_module_type, body_module_type) -> + let mp_kind = analyse_module_type_kind env + current_module_name pmodule_type2 param_module_type + in let param = { mp_name = Name.from_ident ident ; mp_type = Odoc_env.subst_module_type env param_module_type ; + mp_type_code = mp_type_code ; + mp_kind = mp_kind ; } in - ( - match analyse_module_type_kind env current_module_name module_type2 body_module_type with - Module_type_functor (params, k) -> - Module_type_functor (param :: params, k) - | k -> - Module_type_functor ([param], k) - ) + let k = analyse_module_type_kind env + current_module_name + module_type2 + body_module_type + in + Module_type_functor (param, k) | _ -> (* if we're here something's wrong *) @@ -1140,23 +1148,31 @@ module Analyser = (* if we're here something's wrong *) raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat") ) - | Parsetree.Pmty_functor (_,_,module_type2) (* of string * module_type * module_type *) -> + | Parsetree.Pmty_functor (_,pmodule_type2,module_type2) (* of string * module_type * module_type *) -> ( match sig_module_type with Types.Tmty_functor (ident, param_module_type, body_module_type) -> + let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let mp_type_code = get_string_of_file loc_start loc_end in + print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); + let mp_kind = analyse_module_type_kind env + current_module_name pmodule_type2 param_module_type + in let param = { mp_name = Name.from_ident ident ; mp_type = Odoc_env.subst_module_type env param_module_type ; + mp_type_code = mp_type_code ; + mp_kind = mp_kind ; } in - ( - match analyse_module_kind env current_module_name module_type2 body_module_type with - Module_functor (params, k) -> - Module_functor (param :: params, k) - | k -> - Module_functor ([param], k) - ) + let k = analyse_module_kind env + current_module_name + module_type2 + body_module_type + in + Module_functor (param, k) | _ -> (* if we're here something's wrong *) @@ -1196,7 +1212,7 @@ module Analyser = let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in Types.Vars.iter f_DEBUG class_signature.Types.cty_vars; print_DEBUG ("Type de la classe "^current_class_name^" : "); - print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self); + print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self); (* we get the elements of the class in class_type_field_list *) let (inher_l, ele) = analyse_class_elements env current_class_name last_pos @@ -1250,7 +1266,7 @@ module Analyser = let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in Types.Vars.iter f_DEBUG class_signature.Types.cty_vars; print_DEBUG ("Type de la classe "^current_class_name^" : "); - print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self); + print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self); (* we get the elements of the class in class_type_field_list *) let (inher_l, ele) = analyse_class_elements env current_class_name last_pos @@ -1321,41 +1337,18 @@ module Analyser = else None in - let m = - { - m_name = mod_name ; - m_type = Types.Tmty_signature signat ; - m_info = info_opt ; - m_is_interface = true ; - m_file = !file_name ; - m_kind = Module_struct elements ; - m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ; - m_top_deps = [] ; - m_code = None ; - m_code_intf = code_intf ; - } - in - - print_DEBUG "Eléments du module:"; - let f e = - let s = - match e with - Element_module m -> "module "^m.m_name - | Element_module_type mt -> "module type "^mt.mt_name - | Element_included_module im -> "included module "^im.im_name - | Element_class c -> "class "^c.cl_name - | Element_class_type ct -> "class type "^ct.clt_name - | Element_value v -> "value "^v.val_name - | Element_exception e -> "exception "^e.ex_name - | Element_type t -> "type "^t.ty_name - | Element_module_comment t -> Odoc_misc.string_of_text t - in - print_DEBUG s; - () - in - List.iter f elements; - - m + { + m_name = mod_name ; + m_type = Types.Tmty_signature signat ; + m_info = info_opt ; + m_is_interface = true ; + m_file = !file_name ; + m_kind = Module_struct elements ; + m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ; + m_top_deps = [] ; + m_code = None ; + m_code_intf = code_intf ; + } end diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml index c644675f6c..de82a9e46a 100644 --- a/ocamldoc/odoc_str.ml +++ b/ocamldoc/odoc_str.ml @@ -69,11 +69,14 @@ let raw_string_of_type_list sep type_list = Format.pp_print_flush fmt (); Buffer.contents buf -let string_of_type_list sep type_list = +let string_of_type_list ?par sep type_list = let par = - match type_list with - [] | [_] -> false - | _ -> true + match par with + | Some b -> b + | None -> + match type_list with + [] | [_] -> false + | _ -> true in Printf.sprintf "%s%s%s" (if par then "(" else "") diff --git a/ocamldoc/odoc_str.mli b/ocamldoc/odoc_str.mli index a06852ebe3..6c9fa820c8 100644 --- a/ocamldoc/odoc_str.mli +++ b/ocamldoc/odoc_str.mli @@ -17,16 +17,18 @@ val string_of_variance : Odoc_type.t_type -> (bool * bool) -> string (** This function returns a string to represent the given list of types, - with a given separator. It writes in and flushes [Format.str_formatter].*) -val string_of_type_list : string -> Types.type_expr list -> string + with a given separator. + @param par can be used to force the addition or not of parentheses around the returned string. +*) +val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string (** This function returns a string to represent the list of type parameters - for the given type. It writes in and flushes [Format.str_formatter].*) + for the given type. *) val string_of_type_param_list : Odoc_type.t_type -> string (** This function returns a string to represent the given list of type parameters of a class or class type, - with a given separator. It writes in and flushes [Format.str_formatter].*) + with a given separator. *) val string_of_class_type_param_list : Types.type_expr list -> string (** @return a string to describe the given type. *) diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml index 8090a2b3c4..5eb18ca602 100644 --- a/ocamldoc/odoc_texi.ml +++ b/ocamldoc/odoc_texi.ml @@ -1,7 +1,7 @@ (***********************************************************************) (* OCamldoc *) (* *) -(* Olivier Andrieu, basé sur du code de Maxence Guesdon *) +(* Olivier Andrieu, base sur du code de Maxence Guesdon *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) @@ -297,6 +297,8 @@ 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 -> "" method texi_of_Verbatim s = s method texi_of_Raw s = self#escape s diff --git a/ocamldoc/odoc_text.ml b/ocamldoc/odoc_text.ml index b83c88a19f..85578098b7 100644 --- a/ocamldoc/odoc_text.ml +++ b/ocamldoc/odoc_text.ml @@ -134,6 +134,12 @@ module Texter = ) | Superscript t -> p b "{^" ; p_text b t ; p b "}" | Subscript t -> p b "{_" ; p_text b t ; p b "}" + | Module_list l -> + p b "{!modules:"; + List.iter (fun s -> p b " %s" s) l; + p b "}" + | Index_list -> + p b "{!indexlist}" let string_of_text s = let b = Buffer.create 256 in diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll index f21ec9ae39..f0c3738a6f 100644 --- a/ocamldoc/odoc_text_lexer.mll +++ b/ocamldoc/odoc_text_lexer.mll @@ -160,8 +160,8 @@ let begin_clt_ref = "{!classtype:"blank_nl | "{!classtype:" let begin_att_ref = "{!attribute:"blank_nl | "{!attribute:" 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_superscript = "{^"blank_nl | "{^" let begin_subscript = "{_"blank_nl | "{_" @@ -641,6 +641,34 @@ rule main = parse ) } +| begin_mod_list_ref + { + incr_cpts lexbuf ; + if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then + Char (Lexing.lexeme lexbuf) + else + if not !ele_ref_mode then + ( + ele_ref_mode := true; + MOD_LIST_REF + ) + else + ( + Char (Lexing.lexeme lexbuf) + ) + } + +| index_list + { + incr_cpts lexbuf ; + if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then + Char (Lexing.lexeme lexbuf) + else + if not !ele_ref_mode then + INDEX_LIST + else + Char (Lexing.lexeme lexbuf) + } | begin_verb { @@ -708,7 +736,10 @@ rule main = parse END_SHORTCUT_LIST ) else - BLANK_LINE + if !latex_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode or !verb_mode then + Char (Lexing.lexeme lexbuf) + else + BLANK_LINE } | eof { EOF } diff --git a/ocamldoc/odoc_text_parser.mly b/ocamldoc/odoc_text_parser.mly index 2abd562f74..8711ca05fb 100644 --- a/ocamldoc/odoc_text_parser.mly +++ b/ocamldoc/odoc_text_parser.mly @@ -60,7 +60,8 @@ let print_DEBUG s = print_string s; print_newline () %token ATT_REF %token MET_REF %token SEC_REF - +%token MOD_LIST_REF +%token INDEX_LIST %token SUPERSCRIPT %token SUBSCRIPT @@ -164,6 +165,13 @@ text_element: let s3 = remove_trailing_blanks s2 in Ref (s3, Some (RK_section [])) } +| 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 } | VERB string END_VERB { Verbatim $2 } | LATEX string END_LATEX { Latex $2 } | LINK string END text END { Link ($2, $4) } diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml index a80eb3889a..426432a65f 100644 --- a/ocamldoc/odoc_to_text.ml +++ b/ocamldoc/odoc_to_text.ml @@ -188,21 +188,37 @@ class virtual to_text = in s2 + (** Take a string and return the string where fully qualified idents + have been replaced by idents relative to the given module name. + Also remove the "hidden modules".*) + method relative_module_idents 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 + Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel + in + let s2 = Str.global_substitute + (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)") + f + s + in + s2 + (** Get a string for a [Types.class_type] where all idents are relative. *) method normal_class_type m_name t = (self#relative_idents m_name (Odoc_info.string_of_class_type t)) (** Get a string for a [Types.module_type] where all idents are relative. *) - method normal_module_type m_name t = - (self#relative_idents m_name (Odoc_info.string_of_module_type t)) + method normal_module_type ?code m_name t = + (self#relative_module_idents m_name (Odoc_info.string_of_module_type ?code t)) (** Get a string for a type where all idents are relative. *) method normal_type m_name t = (self#relative_idents m_name (Odoc_info.string_of_type_expr t)) (** Get a string for a list of types where all idents are relative. *) - method normal_type_list m_name sep t = - (self#relative_idents m_name (Odoc_info.string_of_type_list sep t)) + method normal_type_list ?par m_name sep t = + (self#relative_idents m_name (Odoc_info.string_of_type_list ?par sep t)) (** Get a string for a list of class or class type type parameters where all idents are relative. *) @@ -244,7 +260,8 @@ class virtual to_text = (** @return [text] value for a value. *) method text_of_value v = - let s_name = Name.simple v.val_name in + let name = v.val_name in + let s_name = Name.simple name in let s = Format.fprintf Format.str_formatter "@[<hov 2>val %s :@ %s" s_name @@ -252,7 +269,7 @@ class virtual to_text = Format.flush_str_formatter () in [ CodePre s ] @ - [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @ + [Latex ("\\index{"^(self#label name)^"@\\verb`"^(self#label ~no_:false name)^"`}\n")] @ (self#text_of_info v.val_info) (** @return [text] value for a class attribute. *) @@ -296,7 +313,9 @@ class virtual to_text = | _ -> Format.fprintf Format.str_formatter "@ of " ); - let s = self#normal_type_list (Name.father e.ex_name) " * " e.ex_args in + let s = self#normal_type_list + ~par: false (Name.father e.ex_name) " * " e.ex_args + in let s2 = Format.fprintf Format.str_formatter "%s" s ; (match e.ex_alias with @@ -500,25 +519,24 @@ class virtual to_text = [Code ((if with_def_syntax then " : " else "")^ Odoc_messages.struct_end^" ")] - | Module_functor (_, k) -> + | Module_functor (p, k) -> (if with_def_syntax then [Code " : "] else []) @ [Code "functor ... "] @ [Code " -> "] @ (self#text_of_module_kind ~with_def_syntax: false k) - (** Return html code for a [module_type_kind]. *) + (** Return html code for a [module_type_kind].*) method text_of_module_type_kind ?(with_def_syntax=true) tk = match tk with | Module_type_struct _ -> [Code ((if with_def_syntax then " = " else "")^Odoc_messages.sig_end)] - | Module_type_functor (params, k) -> - let f p = - [Code ("("^p.mp_name^" : ")] @ - (self#text_of_module_type p.mp_type) @ + | Module_type_functor (p, k) -> + let t1 = + [Code ("("^p.mp_name^" : ")] @ + (self#text_of_module_type_kind p.mp_kind) @ [Code ") -> "] in - let t1 = List.flatten (List.map f params) in let t2 = self#text_of_module_type_kind ~with_def_syntax: false k in (if with_def_syntax then [Code " = "] else []) @ t1 @ t2 @@ -534,4 +552,5 @@ class virtual to_text = | Some mt -> mt.mt_name)) ] + end diff --git a/ocamldoc/odoc_types.ml b/ocamldoc/odoc_types.ml index fd8938ed69..1bd749c0cd 100644 --- a/ocamldoc/odoc_types.ml +++ b/ocamldoc/odoc_types.ml @@ -44,6 +44,8 @@ and text_element = | Ref of string * ref_kind option | Superscript of text | Subscript of text + | Module_list of string list + | Index_list and text = text_element list diff --git a/ocamldoc/odoc_types.mli b/ocamldoc/odoc_types.mli index 61e8db7b26..17eee74900 100644 --- a/ocamldoc/odoc_types.mli +++ b/ocamldoc/odoc_types.mli @@ -49,6 +49,9 @@ 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 + (** The table of the given modules with their abstract; *) + | Index_list (** The links to the various indexes (values, types, ...) *) (** [text] is a list of text_elements. The order matters. *) and text = text_element list diff --git a/ocamldoc/remove_DEBUG b/ocamldoc/remove_DEBUG index 6dd7ad0b0f..7233afbac0 100755 --- a/ocamldoc/remove_DEBUG +++ b/ocamldoc/remove_DEBUG @@ -1,5 +1,18 @@ #!/bin/sh +#(***********************************************************************) +#(* OCamldoc *) +#(* *) +#(* Damien Doligez, projet Moscova, INRIA Rocquencourt *) +#(* *) +#(* Copyright 2003 Institut National de Recherche en Informatique et *) +#(* en Automatique. All rights reserved. This file is distributed *) +#(* under the terms of the Q Public License version 1.0. *) +#(* *) +#(***********************************************************************) + +# $Id$ + # usage: remove_DEBUG <file> # remove from <file> every line that contains the string "DEBUG", # respecting the cpp # line annotation conventions |