IMPLEMENTATION MODULE Buffers ;

(* This module performs the allocation and maintenance of the editing
   buffer headers used by the editor.
*)

FROM SYSTEM IMPORT SIZE, ADR;
FROM Strings IMPORT LengthC, CompareCC, CaseMode, Comparison;

FROM Universe IMPORT BYTE, Debugging, DebugFlags, MarkerFlagByte,
		     WindowI (* Should be FROM Windows but would recurse *) ;
FROM Memory IMPORT DynamicArray, MemoryDirection, MemoryType,
		   Allocate, DeAllocate, NewDynamicArray,
		   ALLOCATE, DEALLOCATE;
IMPORT Slist;
IMPORT Errors, StringData, Fast, Interface, Actions;
IMPORT Handler, File;
IMPORT Sets;

IMPORT Debug;

VAR
  AllBuffers: BufferP;
  TerminatedCleanly: BOOLEAN;
  nextTag: CARDINAL;

PROCEDURE New (VAR Header: BufferP; Size: CARDINAL;
	       WindowIdentity: WindowI): BOOLEAN;
(* Attempts to create a new buffer and buffer header of the given size *)
  BEGIN
    IF Allocate (Header, SIZE (Header^), HeapMemory) THEN
      IF NewDynamicArray (Header^.Array, Size, BuffersMemory) THEN
	WITH Header^ DO
	  Next := AllBuffers;
	  Window := WindowIdentity;
	  Markers := NIL;
	  Before.Start := 0;
	  Before.End := 0;
	  After.Start := Size;
	  After.End := Size;
	  Deleted.Valid := FALSE;
	  Deleted.Area.Start := 0;
	  Deleted.Area.End := 0;
	  Status := BufferStatus {};
	  Sets.Initialise (LocalBindings.Active, FALSE);
	  LocalBindings.List := NIL;
	  Name := NIL;
	  StampedTime.LS := 0;
	  StampedTime.MS := 0;
	END (* with *);
	AllBuffers := Header;
	RETURN TRUE
      END (* if *);
      DeAllocate (Header, SIZE (Header^), HeapMemory); (* BB addition *)
    END (* if *);
    RETURN FALSE
  END New;


PROCEDURE Dispose( VAR Header : BufferP ) ;
(* Discards the given buffer and header *)
BEGIN
   IF Header <> NIL THEN
      Actions.DeleteLocalBindings( Header ) ;
      ScanAreaForMarkers( Header , Header^.Before , DeleteMarker , 0 ) ;
      ScanAreaForMarkers( Header , Header^.After , DeleteMarker , 0 ) ;
      WITH Header^.Array DO
	 IF Data <> NIL THEN
	    DeAllocate( Data , Size , BuffersMemory ) ;
	 END (* if *) ;
      END (* with *) ;
      StringData.Delete( Header^.Name ) ;
      Slist.Remove( AllBuffers , Header ) ;
      DeAllocate( Header , SIZE( Header^ ) , HeapMemory ) ;
   END (* if *) ;
END Dispose ;


PROCEDURE Select( Buffer : BufferP ) ;
BEGIN
   IF Buffer = NIL THEN
      Errors.Panic( "Buffers.Select NIL pointer" ) ;
   END (* if *) ;
   Selected := Buffer ;
END Select ;

PROCEDURE NewMarkerTag (): CARDINAL;

   BEGIN
     INC (nextTag);
     RETURN nextTag
   END NewMarkerTag;

PROCEDURE NewMarker( VAR Marker : MarkerP ;
		     Buffer : BufferP ;
		     Position : CARDINAL ) : BOOLEAN ;

   PROCEDURE InsertMarkerInChain( VAR Chain : MarkerP ;
				  Marker : MarkerP ;
				  Previous : MarkerP ) ;
   BEGIN
      IF Chain = NIL THEN
	 Marker^.Previous := Previous ;
	 Marker^.Next := NIL ;
	 Chain := Marker ;
      ELSE
	 IF Position >= Chain^.Where THEN
	    InsertMarkerInChain( Chain^.Next , Marker , Chain ) ;
	 ELSE
	    Marker^.Next := Chain ;
	    Marker^.Previous := Previous ;
	    Chain^.Previous := Marker ;
	    IF Previous <> NIL THEN
	       Previous^.Next := Marker ;
	    END (* if *) ;
	    Chain := Marker ;
	 END (* if *) ;
      END (* if *) ;
   END InsertMarkerInChain ;


