(*****************************************************************************)

(*> <*)

(*> SYSOP4 .PAS - Written by Eric Oman <*)

(*> <*)

(*> SysOp functions: Text Editor. <*)

(*> <*)

(*> <*)

(*****************************************************************************)

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

unit sysop4;

interface

uses

crt, dos,

{rcg11172000 no overlay under Linux.}

{overlay,}

common;

procedure tedit1;

procedure tedit(fspec:astr);

implementation

type strptr=^strrec;

strrec=

record

i:astr;

next,last:strptr;

end;

var topheap:^byte;

lastvar:byte;

procedure tedit1;

var espec,s1,s2,s3:astr;

f:file;

begin

nl;

prt('Filename: ');

if (fso) then begin

nl; mpl(79); input(espec,79);

end else begin

mpl(12); input(espec,12);

fsplit(espec,s1,s2,s3); espec:=s2+s3;

end;

if (pos('.',espec)=0) then espec:=espec+'.MSG';

nofile:=FALSE;

assign(f,systat.afilepath+espec);

{$I-} reset(f); {$I+}

if (ioresult<>0) then begin

if (fso) then begin

assign(f,systat.gfilepath+espec);

{$I-} reset(f); {$I+}

nofile:=(ioresult<>0);

if (not nofile) then espec:=systat.gfilepath+espec;

end;

end

else espec:=systat.afilepath+espec;

if (nofile) then espec:=systat.afilepath+espec;

tedit(espec);

if (filerec(f).mode<>fmclosed) then begin

{$I-} close(f); {$I+}

nofile:=(ioresult<>0);

end;

end;

procedure tedit(fspec:astr);

var fil:text;

cur,nex,las,b4,top,bottom,used:strptr;

i1,i2,ps1,ps2,ps3:astr;

tline,curline,c1,c2:integer;

abort,next,done,allread:boolean;

procedure inli(var i:astr);

var cp,rp:integer; c,c1:char; cv,cc:integer;

procedure bkspc;

begin

if (cp>1) then begin

