87 |
87 |
88 local |
88 local |
89 |
89 |
90 fun chunk s = [string_of_int (size s), "\n", s]; |
90 fun chunk s = [string_of_int (size s), "\n", s]; |
91 |
91 |
92 fun message do_flush mbox ch raw_props body = |
92 fun message do_flush mbox name raw_props body = |
93 let |
93 let |
94 val robust_props = map (pairself YXML.embed_controls) raw_props; |
94 val robust_props = map (pairself YXML.embed_controls) raw_props; |
95 val header = YXML.string_of (XML.Elem ((ch, robust_props), [])); |
95 val header = YXML.string_of (XML.Elem ((name, robust_props), [])); |
96 in Mailbox.send mbox (chunk header @ chunk body, do_flush) end; |
96 in Mailbox.send mbox (chunk header @ chunk body, do_flush) end; |
97 |
97 |
98 fun standard_message mbox opt_serial ch body = |
98 fun standard_message mbox opt_serial name body = |
99 if body = "" then () |
99 if body = "" then () |
100 else |
100 else |
101 message false mbox ch |
101 message false mbox name |
102 ((case opt_serial of SOME i => cons (Isabelle_Markup.serialN, string_of_int i) | _ => I) |
102 ((case opt_serial of SOME i => cons (Isabelle_Markup.serialN, string_of_int i) | _ => I) |
103 (Position.properties_of (Position.thread_data ()))) body; |
103 (Position.properties_of (Position.thread_data ()))) body; |
104 |
104 |
105 fun message_output mbox channel = |
105 fun message_output mbox channel = |
106 let |
106 let |
122 val _ = TextIO.StreamIO.setBufferMode (TextIO.getOutstream TextIO.stdErr, IO.LINE_BUF); |
122 val _ = TextIO.StreamIO.setBufferMode (TextIO.getOutstream TextIO.stdErr, IO.LINE_BUF); |
123 |
123 |
124 val mbox = Mailbox.create () : (string list * bool) Mailbox.T; |
124 val mbox = Mailbox.create () : (string list * bool) Mailbox.T; |
125 val _ = Simple_Thread.fork false (message_output mbox channel); |
125 val _ = Simple_Thread.fork false (message_output mbox channel); |
126 in |
126 in |
127 Output.Private_Hooks.status_fn := standard_message mbox NONE "B"; |
127 Output.Private_Hooks.status_fn := standard_message mbox NONE Isabelle_Markup.statusN; |
128 Output.Private_Hooks.report_fn := standard_message mbox NONE "C"; |
128 Output.Private_Hooks.report_fn := standard_message mbox NONE Isabelle_Markup.reportN; |
129 Output.Private_Hooks.writeln_fn := (fn s => standard_message mbox (SOME (serial ())) "D" s); |
129 Output.Private_Hooks.writeln_fn := |
|
130 (fn s => standard_message mbox (SOME (serial ())) Isabelle_Markup.writelnN s); |
130 Output.Private_Hooks.tracing_fn := |
131 Output.Private_Hooks.tracing_fn := |
131 (fn s => (update_tracing_limits s; standard_message mbox (SOME (serial ())) "E" s)); |
132 (fn s => |
132 Output.Private_Hooks.warning_fn := (fn s => standard_message mbox (SOME (serial ())) "F" s); |
133 (update_tracing_limits s; |
133 Output.Private_Hooks.error_fn := (fn (i, s) => standard_message mbox (SOME i) "G" s); |
134 standard_message mbox (SOME (serial ())) Isabelle_Markup.tracingN s)); |
134 Output.Private_Hooks.protocol_message_fn := message true mbox "H"; |
135 Output.Private_Hooks.warning_fn := |
|
136 (fn s => standard_message mbox (SOME (serial ())) Isabelle_Markup.warningN s); |
|
137 Output.Private_Hooks.error_fn := |
|
138 (fn (i, s) => standard_message mbox (SOME i) Isabelle_Markup.errorN s); |
|
139 Output.Private_Hooks.protocol_message_fn := message true mbox Isabelle_Markup.protocolN; |
135 Output.Private_Hooks.urgent_message_fn := ! Output.Private_Hooks.writeln_fn; |
140 Output.Private_Hooks.urgent_message_fn := ! Output.Private_Hooks.writeln_fn; |
136 Output.Private_Hooks.prompt_fn := ignore; |
141 Output.Private_Hooks.prompt_fn := ignore; |
137 message true mbox "A" [] (Session.welcome ()) |
142 message true mbox Isabelle_Markup.initN [] (Session.welcome ()) |
138 end; |
143 end; |
139 |
144 |
140 end; |
145 end; |
141 |
146 |
142 |
147 |