eric
/
telegard
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
telegard/sysop4.pas

468 lines
14 KiB
ObjectPascal
Raw Normal View History

Initial revision
2000-11-17 16:33:00 -08:00
(*****************************************************************************)
(*> <*)
(*> 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+' <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.