BEGIN
   NEW( Marker ) ;
   IF Marker <> NIL THEN
      Marker^.Next := NIL ;
      Marker^.Previous := NIL ;
      Marker^.Where := Position ;
      Marker^.Buffer := Buffer ;
      Marker^.Overlayed := FALSE ;
      Marker^.DisplaySize := 0 ;
      Marker^.Text := "" ;
      Marker^.FlagByteInserted := FALSE ;
      Marker^.tag := 0;
      InsertMarkerInChain( Buffer^.Markers , Marker , NIL ) ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "NewMarker( , " ) ;
Debug.WritePointer( Buffer ) ;
Debug.WriteS( " @ " ) ;
Debug.WriteC( Marker^.Where ) ;
Debug.WriteS( " ) -> " ) ;
Debug.WritePointer( Marker ) ;
Debug.Writeln ;
END (* if debugging *) ;
*: *)

      RETURN TRUE ;
   END (* if *) ;
   RETURN FALSE ;
END NewMarker ;



PROCEDURE ScanMarkers( Buffer : BufferP ;
		       Position : CARDINAL ;
		       Proc : MarkerProc ;
		       Parameter : INTEGER ) ;
(* Checks for markers at the Position and applies the given
	    Proc( Marker , Param )
to them.
*)
VAR
   Marker			 : MarkerP ;
   nextMarker                    : MarkerP;
BEGIN
   Marker := Buffer^.Markers ;
   WHILE Marker <> NIL DO
      nextMarker := Marker^.Next;
      IF Marker^.Where = Position THEN
	 Proc( Marker , Parameter ) ;
      END (* if *) ;
      Marker := nextMarker ;
   END (* while *) ;
END ScanMarkers ;



PROCEDURE ScanAreaForMarkers( Buffer : BufferP ;
			      Area : AreaR ;
			      Proc : MarkerProc ;
			      Parameter : INTEGER ) ;
(* Equivalent to a ScanMarkers( Buffer , x , Proc , Parameter ) for all
   x :: Area.Start <= x < Area.End
*)
VAR
   Marker			 : MarkerP ;
   NextMarker			 : MarkerP ;
BEGIN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "ScanAreaForMarkers( , [ " ) ;
Debug.WriteC( Area.Start ) ;
Debug.WriteS( ".." ) ;
Debug.WriteC( Area.End ) ;
Debug.WriteS( " ] , , )*N" ) ;
END (* if debugging *) ;
*: *)

   Marker := Buffer^.Markers ;
   WHILE Marker <> NIL DO
      NextMarker := Marker^.Next ;
      IF ( Area.Start <= Marker^.Where ) AND ( Marker^.Where < Area.End ) THEN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "   Proc( " ) ;
Debug.WriteH( Marker ) ;
Debug.WriteS( " @ " ) ;
Debug.WriteC( Marker^.Where ) ;
Debug.WriteS( " )*N" ) ;
END (* if debugging *) ;
*: *)

	 Proc( Marker , Parameter ) ;
      END (* if *) ;
      Marker := NextMarker ;
   END (* while *) ;
END ScanAreaForMarkers ;




PROCEDURE UnHoleMarker( Marker : MarkerP ; Parameter : INTEGER ) ;
(* If Parameter = -1 then moves the Marker back by the size of the hole,
		= +1 then moves the Marker forward by the size of the hole.
*)
VAR
   Distance		: INTEGER ;
BEGIN
   WITH Marker^.Buffer^ DO
      Distance := After.Start - Before.End ;
   END (* with *) ;
   MoveMarker( Marker , Distance * Parameter ) ;
