state: body context;
added theory_context, proof_to_theory_context;
added is_proof, level;
turned excursion_result into present_excursion;

--- a/src/Pure/Isar/toplevel.ML	Tue Aug 16 13:42:46 2005 +0200
+++ b/src/Pure/Isar/toplevel.ML	Tue Aug 16 13:42:47 2005 +0200
@@ -8,18 +8,22 @@
 signature TOPLEVEL =
 sig
   datatype node =
-    Theory of theory | Proof of ProofHistory.T | SkipProof of int History.T * theory
+    Theory of theory * Proof.context option |
+    Proof of ProofHistory.T |
+    SkipProof of int History.T * theory
   type state
   val toplevel: state
   val is_toplevel: state -> bool
+  val level: state -> int
   exception UNDEF
   val node_history_of: state -> node History.T
   val node_of: state -> node
   val node_case: (theory -> 'a) -> (Proof.state -> 'a) -> state -> 'a
   val theory_of: state -> theory
   val sign_of: state -> theory    (*obsolete*)
-  val context_of: state -> Proof.context
+  val body_context_of: state -> Proof.context
   val proof_of: state -> Proof.state
+  val is_proof: state -> bool
   val enter_forward_proof: state -> Proof.state
   val prompt_state_default: state -> string
   val prompt_state_fn: (state -> string) ref
@@ -60,6 +64,7 @@
     -> transition -> transition
   val theory: (theory -> theory) -> transition -> transition
   val theory': (bool -> theory -> theory) -> transition -> transition
+  val theory_context: (theory -> theory * Proof.context) -> transition -> transition
   val theory_to_proof: (bool -> theory -> ProofHistory.T) -> transition -> transition
   val proof: (ProofHistory.T -> ProofHistory.T) -> transition -> transition
   val proof': (bool -> ProofHistory.T -> ProofHistory.T) -> transition -> transition
@@ -67,13 +72,15 @@
   val skip_proof: (int History.T -> int History.T) -> transition -> transition
   val proof_to_theory: (ProofHistory.T -> theory) -> transition -> transition
   val proof_to_theory': (bool -> ProofHistory.T -> theory) -> transition -> transition
+  val proof_to_theory_context: (ProofHistory.T -> theory * Proof.context)
+    -> transition -> transition
   val skip_proof_to_theory: (int History.T -> bool) -> transition -> transition
   val unknown_theory: transition -> transition
   val unknown_proof: transition -> transition
   val unknown_context: transition -> transition
   val exn_message: exn -> string
   val apply: bool -> transition -> state -> (state * (exn * string) option) option
