468 lines
14 KiB
ObjectPascal
468 lines
14 KiB
ObjectPascal
(*****************************************************************************)
|
||
(*> <*)
|
||
(*> SYSOP4 .PAS - Written by Eric Oman <*)
|
||
(*> <*)
|
||
(*> SysOp functions: Text Editor. <*)
|
||
(*> <*)
|
||
(*> <*)
|
||
(*****************************************************************************)
|
||
{$A+,B+,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+' <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
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.
|