{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT ListEdit;

{$i platform.inc}

{ all routines to edit a mailing list definition + subscribers }

INTERFACE

USES DataBase;

PROCEDURE EditMailingLists;


IMPLEMENTATION

USES Ramon,
     Cfg,
     Fido,
     UnixTime,
     Globals,
     FlexCfg;

{$I WTRHLP.INC}

CONST AccessEditOptions = 'full|receive-only|post-only';

VAR ListAkaStr     : STRING[30];
    ListDomainStr  : STRING[MaxLenDomain];
    ListConfirmStr : STRING[3];
    ListAreaName   : STRING[40];

    EditListRec    : MailingListRecord;


{--------------------------------------------------------------------------}
{ EditListUser                                                             }
{                                                                          }
{ This routine is used to edit a mailing list subscriber record.           }
{                                                                          }
PROCEDURE EditListUser (VAR ListUser : ListUserRecord);

CONST Xb  = 5;
      Xb2 = Xb+20;
      Yb  = 10;
      Xl  = 72;

VAR Yl,
    FieldY : XYType;
    AkaStr : STRING[MaxLenFidoAddrString];

BEGIN
     CASE ListUser.UserType OF
          lutFTN :
              Yl:=13;

          lutRFC :
              Yl:=12;

          lutRemoteGW :
              Yl:=14;
     END; { case }

     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     FieldPushAll;
     FieldInit;

     FieldY:=Yb+1;

     WITH ListUser DO
     BEGIN
          AkaStr:=AddUpWithSpaces (MaxLenFidoAddrString,Fido2Str (Aka));
          User:=AddUpWithSpaces (MaxLenUserName,User);
          Email:=AddUpWithSpaces (MaxLenDomain,Email);
          
          IF (ListUser.UserType <> lutRFC) THEN
          BEGIN
               WriteXY (Xb+2,FieldY,'Name');
               FieldAutoDefineOne (Xb2,FieldY,@User,RepChar (MaxLenUserName,'$'));
               FieldSetHelp (0,htr_ListUser_Name);
               Inc (FieldY);
          END;

          IF (ListUser.UserType <> lutRFC) THEN
          BEGIN
               WriteXY (Xb+2,FieldY,'AKA');
               FieldAutoDefineCheckOne (Xb2,FieldY,@AkaStr,RepChar (MaxLenFidoAddrString,'$'),CheckFidoAddr);
               FieldSetHelp (0,htr_ListUser_AKA);
               Inc (FieldY);
          END;

          IF (ListUser.UserType <> lutFTN) THEN
          BEGIN
               WriteXY (Xb+2,FieldY,'E-mail');
               FieldAutoDefineOne (Xb2,FieldY,@Email,RepChar (MaxLenDomain,'$'));
               FieldSetHelp (0,htr_ListUser_Email);
               Inc (FieldY);
          END;

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Access');
          FieldAutoDefineToggles (Xb2,FieldY,Access,AccessEditOptions,0);
          FieldSetHelp (0,htr_ListUser_Access);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Receive own mail');
          FieldAutoDefineToggles (Xb2,FieldY,ReceiveOwnMail,'no|yes',0);
          FieldSetHelp (0,htr_ListUser_ReceiveOwnMail);
          
          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Confirm state');
          FieldAutoDefineToggles (Xb2,FieldY,ConfirmState,'disabled|ok|try1|try2|try3',0);
          FieldSetHelp (0,htr_ListUser_ConfirmState);

          Inc (FieldY);
          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Subscribed');
          WriteXY (Xb+2,FieldY+1,'Last confirmed');
          WriteXY (Xb+2,FieldY+2,'Confirm requested');
          WriteXY (Xb+2,FieldY+3,'Last code used');

          WriteXYC (Xb2,FieldY,cBoxBack,UnixTimeToString (SubscribedDate));
          WriteXY (Xb2,FieldY+1,UnixTimeToString (ConfirmedDate));
          WriteXY (Xb2,FieldY+2,UnixTimeToString (ConfirmReqDate));
          WriteXY (Xb2,FieldY+3,Long2HexString (ConfirmCode));

          FieldEdit;

          { remove spaces }
          FidoSplit (DeleteBackSpaces (AkaStr),ListUser.Aka);
          User:=DeleteFrontAndBackspaces (User);
          Email:=DeleteFrontAndBackSpaces (Email);
     END; { with }

     FieldPopAll;
     WindowPop;
END;


{ following two functions are used to add items the list of list subscribers }

{----------------------------------------------------------------------}
{ BuildAddOne                                                          }
{                                                                      }
PROCEDURE BuildAddOne (VAR ListUser : ListUserRecord; RecNo : ListUserRecordNrType);

VAR AccessStr : STRING[5];

BEGIN
     CASE ListUser.Access OF
          laReadWrite :
              AccessStr:=' (rw)';

          laReadOnly :
              AccessStr:=' (ro)';

          laWriteOnly :
              AccessStr:=' (wo)';

          ELSE
              AccessStr:=' (??)';
     END;

     { voeg een entry aan de lijst toe }
     CASE ListUser.UserType OF
          lutFTN :
              ListAddItem (ListUser.User+' at '+Fido2Str (ListUser.Aka)+AccessStr,
                           RecNo,Sorted);

          lutRFC :
              ListAddItem (ListUser.Email+AccessStr,
                           RecNo,Sorted);

          lutRemoteGW :
              ListAddItem (ListUser.Email+' via '+ListUser.User+' at '+Fido2Str (ListUser.Aka)+AccessStr,
                           RecNo,Sorted);
     END; { case }
END;


{--------------------------------------------------------------------------}
{ BuildReadAddOne                                                          }
{                                                                          }
PROCEDURE BuildReadAddOne (Pos : ListUserRecordNrType);

VAR ListUser : ListUserRecord;

BEGIN
     ListUser_Read (Pos,ListUser);
     BuildAddOne (ListUser,Pos);
END;


{--------------------------------------------------------------------------}
{ ImportSubscribersList_FTN                                                }
{                                                                          }
{ Haalt een lijst met Fido users van disk om toe te voegen.                }
{                                                                          }
{ Formaat:                                                                 }
{                                                                          }
{ ; Rem regel                                                              }
{ 2:280/802.6           Martijn Dijksterhuis                               }
{                                                                          }
PROCEDURE ImportSubscribersList_FTN (VAR ListRec : MailingListRecord);

CONST Xb = 9;
      Yb = 17;
      Xl = 64;
      Yl = 6;

VAR Quit        : BOOLEAN;
    Regel       : STRING;
    Path        : STRING[80];
    ImpFile     : TEXT;
    FidoStr     : FidoAddrString;
    ListUserRec : ListUserRecord;

BEGIN
     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     FieldPushAll;
     FieldInit;
     WriteXY (Xb+2,Yb+1,'Path+Filename of the file to import (F3 to pick file)');
     Path:=RepChar (79,' ');

     FieldDefineFileMgr (1,Xb+2,Yb+3,79,60,0,0,@Path,AnyFileMgr,FALSE);
     FieldSetHelp (1,htr_ListUserImport_FTN);

     PushKeysLine;
     WriteFieldEditDirectKeysLine;

     Quit:=FALSE;
     REPEAT
           FieldEditDirect;

           Quit:=TRUE;
           IF (Key = kRet) THEN
              IF TestIfExist (Path)  THEN
              BEGIN
                   Assign (ImpFile,Path);
                   {$I-} Reset (ImpFile); {$I+}

                   WHILE (NOT Eof (ImpFile)) DO
                   BEGIN
                        ReadLn (ImpFile,Regel);
                        Regel:=DeleteCTFBS (Regel);

                        IF (Regel = '') THEN
                           Continue;

                        FidoStr:=Copy (Regel,1,Pos (' ',Regel)-1);
                        Delete (Regel,1,Pos (' ',Regel));

                        FillChar (ListUserRec,SizeOf (ListUserRec),0);
                        WITH ListUserRec DO
                        BEGIN
                             ListID:=ListRec.ListID;
                             UserType:=lutFTN;
                             FidoSplit (FidoStr,Aka);
                             User:=DeleteFrontSpaces (Regel);
                             Access:=ListRec.DefaultAccess;
                             SubscribedDate:=GetCurrentUnixTime;
                             ConfirmedDate:=0;  { trigger at once }
                             ConfirmReqDate:=0;
                             ConfirmState:=lcReq2;
                             ConfirmCode:=0;
                        END; { with }

                        BuildReadAddOne (ListUser_WriteNew (ListUserRec));
                   END; { while not eof }

                   Close (ImpFile);
              END ELSE
              BEGIN
                   Error ('File does not exist');
                   Quit:=FALSE;
              END;
     UNTIL Quit;

     FieldPopAll;
     PopKeysLine;
     WindowPop; { path window }
END;


{---------------------------------------------------------------------------}
{ ImportSubscribersList_RFC                                                 }
{                                                                           }
{ Deze routine importeert een lijst met adresses voor de list server base.  }
{ Format: op iedere regel een compleet user adres, commentaar regels met    }
{ puntkomma beginnen en lege regels toegestaan.                             }
{                                                                           }
PROCEDURE ImportSubscribersList_RFC (VAR ListRec : MailingListRecord);

CONST Xb = 9;
      Yb = 17;
      Xl = 64;
      Yl = 6;

VAR Quit        : BOOLEAN;
    Regel       : STRING;
    Path        : STRING[80];
    ImpFile     : TEXT;
    ListUserRec : ListUserRecord;

BEGIN
     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     FieldPushAll;
     FieldInit;

     WriteXY (Xb+2,Yb+1,'Path+Filename of the file to import (F3 to pick file)');
     Path:=RepChar (79,' ');

     FieldDefineFileMgr (1,Xb+2,Yb+3,79,60,0,0,@Path,AnyFileMgr,FALSE);
     FieldSetHelp (1,htr_ListUserImport_RFC);

     PushKeysLine;
     WriteFieldEditDirectKeysLine;

     Quit:=FALSE;
     REPEAT
           FieldEditDirect;

           Quit:=TRUE;
           IF (Key = kRet) THEN
              IF TestIfExist (Path)  THEN
              BEGIN
                   Assign (ImpFile,Path);
                   {$I-} Reset (ImpFile); {$I+}

                   WHILE (NOT Eof (ImpFile)) DO
                   BEGIN
                        ReadLn (ImpFile,Regel);
                        Regel:=DeleteCTFBS (Regel);

                        IF (Regel = '') THEN
                           Continue;

                        FillChar (ListUserRec,SizeOf (ListUserRecord),0);

                        WITH ListUserRec DO
                        BEGIN
                             ListID:=ListRec.ListID;
                             UserType:=lutRFC;
                             Email:=Regel;
                             Access:=ListRec.DefaultAccess;
                             SubscribedDate:=GetCurrentUnixTime;
                             ConfirmedDate:=0;  { trigger at once }
                             ConfirmReqDate:=0;
                             ConfirmState:=lcReq2;
                             ConfirmCode:=0;
                        END; { with }

                        BuildReadAddOne (ListUser_WriteNew (ListUserRec));
                   END; { while not eof }

                   Close (ImpFile);
              END ELSE
              BEGIN
                   Error ('File does not exist');
                   Quit:=FALSE;
              END;
     UNTIL Quit;

     FieldPopAll;
     PopKeysLine;
     WindowPop; { path window }
END;


{--------------------------------------------------------------------------}
{ InsertNewSubscriber                                                      }
{                                                                          }
FUNCTION InsertNewSubscriber (VAR ListRec : MailingListRecord) : ListUserRecordNrType;

VAR ListUser      : ListUserRecord;
    ListUserRecNo : ListUserRecordNrType;

BEGIN
     InsertNewSubscriber:=NILRecordNr; { geen }

     MenuDefine (6,15,'Add Subscriber');
     MenuSetHelp (htr_ListUser_Add);
     MenuAddItem ('Add subscriber with RFC address');
     MenuAddItem ('Add subscriber with FTN address');
     MenuAddItem ('Add subscriber with RFC address behind remote FTN-RFC gateway');
     MenuAddItem ('Import list of FTN addresses');
     MenuAddItem ('Import list of RFC addresses');
     MenuShow;

     MenuSelect;
     MenuErase;

     CASE Key OF
          kEsc : Exit;

          mOpt04 :
              BEGIN
                   ImportSubscribersList_FTN (ListRec);
                   Exit;
              END;

          mOpt05 :
              BEGIN
                   ImportSubscribersList_RFC (ListRec);
                   Exit;
              END;
     END; { case }

     WITH ListUser DO
     BEGIN
          ListID:=ListRec.ListID;

          CASE Key OF
               mOpt01 :
                   { RFC subscribers }
                   UserType:=lutRFC;

               mOpt02 :
                   { FTN subscribers }
                   UserType:=lutFTN;

               mOpt03 :
                   { RFC subscribers behind remote gateway }
                   UserType:=lutRemoteGW;
          END; { case }

          User:='';
          FidoSplit ('0',Aka);
          Email:='';
          Access:=ListRec.DefaultAccess;
          SubscribedDate:=GetCurrentUnixTime;
          ConfirmedDate:=0;  { trigger at once }
          ConfirmReqDate:=0;
          ConfirmState:=lcReq2;
          ConfirmCode:=0;
          ReceiveOwnMail := TRUE;
     END; { with }

     { create the new record }
     ListUserRecNo:=ListUser_WriteNew (ListUser);

     { edit it }
     EditListUser (ListUser);

     { save it again }
     ListUser_Write (ListUserRecNo,ListUser);

     { return the new record number so the list can be updated }
     InsertNewSubscriber:=ListUserRecNo;
END;


{----------------------------------------------------------------------}
{ EditUsers_BuildSubscribersList                                       }
{                                                                      }
{ This routine searches the base with list users and adds all matching }
{ users (with the correct ListID) to the ramon list.                   }
{                                                                      }
PROCEDURE EditUsers_BuildSubscribersList (ListID : WORD; ListName : STRING);

CONST Xb = 3;
      Yb = 3;
      Xl = 75;

VAR Lp       : ListUserRecordNrType;
    ListUser : ListUserRecord;

BEGIN
     Message ('Building list, please wait...');

     ListDefine (Xb,Yb,Xl,Video.Rows-Yb-1,Default,
                 'Users subscribed to '+ListName,
                 htr_ListUser_List);

     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUser);

          IF (ListUser.ListID = ListID) AND (ListUser.UserType <> lutDeleted) THEN
             BuildAddOne (ListUser,Lp);
     END; { for }

     WindowPop;
