Topspeed_JPI/TS-V3/REP16/BUILDLST.MOD

IMPLEMENTATION MODULE BuildLst;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/buildlst.mov   1.5   10 Mar 1991 15:25:16   coleb  $
 *
 *)


IMPORT AltKeys;
IMPORT ErrorManager;
IMPORT GenLists;
IMPORT KbdInput;
IMPORT M2Strings;
IMPORT NdxBones;
IMPORT NdxFiles;
IMPORT NdxTypes;
IMPORT PosUtils;
IMPORT ScreenInput;
IMPORT ScrnTypes;
IMPORT ScrnUtl1;
IMPORT StrEdit;
IMPORT StrLogic;
IMPORT VWindows;
IMPORT WindowPrims;

VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      AltKeys.Init();
      ErrorManager.Init();
      GenLists.Init();
      KbdInput.Init();
      M2Strings.Init();
      NdxBones.Init();
      NdxFiles.Init();
      NdxTypes.Init();
      PosUtils.Init();
      ScreenInput.Init();
      ScrnTypes.Init();
      ScrnUtl1.Init();
      StrEdit.Init();
      StrLogic.Init();
      VWindows.Init();
      WindowPrims.Init();
    END Init;


  PROCEDURE DeleteListRec( VAR TheList: GenLists.GenList);
    VAR
      dumc, BadOne: CARDINAL;
    BEGIN
      BadOne := GenLists.ScanList( ListStorageRec,
          TheList, 1, 65535, dumc);
      IF BadOne # 0 THEN
        GenLists.ListDelete( TheList, BadOne, 1);
      END;
    END DeleteListRec;


  PROCEDURE BuildList( NdxFile: NdxTypes.NdxFileType; TheFrame:
      ScrnTypes.DisplayFrame; FirstRuleField, LastRuleField: CARDINAL;
      LimitingListName: ARRAY OF CHAR; VAR ErrorField: CARDINAL; VAR
      OutList: GenLists.GenList);

    VAR
      LimitingList, TmpList, Criteria: GenLists.GenList;
      KeyHit, cnt: CARDINAL;
      dumbool: BOOLEAN;
      TmpFieldRec: ScrnTypes.InputFieldRecord;
      TmpExpression: ARRAY [0..79] OF CHAR;
    BEGIN
      (*BuildLists*)
      ErrorField := 0;
      FOR cnt := FirstRuleField TO LastRuleField DO
        (*First we make sure each non-empty field contains a
          valid search expression.*)
        ScrnUtl1.GetFieldText( TheFrame, cnt, TmpExpression);
        IF NOT PosUtils.IsBlank( TmpExpression ) THEN
          IF StrLogic.ExpressionTest( (*dummy string*) '',
              TmpExpression ) = 0 THEN
            (*do nothing*)
          END;
          IF StrLogic.StrLogicErrorLevel # 0 THEN
            (*something's wrong with this expression*)
            ErrorField := cnt;
          END;
        END;
      END;
      IF ErrorField # 0 THEN
        RETURN;
      END;
      IF M2Strings.Length(LimitingListName) > 0 THEN
        IF NOT GetRecNameList( NdxFile, LimitingListName,
            LimitingList) THEN
          WindowPrims.MsgBox( VWindows.SE,
              "List not stored.  Press any key.",
              KbdInput.AnyKeyNum, KeyHit );
          GenLists.NewList( LimitingList );
        END;
      ELSE
        GenLists.NewList( LimitingList );
      END;
      GenLists.NewList( Criteria );
      FOR cnt := FirstRuleField TO LastRuleField DO
        ScrnUtl1.GetFieldText( TheFrame, cnt, TmpExpression);
        IF NOT PosUtils.IsBlank( TmpExpression ) THEN
          ScrnUtl1.GetFieldRec( TheFrame, cnt, TmpFieldRec );
          AltKeys.AddCriteria( Criteria, AltKeys.or, AltKeys.StrSelector,
              TmpExpression, TmpFieldRec.fnam );
          (*Means the field names in this screen have to be the
            same as the field names we plan to search.*)
        END;
      END;
      IF AltKeys.LoadAltList( NdxFile, LimitingList, 'KEY', Criteria ) THEN
        IF NOT AltKeys.GetAltList( NdxFile, 'KEY', TmpList ) THEN
          ErrorManager.WARN('Critical error in building list.');
        END;
        GenLists.CopyList( TmpList, OutList );
        AltKeys.DisposeAltList( NdxFile, 'KEY' );
      ELSE
        GenLists.NewList( OutList );
      END;
      GenLists.DisposeList( Criteria );
    END BuildList;

  PROCEDURE TypeCheck( TheList: GenLists.GenList; TheElmt: CARDINAL ):
      CARDINAL;
      (*This routine is described in section 6.9 of the manual.*)
    VAR
      TypeCode, DummySize: CARDINAL;
      DummyAddr: POINTER TO CARDINAL;
    BEGIN
      GenLists.GetElmtAdr( TheList, TheElmt, DummyAddr, DummySize,
          TypeCode );
      RETURN TypeCode;
    END TypeCheck;

  VAR
    LastSpot: CARDINAL;

  PROCEDURE GetNamedList( MainList: GenLists.GenList; ListName: ARRAY OF
      CHAR; VAR TheList: GenLists.GenList ): BOOLEAN;
    VAR
      TypeCode, lngth, cnt: CARDINAL;
      TmpStr: ARRAY [0..79] OF CHAR;
      NameList: GenLists.GenList;
    BEGIN
      IF GenLists.ListLength( MainList ) < 2 THEN
        RETURN FALSE;
      END;
      IF TypeCheck( MainList, 1 ) # GenLists.ListCode THEN
        RETURN FALSE;
      END;
      GenLists.GetChildList( MainList, 1, NameList );
      lngth := GenLists.ListLength( NameList );
      IF lngth # (GenLists.ListLength(MainList) -1) THEN
        (*Corrupted list.*)
        HALT();
      END;
      StrEdit.CrunchBlanks( ListName );
      FOR cnt := 1 TO lngth DO
        GenLists.GetElmt( NameList, cnt, TmpStr, TypeCode );
        StrEdit.CrunchBlanks( TmpStr );
        IF PosUtils.Equal(TmpStr, ListName) THEN
          LastSpot := cnt;
          GenLists.GetElmt( MainList, cnt + 1, TheList, TypeCode );
          RETURN TRUE;
        END;
      END;
      RETURN FALSE;
    END GetNamedList;

  PROCEDURE AddNamedList( MainList: GenLists.GenList; ListName: ARRAY OF
      CHAR; VAR TheList: GenLists.GenList );
    VAR
      NameList: GenLists.GenList;
    BEGIN
      IF GenLists.ListLength( MainList ) = 0 THEN
        GenLists.NewList( NameList );
        GenLists.ListInsert( NameList, GenLists.ListCode, MainList, 1 );
      END;
      StrEdit.CrunchBlanks( ListName );
      GenLists.GetChildList( MainList, 1, NameList );
      GenLists.ListInsert( ListName, GenLists.StrCode, NameList, GenLists.ListLength(NameList) + 1 );
      GenLists.ListInsert( TheList, GenLists.ListCode, MainList, GenLists.ListLength(MainList) + 1 );
      LastSpot := GenLists.ListLength(NameList) + 1;
    END AddNamedList;

  PROCEDURE DelNamedList( MainList: GenLists.GenList; ListName: ARRAY OF
      CHAR ): BOOLEAN;
    VAR
      NameList: GenLists.GenList;
    BEGIN
      StrEdit.CrunchBlanks( ListName );
      IF NOT GetNamedList( MainList, ListName, NameList ) THEN
        RETURN FALSE;
      END;
      GenLists.ListDelete( MainList, LastSpot + 1, 1 );
      GenLists.GetChildList( MainList, 1, NameList );
      GenLists.ListDelete( NameList, LastSpot, 1 );
      RETURN TRUE;
    END DelNamedList;



  PROCEDURE GetRecNameList( NdxFile: NdxTypes.NdxFileType; ListName: ARRAY
      OF CHAR; VAR TheList: GenLists.GenList ): BOOLEAN;
    VAR
      TypeCode: CARDINAL;
      TopList, TmpList, TmpList2: GenLists.GenList;
    BEGIN
      IF NOT NdxFiles.GetField( NdxFile, ListStorageRec, 'RECORD',
          TypeCode, TopList ) THEN
        RETURN FALSE;
      END;
      IF TypeCode # GenLists.ListCode THEN
        (*Something's wrong with this file.*)
        HALT();
      END;
      IF TypeCheck( TopList, 2 ) = GenLists.ListCode THEN
        GenLists.GetElmt( TopList, 2, TmpList, TypeCode );
      ELSE
        RETURN FALSE;
      END;
      IF NOT GetNamedList( TmpList, ListName, TmpList2 ) THEN
        RETURN FALSE;
      ELSE
        GenLists.CopyList( TmpList2, TheList );
        RETURN TRUE;
      END;
    END GetRecNameList;


  PROCEDURE StoreRecNameList( NdxFile: NdxTypes.NdxFileType; ListName: ARRAY
      OF CHAR; TheList: GenLists.GenList ): BOOLEAN;
    VAR
      TypeCode: CARDINAL;
      TopList, OldList: GenLists.GenList;
        (*A list of lists; structured just like the AltKey list
          in an NdxFileType record.*)

    BEGIN
      IF NOT NdxFiles.GetField( NdxFile, ListStorageRec, 'RECORD',
          TypeCode, TopList ) THEN
        IF GenLists.ListLength( NdxFile^.ListBuf ) = 0 THEN
          (*File has just been opened; ListBuf needs to be
            initialized.  We'll do it by calling PutField.*)
          GenLists.NewList( TopList );
          IF NdxFiles.PutField( NdxFile, ListStorageRec,
              'RECORD', GenLists.ListCode, TopList ) THEN
            (*This shouldn't happen; we're supposed to return
              false here.*)
            HALT();
          END;
        END;
        GenLists.CopyList( NdxFile^.ListBuf, TopList );
      END;
      IF TypeCheck( TopList, 2 ) = GenLists.ListCode THEN
        GenLists.GetElmt( TopList, 2, OldList, TypeCode );
      ELSE
        GenLists.NewList( OldList );
      END;
      IF DelNamedList( OldList, ListName ) THEN
        (*Do nothing; we do this just to make sure we don't have
          two lists with the same name.*)
      END;
      AddNamedList( OldList, ListName, TheList );
      GenLists.ListReplace( OldList, GenLists.ListCode, TopList, 2 );
      IF NOT NdxFiles.PutField( NdxFile, ListStorageRec,
          'RECORD', GenLists.ListCode, TopList ) THEN
        RETURN FALSE;
      END;
      IF NOT NdxFiles.WriteRecord( NdxFile, ListStorageRec ) THEN
        RETURN FALSE;
      END;
      RETURN TRUE;
    END StoreRecNameList;

  PROCEDURE DelRecNameList( NdxFile: NdxTypes.NdxFileType; ListName: ARRAY
      OF CHAR ): BOOLEAN;
    VAR
      TmpList, TopList: GenLists.GenList;
      TypeCode: CARDINAL;
    BEGIN
      IF PosUtils.IsBlank( ListName) THEN
        RETURN FALSE;
      END;
      IF NOT NdxFiles.GetField( NdxFile, ListStorageRec, 'RECORD',
          TypeCode, TopList ) THEN
        RETURN FALSE;
      END;
      IF TypeCode # GenLists.ListCode THEN
        RETURN FALSE;
      END;
      IF TypeCheck( TopList, 2 ) = GenLists.ListCode THEN
        GenLists.GetElmt( TopList, 2, TmpList, TypeCode );
      ELSE
        RETURN FALSE;
      END;
      IF NOT DelNamedList( TmpList, ListName ) THEN
        RETURN FALSE;
      END;
      GenLists.ListReplace( TmpList, GenLists.ListCode, TopList, 2 );
      IF NOT NdxFiles.PutField( NdxFile, ListStorageRec,
          'RECORD', GenLists.ListCode, TopList ) THEN
        RETURN FALSE;
      END;
      IF NOT NdxFiles.WriteRecord( NdxFile, ListStorageRec ) THEN
        RETURN FALSE;
      END;
      RETURN TRUE;
    END DelRecNameList;


  PROCEDURE GetListNames( NdxFile: NdxTypes.NdxFileType; VAR TheList:
      GenLists.GenList ): BOOLEAN;
    VAR
      TypeCode: CARDINAL;
      TopList, TmpList, TmpList2: GenLists.GenList;
    BEGIN
      IF NOT NdxFiles.GetField( NdxFile, ListStorageRec, 'RECORD',
          TypeCode, TopList ) THEN
        RETURN FALSE;
      END;
      IF TypeCode # GenLists.ListCode THEN
        (*Something's wrong with this file.*)
        HALT();
      END;
      IF TypeCheck( TopList, 2 ) = GenLists.ListCode THEN
        GenLists.GetElmt( TopList, 2, TmpList, TypeCode );
      ELSE
        RETURN FALSE;
      END;
      GenLists.GetChildList( TmpList, 1, TmpList2 );
      IF GenLists.Initialized(TmpList2) THEN
        GenLists.CopyList( TmpList2, TheList );
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END GetListNames;


BEGIN
  Initialized := FALSE;
  Init();
END BuildLst.