204 |
204 |
205 |
205 |
206 (* command spans *) |
206 (* command spans *) |
207 |
207 |
208 type command = string * Position.T * string list; (*name, position, tags*) |
208 type command = string * Position.T * string list; (*name, position, tags*) |
209 type tok = string * token * int; (*raw text, token, meta-comment depth*) |
209 type tok = token * string * int; (*token, markup flag, meta-comment depth*) |
210 type source = tok list; |
210 type source = tok list; |
211 |
211 |
212 datatype span = Span of command * (source * source * source * source) * bool; |
212 datatype span = Span of command * (source * source * source * source) * bool; |
213 |
213 |
214 fun make_span cmd src = |
214 fun make_span cmd src = |
215 let |
215 let |
216 fun take_newline ((tok: tok) :: toks) = |
216 fun take_newline ((tok: tok) :: toks) = |
217 if newline_token (#2 tok) then ([tok], toks, true) |
217 if newline_token (#1 tok) then ([tok], toks, true) |
218 else ([], tok :: toks, false) |
218 else ([], tok :: toks, false) |
219 | take_newline [] = ([], [], false); |
219 | take_newline [] = ([], [], false); |
220 val (((src_prefix, src_main), src_suffix1), (src_suffix2, src_appendix, newline)) = |
220 val (((src_prefix, src_main), src_suffix1), (src_suffix2, src_appendix, newline)) = |
221 src |
221 src |
222 |> take_prefix (improper_token o #2) |
222 |> take_prefix (improper_token o #1) |
223 ||>> take_suffix (improper_token o #2) |
223 ||>> take_suffix (improper_token o #1) |
224 ||>> take_prefix (comment_token o #2) |
224 ||>> take_prefix (comment_token o #1) |
225 ||> take_newline; |
225 ||> take_newline; |
226 in Span (cmd, (src_prefix, src_main, src_suffix1 @ src_suffix2, src_appendix), newline) end; |
226 in Span (cmd, (src_prefix, src_main, src_suffix1 @ src_suffix2, src_appendix), newline) end; |
227 |
227 |
228 |
228 |
229 (* present spans *) |
229 (* present spans *) |
230 |
230 |
244 in |
244 in |
245 |
245 |
246 fun present_span lex default_tags span state state' |
246 fun present_span lex default_tags span state state' |
247 (tag_stack, active_tag, newline, buffer, present_cont) = |
247 (tag_stack, active_tag, newline, buffer, present_cont) = |
248 let |
248 let |
249 val present = fold (fn (raw, tok, d) => |
249 val present = fold (fn (tok, flag, 0) => |
250 Buffer.add raw o (if d > 0 then I else Buffer.add (output_token lex state' tok))); |
250 Buffer.add (output_token lex state' tok) #> Buffer.add flag | _ => I); |
251 |
251 |
252 val Span ((cmd_name, cmd_pos, cmd_tags), srcs, span_newline) = span; |
252 val Span ((cmd_name, cmd_pos, cmd_tags), srcs, span_newline) = span; |
253 |
253 |
254 val (tag, tags) = tag_stack; |
254 val (tag, tags) = tag_stack; |
255 val tag' = |
255 val tag' = |
327 fun present_thy lex default_tags is_markup trs src = |
327 fun present_thy lex default_tags is_markup trs src = |
328 let |
328 let |
329 (* tokens *) |
329 (* tokens *) |
330 |
330 |
331 val ignored = Scan.state --| ignore |
331 val ignored = Scan.state --| ignore |
332 >> (fn d => (NONE, ("", NoToken, d))); |
332 >> (fn d => (NONE, (NoToken, "", d))); |
333 |
333 |
334 fun markup flag mark mk = Scan.peek (fn d => |
334 fun markup mark mk flag = Scan.peek (fn d => |
335 improper |-- |
335 improper |-- |
336 P.position (Scan.one (T.is_kind T.Command andf is_markup mark o T.val_of)) -- |
336 P.position (Scan.one (T.is_kind T.Command andf is_markup mark o T.val_of)) -- |
337 Scan.repeat tag -- |
337 Scan.repeat tag -- |
338 P.!!!! (improper |-- P.position P.text --| improper_end) |
338 P.!!!! (improper |-- P.position P.text --| improper_end) |
339 >> (fn (((tok, pos), tags), txt) => |
339 >> (fn (((tok, pos), tags), txt) => |
340 let val name = T.val_of tok |
340 let val name = T.val_of tok |
341 in (SOME (name, pos, tags), (flag, mk (name, txt), d)) end)); |
341 in (SOME (name, pos, tags), (mk (name, txt), flag, d)) end)); |
342 |
342 |
343 val command = Scan.peek (fn d => |
343 val command = Scan.peek (fn d => |
344 P.position (Scan.one (T.is_kind T.Command)) -- |
344 P.position (Scan.one (T.is_kind T.Command)) -- |
345 Scan.repeat tag |
345 Scan.repeat tag |
346 >> (fn ((tok, pos), tags) => |
346 >> (fn ((tok, pos), tags) => |
347 let val name = T.val_of tok |
347 let val name = T.val_of tok |
348 in (SOME (name, pos, tags), (Latex.markup_false, BasicToken tok, d)) end)); |
348 in (SOME (name, pos, tags), (BasicToken tok, Latex.markup_false, d)) end)); |
349 |
349 |
350 val cmt = Scan.peek (fn d => |
350 val cmt = Scan.peek (fn d => |
351 P.$$$ "--" |-- P.!!!! (improper |-- P.position P.text) |
351 P.$$$ "--" |-- P.!!!! (improper |-- P.position P.text) |
352 >> (fn txt => (NONE, ("", MarkupToken ("cmt", txt), d)))); |
352 >> (fn txt => (NONE, (MarkupToken ("cmt", txt), "", d)))); |
353 |
353 |
354 val other = Scan.peek (fn d => |
354 val other = Scan.peek (fn d => |
355 Scan.one T.not_eof >> (fn tok => (NONE, ("", BasicToken tok, d)))); |
355 Scan.one T.not_eof >> (fn tok => (NONE, (BasicToken tok, "", d)))); |
356 |
356 |
357 val token = |
357 val token = |
358 ignored || |
358 ignored || |
359 markup Latex.markup_true Markup MarkupToken || |
359 markup Markup MarkupToken Latex.markup_true || |
360 markup Latex.markup_true MarkupEnv MarkupEnvToken || |
360 markup MarkupEnv MarkupEnvToken Latex.markup_true || |
361 markup "" Verbatim (VerbatimToken o #2) || |
361 markup Verbatim (VerbatimToken o #2) "" || |
362 command || cmt || other; |
362 command || cmt || other; |
363 |
363 |
364 |
364 |
365 (* spans *) |
365 (* spans *) |
366 |
366 |
367 val stopper = |
367 val stopper = |
368 ((NONE, ("", BasicToken (#1 T.stopper), 0)), |
368 ((NONE, (BasicToken (#1 T.stopper), "", 0)), |
369 fn (_, (_, BasicToken x, _)) => #2 T.stopper x | _ => false); |
369 fn (_, (BasicToken x, _, _)) => #2 T.stopper x | _ => false); |
370 |
370 |
371 val cmd = Scan.one (is_some o #1); |
371 val cmd = Scan.one (is_some o #1); |
372 val non_cmd = Scan.one (is_none o #1 andf not o #2 stopper) >> #2; |
372 val non_cmd = Scan.one (is_none o #1 andf not o #2 stopper) >> #2; |
373 |
373 |
374 val comments = Scan.any (comment_token o #2 o #2); |
374 val comments = Scan.any (comment_token o #1 o #2); |
375 val blank = Scan.one (blank_token o #2 o #2); |
375 val blank = Scan.one (blank_token o #1 o #2); |
376 val newline = Scan.one (newline_token o #2 o #2); |
376 val newline = Scan.one (newline_token o #1 o #2); |
377 val before_cmd = |
377 val before_cmd = |
378 Scan.option (newline -- comments) -- |
378 Scan.option (newline -- comments) -- |
379 Scan.option (newline -- comments) -- |
379 Scan.option (newline -- comments) -- |
380 Scan.option (blank -- comments) -- cmd; |
380 Scan.option (blank -- comments) -- cmd; |
381 |
381 |