1.1 --- a/src/Pure/PIDE/command.ML	Wed Jul 03 16:58:35 2013 +0200
     1.2 +++ b/src/Pure/PIDE/command.ML	Wed Jul 03 17:50:47 2013 +0200
     1.3 @@ -17,8 +17,9 @@
     1.4    val read: span -> Toplevel.transition
     1.5    val eval: span -> Toplevel.transition ->
     1.6      Toplevel.state * {malformed: bool} -> {failed: bool} * (Toplevel.state * {malformed: bool})
     1.7 -  val no_print: unit lazy
     1.8 -  val print: Toplevel.transition -> Toplevel.state -> unit lazy
     1.9 +  val print: Toplevel.transition -> Toplevel.state -> (string * unit lazy) list
    1.10 +  val print_function: string ->
    1.11 +    ({tr: Toplevel.transition, state: Toplevel.state} -> (unit -> unit) option) -> unit
    1.12  end;
    1.13  
    1.14  structure Command: COMMAND =
    1.15 @@ -150,21 +151,38 @@
    1.16  
    1.17  (* print *)
    1.18  
    1.19 -val no_print = Lazy.value ();
    1.20 +local
    1.21 +
    1.22 +type print_function =
    1.23 +  {tr: Toplevel.transition, state: Toplevel.state} -> (unit -> unit) option;
    1.24 +
    1.25 +val print_functions =
    1.26 +  Synchronized.var "Command.print_functions" ([]: (string * print_function) list);
    1.27 +
    1.28 +in
    1.29  
    1.30  fun print tr st' =
    1.31 +  rev (Synchronized.value print_functions) |> map_filter (fn (name, f) =>
    1.32 +    (case f {tr = tr, state = st'} of
    1.33 +      SOME pr => SOME (name, (Lazy.lazy o Toplevel.setmp_thread_position tr) pr)
    1.34 +    | NONE => NONE));
    1.35 +
    1.36 +fun print_function name f =
    1.37 +  Synchronized.change print_functions (fn funs =>
    1.38 +   (if not (AList.defined (op =) funs name) then ()
    1.39 +    else warning ("Redefining command print function: " ^ quote name);
    1.40 +    AList.update (op =) (name, f) funs));
    1.41 +
    1.42 +end;
    1.43 +
    1.44 +val _ = print_function "print_state" (fn {tr, state} =>
    1.45    let
    1.46      val is_init = Toplevel.is_init tr;
    1.47      val is_proof = Keyword.is_proof (Toplevel.name_of tr);
    1.48      val do_print =
    1.49        not is_init andalso
    1.50 -        (Toplevel.print_of tr orelse (is_proof andalso Toplevel.is_proof st'));
    1.51 -  in
    1.52 -    if do_print then
    1.53 -      (Lazy.lazy o Toplevel.setmp_thread_position tr)
    1.54 -        (fn () => Toplevel.print_state false st')
    1.55 -    else no_print
    1.56 -  end;
    1.57 +        (Toplevel.print_of tr orelse (is_proof andalso Toplevel.is_proof state));
    1.58 +  in if do_print then SOME (fn () => Toplevel.print_state false state) else NONE end);
    1.59  
    1.60  end;
    1.61