--- a/src/Pure/General/completion.ML Wed Mar 25 13:45:52 2015 +0100
+++ b/src/Pure/General/completion.ML Wed Mar 25 14:39:40 2015 +0100
@@ -9,6 +9,7 @@
type T
val names: Position.T -> (string * (string * string)) list -> T
val none: T
+ val make: string * Position.T -> ((string -> bool) -> (string * (string * string)) list) -> T
val reported_text: T -> string
val suppress_abbrevs: string -> Markup.T list
end;
@@ -16,12 +17,12 @@
structure Completion: COMPLETION =
struct
+(* completion of names *)
+
abstype T =
Completion of {pos: Position.T, total: int, names: (string * (string * string)) list}
with
-(* completion of names *)
-
fun dest (Completion args) = args;
fun names pos names =
@@ -34,6 +35,11 @@
val none = names Position.none [];
+fun make (name, pos) make_names =
+ if Position.is_reported pos andalso name <> "" andalso name <> "_"
+ then names pos (make_names (String.isPrefix (Name.clean name)))
+ else none;
+
fun reported_text completion =
let val {pos, total, names} = dest completion in
if Position.is_reported pos andalso not (null names) then
--- a/src/Pure/General/name_space.ML Wed Mar 25 13:45:52 2015 +0100
+++ b/src/Pure/General/name_space.ML Wed Mar 25 14:39:40 2015 +0100
@@ -232,7 +232,7 @@
(* completion *)
fun completion context space (xname, pos) =
- if Position.is_reported pos andalso xname <> "" andalso xname <> "_" then
+ Completion.make (xname, pos) (fn completed =>
let
fun result_ord ((xname1, (_, name1)), (xname2, (_, name2))) =
(case bool_ord (apply2 Long_Name.is_local (name2, name1)) of
@@ -241,21 +241,18 @@
EQUAL => string_ord (xname1, xname2)
| ord => ord)
| ord => ord);
- val x = Name.clean xname;
val Name_Space {kind, internals, ...} = space;
val ext = extern_shortest (Context.proof_of context) space;
- val names =
- Change_Table.fold
- (fn (a, (name :: _, _)) =>
- if String.isPrefix x a andalso not (is_concealed space name)
- then
- let val a' = ext name
- in if a = a' then cons (a', (kind, name)) else I end
- else I
- | _ => I) internals []
- |> sort_distinct result_ord;
- in Completion.names pos names end
- else Completion.none;
+ in
+ Change_Table.fold
+ (fn (a, (name :: _, _)) =>
+ if completed a andalso not (is_concealed space name) then
+ let val a' = ext name
+ in if a = a' then cons (a', (kind, name)) else I end
+ else I
+ | _ => I) internals []
+ |> sort_distinct result_ord
+ end);
(* merge *)
--- a/src/Pure/ML/ml_antiquotations.ML Wed Mar 25 13:45:52 2015 +0100
+++ b/src/Pure/ML/ml_antiquotations.ML Wed Mar 25 14:39:40 2015 +0100
@@ -37,8 +37,19 @@
val _ = Theory.setup
(ML_Antiquotation.value @{binding system_option}
(Args.context -- Scan.lift (Parse.position Args.name) >> (fn (ctxt, (name, pos)) =>
- (Context_Position.report ctxt pos (Options.default_markup (name, pos));
- ML_Syntax.print_string name))) #>
+ let
+ val markup =
+ Options.default_markup (name, pos) handle ERROR msg =>
+ let
+ val completion =
+ Completion.make (name, pos) (fn completed =>
+ Options.names (Options.default ())
+ |> filter completed
+ |> map (fn a => (a, ("system_option", a))));
+ val report = Markup.markup_report (Completion.reported_text completion);
+ in cat_error msg report end;
+ val _ = Context_Position.report ctxt pos markup;
+ in ML_Syntax.print_string name end)) #>
ML_Antiquotation.value @{binding theory}
(Args.context -- Scan.lift (Parse.position Args.name) >> (fn (ctxt, (name, pos)) =>
--- a/src/Pure/System/options.ML Wed Mar 25 13:45:52 2015 +0100
+++ b/src/Pure/System/options.ML Wed Mar 25 14:39:40 2015 +0100
@@ -13,6 +13,7 @@
val unknownT: string
type T
val empty: T
+ val names: T -> string list
val markup: T -> string * Position.T -> Markup.T
val typ: T -> string -> string
val bool: T -> string -> bool
@@ -59,6 +60,8 @@
val empty = Options Symtab.empty;
+fun names (Options tab) = sort_strings (Symtab.keys tab);
+
(* check *)