(*----------------------------------------------------------------------*)

IMPLEMENTATION MODULE Oblist;

(*----------------------------------------------------------------------*)

FROM Strings IMPORT EqualCC;

FROM Universe IMPORT BYTE;
FROM List IMPORT ListP, ListType, NameValueType, NameListP, False, True;
FROM Actions IMPORT ActionR, allNames, DispatchTable, LocalBinding,
                    BuiltInAction, Bind;
IMPORT Execute, StringData, Windows;
IMPORT Errors;

IMPORT Debug;

(*----------------------------------------------------------------------*)

PROCEDURE DescribeListBody( Arg : ListP ;
			    BracketCount : CARDINAL ;
			VAR NestedList : BOOLEAN ) ;
VAR
   P				  : ListP ;
   Index			  : CARDINAL ;
BEGIN
   NestedList := FALSE ;
   WITH Arg^ DO
      DescribeObject( Head , BracketCount + 1 , NestedList ) ;
      P := Tail ;
      WHILE P <> NIL DO
	 IF P^.Type <> ListT THEN
	    Errors.Panic( "List made of non list material" ) ;
	 END ;
	 Debug.Wrch( ' ' ) ;
	 DescribeObject( P^.Head , BracketCount + 1 , NestedList ) ;
	 P := P^.Tail ;
      END (* while *) ;
      IF ( NestedList ) AND ( BracketCount > 0 ) THEN
	 Debug.Writeln ;
	 FOR Index := 0 TO BracketCount DO
	    Debug.WriteS( "  " ) ;
	 END (* for *) ;
      END (* if *) ;
   END (* with *) ;
END DescribeListBody ;

(*----------------------------------------------------------------------*)

PROCEDURE DescribeObject( Arg : ListP ;
			  BracketCount : CARDINAL ;
		      VAR NestedList : BOOLEAN ) ;
VAR
   Index			  : CARDINAL ;
BEGIN
   IF Arg = NIL THEN
      RETURN ;
   END (* if *) ;
   WITH Arg^ DO
      CASE Type OF
	 NoneT :
	    Debug.WriteS( "++none++" ) ;
      |
	 BooleanT :
	    IF Boolean THEN
	       Debug.Wrch( "T" ) ;
	    ELSE
	       Debug.Wrch( "F" ) ;
	    END (* if *) ;
      |
	 NumberT :
	    Debug.WriteC( Number ) ;
      |
	 ByteT :
	    Debug.WriteChar( Byte ) ;
      |
	 NameT :
	    Debug.WriteS( Name^.Name ) ;
      |
	 StringT :
	    IF String = NIL THEN
	       Debug.WriteS( '""' ) ;
	    ELSE
	       StringData.WriteString( String ) ;
	    END (* if *) ;
      |
	 WindowT :
	    Debug.WriteS( "++Window " ) ;
	    Debug.WritePointer( Window ) ;
	    Debug.WriteS( " ++" ) ;
      |
	 MarkerT :
	    Debug.WriteS( "++Marker " ) ;
	    Debug.WritePointer( Marker ) ;
	    Debug.WriteS( " ++" ) ;
      |
	 ListT :
	    IF BracketCount > 0 THEN
	       Debug.Writeln ;
	       FOR Index := 0 TO BracketCount DO
		  Debug.WriteS( "  " ) ;
	       END (* for *) ;
	    END (* if *) ;
	    Debug.Wrch( '(' ) ;
	    DescribeListBody( Arg , BracketCount , NestedList ) ;
	    Debug.Wrch( ')' ) ;
	    NestedList := TRUE ;
      END (* case *) ;
   END (* with *) ;
END DescribeObject ;

(*----------------------------------------------------------------------*)

PROCEDURE Oblist( Arg : ListP ) : ListP ;
VAR
   P			 : NameListP ;
   NestedList		 : BOOLEAN ;