END;


{--------------------------------------------------------------------------}
{ EditUsers_GlobalChangeAccess                                             }
{                                                                          }
PROCEDURE EditUsers_GlobalChangeAccess (ListID : WORD; NewAccess : ListAccessType);

VAR Lp       : ListUserRecordNrType;
    ListUser : ListUserRecord;

BEGIN
     Message ('Changing access type, please wait...');

     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUser);
          IF (ListUser.ListID = ListID) THEN
          BEGIN
               ListUser.Access:=NewAccess;
               ListUser_Write (Lp,ListUser);
          END;
     END; { for }

     WindowPop;
END;


{--------------------------------------------------------------------------}
{ EditUsers_ExportTaggedUsers                                              }
{                                                                          }
PROCEDURE EditUsers_ExportTaggedUsers;

CONST Xb = 9;
      Yb = 17;
      Xl = 64;
      Yl = 6;

VAR Path     : STRING[80];
    ExpFile  : TEXT;
    Lp       : WORD;
    Keuze    : WORD;
    ListUser : ListUserRecord;

BEGIN
     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     FieldPushAll;
     FieldInit;

     WriteXY (Xb+2,Yb+1,'Path+Filename of the file to export to (F3 for File Manager)');
     Path:=RepChar (79,' ');

     FieldDefineFileMgr (1,Xb+2,Yb+3,79,60,0,0,@Path,AnyFileMgr,FALSE);
     FieldSetHelp (1,htr_ListUser_Export);

     PushKeysLine;
     WriteFieldEditDirectKeysLine;

     FieldEditDirect;

     IF (Key = kRet) THEN
     BEGIN
          Message ('Exporting, please wait...');

          Assign (ExpFile,Path);
          {$I-} ReWrite (ExpFile); {$I+}

          WriteLn (ExpFile,'; Exported by WaterGate');
          WriteLn (ExpFile,';');

          FOR Lp:=1 TO ListTagCount DO
          BEGIN
               Keuze:=ListGetTaggedItemNr (Lp);
               ListUser_Read (Keuze,ListUser);

               CASE ListUser.UserType OF
                    lutFTN:
                        WriteLn (ExpFile,Fido2Str (ListUser.Aka)+' '+ListUser.User);

                    lutRFC:
                        WriteLn (ExpFile,ListUser.Email);

                    lutRemoteGW:
                        WriteLn (ExpFile,ListUser.Email+
                                         ' via '+Fido2Str (ListUser.Aka)+
                                         ' '+ListUser.User);

               END; { case }
          END; { for }

          Close (ExpFile);

          WindowPop;
          Message ('Exported '+Word2String (ListTagCount)+' addresses. Press any key...');
          ReadKey;
          WindowPop;
     END;

     FieldPopAll;
     PopKeysLine;
     WindowPop; { path window }
