better support for revised syntax

Ignore-this: a75d11960fc1daa6c8838f0e00747333

darcs-hash:20120223105439-c41ad-1904218737a1b71fdadc159f606f5c2ca58cfed9
This commit is contained in:
Jeremie Dimino 2012-02-23 11:54:39 +01:00
parent d8dae4ac5f
commit b6c3d44ac2
3 changed files with 71 additions and 25 deletions

View File

@ -454,32 +454,46 @@ let handle_findlib_error = function
| exn ->
raise exn
let () =
Hashtbl.add
Toploop.directive_table
"camlp4o"
(Toploop.Directive_none
(fun () ->
let set_syntax syntax =
match get_syntax (), syntax with
| Normal, Normal
| Camlp4o, Camlp4o
| Camlp4r, Camlp4r ->
()
| (Camlp4o | Camlp4r), _ ->
Lwt_main.run (print_error "Camlp4 already loaded, you cannot change the syntax now.\n")
| Normal, Camlp4o -> begin
set_syntax Camlp4o;
set_phrase_terminator ";;";
try
Topfind.syntax "camlp4o";
Topfind.load_deeply ["utop.camlp4"]
with exn ->
handle_findlib_error exn));
handle_findlib_error exn
end
| Normal, Camlp4r -> begin
set_syntax Camlp4r;
set_phrase_terminator ";";
add_keyword "value";
try
Topfind.syntax "camlp4r";
Topfind.load_deeply ["utop.camlp4"]
with exn ->
handle_findlib_error exn
end
let () =
Hashtbl.add
Toploop.directive_table
"camlp4o"
(Toploop.Directive_none
(fun () -> set_syntax Camlp4o));
Hashtbl.add
Toploop.directive_table
"camlp4r"
(Toploop.Directive_none
(fun () ->
set_syntax Camlp4r;
set_phrase_terminator ";";
try
Topfind.syntax "camlp4r";
Topfind.load_deeply ["utop.camlp4"]
with exn ->
handle_findlib_error exn))
(fun () -> set_syntax Camlp4r))
(* +-----------------------------------------------------------------+
| Initialization |

View File

@ -41,13 +41,21 @@ type syntax =
val syntax : syntax signal
(** The syntax in use. If it is {!Camlp4o} or {!Camlp4r} quotations
are recognized. It is modified when you type [#camlp4o] or
[#camlp4r]. *)
[#camlp4r]. At the beginning it is {!Normal}. *)
val get_syntax : unit -> syntax
(** Returns the current value of {!syntax}. *)
val set_syntax : syntax -> unit
(** Modifies {!syntax}. *)
(** Changes the syntax used in utop. If the syntax is the same as
the current one, it does nothing. Otherwise it loads camlp4 and
setup several configuration variables.
Notes:
- the syntax can only be changed once. Once you set it to
{!Camlp4o} or {!Camlp4r} you cannot change it again.
- Typing [#camlp4o] is the same as calling [set_syntax Camlp4o].
- Typing [#camlp4r] is the same as calling [set_syntax Camlp4r]. *)
val phrase_terminator : string signal
(** The phrase terminator. It is ";;" by default and ";" when you

View File

@ -514,6 +514,23 @@ let reset () =
local_fields_by_path := Path_map.empty;
local_fields_by_longident := Longident_map.empty
let replace x y set =
if String_set.mem x set then
String_set.add y (String_set.remove x set)
else
set
let global_names syntax =
let set = Lazy.force !global_names in
match syntax with
| UTop.Normal | UTop.Camlp4o ->
set
| UTop.Camlp4r ->
replace "true" "True" (replace "false" "False" set)
let global_fields () =
Lazy.force !global_fields
(* +-----------------------------------------------------------------+
| Listing methods |
+-----------------------------------------------------------------+ *)
@ -676,6 +693,13 @@ and find_context_in_quotation = function
+-----------------------------------------------------------------+ *)
let complete ~syntax ~phrase_terminator ~input =
let true_name, false_name =
match syntax with
| UTop.Normal | UTop.Camlp4o ->
("true", "false")
| UTop.Camlp4r ->
("True", "False")
in
let tokens = UTop_lexer.lex_string syntax input in
(* Filter blanks and comments. *)
let tokens = filter tokens in
@ -765,9 +789,9 @@ let complete ~syntax ~phrase_terminator ~input =
match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
| Some (Toploop.Directive_none _) -> [(phrase_terminator, "")]
| Some (Toploop.Directive_string _) -> [(" \"", "")]
| Some (Toploop.Directive_bool _) -> [("true", phrase_terminator); ("false", phrase_terminator)]
| Some (Toploop.Directive_bool _) -> [(true_name, phrase_terminator); (false_name, phrase_terminator)]
| Some (Toploop.Directive_int _) -> []
| Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (Lazy.force !global_names))
| Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (global_names syntax))
| None -> [])
| (Symbol "#", _) :: ((Lident dir | Uident dir), _) :: tokens -> begin
match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
@ -778,7 +802,7 @@ let complete ~syntax ~phrase_terminator ~input =
| Some (Toploop.Directive_bool _) -> begin
match tokens with
| [(Lident id, { idx1 = start })] ->
(start, lookup_assoc id [("true", phrase_terminator); ("false", phrase_terminator)])
(start, lookup_assoc id [(true_name, phrase_terminator); (false_name, phrase_terminator)])
| _ ->
(0, [])
end
@ -787,7 +811,7 @@ let complete ~syntax ~phrase_terminator ~input =
| Some (Toploop.Directive_ident _) -> begin
match parse_longident (List.rev tokens) with
| Some (Value, None, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (Lazy.force !global_names))))
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (global_names syntax))))
| Some (Value, Some longident, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
| _ ->
@ -803,7 +827,7 @@ let complete ~syntax ~phrase_terminator ~input =
| None ->
(0, [])
| Some [] ->
(0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (Lazy.force !global_names))))
(0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (global_names syntax))))
| Some tokens ->
match parse_method tokens with
| Some (longident, meths, start, meth) ->
@ -823,10 +847,10 @@ let complete ~syntax ~phrase_terminator ~input =
| None ->
(0, [])
| Some (Value, None, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (String_set.union !UTop.keywords (Lazy.force !global_names)))))
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (String_set.union !UTop.keywords (global_names syntax)))))
| Some (Value, Some longident, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
| Some (Field, None, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (Lazy.force !global_fields))))
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (global_fields ()))))
| Some (Field, Some longident, start, id) ->
(start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (fields_of_module longident))))