if (i[cp-2]=#3) and (i[cp-1] in [#0..#9]) then begin

cl(1);

dec(cp);

end else

if i[cp-1]=#8 then begin

prompt(' ');

inc(rp);

end else

if i[cp-1]<>#10 then begin

prompt(#8+' '+#8);

dec(rp);

end;

dec(cp);

end;

end;

begin

rp:=1; cp:=1;

i:='';

if (ll<>'') then begin

prompt(ll);

i:=ll; ll:='';

cp:=length(i)+1;

rp:=cp;

end;

repeat

getkey(c);

case c of

#32..#255:if (cp<strlen) and (rp<thisuser.linelen) then begin

i[cp]:=c; inc(cp); inc(rp);

outkey(c);

inc(pap);

end;

^B:dm(' -'+#14+'/'+#14+'l'+#14+'\'+#14,c);

^H:bkspc;

^I:begin

cv:=5-(cp mod 5);

if (cp+cv<strlen) and (rp+cv<thisuser.linelen) then

for cc:=1 to cv do begin

prompt(' '); i[cp]:=' ';

inc(rp); inc(cp);

end;

end;

^J:if (not (rbackspace in thisuser.ac)) and (cp<strlen) then begin

prompt(c);

i[cp]:=c;

inc(cp);

end;

^N:if (not (rbackspace in thisuser.ac)) and

(rp>1) and (cp<strlen) then begin

prompt(^H);

i[cp]:=#8;

inc(cp); dec(rp);

end;

^P:if okansi and (cp<strlen-1) then begin

getkey(c1);

if c1 in ['0'..'9'] then begin

i[cp]:=#3;

inc(cp);

i[cp]:=chr(ord(c1)-ord('0'));

inc(cp);

cl(ord(i[cp-1]));

end;

end;

^S:dm(' '+date,c);

^W:if cp>1 then

repeat bkspc;

until (cp=1) or (i[cp]=' ') or ((i[cp]=^H) and (i[cp-1]<>#3));

^X:begin

cp:=1;

for cv:=1 to rp-1 do prompt(#8+' '+#8);

cl(1);

rp:=1;

end;

end;

until ((c=^M) or (rp=thisuser.linelen) or (hangup));

i[0]:=chr(cp-1);

if c<>^M then begin

cv:=cp-1;

while (cv>1) and (i[cv]<>' ') and ((i[cv]<>^H) or (i[cv-1]=#3)) do dec(cv);

if (cv>(rp div 2)) and (cv<>cp-1) then begin

ll:=copy(i,cv+1,cp-cv); for cc:=cp-2 downto cv do prompt(^H);

for cc:=cp-2 downto cv do prompt(' ');

i[0]:=chr(cv-1);

end;

end;

nl;

{ if c=^M then i:=i+chr(1);}

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<0) or (maxavail>100) 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 abort:boolean);

var next:boolean; i:astr;

begin

if (not abort) then begin

if (cp=nil) then i:=' '+#3+#5+'['+#3+#3+'END'+#3+#5+']' else begin

i:=cstr(cl);

while length(i)<4 do i:=' '+i;

i:=i+': '+cp^.i;

end;

printacr(i,abort,next);

end;

end;

procedure pl;

var abort:boolean;

begin

abort:=FALSE;

pline(curline,cur,abort);

end;

begin

topheap:=heapptr;

{ topheap:=ptr(seg(lastvar),ofs(lastvar));}

release(topheap);

used:=nil; top:=nil; bottom:=nil;

allread:=TRUE;

fsplit(fspec,ps1,ps2,ps3);

if (not fso) and (ps3<>'.MSG') and (ps3<>'.ANS') and

(ps3<>'.40C') and (ps3<>'.TXT') then fspec:='';

if (fspec='') then print('Illegal filename.')

else begin

nl;

assign(fil,fspec); abort:=FALSE;

{$I-} reset(fil); {$I+}

tline:=0;

new(cur);

cur^.last:=nil; cur^.i:='';

if (ioresult<>0) then begin

{$I-} rewrite(fil); {$I+}

if (ioresult<>0) then begin

print('Error reading file.');

abort:=TRUE;

end else begin

close(fil); erase(fil);

print('New file.');

tline:=0;

cur:=nil; top:=cur; bottom:=cur;

end;

end else begin

abort:=not newptr(nex);

top:=nex;

print('Loading...');

while ((not eof(fil)) and (not abort)) do begin

inc(tline);

cur^.next:=nex;

nex^.last:=cur;

cur:=nex;

readln(fil,i1);

cur^.i:=i1;

abort:=not newptr(nex);

end;

close(fil);

cur^.next:=nil;

if (tline=0) then begin cur:=nil; top:=nil; end;

bottom:=cur;

if (abort) then begin print('Not all of file read.'); allread:=FALSE; end;

abort:=FALSE;

end;

if (not abort) then begin

print('Total lines: '+cstr(tline));

cur:=top;

if (top<>nil) then top^.last:=nil;

curline:=1;

done:=FALSE;

pl;

repeat

prt(':');

input(i1,10);

if (i1='') then i1:='+';

if (value(i1)>0) then begin

c1:=value(i1);

if ((c1>0) and (c1<=tline)) then begin

while (c1<>curline) do

if (c1<curline) then begin

if (cur=nil) then begin

cur:=bottom;

curline:=tline;

end else begin

dec(curline);

cur:=cur^.last;

end;

end else begin

inc(curline);

cur:=cur^.next;

end;

pl;

end;

end else

case i1[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','');

end;

'!':print('Heap space available: '+cstr(memavail));

'*':if (cur<>nil) then cur^.i:=#2+cur^.i;

'+':if (cur<>nil) then begin

c1:=value(copy(i1,2,9));

if (c1=0) then c1:=1;

while (cur<>nil) and (c1>0) do begin

cur:=cur^.next;

inc(curline);

dec(c1);

end;

pl;

end;

'-':begin

c1:=value(copy(i1,2,9));

if (c1=0) then c1:=1;

if (cur=nil) then begin

cur:=bottom;

curline:=tline;

dec(c1);

end;

if (cur<>nil) then

if (cur^.last<>nil) then begin

while ((cur^.last<>nil) and (c1>0)) do begin

cur:=cur^.last;

dec(curline);

dec(c1);

end;

pl;

end;

end;

'B':begin

cur:=nil;

curline:=tline+1;

pl;

end;

'C':if pynq('Clear workspace? ') then begin

tline:=0; curline:=1;

cur:=nil; top:=nil; bottom:=nil;

release(topheap);

end;

'D':begin

c1:=value(copy(i1,2,9));

if (c1=0) then c1:=1;

while (cur<>nil) and (c1>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(tline); dec(c1);

end;

pl;

end;

'I':begin

abort:=FALSE; ll:=''; nl;

print(' Enter "." on a seperate line to exit insert mode.');

print(' [ ^S : Sign date ^B : Spinning cursor ] ');

if okansi then

sprint(#3#2+' ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');

i1:=''; dec(thisuser.linelen,6);

while (not hangup) and (not abort) and

(i1<>'.') and (i1<>'.'+#1) do begin

i2:=cstr(curline);

while length(i2)<>4 do i2:=' '+i2;

i2:=i2+': '; prompt(i2);

inli(i1);

if (i1<>'.') and (i1<>'.'+#1) then begin

abort:=not newptr(nex);

if not abort then begin

nex^.i:=i1;

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(tline);

end else print('Out of space.');

end;

end;

inc(thisuser.linelen,6);

end;

'L':begin

abort:=FALSE;

nex:=cur;

c1:=curline;

while (not abort) and (nex<>nil) do begin

pline(c1,nex,abort);

nex:=nex^.next;

inc(c1);

end;

end;

'P':pl;

'R':if (cur<>nil) then begin

pl;

i2:=cstr(curline);

while length(i2)<>4 do i2:=' '+i2;

i2:=i2+': '; prompt(i2);

inli(i1);

cur^.i:=i1;

end;

'Q':done:=TRUE;

'S':begin

if (not allread) then begin

cl(5); prompt('Not all of file read. ');

allread:=pynq('Save anyway? ');

end;

if allread then begin

done:=TRUE; c1:=0;

writeln('Saving...');

sysoplog('TEDIT: Saved "'+fspec+'"');

rewrite(fil);

cur:=top;

while cur<>nil do begin

writeln(fil,cur^.i);

cur:=cur^.next;

dec(c1);

end;

if (c1=0) then writeln(fil);

close(fil);

end;

end;

'T':begin

cur:=top;

curline:=1;

pl;

end;

end;

until ((done) or (hangup));

prompt('2');

end;

end;

{}{}{}

{ topheap:=ptr(seg(lastvar),ofs(lastvar));}

{}{}{}

sprompt('3');

release(topheap);

sprompt('4');

printingfile:=FALSE; cfilteron:=FALSE;

sprompt('5');

end;

end.