END;


{--------------------------------------------------------------------------}
{ EditSubScribedUsers                                                      }
{                                                                          }
{ Edit handmatig een user van een list server.                             }
{                                                                          }
PROCEDURE EditSubScribedUsers; FAR;

VAR ListUser : ListUserRecord;
    Quit     : BOOLEAN;
    Keuze    : WORD;
    Yl       : XYType;

BEGIN
     EditUsers_BuildSubscribersList (EditListRec.ListID,EditListRec.Name);

     Quit:=FALSE;

     WHILE (NOT Quit) DO
     BEGIN
          IF (ListItemCount = 0) THEN
             ListAddItem ('<no subscribers>',65535,Bottom);

          Keuze:=ListSelect (DoTag,[kIns,kDel,kF2]);

          ListRemoveItem (65535);

          CASE Key OF
               kEsc :
                   Quit:=TRUE;

               kRet :
                   IF (ListTagCount = 0) THEN
                   BEGIN
                        ListUser_Read (Keuze,ListUser);
                        EditListUser (ListUser);
                        ListUser_Write (Keuze,ListUser);

                        ListRemoveItem (Keuze);
                        BuildReadAddOne (Keuze);
                        ListSetCursorOnItem (Keuze);
                   END ELSE
                   BEGIN
                        MenuDefine (40,15,'Global Change Access');
                        MenuAddItem ('Full access');
                        MenuAddItem ('Receive-only');
                        MenuAddItem ('Post-only');
                        MenuAddItem ('Don''t change anything');
                        MenuSetHelp (htr_ListUser_ChangeAccess);
                        MenuShow;
                        MenuSelect;
                        MenuErase;

                        IF (Key IN [mOpt01,mOpt02,mOpt03]) THEN
                           EditUsers_GlobalChangeAccess (EditListRec.ListID,ListAccessType (Ord (Key)-Ord (mOpt01)));
                   END;

               kIns :
                   BEGIN
                        Keuze:=InsertNewSubscriber (EditListRec);
                        IF (Keuze <> NILRecordNr) THEN
                        BEGIN
                             BuildReadAddOne (Keuze);
                             ListSetCursorOnItem (Keuze);
                        END;
                   END;

               kDel :
                   IF (ListTagCount = 0) THEN
                   BEGIN
                        IF (Keuze < 65000) THEN
                        BEGIN
                             MenuDefine (6,15,'Remove this user?');
                             MenuAddItem ('Yes');
                             MenuAddItem ('No');
                             MenuShow;

                             IF (MenuSelect = mOpt01) THEN
                             BEGIN
                                  ListRemoveItem (Keuze);
                                  ListUser_Read (Keuze,ListUser);
                                  ListUser.UserType:=lutDeleted;
                                  ListUser_Write (Keuze,ListUser);
                             END;

                             MenuErase;
                        END;
                   END ELSE
                   BEGIN
                        MenuDefine (6,15,'Remove all tagged users?');
                        MenuAddItem ('Yes');
                        MenuAddItem ('No');
                        MenuShow;

                        IF (MenuSelect = mOpt01) THEN
                           WHILE (ListTagCount > 0) DO
                           BEGIN
                                Keuze:=ListGetTaggedItemNr (1);
                                ListRemoveItem (Keuze);
                                ListUser_Read (Keuze,ListUser);
                                ListUser.UserType:=lutDeleted;
                                ListUser_Write (Keuze,ListUser);
                           END;

                        MenuErase;
                   END;

               kF2 :
                   IF (ListTagCount = 0) THEN
                      Error ('Please tag some subscribers first')
                   ELSE
                       EditUsers_ExportTaggedUsers;

               (*
               kAltF7 :
                   IF (ListTagCount = 0) THEN
                   BEGIN
                        IF ReadListBaseRecord (Keuze,ListUserRec) AND
                           (ListUserRec.ListSystem = lstUsenet) THEN
                        WITH ListUserRec DO
                        BEGIN
                             { change from Usenet type to RemoteGateway type }
                             ListSystem:=lstRemoteGW;
                             GWEMail:=EMail;
                             FidoSplit ('2:200/111',GWAddress);
                             GWUser:='UUCP';

                             WriteListBaseRecord (Keuze,ListUserRec);
                        END; { with, if }
                   END ELSE
                       FOR Keuze:=1 TO ListTagCount DO
                           IF ReadListBaseRecord (ListGetTaggedItemNr (Keuze),ListUserRec) AND
                              (ListUserRec.ListSystem = lstUsenet) THEN
                           WITH ListUserRec DO
                           BEGIN
                                { change from Usenet type to RemoteGateway type }
                                ListSystem:=lstRemoteGW;
                                GWEMail:=EMail;
                                FidoSplit ('2:200/111',GWAddress);
                                GWUser:='UUCP';

                                WriteListBaseRecord (ListGetTaggedItemNr (Keuze),ListUserRec);
                           END; { with,if,for }
               *)

               (*
               kAltF8 :
                   IF (ListTagCount = 0) THEN
                   BEGIN
                        IF ReadListBaseRecord (Keuze,ListUserRec) AND
                           (ListUserRec.ListSystem = lstRemoteGW) THEN
                        WITH ListUserRec DO
                        BEGIN
                             { change from Usenet type to RemoteGateway type }
                             ListSystem:=lstRFC;
                             EMail:=GWEMail;
                             WriteListBaseRecord (Keuze,ListUserRec);
                        END; { with, if }
                   END ELSE
                       FOR Keuze:=1 TO ListTagCount DO
                           IF ReadListBaseRecord (ListGetTaggedItemNr (Keuze),ListUserRec) AND
                              (ListUserRec.ListSystem = lstRemoteGW) THEN
                           WITH ListUserRec DO
                           BEGIN
                                { change from Usenet type to RemoteGateway type }
                                ListSystem:=lstRFC;
                                EMail:=GWEMail;
                                WriteListBaseRecord (ListGetTaggedItemNr (Keuze),ListUserRec);
                           END; { with,if,for }
               *)
          END; { case }

     END; { while }

     ListErase;