END UnHoleMarker ;


PROCEDURE MoveMarker( Marker : MarkerP ; Parameter : INTEGER ) ;
(* Moves Marker.Where by the given amount +/- *)
BEGIN
   INC( Marker^.Where , Parameter ) ;
END MoveMarker ;



PROCEDURE DeleteMarker( Marker : MarkerP ; Parameter : INTEGER ) ;
(* Deletes the given marker. *)
VAR
   P			 : MarkerP ;
   Area 		 : AreaR ;
BEGIN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "DeleteMarker( " ) ;
Debug.WriteH( Marker ) ;
Debug.WriteS( " @ " ) ;
Debug.WriteC( Marker^.Where ) ;
Debug.WriteS( " )*N" ) ;
END (* if debugging *) ;
*: *)

   P := Marker ;
   Area.Start := Marker^.Where ;
   Area.End := Area.Start + 1 ;
   RemoveMarkerFlags( Marker^.Buffer , Area ) ;
   IF Marker^.Previous = NIL THEN
      Marker^.Buffer^.Markers := Marker^.Next ;
   ELSE
      Marker^.Previous^.Next := Marker^.Next ;
   END (* if *) ;
   IF Marker^.Next <> NIL THEN
      Marker^.Next^.Previous := Marker^.Previous ;
   END (* if *) ;
   IF Marker = EditMarkers[ 1 ] THEN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "DeleteMarker : Was EditMarker[ 1 ]*N" ) ;
END (* if debugging *) ;
*: *)

      EditMarkers[ 1 ] := EditMarkers[ 2 ] ;
      EditMarkers[ 2 ] := NIL ;
   END (* if *) ;
   IF Marker = EditMarkers[ 2 ] THEN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "DeleteMarker : Was EditMarker[ 2 ]*N" ) ;
END (* if debugging *) ;
*: *)

      EditMarkers[ 2 ] := NIL ;
   END (* if *) ;
   DISPOSE( Marker ) ;
END DeleteMarker ;



PROCEDURE AssignMarker( Marker : MarkerP ; Parameter : INTEGER ) ;
(* Assigns the given marker. *)
BEGIN
   Marker^.Where := Parameter ;
END AssignMarker ;




PROCEDURE MarkerWithin( Buffer : BufferP ;
			Area : AreaR ;
		    VAR Marker : MarkerP ) : BOOLEAN ;
VAR
   P			 : MarkerP ;
BEGIN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "MarkerWithin( [ " ) ;
Debug.WriteC( Area.Start ) ;
Debug.WriteS( ".." ) ;
Debug.WriteC( Area.End ) ;
Debug.WriteS( " ] )" ) ;
END (* if debugging *) ;
*: *)

   IF Marker = NIL THEN
      P := Buffer^.Markers ;
   ELSE
      P := Marker^.Next ;
      Marker := NIL ;
   END (* if *) ;
   WHILE P <> NIL DO
      IF ( Area.Start <= P^.Where ) AND ( P^.Where < Area.End ) THEN
	 Marker := P ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteB( TRUE ) ;
Debug.WriteS( " @ " ) ;
Debug.WriteC( P^.Where ) ;
Debug.Writeln ;
END (* if debugging *) ;
*: *)

	 RETURN TRUE ;
      END (* if *) ;
      P := P^.Next ;
   END (* while *) ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteB( FALSE ) ;
Debug.Writeln ;
END (* if debugging *) ;
*: *)

   RETURN FALSE ;
END MarkerWithin ;


PROCEDURE MarkerAt( Buffer : BufferP ;
		    Position : CARDINAL ;
		VAR Marker : MarkerP ) : BOOLEAN ;
VAR
   P		      : MarkerP ;
BEGIN
   IF Marker = NIL THEN
      P := Buffer^.Markers ;
   ELSE
      P := Marker^.Next ;
      Marker := NIL ;
   END (* if *) ;
   WHILE P <> NIL DO
      IF P^.Where = Position THEN
	 Marker := P ;
	 RETURN TRUE ;
      END (* if *) ;
      P := P^.Next ;
   END (* while *) ;
   RETURN FALSE ;
