# HG changeset patch # User wenzelm # Date 1368540266 -7200 # Node ID 378ecac28f33b73b6af21bc41a7aa783dc366cd3 # Parent 32692ce4c61aff48dfd2e12cbf1323175285f0c3 misc tuning and simplification; diff -r 32692ce4c61a -r 378ecac28f33 src/Pure/ProofGeneral/proof_general_pgip.ML --- a/src/Pure/ProofGeneral/proof_general_pgip.ML Tue May 14 15:40:18 2013 +0200 +++ b/src/Pure/ProofGeneral/proof_general_pgip.ML Tue May 14 16:04:26 2013 +0200 @@ -1,8 +1,7 @@ (* Title: Pure/ProofGeneral/proof_general_pgip.ML Author: David Aspinall and Markus Wenzel -Isabelle configuration for Proof General using PGIP protocol. -See http://proofgeneral.inf.ed.ac.uk/kit +Rudiments of PGIP for ProofGeneral preferences. *) signature PROOF_GENERAL_PGIP = @@ -13,37 +12,24 @@ structure ProofGeneralPgip : PROOF_GENERAL_PGIP = struct -(* assembling and issuing PGIP packets *) - -val pgip_refid = Unsynchronized.ref NONE: string option Unsynchronized.ref; -val pgip_refseq = Unsynchronized.ref NONE: int option Unsynchronized.ref; +(* output PGIP packets *) -local - val pgip_class = "pg" - val pgip_tag = "Isabelle/Isar" - val pgip_id = "dummy" - val pgip_seq = Unsynchronized.ref 0 - fun pgip_serial () = Unsynchronized.inc pgip_seq +val pgip_id = "dummy"; +val pgip_serial = Synchronized.counter (); - fun assemble_pgip content = - XML.Elem(("pgip", - [("tag", pgip_tag), ("id", pgip_id)] @ - PgipTypes.opt_attr "destid" (! pgip_refid) @ - [("class", pgip_class)] @ - PgipTypes.opt_attr "refid" (! pgip_refid) @ - PgipTypes.opt_attr_map string_of_int "refseq" (! pgip_refseq) @ - [("seq", string_of_int (pgip_serial ()))]), - content) -in - -fun matching_pgip_id id = (id = pgip_id) - -fun output_pgip content = Output.urgent_message (XML.string_of (assemble_pgip content)); - -end; +fun output_pgip refid refseq content = + XML.Elem (("pgip", + [("tag", "Isabelle/Isar"), ("id", pgip_id)] @ + PgipTypes.opt_attr "destid" refid @ + [("class", "pg")] @ + PgipTypes.opt_attr "refid" refid @ + [("refseq", refseq)] @ + [("seq", string_of_int (pgip_serial ()))]), content) + |> XML.string_of + |> Output.urgent_message; -(* Preferences: tweak for PGIP interfaces *) +(* preferences *) val preferences = Unsynchronized.ref Preferences.pure_preferences; @@ -56,7 +42,7 @@ | NONE => error ("Unknown prover preference: " ^ quote pref)); -(** PGIP/Emacs rudiments **) +(* process_pgip *) local @@ -66,10 +52,11 @@ XML.Elem (("haspref", [("name", name), ("descr", descr), ("default", default)]), [PgipTypes.pgiptype_to_xml pgiptype]); -fun process_element_emacs (XML.Elem (("askprefs", _), _)) = +fun process_element refid refseq (XML.Elem (("askprefs", _), _)) = ! preferences |> List.app (fn (category, prefs) => - output_pgip [XML.Elem (("hasprefs", [("prefcategory", category)]), map haspref prefs)]) - | process_element_emacs (XML.Elem (("setpref", attrs), data)) = + output_pgip refid refseq + [XML.Elem (("hasprefs", [("prefcategory", category)]), map haspref prefs)]) + | process_element _ _ (XML.Elem (("setpref", attrs), data)) = let val name = (case Properties.get attrs "name" of @@ -77,39 +64,30 @@ | NONE => invalid_pgip ()); val value = XML.content_of data; in set_preference name value end - | process_element_emacs _ = invalid_pgip (); + | process_element _ _ _ = invalid_pgip (); + +fun process_pgip str = + (case XML.parse str of + XML.Elem (("pgip", attrs), pgips) => + let + val class = PgipTypes.get_attr "class" attrs; + val dest = PgipTypes.get_attr_opt "destid" attrs; + val refid = PgipTypes.get_attr_opt "id" attrs; + val refseq = PgipTypes.get_attr "seq" attrs; + val processit = + (case dest of + NONE => class = "pa" + | SOME id => id = pgip_id); + in if processit then List.app (process_element refid refseq) pgips else () end + | _ => invalid_pgip ()) + handle PgipTypes.PGIP msg => error (msg ^ "\n" ^ str); in -fun process_pgip_emacs str = - let - val _ = pgip_refid := NONE; - val _ = pgip_refseq := NONE; - in - (case XML.parse str of - XML.Elem (("pgip", attrs), pgips) => - let - val class = PgipTypes.get_attr "class" attrs; - val dest = PgipTypes.get_attr_opt "destid" attrs; - val seq = PgipTypes.read_pgipnat (PgipTypes.get_attr "seq" attrs); - val processit = - (case dest of - NONE => class = "pa" - | SOME id => matching_pgip_id id); - in - if processit then - (pgip_refid := PgipTypes.get_attr_opt "id" attrs; - pgip_refseq := SOME seq; - List.app process_element_emacs pgips) - else () - end - | _ => invalid_pgip ()) - end handle PgipTypes.PGIP msg => error (msg ^ "\n" ^ str); - val _ = Outer_Syntax.improper_command (("ProofGeneral.process_pgip", Keyword.control), Position.none) "(internal)" - (Parse.text >> (fn str => Toplevel.imperative (fn () => process_pgip_emacs str))); + (Parse.text >> (fn str => Toplevel.imperative (fn () => process_pgip str))); end;