END;


{--------------------------------------------------------------------------}
{ CheckListName                                                            }
{                                                                          }
{ Deze routine controleert of er een spatie in de mailing list naam zit en }
{ klaagt daar dan over.                                                    }
{                                                                          }
FUNCTION CheckListName (BufferPtr : StringPtr) : BOOLEAN; FAR;
BEGIN
     CheckListName:=TRUE;   { nooit problemen }

     IF (Pos (' ',DeleteFrontAndBackSpaces (BufferPtr^)) > 0) THEN
        Error2Lines ('It is not advisable to use spaces in a mailing list name.',
                     'Use a dash ("-") or underscore ("_") instead.');
END;


{--------------------------------------------------------------------------}
{ CheckConfirmInterval                                                     }
{                                                                          }
{ Deze routine kijkt of het ingetikte confirm interval tussen 0 en 255     }
{ ligt, formatteert het veld zodat het left-alligned is en stopt de nieuwe }
{ waarde in MainListRec.ConfirmInterval. Als de waarde tussen 1 en 7       }
{ ingesteld wordt, dan wordt een opmerking gemaakt over de gevaren.        }
{                                                                          }
FUNCTION CheckConfirmInterval (BufferPtr : StringPtr) : BOOLEAN; FAR;

VAR Value : INTEGER;
    Nop   : ValNop;