END MarkerAt ;


PROCEDURE RemoveMarkerFlags( Buffer : BufferP ; VAR AreaParameter : AreaR ) ;
VAR
   Marker			 : MarkerP ;
   Area 			 : AreaR ;
   BeforeAfter			 : AreaR ;
   BeforeBit			 : AreaR ;
   AfterBit			 : AreaR ;
   Adjustment			 : CARDINAL ;
   CurrentPosition		 : CARDINAL ;
BEGIN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "RemoveMarkerFlags( " ) ;
Debug.WritePointer( Buffer ) ;
Debug.WriteS( " , [ " ) ;
Debug.WriteC( AreaParameter.Start ) ;
Debug.WriteS( ".." ) ;
Debug.WriteC( AreaParameter.End ) ;
Debug.WriteS( " ] )*N" ) ;
END (* if debugging *) ;
*: *)

   Area := AreaParameter ;
   Adjustment := 0 ;
   CurrentPosition := 0 ;
   WITH Buffer^ DO
      IF Area.Start >= After.Start THEN
	 BeforeAfter := After ;
      ELSIF Area.End <= Before.End THEN
	 BeforeAfter := Before ;
      ELSE
	 BeforeBit.Start := Area.Start ;
	 BeforeBit.End := Before.End ;
	 AfterBit.Start := After.Start ;
	 AfterBit.End := Area.End ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "RemoveMarkerFlags : Recursing with [ " ) ;
Debug.WriteC( BeforeBit.Start ) ;
Debug.WriteS( ".." ) ;
Debug.WriteC( BeforeBit.End ) ;
Debug.WriteS( " ] and [ " ) ;
Debug.WriteC( AfterBit.Start ) ;
Debug.WriteS( ".." ) ;
Debug.WriteC( AfterBit.End ) ;
Debug.WriteS( " ]*N" ) ;
END (* if debugging *) ;
*: *)

	 RemoveMarkerFlags( Buffer , BeforeBit ) ;
	 RemoveMarkerFlags( Buffer , AfterBit ) ;
	 RETURN ;
      END (* if *) ;
      Marker := Markers ;
      WHILE Marker <> NIL DO

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "RemoveMarkerFlags : Marker " ) ;
Debug.WritePointer( Marker ) ;
Debug.WriteS( " @ " ) ;
Debug.WriteC( Marker^.Where ) ;
END (* if debugging *) ;
*: *)

	 IF ( BeforeAfter.Start <= Marker^.Where )
	 AND ( Marker^.Where <= BeforeAfter.End ) THEN
	    IF Marker^.Where = CurrentPosition THEN
	       IF Adjustment > 0 THEN
		  DEC( Marker^.Where , Adjustment - 1 ) ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( " Moved= " ) ;
Debug.WriteI( -INTEGER( Adjustment - 1 ) ) ;
END (* if debugging *) ;
*: *)

	       END (* if *) ;
	    ELSE

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( " Moved " ) ;
Debug.WriteI( -INTEGER( Adjustment ) ) ;
END (* if debugging *) ;
*: *)

	       DEC( Marker^.Where , Adjustment ) ;
	    END (* if *) ;
	 END (* if *) ;
	 IF ( Marker^.DisplaySize > 0 )
	    AND ( Area.Start <= Marker^.Where )
	    AND ( Marker^.Where < Area.End ) THEN
	    IF Marker^.Buffer^.Array.Data^[
		     Marker^.Where ] <> BYTE( MarkerFlagByte ) THEN
	       Errors.Panic( "Buffers.RemoveMarkerFlag : Missing" ) ;
	    END (* if *) ;
	    Fast.Move( Marker^.Buffer^.Array ,
		       BeforeAfter.End - ( Marker^.Where + 1 ) ,
		       Marker^.Where + 1 ,
		       Marker^.Where ) ;
	    INC( Adjustment ) ;
	    DEC( Area.End ) ;
	    DEC( BeforeAfter.End ) ;
	    Marker^.FlagByteInserted := FALSE ;
	    CurrentPosition := Marker^.Where ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( " FlagByteDeleted, Now @ " ) ;
