(*****************************************************************************)
(*>                                                                         <*)
(*>  SYSOP1  .PAS -  Written by Eric Oman                                   <*)
(*>                                                                         <*)
(*>  SysOp functions: Protocol editor.                                      <*)
(*>                                                                         <*)
(*****************************************************************************)
{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit sysop1;

interface

procedure ee_help;
procedure exproedit;

implementation

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  common,
  file1,
  menus2;

var menuchanged:boolean;
    x:integer;

procedure ee_help;
begin
  sprint(' #:Modify item   <CR>Redisplay screen');
  lcmds(15,3,'[Back entry',']Forward entry');
  lcmds(15,3,'Jump to entry','First entry in list');
  lcmds(15,3,'Quit and save','Last entry in list');
end;

procedure exproedit;
var wrd:word;
    i1,i2,ii,xloaded:integer;
    c:char;
    abort,next:boolean;
    st:astr;

  procedure xed(i:integer);
  var x:integer;
  begin
    if (i>=0) and (i<=filesize(xf)-1) then begin
      if (i>=0) and (i<filesize(xf)-1) then
        for x:=i to filesize(xf)-2 do begin
          seek(xf,x+1); read(xf,protocol);
          seek(xf,x); write(xf,protocol);
        end;
      seek(xf,filesize(xf)-1); truncate(xf);
    end;
  end;

  function newindexno:longint;
  var xpr:protrec;
      i,j:integer;
  begin
    reset(xf);
    j:=-1;
    for i:=1 to filesize(xf) do begin
      read(xf,xpr);
      if (xpr.permindx>j) then j:=xpr.permindx;
    end;
    inc(j);
    newindexno:=j;
  end;

  procedure xei(i:integer);
  var x:integer;
  begin
    if (i>=0) and (i<=filesize(xf)) and (filesize(xf)<maxprotocols) then begin
      for x:=filesize(xf)-1 downto i do begin
        seek(xf,x); read(xf,protocol);
        write(xf,protocol);  (* to next record *)
      end;
      with protocol do begin
        xbstat:=[xbxferokcode];
        ckeys:='!';
        descr:=#3#4+'('+#3#3+'!'+#3#4+') New Protocol';
        acs:='';
        templog:='';
        uloadlog:=''; dloadlog:='';
        ulcmd:='QUIT'; dlcmd:='QUIT';
        for x:=1 to 6 do begin ulcode[x]:=''; dlcode[x]:=''; end;
        envcmd:='';
        dlflist:='';
        maxchrs:=128;
        logpf:=0; logps:=0;
        permindx:=newindexno;
        for x:=1 to 11 do res[x]:=0;
      end;
      seek(xf,i); write(xf,protocol);
    end;
  end;

  function udq:integer;
  var c:char;
  begin
    prt('What type? (U)pload (D)ownload : ');
    onek(c,'DU'); nl;
    if (c='U') then udq:=1 else udq:=2;
  end;

  {rcg11172000 had to change this to get it compiling under Free Pascal...}
  {function substone(src,old,new:astr):astr;}
  function substone(src,old,_new:astr):astr;
  var p:integer;
  begin
    p:=pos(old,src);
    if (p>0) then begin
      insert(_new,src,p+length(old));
      delete(src,p,length(old));
    end;
    substone:=src;
  end;

  function showpmci(s:astr):astr;
  begin
    s:=substone(s,'%B',#3#3+'%B'+#3#1);
    s:=substone(s,'%C',#3#3+'%C'+#3#1);
    s:=substone(s,'%F',#3#3+'%F'+#3#1);
    s:=substone(s,'%G',#3#3+'%G'+#3#1);
    s:=substone(s,'%L',#3#3+'%L'+#3#1);
    s:=substone(s,'%P',#3#3+'%P'+#3#1);
    s:=substone(s,'%T',#3#3+'%T'+#3#1);
    showpmci:=s;
  end;

  procedure xem;
  var s:astr;
      i,j,i1,i2,ii:integer;
      c,c1:char;
      bb:byte;
      changed,b:boolean;

    function cfip(pt:integer; s:astr):astr;
    begin
      if (pt<1) or (pt>5) then cfip:=s else cfip:='';
    end;

    function nnon(s:astr):astr;
    begin
      if (s<>'') then nnon:='"'+s+'"' else nnon:='*None*';
    end;

    procedure pprint(s:astr);
    var i:integer;
    begin
      s:=showpmci(s);
      cl(1);
      for i:=1 to length(s) do
        if ((s[i]=#3) and (i<>length(s))) then begin
          cl(ord(s[i+1]));
          inc(i);
        end else
          outkey(s[i]);
      nl;
    end;

  begin
    xloaded:=-1;
    prt('Begin editing at which? (0-'+cstr(filesize(xf)-1)+') : '); inu(ii);
    c:=' ';
    if (ii>=0) and (ii<=filesize(xf)-1) then begin
      while (c<>'Q') and (not hangup) do begin
        if (xloaded<>ii) then begin
          seek(xf,ii); read(xf,protocol);
          xloaded:=ii; changed:=FALSE;
        end;
        with protocol do
          repeat
            if (c<>'?') then begin
              cls;
              abort:=FALSE; next:=FALSE; i:=1;
              while ((i<=15) and (not abort)) do begin
                case i of
                  1:print('Protocol #'+cstr(ii)+' of '+cstr(filesize(xf)-1));
                  2:print('!. Type/protocl:'+
                      aonoff(xbactive in xbstat,'Active','NOT ACTIVE')+' - '+
                      aonoff(xbisbatch in xbstat,'Batch protocol','Single protocol')+
                      aonoff(xbisresume in xbstat,' - RESUME protocol',''));
                  3:pprint('1. Keys/descrip:"'+ckeys+'" / "'+descr+'"');
                  4:print('2. ACS required: "'+acs+'"');
                  5:pprint('3. Temp. log   : '+nnon(templog));
                  6:pprint('4. <U>L log    : '+nnon(uloadlog));
                  7:pprint('   <D>L log    : '+nnon(dloadlog));
                  8:pprint('5. <U>L command: '+nnon(ulcmd));
                  9:pprint('   <D>L command: '+nnon(dlcmd));
                  10:print('6. Codes mean  :'+aonoff(xbxferokcode in xbstat,
                     'Transfer OK','Transfer bad'));
                  11:begin
                       s:='7. <U>L codes  :';
                       for j:=1 to 6 do
                         s:=s+mln('('+cstr(j)+')"'+ulcode[j]+'" ',10);
                       print(copy(s,1,length(s)-1));
                     end;
                  12:begin
                       s:='   <D>L codes  :';
                       for j:=1 to 6 do
                         s:=s+mln('('+cstr(j)+')"'+dlcode[j]+'" ',10);
                       print(copy(s,1,length(s)-1));
                     end;
                  13:pprint('E. Environ. cmd: '+nnon(envcmd));
                  14:pprint('I. DL File list: '+nnon(dlflist));
                  15:print('C. Max DOS chrs:'+cstr(maxchrs)+
                           '   P. Log position: Filename: '+cstr(logpf)+
                           ' - Status: '+cstr(logps));
                end;
                inc(i);
                wkey(abort,next);
              end;
            end;
            nl;
            prt('Edit menu (?=help) : '); onek(c,'Q!1234567CEIP[]FJL?'^M);
            nl;
            case c of
              '!':begin
                    repeat
                      print('1. Protocol active   :'+syn(xbactive in xbstat));
                      print('2. Is batch protocol :'+syn(xbisbatch in xbstat));
                      print('3. Is resume protocol:'+syn(xbisresume in xbstat));
                      nl;
                      prt('Select (1-3,Q=Quit) : '); onek(c,'Q123'^M);
                      nl;
                      if (c in ['1'..'3']) then begin
                        changed:=TRUE;
                        case c of
                          '1':if (xbactive in xbstat) then
                                xbstat:=xbstat-[xbactive]
                              else xbstat:=xbstat+[xbactive];
                          '2':if (xbisbatch in xbstat) then
                                xbstat:=xbstat-[xbisbatch]
                              else xbstat:=xbstat+[xbisbatch];
                          '3':if (xbisresume in xbstat) then
                                xbstat:=xbstat-[xbisresume]
                              else xbstat:=xbstat+[xbisresume];
                        end;
                      end;
                    until ((not (c in ['1'..'3'])) or (hangup));
                    c:=#0;
                  end;
              '1':begin
                    prt('New command keys: '); mpl(14); input(s,14);
                    if (s<>'') then begin
                      if (s<>ckeys) then changed:=TRUE;
                      ckeys:=s;
                    end;
                    nl;
                    print('New description:');
                    prt(':'); cl(1); inputwc(s,40);
                    if (s<>'') then begin
                      if (s<>descr) then changed:=TRUE;
                      descr:=s;
                    end;
                  end;
              '2':begin
                    prt('New ACS: '); mpl(20);
                    inputwn(acs,20,changed);
                  end;
              '3':begin
                    print('New temp. log:');
                    prt(':'); inputwn(templog,25,changed);
                  end;
              '4':case udq of
                    1:begin
                        print('New permanent upload log:');
                        prt(':'); inputwn(uloadlog,25,changed);
                      end;
                    2:begin
                        print('New permanent download log:');
                        prt(':'); inputwn(dloadlog,25,changed);
                      end;
                  end;
              '5':begin
                    s:=#0#0#0; j:=udq;
                    prt('Type: (A)scii (C)ommand (E)xternal (O)ff : ');
                    onek(c,^M'ACEO'); nl;
                    case c of
                      'A':s:='ASCII';
                      'C':begin
                            prt('(B)atch (N)ext (Q)uit : ');
                            onek(c,'BNQ'^M);
                            case c of
                              'B':s:='BATCH';
                              'N':s:='NEXT';
                              'Q':s:='QUIT';
                            end;
                          end;
                      'E':begin
                            if (j=1) then print('New upload commandline:')
                              else print('New download commandline:');
                            prt(':'); inputwn(s,78,changed);
                          end;
                      'O':if pynq('Set to NULL string? ') then s:='';
                    end;
                    if (s<>#0#0#0) then begin
                      changed:=TRUE;
                      case j of
                        1:ulcmd:=s;
                        2:dlcmd:=s;
                      end;
                    end;
                    c:=#0;
                  end;
              '6':begin
                    if (xbxferokcode in xbstat) then
                      xbstat:=xbstat-[xbxferokcode]
                      else xbstat:=xbstat+[xbxferokcode];
                    changed:=TRUE;
                  end;
              '7':begin
                    case udq of
                      1:begin
                          print('New upload codes:'); nl;
                          for i:=1 to 6 do begin
                            prt('Code #'+cstr(i)+' ["'+ulcode[i]+'"] : ');
                            inputwn(ulcode[i],6,changed);
                          end;
                        end;
                      2:begin
                          print('New download codes:'); nl;
                          for i:=1 to 6 do begin
                            prt('Code #'+cstr(i)+' ["'+dlcode[i]+'"] : ');
                            inputwn(dlcode[i],6,changed);
                          end;
                        end;
                    end;
                  end;
              'C':begin
                    prt('New max DOS chrs in commandline: '); inu(i);
                    if (not badini) then begin
                      if (i<>maxchrs) then changed:=TRUE;
                      maxchrs:=i;
                    end;
                  end;
              'E':begin
                    print('New environment setup commandline:');
                    prt(':'); inputwn(envcmd,60,changed);
                  end;
              'I':begin
                    print('New batch file list:');
                    prt(':'); inputwn(dlflist,25,changed);
                  end;
              'P':begin
                    prt('New "Filename" log position? ['+cstr(logpf)+'] : ');
                    inu(i);
                    if (not badini) then begin
                      if (i<>logpf) then changed:=TRUE;
                      logpf:=i;
                    end;
                    prt('New "Status" log position? ['+cstr(logps)+'] : ');
                    inu(i);
                    if (not badini) then begin
                      if (i<>logpf) then changed:=TRUE;
                      logps:=i;
                    end;
                  end;
              '[':if (ii>0) then dec(ii) else c:=' ';
              ']':if (ii<filesize(xf)-1) then inc(ii) else c:=' ';
              'F':if (ii<>0) then ii:=0 else c:=' ';
              'J':begin
                    prt('Jump to entry: ');
                    input(s,3);
                    if ((value(s)>=0) and (value(s)<=filesize(xf)-1)) then
                      ii:=value(s) else c:=' ';
                  end;
              'L':if (ii=filesize(xf)-1) then c:=' ' else ii:=filesize(xf)-1;
              '?':ee_help;
            end;
          until (pos(c,'Q[]FJL')<>0) or (hangup);
        if (changed) then begin
          seek(xf,xloaded); write(xf,protocol);
          changed:=FALSE;
        end;
      end;
    end;
  end;

  procedure xep;
  var i,j,k:integer;
  begin
    prt('Move which protocol? (0-'+cstr(filesize(xf)-1)+') : '); inu(i);
    if ((not badini) and (i>=0) and (i<=filesize(xf)-1)) then begin
      prt('Move before which protocol? (0-'+cstr(filesize(xf))+') : '); inu(j);
      if ((not badini) and (j>=0) and (j<=filesize(xf)) and
          (j<>i) and (j<>i+1)) then begin
        xei(j);
        if (j>i) then k:=i else k:=i+1;
        seek(xf,k); read(xf,protocol);
        seek(xf,j); write(xf,protocol);
        if (j>i) then xed(i) else xed(i+1);
      end;
    end;
  end;

  function nar(c:char):char;
  begin
    if c='@' then nar:=' ' else nar:=c;
  end;

begin
  reset(xf); xloaded:=-1; c:=#0;
  repeat
    if (c<>'?') then
    begin
      cls; abort:=FALSE;
      printacr(#3#3+' NNN'+sepr2+'ACS       '+sepr2+'Description',abort,next);
      printacr(#3#4+' ===:==========:=============================================================',abort,next);
      ii:=0;
      seek(xf,0);
      while (ii<=filesize(xf)-1) and (not abort) do begin
        read(xf,protocol);
        with protocol do begin
          printacr(aonoff((xbactive in xbstat),#3#5+'+',#3#1+'-')+
                   #3#0+mn(ii,3)+' '+#3#9+mln(acs,10)+' '+
                   #3#1+descr,abort,next);
          inc(ii);
        end;
      end;
    end;
    nl;
    prt('Protocol editor (?=help) : ');
    onek(c,'QDIMP?'^M);
    case c of
      '?':begin
            nl;
            print('<CR>Redisplay screen');
            lcmds(16,3,'Delete protocol','Insert protocol');
            lcmds(16,3,'Modify protocol','Position protocol');
            lcmds(16,3,'Quit','');
          end;
      'D':begin
            prt('Protocol to delete? (0-'+cstr(filesize(xf)-1)+') : '); inu(ii);
            if (ii>=0) and (ii<=filesize(xf)-1) then begin
              seek(xf,ii); read(xf,protocol);
              nl; sprint('Protocol: '+#3#4+protocol.descr);
              if pynq('Delete this? ') then
              begin
                sysoplog('* Deleted protocol: '+protocol.descr); xed(ii);
              end;
            end;
          end;
      'I':begin
            prt('Protocol to insert before? (0-'+cstr(filesize(xf))+') : '); inu(ii);
            if (ii>=0) and (ii<=filesize(xf)) then
            begin
              xei(ii); sysoplog('* Inserted new protocol');
            end;
          end;
      'M':xem;
      'P':xep;
    end;
  until ((c='Q') or (hangup));
  close(xf);
end;

end.