BEGIN
     CheckConfirmInterval:=TRUE;   { nooit problemen }

     Val (DeleteFrontAndBackSpaces (BufferPtr^),Value,Nop);
     IF (Nop <> 0) THEN
        Value:=0;

     IF (Value > 255) THEN
        Value:=255;

     IF (Value < 0) THEN
        Value:=0;

     IF (Value > 0) AND (Value < 7) THEN
        Error2Lines ('WARNING: Setting the confirmation interval from 1 to 6',
                     'can cause a dangerous amount of confirmation messages!');

     EditListRec.ConfirmInterval:=Byte (Value);

     BufferPtr^:=AddUpWithSpaces (3,Byte2String (EditListRec.ConfirmInterval));
END;


{--------------------------------------------------------------------------}
{ SelectListArea                                                           }
{                                                                          }
PROCEDURE SelectListArea; FAR;

VAR Lp       : WORD;
    CursorLp : WORD;
    AreaRec  : AreaBaseRecord;

BEGIN
     ListDefine (3,3,39,Video.Rows-4,Default,
                 'Configured Areas',
                 htr_ListEdit_SelectArea);

     Message ('Please wait...');

     CursorLp:=1;

     FOR Lp:=1 TO AreaBaseRecCount DO
     BEGIN
          ReadAreaBaseRecord (Lp,AreaRec);
          IF (NOT AreaRec.Deleted) THEN
             ListAddItem (AreaRec.AreaName_F,Lp,Bottom);

          IF (EditListRec.AreaName = AddUpWithSpaces (MaxLenAreaName,AreaRec.AreaName_F)) THEN
             CursorLp:=Lp;
     END; { for }

     WindowPop;

     ListSortNow;
     ListSetCursorOnItem (CursorLp);

     Lp:=ListSelect (NoTag,[]);
     ListErase;

     IF (Key <> kEsc{thus kF10 or kRet}) THEN
     BEGIN
          ReadAreaBaseRecord (Lp,AreaRec);
          EditListRec.AreaName:=AddUpWithSpaces (60,AreaRec.AreaName_F);
          ListAreaName:=Copy (EditListRec.AreaName,1,40);
     END;