Debug.WriteC( Marker^.Where ) ;
END (* if debugging *) ;
*: *)

	 END (* if *) ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.Writeln ;
END (* if debugging *) ;
*: *)

	 Marker := Marker^.Next ;
      END (* if *) ;
      EXCL( Status , MarkerFlagsInsertedF ) ;
      IF Area.End <= Before.End THEN
	 DEC( Before.End , Adjustment ) ;
      ELSIF Area.Start >= After.Start THEN
	 DEC( After.End , Adjustment ) ;
      ELSE
	 Errors.Panic( "Buffers.RemoveMarkerFlags : Where was the area ?" ) ;
      END (* if *) ;
   END (* with *) ;
   AreaParameter := Area ;
END RemoveMarkerFlags ;



PROCEDURE InsertMarkerFlags( Buffer : BufferP ; VAR AreaParameter : AreaR ) ;
VAR
   Marker			 : MarkerP ;
   Area 			 : AreaR ;
   BeforeAfter			 : AreaR ;
   Adjustment			 : CARDINAL ;
BEGIN

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "InsertMarkerFlags( " ) ;
Debug.WritePointer( Buffer ) ;
Debug.WriteS( " , [ " ) ;
Debug.WriteC( AreaParameter.Start ) ;
Debug.WriteS( ".." ) ;
Debug.WriteC( AreaParameter.End ) ;
Debug.WriteS( " ] )*N" ) ;
END (* if debugging *) ;
*: *)

   Area := AreaParameter ;
   Adjustment := 0 ;
   WITH Buffer^ DO
      IF Area.Start >= After.Start THEN
	 BeforeAfter := After ;
      ELSE
	 BeforeAfter := Before ;
      END (* if *) ;
      Marker := Markers ;
      WHILE Marker <> NIL DO

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( "InsertMarkerFlags : Marker @ " ) ;
Debug.WriteC( Marker^.Where ) ;
END (* if debugging *) ;
*: *)

	 INC( Marker^.Where , Adjustment ) ;
	 IF ( Marker^.DisplaySize > 0 )
	    AND ( Area.Start <= Marker^.Where )
	    AND ( Marker^.Where < Area.End ) THEN
	    Fast.Move( Marker^.Buffer^.Array ,
		       BeforeAfter.End - Marker^.Where ,
		       Marker^.Where ,
		       Marker^.Where + 1 ) ;
	    INC( Adjustment ) ;
	    INC( Area.End ) ;
	    DEC( BeforeAfter.End ) ;
	    Array.Data^[ Marker^.Where ] := MarkerFlagByte ;
	    Marker^.FlagByteInserted := TRUE ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.WriteS( " FlagByteInserted, Now @ " ) ;
Debug.WriteC( Marker^.Where ) ;
END (* if debugging *) ;
*: *)

	 END (* if *) ;

(* :*
IF DebugMarkerF IN Debugging THEN
Debug.Writeln ;
END (* if debugging *) ;
*: *)

	 Marker := Marker^.Next ;
      END (* if *) ;
      INCL( Status , MarkerFlagsInsertedF ) ;
      IF Area.End <= Before.End THEN
	 INC( Before.End , Adjustment ) ;
      ELSIF Area.Start >= After.Start THEN
	 INC( After.End , Adjustment ) ;
      ELSE
	 Errors.Panic( "Buffers.InsertMarkerFlags : Where was the area ?" ) ;
      END (* if *) ;
   END (* with *) ;
   AreaParameter := Area ;
END InsertMarkerFlags ;



