{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-}

UNIT SysOp4;

INTERFACE

USES
  Common;

PROCEDURE TEdit1;
PROCEDURE TEdit(CONST FSpec: AStr);

IMPLEMENTATION

USES
  Dos;

PROCEDURE TEdit1;
VAR
  FSpec: AStr;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
BEGIN
  NL;
  Prt('File name: ');
  IF (FileSysOp) THEN
  BEGIN
    MPL(50);
    Input(FSpec,50);
  END
  ELSE
  BEGIN
    MPL(12);
    Input(FSpec,12);
    FSplit(FSpec,Dir,Name,Ext);
    FSpec := Name+Ext;
  END;
  TEdit(FSpec);
END;

PROCEDURE TEdit(CONST FSpec: AStr);
TYPE
  StrPtr = ^StrRec;

  StrRec = RECORD
    S: AStr;
    Next,
    Last: StrPtr;
  END;

VAR
  TopHeap: ^Byte;
  Fil: Text;
  Cur,
  Nex,
  Las,
  Top,
  Bottom,
  Used: StrPtr;
  S: AStr;
  TotalLines,
  CurLine,
  I: Integer;
  Done,
  AllRead: Boolean;

  PROCEDURE InLi(VAR S1: AStr);
  VAR
    C,
    C1: Char;
    Cp,
    Rp,
    CV,
    CC: Integer;

    PROCEDURE BKSpc;
    BEGIN
      IF (Cp > 1) THEN
      BEGIN
        IF (S1[Cp - 2] = '^') AND (S1[Cp - 1] IN ['0'..'9']) THEN
        BEGIN
          UserColor(1);
          Dec(Cp);
        END
        ELSE IF (S1[Cp - 1] = #8) THEN
        BEGIN
          Prompt(' ');
          Inc(Rp);
        END
        ELSE IF (S1[Cp - 1] <> #10) THEN
        BEGIN
          Prompt(#8+' '+#8);
          Dec(Rp);
        END;
        Dec(Cp);
      END;
    END;

  BEGIN
    Rp := 1;
    Cp := 1;
    S1 := '';
    IF (LastLineStr <> '') THEN
    BEGIN
      Prompt(LastLineStr);
      S1 := LastLineStr;
      LastLineStr := '';
      Cp := (Length(S1) + 1);
      Rp := Cp;
    END;
    REPEAT
      C := Char(GetKey);
      CASE C of
        #32..#255 :
              IF (Cp < StrLen) AND (Rp < ThisUser.LineLen) THEN
              BEGIN
                S1[Cp] := C;
                Inc(Cp);
                Inc(Rp);
                OutKey(C);
              END;
         ^H : BKSpc;
         ^S : BEGIN
                CV := (5 - (Cp MOD 5));
                IF ((Cp + CV) < StrLen) AND ((Rp + CV) < ThisUser.LineLen) THEN
                  FOR CC := 1 TO CV DO
                  BEGIN
                    Prompt(' ');
                    S1[Cp] := ' ';
                    Inc(Rp);
                    Inc(Cp);
                  END;
              END;
         ^P : IF (OkANSI OR OkAvatar) AND (Cp < (StrLen - 1)) THEN
              BEGIN
                C1 := Char(GetKey);
                IF (C1 IN ['0'..'9']) THEN
                BEGIN
                  S1[Cp] := '^';
                  Inc(Cp);
                  S1[Cp] := C1;
                  Inc(Cp);
                  UserColor(Ord(S1[Cp - 1]));
                END;
              END;
         ^X : BEGIN
                Cp := 1;
                FOR CV := 1 TO (Rp - 1) DO
                  Prompt(#8+' '+#8);
                UserColor(1);
                Rp := 1;
              END;
      END;
    UNTIL ((C = ^M) OR (Rp = ThisUser.LineLen) OR (HangUp));
    S1[0] := Chr(Cp - 1);
    IF (C <> ^M ) THEN
    BEGIN
      CV := (Cp - 1);
      WHILE (CV > 1) AND (S1[CV] <> ' ') AND ((S1[CV] <> ^H) OR (S1[CV - 1] = '^')) DO
        Dec(CV);
      IF (CV > (Rp DIV 2)) AND (CV <> (Cp - 1)) THEN
      BEGIN
        LastLineStr := Copy(S1,(CV + 1),(Cp - CV));
        FOR CC := (Cp - 2) DOWNTO CV DO
          Prompt(^H);
        FOR CC := (Cp - 2) DOWNTO CV DO
          Prompt(' ');
        S1[0] := Chr(CV - 1);
      END;
    END;
    NL;
  END;

  FUNCTION NewPtr(VAR x: StrPtr): Boolean;
  BEGIN
    IF (Used <> NIL) THEN
    BEGIN
      x := Used;
      Used := Used^.Next;
      NewPtr := TRUE;
    END
    ELSE
    BEGIN
      IF (MaxAvail > 2048) THEN
      BEGIN
        New(x);
        NewPtr := TRUE;
      END
      ELSE
        NewPtr := FALSE;
    END;
  END;

  PROCEDURE OldPtr(VAR x: StrPtr);
  BEGIN
    x^.Next := Used;
    Used := x;
  END;

  PROCEDURE PLine(Cl: Integer; VAR Cp: StrPtr);
  VAR
    S1: AStr;
  BEGIN
    IF (NOT Abort) THEN
    BEGIN
      IF (Cp = NIL) THEN
        S1 := '      ^5'+'[^3'+'END^5'+']'
      ELSE
        S1 := PadRightInt(Cl,4)+': '+Cp^.S;
      PrintACR(S1);
    END;
  END;

  PROCEDURE PL;
  BEGIN
    Abort := FALSE;
    PLine(CurLine,Cur);
  END;

BEGIN
  Mark(TopHeap);
  Used := NIL;
  Top := NIL;
  Bottom := NIL;
  AllRead := TRUE;
  IF (FSpec = '') THEN
  BEGIN
    Print('Aborted.');
  END
  ELSE
  BEGIN
    Abort := FALSE;
    Next := FALSE;
    TotalLines := 0;
    New(Cur);
    Cur^.Last := NIL;
    Cur^.S := '';
    NL;
    Assign(Fil,FSpec);
    Reset(Fil);
    IF (IOResult <> 0) THEN
    BEGIN
      ReWrite(Fil);
      IF (IOResult <> 0) THEN
      BEGIN
        Print('Error reading file.');
        Abort := TRUE;
      END
      ELSE
      BEGIN
        Close(Fil);
        Erase(Fil);
        Print('New file.');
        TotalLines := 0;
        Cur := NIL;
        Top := Cur;
        Bottom := Cur;
      END;
    END
    ELSE
    BEGIN
      Abort := NOT NewPtr(Nex);
      Top := Nex;
      Print('^1Loading...');
      WHILE ((NOT EOF(Fil)) AND (NOT Abort)) DO
      BEGIN
        Inc(TotalLines);
        Cur^.Next := Nex;
        Nex^.Last := Cur;
        Cur := Nex;
        ReadLn(Fil,S);
        Cur^.S := S;
        Abort := NOT NewPtr(Nex);
      END;
      Close(Fil);
      Cur^.Next :=  NIL;
      IF (TotalLines = 0) THEN
      BEGIN
        Cur := NIL;
        Top := NIL;
      END;
      Bottom := Cur;
      IF (Abort) THEN
      BEGIN
        NL;
        Print(^G^G'|12WARNING: |10Not all of file read.^3');
        NL;
        AllRead := FALSE;
      END;
      Abort := FALSE;
    END;
    IF (NOT Abort) THEN
    BEGIN
      Print('Total lines: '+IntToStr(TotalLines));
      Cur := Top;
      IF (Top <> NIL) THEN
        Top^.Last := NIL;
      CurLine := 1;
      Done := FALSE;
      PL;
      REPEAT
        Prt(':');
        Input(S,10);
        IF (S = '') THEN
          S := '+';
        IF (StrToInt(S) > 0) THEN
        BEGIN
          I := StrToInt(S);
          IF ((I > 0) AND (I <= TotalLines)) THEN
          BEGIN
            WHILE (I <> CurLine) DO
              IF (I < CurLine) THEN
              BEGIN
                IF (Cur = NIL) THEN
                BEGIN
                  Cur := Bottom;
                  CurLine := TotalLines;
                END
                ELSE
                BEGIN
                  Dec(CurLine);
                  Cur := Cur^.Last;
                END;
              END
              ELSE
              BEGIN
                Inc(CurLine);
                Cur := Cur^.Next;
              END;
              PL;
          END;
        END
        ELSE
          CASE S[1] of
            '?' : BEGIN
                    LCmds(14,3,'+Forward line','-Back line');
                    LCmds(14,3,'Top','Bottom');
                    LCmds(14,3,'Print line','List');
                    LCmds(14,3,'Insert lines','Delete line');
                    LCmds(14,3,'Replace line','Clear all');
                    LCmds(14,3,'Quit (Abort)','Save');
                    LCmds(14,3,'*Center line','!Memory Available');
                  END;
            '!' : Print('Heap space available: '+IntToStr(MemAvail));
            '*' : IF (Cur <> NIL) THEN
                    Cur^.S := #2+Cur^.S;
            '+' : IF (Cur <> NIL) THEN
                  BEGIN
                    I := StrToInt(Copy(S,2,9));
                    IF (I = 0) THEN
                      I := 1;
                    WHILE (Cur <> NIL) AND (I > 0) DO
                    BEGIN
                      Cur := Cur^.Next;
                      Inc(CurLine);
                      Dec(I);
                    END;
                    PL;
                  END;
            '-' : BEGIN
                    I := StrToInt(Copy(S,2,9));
                    IF (I = 0) THEN
                      I := 1;
                    IF (Cur = NIL) THEN
                    BEGIN
                      Cur := Bottom;
                      CurLine := TotalLines;
                      Dec(I);
                    END;
                    IF (Cur <> NIL) THEN
                      IF (Cur^.Last <> NIL) THEN
                      BEGIN
                        WHILE ((Cur^.Last <> NIL) AND (I > 0)) DO
                        BEGIN
                          Cur := Cur^.Last;
                          Dec(CurLine);
                         Dec(I);
                        END;
                        PL;
                      END;
                  END;
            'B' : BEGIN
                    Cur := NIL;
                    CurLine := (TotalLines + 1);
                    PL;
                  END;
            'C' : IF PYNQ('Clear workspace? ',0,FALSE) THEN
                  BEGIN
                    TotalLines := 0;
                    CurLine := 1;
                    Cur := NIL;
                    Top := NIL;
                    Bottom := NIL;
                    Release(TopHeap);
                  END;
            'D' : BEGIN
                    I := StrToInt(Copy(S,2,9));
                    IF (I = 0) THEN
                      I := 1;
                    WHILE (Cur <> NIL) AND (I > 0) DO
                    BEGIN
                      Las := Cur^.Last;
                      Nex := Cur^.Next;
                      IF (Las <> NIL) THEN
                        Las^.Next := Nex;
                      IF (Nex <> NIL) THEN
                        Nex^.Last := Las;
                      OldPtr(Cur);
                      IF (Bottom = Cur) THEN
                        Bottom := Las;
                      IF (Top = Cur) THEN
                        Top := Nex;
                      Cur := Nex;
                      Dec(TotalLines);
                      Dec(I);
                    END;
                    PL;
                  END;
            'I' : BEGIN
                    Abort := FALSE;
                    Next := FALSE;
                    LastLineStr := '';
                    NL;
                    Print('   Enter "." on a separate line to exit insert mode.');
                    IF (OkANSI OR OkAvatar) THEN
                      Print('^2   ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ^1');
                    Dec(ThisUser.LineLen,6);
                    S := '';
                    WHILE (S <> '.') AND (S <> '.'+#1) AND (NOT Abort) AND (NOT HangUp) DO
                    BEGIN
                      Prompt(PadRightInt(CurLine,4)+': ');
                      InLi(S);
                      IF (S <> '.') AND (S <> '.'+#1) THEN
                      BEGIN
                        Abort := NOT NewPtr(Nex);
                        IF (Abort) THEN
                          Print('Out of space.')
                        ELSE
                        BEGIN
                          Nex^.S := S;
                          IF (Top = Cur) THEN
                            IF (Cur = NIL) THEN
                            BEGIN
                              Nex^.Last := NIL;
                              Nex^.Next := NIL;
                              Top := Nex;
                              Bottom := Nex;
                            END
                            ELSE
                            BEGIN
                              Nex^.Next := Cur;
                              Cur^.Last := Nex;
                              Top := Nex;
                            END
                          ELSE
                          BEGIN
                            IF (Cur = NIL) THEN
                            BEGIN
                              Bottom^.Next := Nex;
                              Nex^.Last := Bottom;
                              Nex^.Next := NIL;
                              Bottom := Nex;
                            END
                            ELSE
                            BEGIN
                              Las := Cur^.Last;
                              Nex^.Last := Las;
                               Nex^.Next := Cur;
                              Cur^.Last := Nex;
                              Las^.Next := Nex;
                            END;
                          END;
                          Inc(CurLine);
                          Inc(TotalLines);
                        END
                      END;
                    END;
                    Inc(ThisUser.LineLen,6);
                  END;
            'L' : BEGIN
                    Abort := FALSE;
                    Next := FALSE;
                    Nex := Cur;
                    I := CurLine;
                    WHILE (Nex <> NIL) AND (NOT Abort) AND (NOT HangUp) DO
                    BEGIN
                      PLine(I,Nex);
                      Nex := Nex^.Next;
                      Inc(I);
                    END;
                  END;
            'P' : PL;
            'R' : IF (Cur <> NIL) THEN
                  BEGIN
                    PL;
                    Prompt(PadRightInt(CurLine,4)+': ');
                    InLi(S);
                    Cur^.S := S;
                  END;
            'Q' : Done := TRUE;
            'S' : BEGIN
                    IF (NOT AllRead) THEN
                    BEGIN
                      UserColor(5);
                      Prompt('Not all of file read.  ');
                      AllRead := PYNQ('Save anyway? ',0,FALSE);
                    END;
                    IF (AllRead) THEN
                    BEGIN
                      Done := TRUE;
                      Print('Saving ...');
                      SysOpLog('Saved "'+FSpec+'"');
                      ReWrite(Fil);
                      I := 0;
                      Cur := Top;
                      WHILE (Cur <> NIL) DO
                      BEGIN
                        WriteLn(Fil,Cur^.S);
                        Cur := Cur^.Next;
                        Dec(I);
                      END;

                      IF (I = 0) THEN
                        WriteLn(Fil);

                      Close(Fil);
                    END;
                  END;
            'T' : BEGIN
                    Cur := Top;
                    CurLine := 1;
                    PL;
                  END;
          END;
      UNTIL ((Done) OR (HangUp));
    END;
  END;
  Release(TopHeap);
  PrintingFile := FALSE;
  LastError := IOResult;
END;

END.