END;


{--------------------------------------------------------------------------}
{ SelectListAka                                                            }
{                                                                          }
{ Met deze routine kan een van de AKAs uitgekozen worden als List AKA.     }
{                                                                          }
PROCEDURE SelectListAka; FAR;

VAR AkaLp : 1..MaxAkas;
    Line  : STRING[50];
    Keuze : WORD;
    Quit  : BOOLEAN;

BEGIN
     ListDefine (3,3,39,Video.Rows-4,Default,
                 'Select the AKA for this list',
                 htr_ListEdit_SelectAKA);

     ListSetConvertRoutine (FidoAkaListConvertFunc);

     FOR AkaLp:=1 TO MaxAkas DO
     BEGIN
          Line:=Fido2Str (Config.NodeNrs[AkaLp]);
          IF (Line <> '0') THEN
             ListAddItem (Line,AkaLp,Convert);
     END; { for }

     ListSetCursorOnItem (EditListRec.Aka);

     IF (ListItemCount = 0) THEN
        ListAddItem (Line,1,Bottom);

     Quit:=FALSE;
     REPEAT
           Keuze:=ListSelect (NoTag,[]);

           CASE Key OF
                kRet : BEGIN
                            EditListRec.Aka:=Keuze;
                            ListAKAStr:=AddUpWithSpaces (30,Fido2Str(Config.NodeNrs[EditListRec.Aka]));
                            Quit:=TRUE;
                       END;

                kEsc : Quit:=TRUE;
           END; { case }
     UNTIL Quit;

     ListErase;
END;


{--------------------------------------------------------------------------}
{ SelectListDomain                                                         }
{                                                                          }
{ Met deze routine kan een van de systeem domains uitgekozen worden als    }
{ HomeDomain voor de mailing list.                                         }
{                                                                          }
PROCEDURE SelectListDomain; FAR;

VAR Lp    : 1..MaxSystemDomains;
    Keuze : WORD;
    Quit  : BOOLEAN;

BEGIN
     ListDefine (3,3,39,Video.Rows-4,Default,
                 'Select a system domain',
                 htr_ListEdit_SelectHomeDomain);

     FOR Lp:=1 TO MaxSystemDomains DO
         IF (Config.Domains[Lp] <> '') THEN
            ListAddItem (Config.Domains[Lp],Lp,Sorted);

     IF (ListItemCount = 0) THEN
     BEGIN
          ListErase;
          Error ('Enter a system domain under RFC Settings first!');
          Exit;
     END;

     ListSetCursorOnItem (EditListRec.HomeDomain);

     Quit:=FALSE;
     REPEAT
           Keuze:=ListSelect (NoTag,[]);

           CASE Key OF
                kRet : BEGIN
                            EditListRec.HomeDomain:=Keuze;
                            ListDomainStr:=AddUpWithSpaces (MaxLenDomain,Config.Domains[EditListRec.HomeDomain]);
                            Quit:=TRUE;
                       END;

                kEsc : Quit:=TRUE;
           END; { case }
     UNTIL Quit;

     ListErase;
END;


{--------------------------------------------------------------------------}
{ DeleteListServerRecord                                                   }
{                                                                          }
{ Lees de rij record die aangesloten zijn op een list, en zet bij allemaal }
{ de deleted vlag.                                                         }
{                                                                          }
PROCEDURE DeleteListServerRecord (ListPos : LONGINT);

VAR ListRec     : MailingListRecord;
    Lp          : ListUserRecordNrType;
    ListUserRec : ListUserRecord;

BEGIN
     Flex_MailingList_Read (ListPos,ListRec);

     { change all users with this ListID to lutDeleted }
     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          IF (ListUserRec.ListID = ListRec.ListID) THEN
          BEGIN
               ListUserRec.UserType:=lutDeleted;
               ListUser_Write (Lp,ListUserRec);
          END;

     END; { for }

     { erase the list definition itself }
     Flex_MailingList_Erase (ListPos);
END;