BEGIN
   P := allNames ;
   Debug.Wrch( '(' ) ;
   WHILE P <> NIL DO
      Debug.Writeln ;
      Debug.WriteS( "  (" ) ;
      CASE P^.CurrentValue^.Type OF
	 BuiltInT :
	    Debug.WriteS( "BuiltIn " ) ;
	    Debug.WriteS( P^.Name ) ;
	    Debug.WriteS( ' "' ) ;
	    Debug.WriteS( P^.CurrentValue^.Text ) ;
	    Debug.WriteS( '" ' ) ;
	    IF P^.CurrentValue^.ArgsText = NIL THEN
	       Debug.WriteS( '""' ) ;
	    ELSE
	       StringData.WriteString( P^.CurrentValue^.ArgsText ) ;
	    END (* if *) ;
      |
	 DefinedT :
	    Debug.WriteS( "Define " ) ;
	    Debug.WriteS( P^.Name ) ;
	    Debug.WriteS( ' "' ) ;
	    Debug.WriteS( P^.CurrentValue^.Text ) ;
	    Debug.WriteS( '" ' ) ;
	    IF P^.CurrentValue^.Args = NIL THEN
	       Debug.WriteS( "()" ) ;
	    ELSE
	       DescribeObject( P^.CurrentValue^.Args , 2 , NestedList ) ;
	    END (* if *) ;
	    Debug.WriteS( "    " ) ;
	    DescribeListBody( P^.CurrentValue^.Body , 1 , NestedList ) ;
      |
	 VariableT :
	    Debug.WriteS( "SetVar " ) ;
	    Debug.WriteS( P^.Name ) ;
	    DescribeObject( P^.CurrentValue^.Body , 2 , NestedList ) ;
      END (* case *) ;
      Debug.Wrch( ')' ) ;
      P := P^.next ;
      IF NOT Execute.Idle() THEN
	 Debug.WriteS( "*N{ Oblist truncated }*N)*N" ) ;
	 RETURN True ;
      END (* if *) ;
   END (* while *) ;
   Debug.WriteS( ")*N" ) ;
   RETURN True ;
END Oblist ;

(*----------------------------------------------------------------------*)

PROCEDURE DescribeAction( Action : ActionR ) ;
VAR
   Nested	      : BOOLEAN ;
BEGIN
   WITH Action DO
      Debug.WriteS( " => '" ) ;
      Debug.WriteS( Binding^.Name ) ;
      Debug.WriteS( "' " ) ;
      IF Binding^.CurrentValue^.Type = BuiltInT THEN
	 Debug.WriteHex( CARDINAL( Binding^.CurrentValue^.Proc ) DIV 10000H , 4 ) ;
	 Debug.Wrch( ':' ) ;
	 Debug.WriteHex( CARDINAL( Binding^.CurrentValue^.Proc ) MOD 10000H , 4 ) ;
	 Debug.WriteS( "()" ) ;
      ELSIF Binding^.CurrentValue^.Type = DefinedT THEN
	 Debug.WriteS( "Defined => " ) ;
	 DescribeObject( Binding^.CurrentValue^.Body , 0 , Nested ) ;
	 Debug.Writeln ;
      ELSE
	 Debug.WriteS( "??? Funny Type ???" ) ;
      END (* if *) ;
      Debug.WriteS( " A=" ) ;
      Debug.WriteHex( Arg , 8 ) ;
      Debug.Writeln ;
   END (* with *) ;
END DescribeAction ;

(*----------------------------------------------------------------------*)

PROCEDURE DebugKeyBindings( Arg : ListP ) : ListP ;
VAR
   I		      : [ 0..255 ] ;
   Action	      : ActionR ;
BEGIN
   FOR I := 000H TO 0FFH DO
      IF LocalBinding( Windows.Selected^.Buffer , Action , BYTE( I ) ) THEN
	 Debug.WriteS( "Local  " ) ;
	 Debug.WriteS( "Key " ) ;
	 Debug.WriteHex( I , 2 ) ;
	 DescribeAction( Action ) ;
      ELSE
(*
	 IF EqualCC( "Nothing" , DispatchTable[ I ].Binding^.Name )
	 OR EqualCC( "Insert" , DispatchTable[ I ].Binding^.Name ) THEN
	    (* Ignore these *)
	 ELSE
*)
	    Debug.WriteS( "Global " ) ;
	    Debug.WriteS( "Key " ) ;
	    Debug.WriteHex( I , 2 ) ;
	    DescribeAction( DispatchTable[ I ] ) ;
(*
	 END (* if *) ;
*)
      END (* if *) ;
      IF NOT Execute.Idle() THEN
	 RETURN True ;
      END (* if *) ;
   END (* for *) ;
   RETURN True ;
END DebugKeyBindings ;

(*----------------------------------------------------------------------*)

PROCEDURE Initialise;

   BEGIN
      BuiltInAction ("DebugKey", DebugKeyBindings, "Debug[ Key bindings ]");
      BuiltInAction ("Oblist", Oblist, "Print Oblist");

      Bind (BYTE (0DEH), "DebugKey", NIL);
      Bind (BYTE (0DFH), "Oblist", NIL);
   END Initialise;

(*----------------------------------------------------------------------*)

PROCEDURE Terminate;

   BEGIN
   END Terminate;

(*----------------------------------------------------------------------*)

END Oblist.