# HG changeset patch # User wenzelm # Date 1426501854 -3600 # Node ID ae322325adbbbbf45eea110f8792a3c01c1d27db # Parent 6da3efec20ca244268286559f65b57cd056a806c tuned protocol -- resolve command positions in ML; diff -r 6da3efec20ca -r ae322325adbb src/Pure/PIDE/protocol.ML --- a/src/Pure/PIDE/protocol.ML Mon Mar 16 11:07:56 2015 +0100 +++ b/src/Pure/PIDE/protocol.ML Mon Mar 16 11:30:54 2015 +0100 @@ -32,11 +32,15 @@ let val (blobs, blobs_index) = YXML.parse_body blobs_yxml |> - let open XML.Decode in + let + val message = + YXML.string_of_body o Protocol_Message.command_positions id; + open XML.Decode; + in pair (list (variant [fn ([], a) => Exn.Res (pair string (option string) a), - fn ([], a) => Exn.Exn (ERROR (YXML.string_of_body a))])) + fn ([], a) => Exn.Exn (ERROR (message a))])) int end; val toks = diff -r 6da3efec20ca -r ae322325adbb src/Pure/PIDE/protocol.scala --- a/src/Pure/PIDE/protocol.scala Mon Mar 16 11:07:56 2015 +0100 +++ b/src/Pure/PIDE/protocol.scala Mon Mar 16 11:30:54 2015 +0100 @@ -307,29 +307,6 @@ def define_blob(digest: SHA1.Digest, bytes: Bytes): Unit = protocol_command_bytes("Document.define_blob", Bytes(digest.toString), bytes) - private def resolve_id(id: String, body: XML.Body): XML.Body = - { - def resolve_property(p: (String, String)): (String, String) = - if (p._1 == Markup.ID && p._2 == Markup.COMMAND) (Markup.ID, id) else p - - def resolve_markup(markup: Markup): Markup = - Markup(markup.name, markup.properties.map(resolve_property)) - - def resolve_tree(t: XML.Tree): XML.Tree = - t match { - case XML.Wrapped_Elem(markup, ts1, ts2) => - XML.Wrapped_Elem(resolve_markup(markup), ts1.map(resolve_tree _), ts2.map(resolve_tree _)) - case XML.Elem(markup, ts) => - XML.Elem(resolve_markup(markup), ts.map(resolve_tree _)) - case text => text - } - body.map(resolve_tree _) - } - - private def resolve_id(id: String, s: String): XML.Body = - try { resolve_id(id, YXML.parse_body(s)) } - catch { case ERROR(_) => XML.Encode.string(s) } - def define_command(command: Command) { val blobs_yxml = @@ -338,7 +315,7 @@ variant(List( { case Exn.Res((a, b)) => (Nil, pair(string, option(string))((a.node, b.map(p => p._1.toString)))) }, - { case Exn.Exn(e) => (Nil, resolve_id(command.id.toString, Exn.message(e))) })) + { case Exn.Exn(e) => (Nil, string(Exn.message(e))) })) YXML.string_of_body(pair(list(encode_blob), int)(command.blobs, command.blobs_index)) } diff -r 6da3efec20ca -r ae322325adbb src/Pure/PIDE/protocol_message.ML --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Pure/PIDE/protocol_message.ML Mon Mar 16 11:30:54 2015 +0100 @@ -0,0 +1,27 @@ +(* Title: Pure/PIDE/protocol_message.ML + Author: Makarius + +Auxiliary operations on protocol messages. +*) + +signature PROTOCOL_MESSAGE = +sig + val command_positions: string -> XML.body -> XML.body + val command_positions_yxml: string -> string -> string +end; + +structure Protocol_Message: PROTOCOL_MESSAGE = +struct + +fun command_positions id = + let + fun attribute (a, b) = + if a = Markup.idN andalso b = Markup.commandN then (a, id) else (a, b); + fun tree (XML.Elem ((a, atts), ts)) = XML.Elem ((a, map attribute atts), map tree ts) + | tree text = text; + in map tree end; + +fun command_positions_yxml id = + YXML.string_of_body o command_positions id o YXML.parse_body; + +end; diff -r 6da3efec20ca -r ae322325adbb src/Pure/ROOT --- a/src/Pure/ROOT Mon Mar 16 11:07:56 2015 +0100 +++ b/src/Pure/ROOT Mon Mar 16 11:30:54 2015 +0100 @@ -172,6 +172,7 @@ "PIDE/execution.ML" "PIDE/markup.ML" "PIDE/protocol.ML" + "PIDE/protocol_message.ML" "PIDE/query_operation.ML" "PIDE/resources.ML" "PIDE/session.ML" diff -r 6da3efec20ca -r ae322325adbb src/Pure/ROOT.ML --- a/src/Pure/ROOT.ML Mon Mar 16 11:07:56 2015 +0100 +++ b/src/Pure/ROOT.ML Mon Mar 16 11:30:54 2015 +0100 @@ -310,6 +310,7 @@ use "PIDE/resources.ML"; use "Thy/thy_info.ML"; use "PIDE/session.ML"; +use "PIDE/protocol_message.ML"; use "PIDE/document.ML"; (*theory and proof operations*)