{--------------------------------------------------------------------------}
{ EditMailingList                                                          }
{                                                                          }
{ This routine is used to edit one mailing list record. The record must    }
{ have been loaded into ListEditRec.                                       }
{## move options (use msg numbers, name in subj, etc.) to their own window }
{                                                                          }
PROCEDURE EditMailingList;

CONST Xb = 7;
      Xl = 71;

      Xb2 = Xb+19;

VAR Yb,
    Yl,
    FieldY : XYType;

BEGIN
     IF (Video.Rows > 25) THEN
     BEGIN
        Yb:=4;
        Yl:=26;
     END ELSE
     BEGIN
         Yb:=2;
         Yl:=22;
     END;

     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     FieldInit;

     WITH EditListRec DO
     BEGIN
          Name:=AddUpWithSpaces (MaxLenMailingListName,Name);
          WelcomeFile:=AddUpWithSpaces (79,WelcomeFile);
          FooterFile:=AddUpWithSpaces (79,FooterFile);
          Description:=AddUpWithSpaces (MaxLenMailingListDescription,Description);
          AreaName:=AddUpWithSpaces (MaxLenAreaName,AreaName);
          AdminPassword:=AddUpWithSpaces (8,AdminPassword);

          ListAreaName:=Copy (AreaName,1,40);

          ListAkaStr:=AddUpWithSpaces (30,Fido2Str (Config.NodeNrs[Aka]));
          ListDomainStr:=AddUpWithSpaces (MaxLenDomain,Config.Domains[HomeDomain]);
          ListConfirmStr:=AddUpWithSpaces (3,Byte2String (ConfirmInterval));

          FieldY:=Yb+1;

          WriteXY (Xb+2,FieldY,'List name');
          FieldAutoDefineCheckOne (Xb2,FieldY,@Name,RepChar (MaxLenMailingListName,'$'),CheckListName);
          FieldSetHelp (0,htr_ListEdit_Name);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Description');
          FieldAutoDefineOne (Xb2,FieldY,@Description,RepChar (MaxLenMailingListDescription,'$'));
          FieldSetHelp (0,htr_ListEdit_Description);

          Inc (FieldY,2);
          WriteXY (Xb+2,FieldY,'Private list');
          FieldAutoDefineToggles (Xb2,FieldY,PrivateList,'no|yes',0);
          FieldSetHelp (0,htr_ListEdit_Private);

          { On 25-line screens we need more room, so put these in three    }
          { columns                                                        }
          IF (Video.Rows > 25) THEN
          BEGIN
               Inc (FieldY);
               WriteXY (Xb+2,FieldY,'Only known');
               FieldAutoDefineToggles (Xb2,FieldY,OnlyKnown,'no|yes',0);
               FieldSetHelp (0,htr_ListEdit_OnlyKnown);
     
               Inc (FieldY);
               WriteXY (Xb+2,FieldY,'Passive');
               FieldAutoDefineToggles (Xb2,FieldY,Passive,'no|yes',0);
               FieldSetHelp (0,htr_ListEdit_Passive);
          END ELSE
          BEGIN
               WriteXY (Xb2+8,FieldY,'Only known');
               FieldAutoDefineToggles (Xb2+21,FieldY,OnlyKnown,'no|yes',0);
               FieldSetHelp (0,htr_ListEdit_OnlyKnown);
     
               WriteXY (Xb2+30,FieldY,'Passive');
               FieldAutoDefineToggles (Xb2+40,FieldY,Passive,'no|yes',0);
               FieldSetHelp (0,htr_ListEdit_Passive);
          END;
          
          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'List AKA');
          FieldAutoDefineList (Xb2,FieldY,@ListAkaStr,SelectListAka);
          FieldSetHelp (0,htr_ListEdit_ListAKA);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'List domain');
          FieldAutoDefineList (Xb2,FieldY,@ListDomainStr,SelectListDomain);
          FieldSetHelp (0,htr_ListEdit_ListDomain);

          { auto-upgrade }
          IF (Byte (MLAddress) > 1) THEN
             MLAddress:=laHigher;

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'List address');
          FieldAutoDefineToggles (Xb2,FieldY,MLAddress,'lower|higher',0);
          FieldSetHelp (0,htr_ListEdit_ListAddress);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Name in subject');
          FieldAutoDefineToggles (Xb2,FieldY,NameInSubject,'no|yes',0);
          FieldSetHelp (0,htr_ListEdit_NameInSubject);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Welcome file');
          FieldAutoDefineFileMgr (Xb2,FieldY,50,@WelcomeFile,AnyFileMgr,FALSE);
          FieldSetHelp (0,htr_ListEdit_WelcomeFile);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Footer file');
          FieldAutoDefineFileMgr (Xb2,FieldY,50,@FooterFile,AnyFileMgr,FALSE);
          FieldSetHelp (0,htr_ListEdit_FooterFile);

          {
          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Admin password');
          FieldAutoDefineOne (Xb2,FieldY,@AdminPassword,'$$$$$$$$');
          FieldSetHelp (0,htr_ListEdit_AdminPassword);
          }

          Inc (FieldY,2);
          WriteXY (Xb+2,FieldY,'Area name');
          FieldAutoDefineList (Xb2,FieldY,@ListAreaName,SelectListArea);
          FieldSetHelp (0,htr_ListEdit_AreaName);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Area to List');
          FieldAutoDefineToggles (Xb2,FieldY,AreaToList,'no|yes',0);
          FieldSetHelp (0,htr_ListEdit_AreaToList);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'List to Area');
          FieldAutoDefineToggles (Xb2,FieldY,ListToArea,'no|yes',0);
          FieldSetHelp (0,htr_ListEdit_ListToArea);

          Inc (FieldY,2);
          WriteXY (Xb+2,FieldY,'Default access');
          FieldAutoDefineToggles (Xb2,FieldY,DefaultAccess,AccessEditOptions,0);
          FieldSetHelp (0,htr_ListEdit_DefaultAccess);

          Inc (FieldY);
          WriteXY (Xb+2,FieldY,'Confirm interval     days');
          FieldAutoDefineCheckOne (Xb2,FieldY,@ListConfirmStr,'%%%',CheckConfirmInterval);
          FieldSetHelp (0,htr_ListEdit_ConfirmInterval);

          IF (Video.Rows > 25) THEN
               Inc (FieldY, 2)
          ELSE
               Inc (FieldY);

          WriteXY (Xb+2,FieldY,'Use message #s?');
          FieldAutoDefineToggles (Xb2,FieldY,UseMessageCounter,'no|yes',0);
          FieldSetHelp (0,htr_ListEdit_UseMessageNums);

          IF (Video.Rows > 25) THEN
          BEGIN
               Inc (FieldY);
               WriteXY (Xb+2, FieldY, 'Last msg number: ');
               WriteXY (Xb2, FieldY, Longint2String (MessageCounter));
          END ELSE
          BEGIN
               WriteXY (Xb2+8, FieldY, 'Last msg number: ');
               WriteXY (Xb2+28, FieldY, Longint2String (MessageCounter));
          END;

          Inc (FieldY, 2);
          WriteXY (Xb+2,FieldY,'Subscribers');
          FieldAutoDefineList (Xb2,FieldY,@DotDotDot,EditSubScribedUsers);

          IF (EditListRec.Name[1] <> ' ') THEN
             FieldSetFirst (0);

          FieldEdit;

          Name:=DeleteFrontAndBackSpaces (Name);
          WelcomeFile:=DeleteFrontAndBackSpaces (WelcomeFile);
          FooterFile:=DeleteFrontAndBackSpaces (FooterFile);
          Description:=DeleteFrontAndBackSpaces (Description);
          AreaName:=DeleteBackSpaces (AreaName);
          AdminPassword:=DeleteFrontAndBackSpaces (AdminPassword);
     END; { with }

     WindowPop;