-  val excursion_result: ((transition * (state -> state -> 'a -> 'a)) list * 'a) -> 'a
+  val present_excursion: (transition * (state -> state -> 'a -> 'a)) list -> 'a -> 'a
   val excursion: transition list -> unit
   val set_state: state -> unit
   val get_state: unit -> state
@@ -93,9 +100,9 @@
 (* datatype state *)
 
 datatype node =
-  Theory of theory |
-  Proof of ProofHistory.T |              (*history of proof states*)
-  SkipProof of int History.T * theory;   (*history of proof depths*)
+  Theory of theory * Proof.context option |  (*theory with optional body context*)
+  Proof of ProofHistory.T |                  (*history of proof states*)
+  SkipProof of int History.T * theory;       (*history of proof depths*)
 
 datatype state = State of (node History.T * ((node -> unit) * (node -> unit))) option;
 
@@ -104,6 +111,13 @@
 fun is_toplevel (State NONE) = true
   | is_toplevel _ = false;
 
+fun level (State NONE) = 0
+  | level (State (SOME (node, _))) =
+      (case History.current node of
+        Theory _ => 0
+      | Proof prf => Proof.level (ProofHistory.current prf)
+      | SkipProof (h, _) => History.current h + 1);    (*different notion of proof depth!*)
+
 fun str_of_state (State NONE) = "at top level"
   | str_of_state (State (SOME (node, _))) =
       (case History.current node of
@@ -123,14 +137,20 @@
 
 fun node_case f g state =
   (case node_of state of
-    Theory thy => f thy
+    Theory (thy, _) => f thy
   | Proof prf => g (ProofHistory.current prf)
   | SkipProof (_, thy) => f thy);
 
 val theory_of = node_case I Proof.theory_of;
 val sign_of = theory_of;
-val context_of = node_case ProofContext.init Proof.context_of;
+
+fun body_context_of state =
+  (case node_of state of
+    Theory (_, SOME ctxt) => ctxt
+  | _ => node_case ProofContext.init Proof.context_of state);
+
 val proof_of = node_case (fn _ => raise UNDEF) I;
+val is_proof = can proof_of;
 
 val enter_forward_proof = node_case Proof.init_state Proof.enter_forward;
 
@@ -153,7 +173,7 @@
   (case try theory_of state of NONE => []
   | SOME thy => pretty_context thy);
 
-fun pretty_node prf_only (Theory thy) = if prf_only then [] else pretty_context thy
+fun pretty_node prf_only (Theory (thy, _)) = if prf_only then [] else pretty_context thy
   | pretty_node _ (Proof prf) =
       Proof.pretty_state (ProofHistory.position prf) (ProofHistory.current prf)
   | pretty_node _ (SkipProof (h, _)) =
@@ -205,10 +225,10 @@
 
 val stale_theory = ERROR_MESSAGE "Stale theory encountered after succesful execution!";
 
-fun checkpoint_node true (Theory thy) = Theory (Theory.checkpoint thy)
+fun checkpoint_node true (Theory (thy, ctxt)) = Theory (Theory.checkpoint thy, ctxt)
   | checkpoint_node _ node = node;
 
-fun copy_node true (Theory thy) = Theory (Theory.copy thy)
+fun copy_node true (Theory (thy, ctxt)) = Theory (Theory.copy thy, ctxt)
   | copy_node _ node = node;
 
 fun return (result, NONE) = result
@@ -384,18 +404,22 @@
 fun imperative f = keep (fn _ => f ());
 
 fun init_theory f exit kill =
-  init (fn int => Theory (f int))
-    (fn Theory thy => exit thy | _ => raise UNDEF)
-    (fn Theory thy => kill thy | _ => raise UNDEF);
+  init (fn int => Theory (f int, NONE))
+    (fn Theory (thy, _) => exit thy | _ => raise UNDEF)
+    (fn Theory (thy, _) => kill thy | _ => raise UNDEF);
 
 
 (* typed transitions *)
 
-fun theory f = app_current (fn _ => (fn Theory thy => Theory (f thy) | _ => raise UNDEF));
-fun theory' f = app_current (fn int => (fn Theory thy => Theory (f int thy) | _ => raise UNDEF));
+fun theory f = app_current (K (fn Theory (thy, _) => Theory (f thy, NONE) | _ => raise UNDEF));
+fun theory' f = app_current (fn int =>
+  (fn Theory (thy, _) => Theory (f int thy, NONE) | _ => raise UNDEF));
+
+fun theory_context f =
+  app_current (K (fn Theory (thy, _) => Theory (apsnd SOME (f thy)) | _ => raise UNDEF));
 
 fun theory_to_proof f = app_current (fn int =>
-  (fn Theory thy =>
+  (fn Theory (thy, _) =>
         if ! skip_proofs then SkipProof (History.init (undo_limit int) 0,
           fst (SkipProof.global_skip_proof int (ProofHistory.current (f int thy))))
         else Proof (f int thy)
@@ -414,15 +438,17 @@
 fun skip_proof f = map_current (fn _ =>
   (fn SkipProof (h, thy) => SkipProof (f h, thy) | _ => raise UNDEF));
 
-fun proof_to_theory' f =
+fun end_proof f =
   map_current (fn int => (fn Proof prf => Theory (f int prf)
-    | SkipProof (h, thy) => if History.current h = 0 then Theory thy else raise UNDEF
+    | SkipProof (h, thy) => if History.current h = 0 then Theory (thy, NONE) else raise UNDEF
     | _ => raise UNDEF));
 
-val proof_to_theory = proof_to_theory' o K;
+fun proof_to_theory' f = end_proof (rpair NONE oo f);
+fun proof_to_theory f = proof_to_theory' (K f);
+fun proof_to_theory_context f = end_proof (K (apsnd SOME o f));
 
 fun skip_proof_to_theory p = map_current (fn _ =>
-  (fn SkipProof (h, thy) => if p h then Theory thy else raise UNDEF | _ => raise UNDEF));
+  (fn SkipProof (h, thy) => if p h then Theory (thy, NONE) else raise UNDEF | _ => raise UNDEF));
 
 val unknown_theory = imperative (fn () => warning "Unknown theory context");
 val unknown_proof = imperative (fn () => warning "Unknown proof context");
@@ -526,29 +552,30 @@
 end;
 
 
-(* excursion: toplevel -- apply transformers -- toplevel *)
+(* excursion: toplevel -- apply transformers/presentation -- toplevel *)
 
 local
 
 fun excur [] x = x
-  | excur ((tr, f) :: trs) (st, res) =
+  | excur ((tr, pr) :: trs) (st, res) =
       (case apply false tr st of
         SOME (st', NONE) =>
-          excur trs (st', transform_error (fn () => f st st' res) () handle exn =>
+          excur trs (st', transform_error (fn () => pr st st' res) () handle exn =>
             raise EXCURSION_FAIL (exn, "Presentation failed\n" ^ at_command tr))
       | SOME (st', SOME exn_info) => raise EXCURSION_FAIL exn_info
       | NONE => raise EXCURSION_FAIL (TERMINATE, at_command tr));
 
+fun no_pr _ _ _ = ();
+
 in
 
-fun excursion_result (trs, res) =
+fun present_excursion trs res =
   (case excur trs (State NONE, res) of
     (State NONE, res') => res'
   | _ => raise ERROR_MESSAGE "Unfinished development at end of input")
   handle exn => error (exn_message exn);
 
-fun excursion trs =
-  excursion_result (map (fn tr => (tr, fn _ => fn _ => fn _ => ())) trs, ());
+fun excursion trs = present_excursion (map (rpair no_pr) trs) ();
 
 end;