From 642504c5e7017a771bba6a16ce1993dc294ef48b Mon Sep 17 00:00:00 2001 From: Florian Angeletti Date: Sat, 1 Sep 2018 16:56:57 +0200 Subject: [PATCH] ocamldoc: add a -lib flag for prefixed libraries --- ocamldoc/odoc_analyse.ml | 13 +++++++++---- ocamldoc/odoc_args.ml | 1 + ocamldoc/odoc_ast.ml | 2 +- ocamldoc/odoc_cross.ml | 5 ++++- ocamldoc/odoc_global.ml | 2 ++ ocamldoc/odoc_global.mli | 3 +++ ocamldoc/odoc_html.ml | 10 ++++++---- ocamldoc/odoc_info.mli | 4 ++++ ocamldoc/odoc_messages.ml | 5 +++++ ocamldoc/odoc_name.ml | 17 +++++++++++++++-- ocamldoc/odoc_name.mli | 10 ++++++++-- ocamldoc/odoc_sig.ml | 3 ++- 12 files changed, 60 insertions(+), 15 deletions(-) diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml index aa70b57e5..0e46a7afc 100644 --- a/ocamldoc/odoc_analyse.ml +++ b/ocamldoc/odoc_analyse.ml @@ -30,18 +30,23 @@ let init_path () = Compmisc.init_path false (** Return the initial environment in which compilation proceeds. *) let initial_env () = + let current = Env.get_unit_name () in + let initial = !Odoc_global.initially_opened_module in let initially_opened_module = - let m = !Odoc_global.initially_opened_module in - if m = Env.get_unit_name () then + if initial = current then None else - Some m + Some initial in + let open_implicit_modules = + let ln = !Odoc_global.library_namespace in + let ln = if current = ln || ln = initial || ln = "" then [] else [ln] in + ln @ List.rev !Clflags.open_modules in Typemod.initial_env ~loc:(Location.in_file "ocamldoc command line") ~safe_string:(Config.safe_string || not !Clflags.unsafe_string) + ~open_implicit_modules ~initially_opened_module - ~open_implicit_modules:(List.rev !Clflags.open_modules) (** Optionally preprocess a source file *) let preprocess sourcefile = diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index 2bebd9654..faa65870e 100644 --- a/ocamldoc/odoc_args.ml +++ b/ocamldoc/odoc_args.ml @@ -258,6 +258,7 @@ let default_options = Options.list @ [ "-initially-opened-module", Arg.Set_string Odoc_global.initially_opened_module, M.initially_opened_module; + "-lib", Arg.Set_string Odoc_global.library_namespace, M.library_namespace; "-text", Arg.String (fun s -> Odoc_global.files := !Odoc_global.files @ [Odoc_global.Text_file s]), M.option_text ; diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 7c7ac9dd3..7ac5d761d 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -1699,7 +1699,7 @@ module Analyser = Typedtree.Tmod_constraint ({Typedtree.mod_desc = Typedtree.Tmod_ident (path, _)}, _, _, _)) -> - let alias_name = Odoc_env.full_module_name env (Name.from_path path) in + let alias_name = Odoc_env.full_module_name env (Name.from_path path) in { m_base with m_kind = Module_alias { ma_name = alias_name ; ma_module = None ; } } diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index d08e0356d..143c675dc 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -400,7 +400,10 @@ and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module Some _ -> (acc_b, acc_inc, acc_names) | None -> - let mta_name = Name.get_relative "Stdlib" mta.mta_name in + let mta_name = + Name.get_relative_opt + !Odoc_global.library_namespace + mta.mta_name in let mt_opt = try Some (lookup_module_type mta_name) with Not_found -> None diff --git a/ocamldoc/odoc_global.ml b/ocamldoc/odoc_global.ml index 92b9308e1..3bb1a67cd 100644 --- a/ocamldoc/odoc_global.ml +++ b/ocamldoc/odoc_global.ml @@ -79,3 +79,5 @@ let with_toc = ref true let with_index = ref true let initially_opened_module = ref "Stdlib" + +let library_namespace = ref "" diff --git a/ocamldoc/odoc_global.mli b/ocamldoc/odoc_global.mli index 509f02433..c85b45345 100644 --- a/ocamldoc/odoc_global.mli +++ b/ocamldoc/odoc_global.mli @@ -105,3 +105,6 @@ val with_trailer : bool ref (** Name of the module that is initially opened. *) val initially_opened_module : string ref + +(** Name of the library namespace for a prefixed library *) +val library_namespace: string ref diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index 02e40d1a5..e9b98fd12 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -1240,12 +1240,13 @@ class html = type (or class or class type) idents have been replaced by links to the type referenced by the ident.*) method create_fully_qualified_idents_links m_name s = + let ln = !Odoc_global.library_namespace in let f str_t = let match_s = Str.matched_string str_t in let known_type = String.Set.mem match_s known_types_names in let known_class = String.Set.mem match_s known_classes_names in - let retry, match_s = if not (known_type || known_class) then - true, Name.get_relative "Stdlib" match_s + let retry, match_s = if not (known_type || known_class) && ln <> "" then + true, Name.get_relative_opt ln match_s else false, match_s in @@ -1279,9 +1280,10 @@ class html = let f str_t = let match_s = Str.matched_string str_t in let known_module = String.Set.mem match_s known_modules_names in + let ln = !Odoc_global.library_namespace in let retry, match_s = - if not known_module then - true, Name.get_relative "Stdlib" match_s + if not known_module && ln <> "" then + true, Name.get_relative_opt ln match_s else false, match_s in let rel = Name.get_relative m_name match_s in diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index d0d183b40..006a28b93 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -128,6 +128,10 @@ module Name : (** 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 and n2 = n3.n4 and return n4 if n3=n1 and n1<>"" or else n2. *) + val get_relative_opt : t -> t -> t + + (** Return the name of the 'father' (like [dirname] for a file name).*) val father : t -> t end diff --git a/ocamldoc/odoc_messages.ml b/ocamldoc/odoc_messages.ml index 0f72c800a..cef1929c3 100644 --- a/ocamldoc/odoc_messages.ml +++ b/ocamldoc/odoc_messages.ml @@ -240,6 +240,11 @@ let merge_options = let initially_opened_module = " Name of the module that is initially opened" +let library_namespace = + " Name of the library namespace for a prefixed library.\ + Note: very experimental." + + let help = " Display this list of options" diff --git a/ocamldoc/odoc_name.ml b/ocamldoc/odoc_name.ml index 0672b9ba8..7e8d938e2 100644 --- a/ocamldoc/odoc_name.ml +++ b/ocamldoc/odoc_name.ml @@ -185,8 +185,21 @@ let get_relative n1 n2 = else n2 -let stdlib_unprefix s = - let p = "Stdlib__" in +let get_relative_opt n1 n2 = + if n1 = "" then n2 else + if prefix n1 n2 then + let len1 = String.length n1 in + try + String.sub n2 (len1+1) ((String.length n2) - len1 - 1) + with + _ -> n2 + else + n2 + + +let alias_unprefix ln s = + if ln = "" then s else + let p = ln ^ "__" in let n, k = String.(length p, length s) in if k > n && String.sub s 0 n = p then diff --git a/ocamldoc/odoc_name.mli b/ocamldoc/odoc_name.mli index 8aa803b53..5da8d7d41 100644 --- a/ocamldoc/odoc_name.mli +++ b/ocamldoc/odoc_name.mli @@ -44,12 +44,18 @@ val depth : t -> int If the two names are equal, then it is false (strict prefix).*) val prefix : t -> t -> bool -(** remove a [Stdlib__] prefix and capitalize the resulting name *) -val stdlib_unprefix: t -> t +(** remove a [Library__] prefix and capitalize the resulting name *) +val alias_unprefix: t -> t -> t (** Take two names n1 and n2 = n3.n4 and return n4 if n3=n1 or else n2. *) val get_relative : t -> t -> t + +(** [get_relative_opt n1 n2] is [n2] if [n1=""] and + [get_relative n1 n2] otherwise *) +val get_relative_opt : 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 diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index d033e1b71..5c00f6ae1 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -1498,8 +1498,9 @@ module Analyser = begin match sig_module_type with Types.Mty_alias(_, path) -> + let ln = !Odoc_global.library_namespace in let alias_name = Odoc_env.full_module_name env - Name.(stdlib_unprefix @@ from_path path) in + Name.(alias_unprefix ln @@ from_path path) in let ma = { ma_name = alias_name ; ma_module = None } in Module_alias ma | _ ->