END;


{--------------------------------------------------------------------------}
{ EditMailingLists                                                         }
{                                                                          }
{ Het GUI menu'tje voor de configuratie.                                   }
{                                                                          }
PROCEDURE EditMailingLists;

    PROCEDURE AddToList (VAR AddListRec : MailingListRecord; Keuze : WORD; Pos : LONGINT);
    BEGIN
         ListAddItem (AddListRec.Name+' ('+AddListRec.Description+')',Keuze,Sorted);
         ListSetItemRef (Keuze,Pos);
    END;

CONST Xb = 3;
      Yb = 3;
      Xl = 75;

VAR Quit    : BOOLEAN;
    ListRec : MailingListRecord;
    Pos     : LONGINT;
    Keuze   : WORD;
    Yl      : XYType;

BEGIN
     Yl:=Video.Rows-4;
     ListDefine (Xb,Yb,Xl,Yl,Default,
                 'Mailing List Definitions',
                 htr_Mailing_list_definitions);

     Message ('Please wait...');

     IF Flex_MailingList_ReadFirst (ListRec,Pos) THEN
        REPEAT
              Keuze:=ListItemCount+1;
              AddToList (ListRec,Keuze,Pos);
        UNTIL (NOT Flex_MailingList_ReadNext (ListRec,Pos));

     WindowPop; { message }

     Quit:=FALSE;
     WHILE (NOT Quit) DO
     BEGIN
          { voeg een melding toe voor het geval de lijst leeg blijkt te zijn }
          IF (ListItemCount = 0) THEN
             ListAddItem ('<no mailing list definitions>',65535,Bottom);

          Keuze:=ListSelect (NoTag,[kDel,kIns]);

          ListRemoveItem (65535);

          CASE Key OF
               kEsc : Quit:=TRUE;

               kRet :
                   BEGIN
                        Pos:=ListGetItemRef (Keuze);
                        Flex_MailingList_Read (Pos,EditListRec);
                        EditMailingList;
                        Flex_MailingList_Write (Pos,EditListRec);

                        { update item in list }
                        ListRemoveItem (Keuze);
                        AddToList (EditListRec,Keuze,Pos);
                        ListSetCursorOnItem (Keuze);
                   END; { kRet }

               kDel :
                   IF (ListTagCount = 0) THEN
                   BEGIN
                        IF (Keuze < 65000) THEN
                        BEGIN
                             MenuDefine (6,15,'Remove this list definition?');
                             MenuAddItem ('Yes');
                             MenuAddItem ('No');
                             MenuShow;

                             IF (MenuSelect = mOpt01) THEN
                             BEGIN
                                  Pos:=ListGetItemRef (Keuze);
                                  DeleteListServerRecord (Pos);
                                  ListRemoveItem (Keuze);
                             END;

                             MenuErase;
                        END;
                    END; { kDel }

               kIns :
                   BEGIN
                        Flex_MailingList_New (Pos,EditListRec);
                        EditMailingList;
                        Flex_MailingList_Write (Pos,EditListRec);

                        Keuze:=ListItemCount+1;
                        AddToList (EditListRec,Keuze,Pos);
                        ListSetCursorOnItem (Keuze);
                   END;
          END; { case }
     END; { while }

     ListErase;
END;

END.