PROCEDURE EditMarkersCount() : CARDINAL ;
VAR
   TempMarker		  : MarkerP ;

   PROCEDURE NameOrderedMarkers( N , Count : CARDINAL ) ;
   BEGIN
      WITH EditMarkers[ N ]^ DO
	 IF N = 1 THEN
	    IF Count = 1 THEN
	       Text := "Marker" ;
	    ELSE
	       Text := "Block Start" ;
	    END (* if *) ;
	 ELSE
	    Text := "Block End" ;
	 END (* if *) ;
	 DisplaySize := 1 + LengthC( Text ) + 1 ;
      END (* with *) ;
   END NameOrderedMarkers ;

BEGIN
   IF EditMarkers[ 1 ] <> NIL THEN
      IF EditMarkers[ 2 ] <> NIL THEN
	 IF EditMarkers[ 1 ]^.Where > EditMarkers[ 2 ]^.Where THEN
	    TempMarker := EditMarkers[ 1 ] ;
	    EditMarkers[ 1 ] := EditMarkers[ 2 ] ;
	    EditMarkers[ 2 ] := TempMarker ;
	 END (* if *) ;
	 NameOrderedMarkers( 2 , 2 ) ;
	 NameOrderedMarkers( 1 , 2 ) ;
	 RETURN 2 ;
      ELSE
	 NameOrderedMarkers( 1 , 1 ) ;
	 RETURN 1 ;
      END (* if *) ;
   ELSE
      IF EditMarkers[ 2 ] <> NIL THEN
	 EditMarkers[ 1 ] := EditMarkers[ 2 ] ;
	 EditMarkers[ 2 ] := NIL ;
	 NameOrderedMarkers( 1 , 1 ) ;
	 RETURN 1 ;
      ELSE
	 RETURN 0 ;
      END (* if *) ;
   END (* for *) ;
END EditMarkersCount ;

PROCEDURE Initialise;
VAR
   Result: INTEGER;
BEGIN
   AllBuffers := NIL;
   Result := Handler.DeclareConditionHandler (TerminationHandler);
   IF Result < 0 THEN
      Debug.WriteS ("Buffers.Initialise : ");
      Debug.WriteH ( Result );
      Debug.Writeln;
   END (* if *);
END Initialise;



PROCEDURE ModifiedBuffers() : BOOLEAN ;
VAR
   Buffer		: BufferP ;
BEGIN
   Buffer := AllBuffers ;
   WHILE Buffer <> NIL DO
      IF ( UserBufferF IN Buffer^.Status )
      AND ( ModifiedF IN Buffer^.Status ) THEN
	 RETURN TRUE ;
      END (* if *) ;
      Buffer := Buffer^.Next ;
   END (* while *) ;
   RETURN FALSE ;
END ModifiedBuffers ;




(* Panos calls this before blowing us away !! *)
PROCEDURE TerminationHandler( Why : Handler.TypeCode ;
			      Result : INTEGER ;
			      VAR E1 : Handler.UsersEnvironment;
			      VAR E2 : Handler.UsersEnvironment) : INTEGER ;
