# HG changeset patch
# User wenzelm
# Date 1216129601 -7200
# Node ID 82399f3a8ca870ec47e436804bac7491b60cadf3
# Parent  2c281958e45d8b11fcdbadede2e6f610d78e059e
support for command status;

diff -r 2c281958e45d -r 82399f3a8ca8 src/Pure/General/markup.ML
--- a/src/Pure/General/markup.ML	Tue Jul 15 14:15:49 2008 +0200
+++ b/src/Pure/General/markup.ML	Tue Jul 15 15:46:41 2008 +0200
@@ -67,6 +67,11 @@
   val subgoalN: string val subgoal: T
   val sendbackN: string val sendback: T
   val hiliteN: string val hilite: T
+  val unprocessedN: string val unprocessed: T
+  val runningN: string val running: T
+  val finishedN: string val finished: T
+  val failedN: string val failed: T
+  val disposedN: string val disposed: T
   val default_output: T -> output * output
   val add_mode: string -> (T -> output * output) -> unit
   val output: T -> output * output
@@ -194,6 +199,15 @@
 val (hiliteN, hilite) = markup_elem "hilite";
 
 
+(* command status *)
+
+val (unprocessedN, unprocessed) = markup_elem "unprocessed";
+val (runningN, running) = markup_elem "running";
+val (finishedN, finished) = markup_elem "finished";
+val (failedN, failed) = markup_elem "failed";
+val (disposedN, disposed) = markup_elem "disposed";
+
+
 (* print mode operations *)
 
 fun default_output (_: T) = ("", "");
diff -r 2c281958e45d -r 82399f3a8ca8 src/Pure/Isar/isar.ML
--- a/src/Pure/Isar/isar.ML	Tue Jul 15 14:15:49 2008 +0200
+++ b/src/Pure/Isar/isar.ML	Tue Jul 15 15:46:41 2008 +0200
@@ -84,6 +84,10 @@
 fun map_status f = map_command (fn (category, transition, status) =>
   (category, transition, f status));
 
+fun status_markup Initial = Markup.unprocessed
+  | status_markup (Result (_, NONE)) = Markup.finished
+  | status_markup (Result (_, SOME _)) = Markup.failed;
+
 
 (* global collection of identified commands *)
 
@@ -125,13 +129,18 @@
   | {transition, ...} => error ("Unfinished command " ^ Toplevel.str_of transition));
 
 val the_state = #1 o the_result;
+val command_status = Toplevel.status o #transition o the_command;
+
 
 fun new_command prev (id, cmd) =
   change_commands (Graph.new_node (id, cmd) #> prev <> no_id ? Graph.add_edge (prev, id));
 
-fun dispose_command id = change_commands (Graph.del_nodes [id]);
+fun dispose_command id =
+  (command_status id Markup.disposed; change_commands (Graph.del_nodes [id]));
 
-fun change_command_status id f = change_commands (Graph.map_node id (map_status f));
+fun update_command_status id status =
+ (change_commands (Graph.map_node id (map_status (K status)));
+  command_status id (status_markup status));
 
 
 
@@ -180,7 +189,7 @@
     (case Toplevel.transition true tr prev_state of
       NONE => (dispose_command id; false)
     | SOME (result as (_, err)) =>
-        (change_command_status id (K (Result result));
+        (update_command_status id (Result result);
           Option.map (Toplevel.error_msg tr) err;
           if is_some err orelse category = Control then dispose_command id
           else set_point id;
diff -r 2c281958e45d -r 82399f3a8ca8 src/Pure/Isar/toplevel.ML
--- a/src/Pure/Isar/toplevel.ML	Tue Jul 15 14:15:49 2008 +0200
+++ b/src/Pure/Isar/toplevel.ML	Tue Jul 15 15:46:41 2008 +0200
@@ -84,6 +84,7 @@
   val unknown_theory: transition -> transition
   val unknown_proof: transition -> transition
   val unknown_context: transition -> transition
+  val status: transition -> Markup.T -> unit
   val error_msg: transition -> exn * string -> unit
   val transition: bool -> transition -> state -> (state * (exn * string) option) option
   val commit_exit: transition
@@ -598,6 +599,9 @@
 fun setmp_thread_position (Transition {pos, ...}) f x =
   Position.setmp_thread_data pos f x;
 
+fun status tr m =
+  setmp_thread_position tr (fn () => Output.status (Markup.markup m "")) ();
+
 fun error_msg tr exn_info =
   setmp_thread_position tr (fn () => Output.error_msg (exn_message (EXCURSION_FAIL exn_info))) ();