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

975 lines
27 KiB
ObjectPascal
Raw Normal View History

Initial revision
2000-11-17 16:33:00 -08:00
{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit mail1;
interface
uses
crt, dos,
{rcg11172000 no overlay under Linux.}
{overlay,}
common,timejunk;
function inmsg(pub,uti:boolean; ftit:string; var mixr:msgindexrec;
var mheader:mheaderrec):boolean;
procedure inli(var i:string);
implementation
uses mail0;
var
inmsgfile:text;
cmdsoff:boolean;
lastline:string;
function inmsg(pub,uti:boolean; ftit:string; var mixr:msgindexrec;
var mheader:mheaderrec):boolean;
var li:array[1..160] of astr;
upin:string[255];
an:anontyp;
mftit,fto,spc,s,s1,s2:string;
t,maxli,lc,ii,i,j,k,quoteli:integer;
c,c1:char;
cantabort,saveline,goquote,exited,save,abortit,abort,next,ptl1,ufo:boolean;
procedure listit(stline:integer; linenum,disptotal:boolean);
var lasts:string;
l:integer;
begin
if (disptotal) then nl;
l:=stline;
abort:=FALSE;
next:=FALSE;
dosansion:=FALSE;
lasts:='';
while ((l<lc) and (not abort)) do begin
if (linenum) then print(cstr(l)+':');
if ((pos(^[,li[l])=0) and (pos(^[,lasts)=0)) then dosansion:=FALSE;
reading_a_msg:=TRUE;
if ((pub) and (aacs(memboard.mciacs))) then read_with_mci:=TRUE;
printacr(li[l],abort,next);
read_with_mci:=FALSE;
reading_a_msg:=FALSE;
lasts:=li[l];
inc(l);
end;
dosansion:=FALSE;
if (disptotal) then
sprint(' ^3Total number of lines were: ^4[^3'+cstr(lc-1)+'^4] ');
saveline:=FALSE;
end;
{rcg11172000 had to change this to get it compiling under Free Pascal...}
{procedure rpl(var v:astr; old,new:astr);}
procedure rpl(var v:astr; old,_new:astr);
var p:integer;
begin
p:=pos(old,v);
if (p>0) then begin
insert(_new,v,p+length(old));
delete(v,p,length(old));
end;
end;
procedure ptl;
var u:userrec;
sr:smalrec;
s,s1:astr;
i,j,tl:integer;
aa,aa1,done,ufo,sfo:boolean;
begin
tl:=60;
s1:='';
nl;
if ((not ptl1) or (ftit<>'')) then begin
if (ftit<>'') then begin
prt('Subject: ');
print(mftit);
end else begin
prt('Old: ');
print(mftit);
end;
end else if ((pub) and (uti)) then begin
if (allcaps(copy(lastmheader.title,1,3))<>'RE:') then
s1:='Re: '+copy(lastmheader.title,1,64) else
s1:=lastmheader.title;
sprint(#3#5+'Hit Enter to use the default title of:');
nl;
prt('Reply: ');
print(s1);
end;
if (ftit='') then begin
prt('Subject: ');
mpl(tl);
inputmain(s,tl,'l');
if (s<>'') then begin
cl(1);
nl;
mftit:=s
end else begin
if (s1<>'') then begin
mftit:=s1;
cl(6);
prompt(mftit);
cl(1);
nl;
end;
if (ptl1) then exit else begin
cl(6);
prompt(mftit);
cl(1);
nl;
end;
end;
end;
if ((pub) and (ptl1) and (fto<>'')) then begin
nl;
prt('To: ');
cl(6);
s:=fto;
if (mbrealname in memboard.mbstat) then begin
if (mheader.toi.real<>'') then begin
s:=caps(mheader.toi.real);
if (memboard.mbtype=0) then s:=s+' #'+cstr(mheader.toi.usernum);
end else
s:='';
end;
prompt(s);
for i:=1 to 50-length(s) do
prompt(' ');
nl;
ptl1:=FALSE;
exit;
end;
if ((pub) and (not uti)) then begin
nl;
sprint(#3#5+'Address message to what person/people?');
sprompt(#3#5+'Press <CR> to leave ');
if (fto='') then sprint('unaddressed.') else sprint('unchanged.');
nl;
if (not ptl1) then begin
prt('Old: ');
print(fto);
end;
prt('Reciever: ');
mpl(50);
inputmain(s,50,'lp');
cl(6);
for i:=1 to length(s) do
prompt(^H' '^H);
aa1:=FALSE;
if (s<>'') then begin
fto:=s;
if (copy(s,1,1)='#') then s:=copy(s,2,length(s)-1);
val(s,i,j);
if ((i<>0) and (j=0)) then begin
ufo:=(filerec(uf).mode<>fmclosed);
if (not ufo) then reset(uf);
if ((i>=1) and (i<=filesize(uf)-1)) then begin
seek(uf,i);
read(uf,u);
fto:=caps(u.name)+' #'+cstr(i);
if (pub) then begin
if (mbrealname in memboard.mbstat) then fto:=caps(u.realname)
else fto:=caps(u.name);
if (memboard.mbtype=0) then fto:=fto+' #'+cstr(i);
end;
end else begin
prompt(s);
cl(1);
nl;
print('Unable to find user number (left unaddressed).');
fto:='';
aa1:=TRUE;
end;
if (not ufo) then close(uf);
end;
end;
aa:=(sqoutsp(fto)='');
if (allcaps(sqoutsp(fto))='Everyone') then aa:=TRUE;
if (aa) then fto:='All';
if (not aa1) then begin
prompt(fto);
cl(1);
nl;
end;
if (pap<>0) then nl;
nl;
if (not ptl1) then sprint(#3#0+'Please continue message...');
end;
ptl1:=FALSE;
end;
procedure rpl1;
begin
if (lc<=1) then sprint(#3#7+'Nothing to replace!') else begin
sprint(#3#5+'Replace string -');
nl;
prt('On which line (1-'+cstr(lc-1)+') ? ');
input(s,4);
if (value(s)<1) or (value(s)>lc-1) then
sprint(#3#7+'Invalid line number.')
else begin
nl;
sprint(#3#3+'Original line:');
abort:=FALSE;
next:=FALSE;
printacr(li[value(s)],abort,next);
nl;
sprint(#3#4+'Enter character(s) to replace:');
prt(':');
inputl(s1,78);
if (s1<>'') then
if (pos(s1,li[value(s)])=0) then
sprint(#3#7+'Character(s) not found.')
else begin
sprint(#3#4+'Enter replacement character(s):');
prt(':');
inputl(s2,78);
if (s2<>'') then begin
rpl(li[value(s)],s1,s2);
nl;
sprint(#3#3+'Edited line:');
abort:=FALSE;
next:=FALSE;
printacr(li[value(s)],abort,next);
end;
end;
end;
nl;
end;
end;
procedure doquote;
var f:text;
t1:integer;
s:string[80];
done:boolean;
procedure openquotefile;
begin
done:=FALSE;
assign(f,'msgtmp');
{$I-} reset(f); {$I+}
if (ioresult<>0) then done:=TRUE;
end;
procedure readquoteline;
begin
if eof(f) then done:=TRUE else begin
{$I-} readln(f,s); {$I+}
if (ioresult<>0) then done:=TRUE;
end;
end;
procedure gotoquoteline(b:boolean);
begin
if (b) then begin
close(f);
openquotefile;
end;
if (not done) then begin
t1:=0;
repeat
inc(t1);
readquoteline;
until ((t1=quoteli) or (done));
end;
if (done) then quoteli:=1;
end;
procedure beginquote;
begin
if (lc>maxli) then done:=TRUE else begin
li[lc]:=('----------Begin Quote----------');
inc(lc);
end;
end;
procedure endquote;
begin
if (lc>maxli) then done:=TRUE else begin
li[lc]:=('-----------End Quote-----------');
inc(lc);
end;
end;
begin
beginquote;
openquotefile;
if (not done) then begin
done:=FALSE;
gotoquoteline(FALSE);
if (not done) then repeat
if (memboard.mbtype=0) then sprompt(#3+cstr(fidor.quote_color))
else sprompt(#3+cstr(memboard.quote_color));
sprint(s);
sprompt('[A]dd line [S]kip Line [P]revious Line [Q]uit :');
repeat
getkey(c1);
c1:=upcase(c1);
until (c1 in ['A','S','Q','P','?',^M]);
for t1:=1 to 60 do
prompt(^H' '^H);
sprompt(#3#3);
case c1 of
'A':begin
if (lc>maxli) then done:=TRUE else begin
li[lc]:=s;
inc(quoteli);
inc(lc);
readquoteline;
if (done) then dec(quoteli);
end;
end;
^M,'S':begin
inc(quoteli);
readquoteline;
if (done) then dec(quoteli);
end;
'P':if (quoteli>1) then begin
dec(quoteli);
gotoquoteline(TRUE);
end;
'Q':done:=TRUE;
end;
until (done);
endquote;
end;
{$I-} close(f); {$I+}
end;
procedure printmsgtitle;
begin
nl;
sprint(fstring.entermsg1);
sprint(fstring.entermsg2);
cl(3);
if (okansi) then
print(copy('/-------------------------------------\_/-------------------------------------\',
1,thisuser.linelen)) else
print(copy('/-------------------------------------\_/-------------------------------------\',
1,thisuser.linelen));
end;
procedure inputthemessage;
var t1:integer;
begin
cmdsoff:=FALSE;
abort:=FALSE;
next:=FALSE;
ptl1:=TRUE;
goquote:=FALSE;
quoteli:=1;
if (freek(exdrv(systat.msgpath))<systat.minspaceforpost) then begin
mftit:='';
nl;
print('Not enough disk space to save a message.');
c:=chr(exdrv(systat.msgpath)+64);
if (c='@') then sysoplog(#3#8+'>>>>'+#3#3+' Main BBS drive full! Insufficient space to save a message!')
else sysoplog(#3#8+'>>>>'+#3#3+' '+c+': drive full! Insufficient space to save a message!');
end else begin
lc:=1;
spc:=' ';
lastline:='';
if cso then maxli:=systat.csmaxlines
else maxli:=systat.maxlines;
ptl;
end;
if (mftit='') then
if (not cantabort) then begin
save:=FALSE;
exit;
end;
printmsgtitle;
repeat
repeat
saveline:=TRUE;
nofeed:=FALSE;
exited:=FALSE;
save:=FALSE;
abortit:=FALSE;
write_msg:=TRUE;
inli(s);
write_msg:=FALSE;
if (s='/'^H) then begin
saveline:=FALSE;
if (lc<>1) then begin
dec(lc);
lastline:=li[lc];
if (copy(lastline,length(lastline),1)=#1) then
lastline:=copy(lastline,1,length(lastline)-1);
sprint(#3#0+'Backed up to line '+cstr(lc)+':');
end;
end;
if (s='/') then begin
sprompt('^3Command (^0?^3=^0help^3) : ^3');
getkey(c);
for t1:=1 to 19 do
prompt(^H' '^H);
saveline:=FALSE;
case upcase(c) of
'/','\':begin
if (mso) then sprompt(#3#0+'[C]enter [T]itle [U]pload : ')
else sprompt(#3#0+'[C]enter [T]itle : ');
getkey(c1); c1:=upcase(c1);
if (mso) then for t1:=1 to 28 do prompt(^H' '^H)
else for t1:=1 to 19 do prompt(^H' '^H);
if (c1 in ['C','T']) then begin
sprint(#3#3+c1+#3#1+':'+#3#3);
inli(s);
if (s<>'') then begin
case c1 of
'C':s:=#2+s;
'T':s:=BOXEDTITLE+s;
end;
saveline:=TRUE;
end;
end;
if ((not hangup) and (c1='U') and (mso)) then begin
prt('Enter file name to upload: ');
mpl(40);
inputl(s,40);
if ((s<>'') and (not hangup)) then begin
assign(inmsgfile,s);
{$I-} reset(inmsgfile); {$I+}
if (ioresult<>0) then
print('File not found.')
else begin
inmsgfileopen:=TRUE;
cmdsoff:=TRUE;
end;
end;
end;
end;
'?','H':printf('prhelp');
'A':if (not cantabort) then
if pynq('@M^7Abort message? ') then begin
exited:=TRUE;
abortit:=TRUE;
end else
sprint(#3#0+'Nothing done.@M');
'C':if pynq('@M^7Clear message? ') then begin
sprint(#3#0+'Message cleared.... Start over...');
lc:=1;
end else
sprint(#3#0+'Nothing done.@M');
'E':exited:=TRUE;
'L':listit(1,pynq('@M^7List message with line numbers? '),TRUE);
'O':printf('color');
'P':rpl1;
'Q':if (not exist('msgtmp')) then
sprint(#3#0+'You are not replying to a message.@M')
else
goquote:=TRUE;
'R':if (lc>1) then begin
sprint(#3#0+'Last line deleted. Continue:'+#3#1);
dec(lc);
end;
'S':if ((not cantabort) or (lc>1)) then begin
exited:=TRUE;
save:=TRUE;
end;
'T':ptl;
end;
end;
if (goquote) then begin
doquote;
goquote:=FALSE;
cls;
sprint(#3#0+'Quoting complete. Continue:');
printmsgtitle;
if (lc>1) then
if (lc>10) then listit(lc-10,FALSE,FALSE)
else listit(1,FALSE,FALSE);
end;
if (saveline) then begin
li[lc]:=s;
inc(lc);
if (lc>maxli) then begin
print('You have used up your maximum amount of lines.');
if (inmsgfileopen) then begin
inmsgfileopen:=FALSE;
cmdsoff:=FALSE;
close(inmsgfile);
end;
exited:=TRUE;
end;
end;
until ((exited) or (hangup));
if (hangup) then abortit:=TRUE;
if ((not abortit) and (not save)) then
repeat
prt(#3#3+'Message editor (^0?^3=^0help^3) : ');
onek(c,'SACDILRTU?'); nl;
case c of
'?':begin
lcmds(15,3,'List message','Continue message');
lcmds(15,3,'Save message','Abort message');
lcmds(15,3,'Delete line','Insert line');
lcmds(15,3,'Replace line','Update line');
lcmds(15,3,'Title re-do','');
end;
'A':if (not cantabort) then
if pynq('Abort message? ') then abortit:=TRUE
else c:=' ';
'C':if (lc>maxli) then begin
sprint(#3#7+'Too many lines!');
c:=' ';
end else
sprompt(#3#0+'Continue...');
'D':begin
prt('Delete which line (1-'+cstr(lc-1)+') ? ');
input(s,4);
t:=value(s);
if (t>0) and (t<lc) then begin
for t1:=t to lc-2 do
li[t1]:=li[t1+1];
dec(lc);
end;
end;
'I':if (lc<maxli) then begin
prt('Insert before which line (1-'+cstr(lc-1)+') ? ');
input(s,4);
t:=value(s);
if (t>0) and (t<lc) then begin
for t1:=lc downto t+1 do li[t1]:=li[t1-1];
inc(lc);
sprint(#3#3+'New line:');
inli(li[t]);
end;
end else
sprint(#3#7+'Too many lines!');
'L':listit(1,pynq('With line numbers? '),TRUE);
'R':begin
prt('Line number to replace (1-'+cstr(lc-1)+') ? ');
input(s,4);
t:=value(s);
if ((t>0) and (t<lc)) then begin
abort:=FALSE;
nl;
sprint(#3#3+'Old line:');
printacr(li[t],abort,next);
sprint(#3#3+'Enter new line:');
inli(s);
if (li[t][length(li[t])]=#1) and
(s[length(s)]<>#1) then li[t]:=s+#1 else li[t]:=s;
end;
end;
'S':if ((not cantabort) or (lc>1)) then
save:=TRUE;
'T':ptl;
'U':rpl1;
end;
nl;
until (c in ['A','C','S']) or (hangup);
until ((abortit) or (save) or (hangup));
if (lc=1) then begin
abortit:=TRUE;
save:=FALSE;
end;
end;
function getorigin:string;
var s:astr;
begin
if (memboard.origin<>'') then s:=memboard.origin
else if (fidor.origin<>'') then s:=fidor.origin
else s:=copy(stripcolor(systat.bbsname),1,50);
while (copy(s,length(s),1)=' ') do
s:=copy(s,1,length(s)-1);
getorigin:=s;
end;
procedure saveit;
var t:text;
i,j,qcolor,tcolor:integer;
c:char;
s:astr;
function getaddr(zone,net,node,point:integer):string;
begin
getaddr:=cstr(zone)+':'+cstr(net)+'/'+cstr(node)+'.'+cstr(point)+')';
end;
begin
mheader.msglength:=0;
with memboard do begin
if (mbtype in [1,2]) then begin
qcolor:=quote_color;
tcolor:=text_color;
end else begin
qcolor:=fidor.quote_color;
tcolor:=fidor.text_color;
end;
assign(t,'tgtemp1.$$$'); rewrite(t);
if ((pub) and (mbfilter in mbstat)) then begin
for i:=1 to lc-1 do
if length(li[i])>0 then begin
li[i]:=stripcolor(li[i]);
for j:=1 to length(li[i]) do begin
c:=li[i][j];
if (c in [#0..#1,#3..#31,#127..#255]) then c:='*';
li[i][j]:=c;
end;
end;
end;
for i:=1 to lc-1 do begin
s:=li[i];
j:=pos('>',stripcolor(s));
if ((not pub) or (mbtype=0) or (copy(s,1,3)='`#[') or (s[1]=#2))
then j:=0;
if ((j>0) and (j<=5)) then s:=#3+cstr(qcolor)+s+#3+cstr(tcolor);
writeln(t,s);
inc(mheader.msglength,length(s)+2);
end;
if ((pub) and (mbtype in [1,2]) and (mbaddtear in mbstat)) then begin
writeln(t,'');
inc(mheader.msglength,2);
s:=#3+cstr(tear_color)+'--- Telegard v'+ver;
writeln(t,s);
inc(mheader.msglength,length(s)+2);
s:=#3+cstr(origin_color)+' * Origin: '+getorigin+' (';
if (zone<>0) then s:=s+getaddr(zone,net,node,point)
else s:=s+getaddr(fidor.zone,fidor.net,fidor.node,fidor.point);
writeln(t,s);
inc(mheader.msglength,length(s)+2);
end;
close(t);
outmessagetext('tgtemp1.$$$',mheader,TRUE);
end;
end;
procedure readytogo;
var f:file;
begin
if (exist('msgtmp')) then begin
assign(f,'msgtmp');
{$I-} reset(f); {$I+}
if (ioresult=0) then begin
close(f);
erase(f);
end;
end;
end;
begin
inmsg:=FALSE;
if (uti) then fto:=caps(mheader.toi.as)
else fto:='';
if (ftit<>'') then mftit:=ftit
else mftit:='';
if (copy(mftit,1,1)='\') then begin
mftit:=copy(mftit,2,length(mftit)-1);
cantabort:=TRUE;
end else
cantabort:=FALSE;
inputthemessage;
if (not save) then begin
print('Aborted.');
readytogo;
exit;
end;
with mheader do begin
signature:=$FFFFFFFF;
title:=mftit;
origindate:='';
with fromi do begin
anon:=0;
usernum:=common.usernum;
as:=allcaps(thisuser.name);
if ((not pub) or (memboard.mbtype=0)) then
as:=as+' #'+cstr(common.usernum);
real:=allcaps(thisuser.realname);
alias:=allcaps(thisuser.name);
end;
if (not uti) then
with toi do begin
anon:=0;
usernum:=0;
as:='';
if (allcaps(sqoutsp(fto))='EVERYONE') then fto:='';
if (pub) then as:=fto;
real:='';
alias:='';
end;
end;
loadboard(board);
if (pub) then begin
an:=memboard.anonymous;
if ((an=atno) and (aacs(systat.anonpubpost))) then an:=atyes;
if (rpostan in thisuser.ac) then an:=atno;
end else
if (aacs(systat.anonprivpost)) then an:=atyes else an:=atno;
case an of
atno :;
atforced :if (cso) then mheader.fromi.anon:=2
else mheader.fromi.anon:=1;
atyes :begin
nl;
if pynq(aonoff(pub,'Post Anonymously? ',
'Send Anonymously? ')) then
if (cso) then mheader.fromi.anon:=2
else mheader.fromi.anon:=1;
end;
atdearabby:begin
nl;
sprint(aonoff(pub,'Post as:','Send as:'));
nl;
sprint(#3#3+'1. ^7[^0User ^8X^7]');
sprint(#3#3+'2. ^1Problemed Person');
sprint(#3#3+'3. ^1'+nam);
nl;
prt('Which? '); onek(c,'123N'^M);
case c of
'1':mheader.fromi.anon:=3;
'2':mheader.fromi.anon:=4;
end;
end;
atanyname :begin
nl;
sprint('You can post your message under any name');
sprint('you want on this base.');
nl;
print('Enter name, or <CR> for your own.');
prt('Name: '); input(s,36);
if (s<>'') then begin
mheader.fromi.anon:=5;
mheader.fromi.as:=caps(s);
end;
end;
end;
if ((pub) and (himsg<>65535)) then begin
j:=0;
for i:=0 to himsg do begin
ensureloaded(i);
k:=mintab[getmixnum(i)].messagenum;
if (k>j) then j:=k;
end;
mixr.messagenum:=j+1;
end;
with mixr do begin
hdrptr:=filesize(brdf);
isreplytoid:=0;
isreplyto:=65535;
numreplys:=0;
getpackdatetime(@msgdate);
getdayofweek(msgdowk);
msgid:=memboard.lastmsgid;
inc(memboard.lastmsgid);
msgindexstat:=[miexist];
if (pub) then begin
if (rvalidate in thisuser.ac) then
msgindexstat:=msgindexstat+[miunvalidated];
if (aacs(memboard.mciacs)) then
msgindexstat:=msgindexstat+[miallowmci];
end;
end;
nl;
sprompt(#3#7+'I am processing your message...');
while ((lc>1) and ((li[lc-1]='') or (li[lc-1]=^J))) do
dec(lc);
saveit;
savesystat;
ufo:=(filerec(bf).mode<>fmclosed);
if (not ufo) then reset(bf);
seek(bf,board-1);
write(bf,memboard);
if (not ufo) then close(bf);
cl(5);
for t:=1 to 31 do begin
prompt('<');
delay(20);
prompt(^H' '^H^H);
end;
prompt('*');
delay(20);
prompt(^H' '^H);
cl(9);
readytogo;
inmsg:=TRUE;
end;
procedure inli(var i:string);
var s:astr;
cp,rp,cv,cc,xxy:integer;
c,c1,ccc,d:char;
hitcmdkey,hitbkspc,escp,dothischar,abort,next,savallowabort:boolean;
procedure bkspc;
begin
if (cp>1) then begin
if (i[cp-2]=#3) and (i[cp-1] in [#0..#9]) then begin
dec(cp);
cl(1);
end else
if (i[cp-1]=^H) then begin
prompt(' ');
inc(rp);
end else
if (i[cp-1]<>#10) then begin
prompt(^H' '^H);
dec(rp);
end;
dec(cp);
end;
end;
begin
write_msg:=TRUE; hitcmdkey:=FALSE; hitbkspc:=FALSE;
ccc:='1';
escp:=FALSE;
rp:=1; cp:=1;
i:='';
if (lastline<>'') then begin
abort:=FALSE; next:=FALSE;
savallowabort:=allowabort; allowabort:=FALSE;
reading_a_msg:=TRUE;
printa1(lastline,abort,next);
reading_a_msg:=FALSE;
allowabort:=savallowabort;
i:=lastline; lastline:='';
escp:=(pos(^[,i)<>0);
cp:=length(i)+1;
rp:=cp;
end;
repeat
if ((inmsgfileopen) and (buf='')) then
if (not eof(inmsgfile)) then begin
readln(inmsgfile,buf);
buf:=buf+^M;
end else begin
close(inmsgfile);
inmsgfileopen:=FALSE; cmdsoff:=FALSE;
dosansion:=FALSE;
buf:=^P+'1';
end;
getkey(c);
dothischar:=FALSE;
if (c=^G) then begin
cmdsoff:=not cmdsoff;
nl; nl;
if (cmdsoff) then begin
sprint(#3#5+'Message commands OFF now, to allow entry of special characters.');
sprint(#3#5+'Press Ctrl-G again to turn message commands back on.');
end else
sprint(#3#5+'Message commands back on again.');
nl;
for xxy:=1 to cp do s[xxy]:=i[xxy]; s[0]:=chr(cp-1);
abort:=FALSE; next:=FALSE;
reading_a_msg:=TRUE; printa1(s,abort,next); reading_a_msg:=FALSE;
end;
if (not cmdsoff) then
if ((c>=#32) and (c<=#255)) then begin
if (c='/') and (cp=1) then hitcmdkey:=TRUE else dothischar:=TRUE;
end else
case c of
^[:dothischar:=TRUE;
^B:dm(' -'^N'/'^N'l'^N'\'^N,c);
^H:if (cp=1) then begin
hitcmdkey:=TRUE;
hitbkspc:=TRUE;
end else
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
outkey(' '); if (trapping) then write(trapfile,' ');
i[cp]:=' ';
inc(rp); inc(cp);
end;
end;
^J:if (not (rbackspace in thisuser.ac)) then begin
outkey(c); i[cp]:=c;
if (trapping) then write(trapfile,^J);
inc(cp);
end;
^N:if (not (rbackspace in thisuser.ac)) then begin
outkey(^H); i[cp]:=^H;
if (trapping) then write(trapfile,^H);
inc(cp); dec(rp);
end;
^P:if (okansi) and (cp<strlen-1) then begin
getkey(c1);
if (c1 in ['0'..'9']) then begin
ccc:=c1; i[cp]:=#3;
inc(cp); i[cp]:=chr(ord(c1)-ord('0'));
inc(cp); cl(ord(i[cp-1]));
end;
end;
^S:dm(' '+nam+' ',c);
^W:if (cp=1) then begin
hitcmdkey:=TRUE;
hitbkspc:=TRUE;
end else
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(^H' '^H);
rp:=1;
if (ccc<>'1') then begin
c1:=ccc; i[cp]:=#3;
inc(cp); i[cp]:=chr(ord(c1)-ord('0'));
inc(cp); cl(ord(i[cp-1]));
end;
end;
end;
if ((dothischar) or (cmdsoff)) and ((c<>^G) and (c<>^M)) then
if ((cp<strlen) and (escp)) or
((rp<thisuser.linelen) and (not escp)) then begin
if (c=^[) then escp:=TRUE;
i[cp]:=c; inc(cp); inc(rp);
outkey(c);
if (trapping) then write(trapfile,c);
inc(pap);
end;
until ((rp=(thisuser.linelen)) and (not escp)) or ((cp=strlen) and (escp)) or
(c=^M) or (hitcmdkey) or (hangup);
if (hitcmdkey) then begin
if (hitbkspc) then i:='/'^H else i:='/';
end else begin
i[0]:=chr(cp-1);
if (c<>^M) and (cp<>strlen) and (not escp) 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
lastline:=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;
if (escp) and (rp=thisuser.linelen) then cp:=strlen;
if (cp<>strlen) then nl
else begin
rp:=1; cp:=1;
i:=i+#29;
end;
end;
write_msg:=FALSE;
end;
end.