VAR
   NothingFound 		    : BOOLEAN ;
   DumpNumber			    : CARDINAL ;


   PROCEDURE Yes() : BOOLEAN ;
   VAR
      Y 		  : ARRAY [ 0..0 ] OF CHAR ;
      Answer		  : ARRAY [ 0..10 ] OF CHAR ;
      Result              : BOOLEAN;
   BEGIN
      Y[ 0 ] := 'Y' ;
      Interface.ReadLine( Answer ) ;
      Result := (CompareCC (Answer, "YES", IgnoreCase) = EQ) OR
       (CompareCC (Answer, Y, IgnoreCase) = EQ);
      ClearLine ;
      RETURN Result ;
   END Yes ;

   PROCEDURE DumpBuffer( Buffer : BufferP ) ;

      PROCEDURE Dump( FileName : ARRAY OF CHAR ; Area : AreaR ) ;
      VAR Result: INTEGER ;
      BEGIN
	 WITH Buffer^ DO
            Result := File.SaveFile (FileName,
                                     Area.End - Area.Start,
                                     ADR (Array.Data^ [Area.Start]));
	    IF Result < 0 THEN Debug.WriteS( " - Sorry cannot" ) ;
	    ELSE Debug.WriteS (" - OK");
	    END (* if *) ;
	 END (* with *) ;
	 ClearLine ;
      END Dump ;

   VAR
      BeforeName		     : ARRAY [ 0..8 ] OF CHAR ;
      AfterName 		     : ARRAY [ 0..8 ] OF CHAR ;
   BEGIN
      IF ( UserBufferF IN Buffer^.Status )
      AND ( ModifiedF IN Buffer^.Status ) THEN
	 IF Buffer^.Name = NIL THEN
	    Debug.WriteS( "Dump <Unnamed> as ");
	 ELSE
	    Debug.WriteS( "Dump " ) ;
	    StringData.WriteString( Buffer^.Name ) ;
	    Debug.WriteS( " as " ) ;
	 END (* iff *) ;
	 BeforeName := "Before?" ;
	 BeforeName[ 6 ] := CHAR( DumpNumber + ORD( 'A' ) ) ;
	 Debug.WriteS( BeforeName ) ;
	 AfterName := "After?" ;
	 AfterName[ 5 ] := CHAR( DumpNumber + ORD( 'A' ) ) ;
	 Debug.WriteS( " and " ) ;
	 Debug.WriteS( AfterName ) ;
	 Debug.WriteS( " ? " ) ;
	 IF Yes() THEN
	    Dump( BeforeName , Buffer^.Before ) ;
	    Dump( AfterName , Buffer^.After ) ;
	    INC( DumpNumber ) ;
	 END (* if *) ;
	 NothingFound := FALSE ;
	 Debug.Writeln ;
	 ClearLine ;
      END (* if *) ;
   END DumpBuffer ;


   PROCEDURE ClearLine ;
   VAR
      Index			    : CARDINAL ;
   BEGIN
      Debug.Wrch( 00DH ) ;
      FOR Index := 0 TO 78 DO
	 Debug.Wrch( ' ' ) ;
      END (* for *) ;
      Debug.Wrch( 00DH ) ;
   END ClearLine ;


VAR
   Buffer			 : BufferP ;
   XY				 : INTEGER ;
BEGIN
   IF ( Why = Handler.Stop ) AND ( NOT TerminatedCleanly ) THEN
      DumpNumber := 0 ;
      Debug.UseWrch( Debug.RawWrch ) ;
      Debug.Wrch( 26 ) ; (* Scrap any windows that might be active *)
      Debug.Wrch( 31 ) ; (* GOTO 0,10 *)
      Debug.Wrch(  0 ) ;
      Debug.Wrch( 10 ) ;
      ClearLine ;
      Debug.Writeln ;
      ClearLine ;
      Debug.WriteS( "Sorry, But the Editor has stopped abnormally*N" ) ;
      ClearLine ;
      Debug.WriteS( "Do you want buffers to be saved ? " ) ;
      XY := Interface.TkByte( 077H , 0 , 0 ) ; (* Close all exec files *)
      XY := Interface.TkByte( 015H , 0 , 0 ) ; (* Flush keyboard buffer *)
      IF Yes() THEN
	 NothingFound := TRUE ;
	 Buffer := AllBuffers ;
	 WHILE Buffer <> NIL DO
	    DumpBuffer( Buffer ) ;
	    Buffer := Buffer^.Next ;
	 END (* while *) ;
	 IF NothingFound THEN
	    ClearLine ;
	    Debug.WriteS( "No modified buffers were found*N" ) ;
	 END (* if *) ;
      END (* if *) ;
   END (* if *) ;
   RETURN 0 ;
END TerminationHandler ;


PROCEDURE Terminate ;
BEGIN
   TerminatedCleanly := TRUE ;
END Terminate ;


BEGIN
   Selected := NIL ;
   EditMarkers[ 1 ] := NIL ;
   EditMarkers[ 2 ] := NIL ;
   TerminatedCleanly := FALSE ;
   nextTag := 0;
END Buffers.