src/Pure/PIDE/resources.ML
changeset 67493 c4e9e0c50487
parent 67473 aad088768872
child 68088 0763d4eb3ebc
--- a/src/Pure/PIDE/resources.ML	Tue Jan 23 17:58:09 2018 +0100
+++ b/src/Pure/PIDE/resources.ML	Tue Jan 23 19:25:39 2018 +0100
@@ -8,8 +8,8 @@
 sig
   val default_qualifier: string
   val init_session_base:
-    {sessions: string list,
-     doc_names: string list,
+    {sessions: (string * Properties.T) list,
+     docs: string list,
      global_theories: (string * string) list,
      loaded_theories: string list,
      known_theories: (string * string) list} -> unit
@@ -45,9 +45,14 @@
 
 val default_qualifier = "Draft";
 
+type entry = {pos: Position.T, serial: serial};
+
+fun make_entry props : entry =
+  {pos = Position.of_properties props, serial = serial ()};
+
 val empty_session_base =
-  {sessions = []: string list,
-   doc_names = []: string list,
+  {sessions = []: (string * entry) list,
+   docs = []: (string * entry) list,
    global_theories = Symtab.empty: string Symtab.table,
    loaded_theories = Symtab.empty: unit Symtab.table,
    known_theories = Symtab.empty: Path.T Symtab.table};
@@ -55,11 +60,11 @@
 val global_session_base =
   Synchronized.var "Sessions.base" empty_session_base;
 
-fun init_session_base {sessions, doc_names, global_theories, loaded_theories, known_theories} =
+fun init_session_base {sessions, docs, global_theories, loaded_theories, known_theories} =
   Synchronized.change global_session_base
     (fn _ =>
-      {sessions = sort_strings sessions,
-       doc_names = doc_names,
+      {sessions = sort_by #1 (map (apsnd make_entry) sessions),
+       docs = sort_by #1 (map (apsnd make_entry o rpair []) docs),
        global_theories = Symtab.make global_theories,
        loaded_theories = Symtab.make_set loaded_theories,
        known_theories = Symtab.make (map (apsnd Path.explode) known_theories)});
@@ -68,7 +73,7 @@
   Synchronized.change global_session_base
     (fn {global_theories, loaded_theories, ...} =>
       {sessions = [],
-       doc_names = [],
+       docs = [],
        global_theories = global_theories,
        loaded_theories = loaded_theories,
        known_theories = #known_theories empty_session_base});
@@ -80,23 +85,28 @@
 fun known_theory a = Symtab.lookup (get_session_base #known_theories) a;
 
 fun check_name which kind markup ctxt (name, pos) =
-  let val names = get_session_base which in
-    if member (op =) names name then
-      (Context_Position.report ctxt pos (markup name); name)
-    else
-      let
-        val completion =
-          Completion.make (name, pos) (fn completed =>
-              names
-              |> filter completed
-              |> sort_strings
-              |> map (fn a => (a, (kind, a))));
-        val report = Markup.markup_report (Completion.reported_text completion);
-      in error ("Bad " ^ kind ^ " " ^ quote name ^ Position.here pos ^ report) end
+  let val entries = get_session_base which in
+    (case AList.lookup (op =) entries name of
+      SOME entry => (Context_Position.report ctxt pos (markup name entry); name)
+    | NONE =>
+        let
+          val completion =
+            Completion.make (name, pos) (fn completed =>
+                entries
+                |> map #1
+                |> filter completed
+                |> sort_strings
+                |> map (fn a => (a, (kind, a))));
+          val report = Markup.markup_report (Completion.reported_text completion);
+        in error ("Bad " ^ kind ^ " " ^ quote name ^ Position.here pos ^ report) end)
   end;
 
-val check_session = check_name #sessions "session" (Markup.entity Markup.sessionN);
-val check_doc = check_name #doc_names "documentation" Markup.doc;
+fun markup_session name {pos, serial} =
+  Markup.properties
+    (Position.entity_properties_of false serial pos) (Markup.entity Markup.sessionN name);
+
+val check_session = check_name #sessions "session" markup_session;
+val check_doc = check_name #docs "documentation" (fn name => fn _ => Markup.doc name);