7 General format of process output: |
7 General format of process output: |
8 |
8 |
9 (a) unmarked stdout/stderr, no line structure (output should be |
9 (a) unmarked stdout/stderr, no line structure (output should be |
10 processed immediately as it arrives) |
10 processed immediately as it arrives) |
11 |
11 |
12 (b) echo of my pid on stdout, appears *relatively* early after |
12 (b) properly marked-up messages, e.g. for writeln channel |
13 startup on a separate line, e.g. "\nPID=4711\n" |
|
14 |
|
15 (c) properly marked-up messages, e.g. for writeln channel |
|
16 |
13 |
17 "\002A" ^ props ^ "\002,\n" ^ text ^ "\002.\n" |
14 "\002A" ^ props ^ "\002,\n" ^ text ^ "\002.\n" |
18 |
15 |
19 where the props consist of name=value lines terminated by "\002," |
16 where the props consist of name=value lines terminated by "\002,\n" |
20 each, and the remaining text is any number of lines (output is |
17 each, and the remaining text is any number of lines (output is |
21 supposed to be processed in one piece). |
18 supposed to be processed in one piece). |
|
19 |
|
20 (c) Special init message holds "pid" and "session" property. |
22 *) |
21 *) |
23 |
22 |
24 signature ISABELLE_PROCESS = |
23 signature ISABELLE_PROCESS = |
25 sig |
24 sig |
26 val test_markupN: string |
25 val test_markupN: string |
41 enclose "</" ">" name); |
40 enclose "</" ">" name); |
42 |
41 |
43 val _ = Markup.add_mode test_markupN test_markup; |
42 val _ = Markup.add_mode test_markupN test_markup; |
44 |
43 |
45 |
44 |
46 (* channels *) |
45 (* symbol output *) |
47 |
46 |
48 val isabelle_processN = "isabelle_process"; |
47 val isabelle_processN = "isabelle_process"; |
49 |
48 |
50 local |
49 local |
51 |
50 |
52 fun special c = chr 2 ^ c; |
51 fun output str = |
|
52 let |
|
53 fun out s = if Symbol.is_raw s then Symbol.decode_raw s else XML.text s; |
|
54 val syms = Symbol.explode str; |
|
55 in (implode (map out syms), Symbol.length syms) end; |
|
56 |
|
57 in |
|
58 |
|
59 val _ = Output.add_mode isabelle_processN output Symbol.encode_raw; |
|
60 |
|
61 end; |
|
62 |
|
63 |
|
64 (* message markup *) |
|
65 |
|
66 val STX = chr 2; |
|
67 val DEL = chr 127; |
|
68 |
|
69 fun special ch = STX ^ ch; |
53 val special_sep = special ","; |
70 val special_sep = special ","; |
54 val special_end = special "."; |
71 val special_end = special "."; |
55 |
72 |
56 fun position_props () = |
73 local |
57 let val props = Position.properties_of (Position.thread_data ()) |
|
58 in implode (map (fn (x, y) => x ^ "=" ^ y ^ special_sep ^ "\n") props) end; |
|
59 |
74 |
60 fun output ch markup txt = |
75 fun print_props props = |
61 Output.writeln_default (special ch ^ position_props () ^ Markup.enclose markup txt ^ special_end); |
76 let |
|
77 val clean = translate_string (fn c => |
|
78 if c = STX orelse c = "\n" orelse c = "\r" then DEL else c); |
|
79 in implode (map (fn (x, y) => clean x ^ "=" ^ clean y ^ special_sep ^ "\n") props) end; |
|
80 |
|
81 fun get_pos (elem as XML.Elem (name, atts, ts)) = |
|
82 if name = Markup.positionN then SOME (Position.of_properties atts) |
|
83 else get_first get_pos ts |
|
84 | get_pos _ = NONE; |
62 |
85 |
63 in |
86 in |
64 |
87 |
65 fun setup_channels () = |
88 fun message ch markup raw_txt = |
66 (Output.writeln_fn := output "A" Markup.writeln; |
89 let |
67 Output.priority_fn := output "B" Markup.priority; |
90 val (txt, pos) = |
68 Output.tracing_fn := output "C" Markup.tracing; |
91 (case try XML.tree_of_string (XML.element "message" [] [raw_txt]) of |
69 Output.warning_fn := output "D" Markup.warning; |
92 NONE => (raw_txt, Position.none) |
70 Output.error_fn := output "E" Markup.error; |
93 | SOME xml => (XML.plain_content xml, the_default Position.none (get_pos xml))) |
71 Output.debug_fn := output "F" Markup.debug); |
94 |>> translate_string (fn c => if c = STX then DEL else c); |
|
95 val props = |
|
96 (case Position.properties_of (Position.thread_data ()) of |
|
97 [] => Position.properties_of pos |
|
98 | props => props); |
|
99 val s = special ch ^ print_props props ^ Markup.enclose markup txt ^ special_end; |
|
100 in Output.writeln_default s end; |
72 |
101 |
73 val _ = Markup.add_mode isabelle_processN (fn (name, _) => |
102 fun init_message () = |
74 if name = Markup.promptN then (special "G", special_end ^ "\n") |
103 let |
75 else ("", "")); |
104 val pid = string_of_pid (Posix.ProcEnv.getpid ()); |
|
105 val session = List.last (Session.id ()) handle List.Empty => "unknown"; |
|
106 val welcome = Session.welcome (); |
|
107 val s = special "H" ^ print_props [("pid", pid), ("session", session)] ^ welcome ^ special_end; |
|
108 in Output.writeln_default s end; |
76 |
109 |
77 end; |
110 end; |
|
111 |
|
112 |
|
113 (* channels *) |
|
114 |
|
115 fun setup_channels () = |
|
116 (Output.writeln_fn := message "A" Markup.writeln; |
|
117 Output.priority_fn := message "B" Markup.priority; |
|
118 Output.tracing_fn := message "C" Markup.tracing; |
|
119 Output.warning_fn := message "D" Markup.warning; |
|
120 Output.error_fn := message "E" Markup.error; |
|
121 Output.debug_fn := message "F" Markup.debug); |
|
122 |
|
123 val _ = Markup.add_mode isabelle_processN (fn (name, props) => |
|
124 if name = Markup.promptN then (special "G", special_end ^ "\n") |
|
125 else if name = Markup.positionN then test_markup (name, props) |
|
126 else ("", "")); |
78 |
127 |
79 |
128 |
80 (* init *) |
129 (* init *) |
81 |
130 |
82 fun init () = |
131 fun init () = |
83 (Output.writeln_default ("\nPID=" ^ string_of_pid (Posix.ProcEnv.getpid ())); |
132 (change print_mode (update (op =) isabelle_processN); |
84 setup_channels (); |
133 setup_channels (); |
85 change print_mode (update (op =) isabelle_processN); |
134 init_message (); |
86 Isar.secure_main ()); |
135 Isar.secure_main ()); |
87 |
136 |
88 end; |
137 end; |
89 |
138 |