diff --git a/libs/dunextract.ml b/libs/dunextract.ml new file mode 100644 index 0000000..442e9cd --- /dev/null +++ b/libs/dunextract.ml @@ -0,0 +1,124 @@ +(**************************************************************************) +(* *) +(* Copyright 2021 OCamlPro *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the Lesser GNU Public License version 3.0. *) +(* *) +(* This software is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) +(* Lesser GNU General Public License for more details. *) +(* *) +(**************************************************************************) + +type sexp = A of string | T of sexp list + +let atom str i = + let rec escaped j = + if j >= String.length str then j + else match str.[j] with + | '"' -> j+1 + | '\\' -> escaped (j+2) + | _ -> escaped (j+1) + in + let rec unescaped j = + if j >= String.length str then j + else match str.[j] with + | ' ' | '\n' | '\t' | '\r' | '(' | ')' -> j + | '\\' -> unescaped (j+2) + | _ -> unescaped (j+1) + in + let j = match str.[i] with + | '"' -> escaped (i+1) + | _ -> unescaped (i+1) + in + j, String.sub str i (j - i) + +let rec sexp_parse str i = + if i >= String.length str then i, [] + else + match str.[i] with + | ' ' | '\n' | '\t' | '\r' -> sexp_parse str (i+1) + | '(' -> + let i, t1 = sexp_parse str (i+1) in + let i, t = sexp_parse str i in + i, T t1 :: t + | ')' -> i+1, [] + | ';' -> + let i = + try String.index_from str (i+1) '\n' + 1 + with Not_found -> String.length str + in + sexp_parse str i + | _ -> + let i, a = atom str i in + let i, t = sexp_parse str i in + i, A a :: t + +let rec cut_list a acc = function + | x :: r -> if x = a then acc, r else cut_list a (x::acc) r + | [] -> acc, [] + +let module_eq name = function + | A n -> IndexMisc.capitalize n = name + | _ -> false + +let rec get_lib_name modname = function + | T (A "library" :: t) :: r -> + if List.mem (T [A "wrapped"; A "false"]) t then get_lib_name modname r + else + let libname = + match + List.find_opt (function T (A "name" :: _) -> true | _ -> false) t + with + | Some (T [_; A name]) -> name + | _ -> "" + in + (match + List.find_opt (function T ( A "modules" :: _) -> true | _ -> false) t + with + | None -> Some libname + | Some (T (_ :: ms)) -> + let inc, exc = cut_list (A "\\") [] ms in + if not (List.exists (module_eq modname) exc) && + List.exists (fun n -> module_eq modname n || n = A ":standard") + inc + then Some libname + else + get_lib_name modname r + | Some _ -> assert false) + | _ :: r -> get_lib_name modname r + | [] -> None + +let string_of_channel ic = + let n = 4096 in + let s = Bytes.create n in + let b = Buffer.create 1024 in + let rec iter ic b s = + let nread = + try input ic s 0 n + with End_of_file -> 0 in + if nread > 0 then ( + Buffer.add_subbytes b s 0 nread; + iter ic b s + ) in + iter ic b s; + Buffer.contents b + +let read_dune dir = + try + let ic = open_in (Filename.concat dir "dune") in + let s = string_of_channel ic in + let r = sexp_parse s 0 in + close_in ic; + Some r + with Sys_error _ -> None + +let get_libname file = + let modname = + IndexMisc.capitalize (Filename.(basename (remove_extension file))) + in + match read_dune (Filename.dirname file) with + | Some (_, sexp) -> get_lib_name modname sexp + | None -> None diff --git a/libs/dunextract.mli b/libs/dunextract.mli new file mode 100644 index 0000000..a4fdfd2 --- /dev/null +++ b/libs/dunextract.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* Copyright 2021 OCamlPro *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the Lesser GNU Public License version 3.0. *) +(* *) +(* This software is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) +(* Lesser GNU General Public License for more details. *) +(* *) +(**************************************************************************) + +(** Looks up a 'dune' file in the dirname of the given file, and attempts to + extract the name of the (wrapped) library the module belongs to. *) +val get_libname: string -> string option diff --git a/libs/indexBuild.ml b/libs/indexBuild.ml index b960db5..9a9e7a8 100644 --- a/libs/indexBuild.ml +++ b/libs/indexBuild.ml @@ -1233,13 +1233,8 @@ let load_files t dirfiles = try let i = String.rindex file '.' in let len = String.length file in -#if OCAML_VERSION >= (4,03,0) - let modul = String.capitalize_ascii (String.sub file 0 i) in - let ext = String.lowercase_ascii (String.sub file (i+1) (len-i-1)) in -#else - let modul = String.capitalize (String.sub file 0 i) in - let ext = String.lowercase (String.sub file (i+1) (len-i-1)) in -#endif + let modul = capitalize (String.sub file 0 i) in + let ext = lowercase (String.sub file (i+1) (len-i-1)) in modul, ext with Not_found -> file, "" in diff --git a/libs/indexMisc.ml b/libs/indexMisc.ml index 509df51..ab68f7c 100644 --- a/libs/indexMisc.ml +++ b/libs/indexMisc.ml @@ -185,3 +185,17 @@ let project_root ?(path=Sys.getcwd()) () = match find path with | None -> None, None | Some (root, build) -> Some root, Some build + +let capitalize = +#if OCAML_VERSION >= (4,03,0) + String.capitalize_ascii +#else + String.capitalize +#endif + +let lowercase = +#if OCAML_VERSION >= (4,03,0) + String.lowercase_ascii +#else + String.lowercase +#endif diff --git a/libs/indexMisc.mli b/libs/indexMisc.mli index 2e72679..e9f9f4d 100644 --- a/libs/indexMisc.mli +++ b/libs/indexMisc.mli @@ -55,3 +55,9 @@ val find_build_dir: string -> string option (** Shorten [file] by making it relative to current [path] (default cwd) *) val make_relative: ?path:string -> string -> string + +(** [String.capitalize_ascii], but compatibile across OCaml versions *) +val capitalize: string -> string + +(** [String.lowercase_ascii], but compatibile across OCaml versions *) +val lowercase: string -> string diff --git a/src/indexOptions.ml b/src/indexOptions.ml index d314965..734c601 100644 --- a/src/indexOptions.ml +++ b/src/indexOptions.ml @@ -268,10 +268,15 @@ let common_opts ?(default_filter = default_filter) () : t Term.t = let chan = match file with Some f -> open_in f | None -> stdin in let scope = IndexScope.read ?line ?column chan in let () = match file with Some _ -> close_in chan | None -> () in - let merlin_open = + let context_opens = match file with - | Some f -> IndexScope.from_dot_merlin (Filename.dirname f) | None -> [] + | Some f -> + match IndexScope.from_dot_merlin (Filename.dirname f) with + | _::_ as opens -> opens + | [] -> match Dunextract.get_libname f with + | Some libname -> [Open [String.capitalize_ascii libname]] + | None -> [] in let info = List.fold_left (fun info -> function @@ -279,7 +284,7 @@ let common_opts ?(default_filter = default_filter) () : t Term.t = LibIndex.open_module ~cleanup_path:true info path | IndexScope.Alias (name,path) -> LibIndex.alias ~cleanup_path:true info path [name]) - info (merlin_open @ IndexScope.to_list scope) + info (context_opens @ IndexScope.to_list scope) in info in