//  subfind.sr


get "BRAVO1.DF";
get "CHAR.DF";
get "MSG.DF";
get "SELECT.DF";
get "DISPLAY.DF";
get "DOC.DF";
get "RN1.DF"
get "COM.DF"


// Incoming procedures

external	[
	inserttx
	mpDlDld
	ugt
	SetRegionSys
	updatedisplay
	backdylines
	setsel
	cpvisible
	bravochar
	putsonts
	getvch
	mapcp
	FAdjustSelEod
	replacea
	invalidateband
	stnum
	SetRegionW
	invalidatedisplay
	OsBuffer
	getchar
	blinkscreen;
	FFaultStor;
	GetSi;
	move;
	SetRegionA;
	]


// Incoming statics

external	[
	mpWwWwd
	chcom
	rgmaccp
	rgcpfirst
	vcpfirst
	vcp
	vcplast
	tsread
	tsmacro
	vdoc
	vmapstatus
	vchremain
	vlook1
	vlb
	vpw
	vchterm
	vrlwsys
	dcpendofdoc
	vdlhint
	doctxcurrent
	vrldsys
	]


// Outgoing procedures

external
	[
	DelInKbdBuf
	findjumpcoms;
	substcom;
	yescom;
	]


// Outgoing statics

// external


// Local structure

structure BUF:		// see Bkbd.sr
	[
	First	word
	Last	word
	In	word
	Out	word
	]


// Local manifests

manifest	[
	risearch = 38
	riFOR = 70
	riOldText = 71
	riSubs = 80
	chFound = $y
	chNotFound = $n
	chComTerm = chdel
	chCoreLow = #200+$\
	abComTerm = 2 lshift (16 - offset AB.crid - size AB.crid) +
		0 lshift (16 - offset AB.nrid - size AB.nrid)
	abNotFound = 2 lshift (16 - offset AB.crid - size AB.crid) +
		2 lshift (16 - offset AB.nrid - size AB.nrid)
	abKeyTooLong = 2 lshift (16 - offset AB.crid - size AB.crid) +
		4 lshift (16 - offset AB.nrid - size AB.nrid)
	abSelEmpty = 2 lshift (16 - offset AB.crid - size AB.crid) +
		6 lshift (16 - offset AB.nrid - size AB.nrid)
	abNoJumps = 2 lshift (16 - offset AB.crid - size AB.crid) +
		8 lshift (16 - offset AB.nrid - size AB.nrid)
	abCoreLow = 2 lshift (16 - offset AB.crid - size AB.crid) +
		10 lshift (16 - offset AB.nrid - size AB.nrid)
	]
 

// F I N D J U M P C O M S 
//
let findjumpcoms(cf) = valof
[
let ab = nil
let tab = nil
let sel = cf>>CF.sel
let wwselm = sel >> SEL.ww;
let docselm = sel >> SEL.doc;
let tdl = nil;
let tcp = nil;
let wwd = mpWwWwd ! wwselm
let dld = nil

unless inserttx(3) do resultis abComTerm

switchon chcom into
	[
case $j:
	tdl = wwd>>WWD.dlFirst;
	dld = mpDlDld(tdl)
	test (dld>>DLD.cpLast) eq ((rgmaccp ! docselm)-1) ifso
		[
		resultis abNoJumps
		]
	ifnot	tcp = rgcpfirst ! (tdl+1)
	endcase;

case $f:
	tcp = sel >> SEL.cplast+1;
	endcase;
	]
if ugt(tcp, rgmaccp ! docselm-1) then
	tcp = rgmaccp ! docselm-1;
SetRegionSys(risyspast, risearch);
updatedisplay();
tab = find(doctx3, 0, rgmaccp!doctx3-1, docselm, tcp, rgmaccp!docselm-1)
if tab ne abnil resultis tab
switchon chcom into
	[
case $j:
	backdylines(wwselm, vcpfirst, 0);
	wwd>>WWD.fUpdate = true;
	wwd>>WWD.cpFDispl = vcp;
	resultis abnil

case $f:
	setsel(sel, vcpfirst, vcplast);
	cpvisible(wwselm, vcpfirst);
	resultis abnil
	]
]


// F I N D 
// 
and find(dock, cpfirstk, cplastk, doc, cpfirst, cplast) = valof
[
let char = nil;
test tsread & not tsmacro ifso 
	[
	char= bravochar()
	if char eq chNotFound then resultis abNotFound
	if char eq chComTerm then resultis abComTerm
	if char eq chCoreLow then
		[ blinkscreen();
		resultis abCoreLow
		]
	]
ifnot
	[ if FFaultStor(0) then
		[ putsonts(chCoreLow)
		blinkscreen();
		resultis abCoreLow
		]
	]
let ab = nil
let chresult= nil
let key = vec 100;
let p = vec 100;
let rp = 0;
if ugt(cpfirst, cplast) then 
	[
	unless tsread do putsonts(chNotFound)
	resultis abNotFound
	]
let keyl = cplastk-cpfirstk+1;
if keyl eq 0 then 
	[
	unless tsread do putsonts(chComTerm)
	resultis abComTerm
	]
if keyl gr 99 then 
	[
	unless tsread do putsonts(chComTerm)
	resultis abKeyTooLong
	]
vcp = cpfirstk;
vdoc = dock;
vmapstatus = statusblind;
for i = 1 to keyl do
	key ! i = getvch( )
p ! 1 = 0;
for fp = 2 to keyl do
	[
	rp = rp+1;
	p ! fp = (key ! fp ne key ! rp)?rp, p ! rp;
	while (key ! fp ne key ! rp) & (rp ne 0 ) do 
		rp = p ! rp;
	]
let i = 0;
vcp = cpfirst;
vmapstatus = statusblind;
let dcpremain = cplast-cpfirst+1
	[
	if dcpremain eq 0 then
		[
		unless tsread do putsonts(chNotFound)
		resultis abNotFound
		]
	if DelInKbdBuf(true) ne 0 then
		[
		unless tsread do putsonts(chComTerm)
		resultis abComTerm
		]
	mapcp(doc, vcp);
	if ugt(vchremain, dcpremain) then
		vchremain = dcpremain
	dcpremain = dcpremain-vchremain
	if vlook1 << LOOK1.trailer then
		[
		vcp = vcp+vchremain
		vmapstatus = statusblind;
		loop
		]
	while vchremain do
		[
		test vlb ifso
			[
			char = vpw >> lh
			vlb = false;
			]
		ifnot	[
			char = vpw >> rh;
			vlb = true;
			vpw = vpw+1;
			]
		vchremain = vchremain-1;
		i = i+1;
		while (char ne key ! i) & (i ne 0) do
			i = p ! i;
		if i eq keyl then
			[
			vcpfirst = vcp-keyl+1;
			vcplast = vcp;
			unless tsread do putsonts(chFound)
			resultis abnil
			]
		vcp = vcp+1;
		]
	] repeat
]


// S U B S T C O M
//
and substcom(cf) = valof
[
let ab, trid, trid1 = nil, nil, nil
if (inserttx(2) eq false) & (vchterm eq chdel) do
	resultis abComTerm
let sel = cf>>CF.sel
FAdjustSelEod(sel)
let cpfirstselm = sel >>SEL.cpfirst;
let cplastselm = sel >> SEL.cplast;
let docselm = sel >> SEL.doc;
SetRegionSys(risyscom, riFOR);
SetRegionSys(risysstate, riOldText);
updatedisplay( );
unless inserttx(3) do resultis abComTerm
let maccp = rgmaccp ! doctx3;
let tdeltacp = rgmaccp ! doctx2-rgmaccp ! doctx3;
let tcpstart = cpfirstselm;
let tcpend = cplastselm;
let tcplast = rgmaccp ! doctx2-1;
let count = 0;
SetRegionSys(risyspast, riSubs);
updatedisplay( );
	[ 
	ab = find(doctx3, 0, maccp-1, docselm, tcpstart, tcpend)
	if ab ne abnil then break	//find successful if abnil
	tcpstart = vcplast+1+tdeltacp;
	tcpend = tcpend+tdeltacp;
	count = count+1;
	replacea(docselm, vcpfirst, vcplast+1-vcpfirst, doctx2, 0, rgmaccp ! doctx2)
// 	deletea(docselm, vcpfirst, vcplast);
// 	inserta(docselm, vcpfirst, doctx2, 0, tcplast) 
	] repeat;

setsel(sel, cpfirstselm, tcpend);
invalidateband(docselm, cpfirstselm, sel >> SEL.cplast);
let trgrid = vec 20;
let tcrid = 0;
if ab eq abCoreLow then
	[ trgrid ! 0 = 49;
	trgrid ! 1 = 50;
	tcrid = 2;
	]
if ab eq abKeyTooLong then
	[ trgrid ! 0 = 82;
	trgrid ! 1 = 50;
	tcrid = 2;
	]
let tsb = vec 5
stnum(tsb, count);
SetRegionW(vrlwsys, 0, tsb)
trid<<RID.nrl = 1;	trid<<RID.ri = 0
switchon count into
	[
case 0:	trgrid ! tcrid = 121;
	tcrid = tcrid+1;
// SetRegionSys(risyspast, 121)	//No Substitutions made 
	endcase;
case 1:	trgrid ! tcrid = trid;
	tcrid = tcrid+1;
	trgrid ! tcrid = 122;
	tcrid = tcrid+1;
// SetRegionSys(risyspast, trid, 122) //substitution made 
	endcase;
default:trgrid ! tcrid = trid;
	tcrid = tcrid+1;
	trgrid ! tcrid = 123;
	tcrid = tcrid+1;
// SetRegionSys(risyspast, trid, 123) // substitutions made 
	endcase;
	]
SetRegionA(vrldsys, risyspast, tcrid, trgrid)
resultis abmsg
]


// Y E S C O M
//
and yescom(cf) = valof
[
let ab = nil
let sel = cf>>CF.sel
if sel >> SEL.type eq snone then resultis abSelEmpty

let cpfirstselm = sel >>SEL.cpfirst;
let cplastselm = sel >> SEL.cplast;
let docselm = sel >> SEL.doc;
let wwselm = sel >> SEL.ww;
let maccp= nil
let tcp= nil
let tdeltacp= nil

if ugt(cpfirstselm, cplastselm) then resultis abSelEmpty

if ugt(cplastselm, rgmaccp!docselm - dcpendofdoc - 1) then 
	[
	SetRegionSys(risyspast, 218, 50)	//can't edit endmark
	resultis abmsg
	]

invalidatedisplay(docselm, cpfirstselm, vdlhint);

maccp = rgmaccp ! doctxcurrent;
test (cf>>CF.frepeat) 	//ESC means don't replace	
ifso	tcp= cplastselm + 1
ifnot	[
	//deletea(docselm, cpfirstselm, cplastselm);
	tdeltacp = maccp-1-cplastselm+cpfirstselm;
	tcp = cplastselm+tdeltacp+1;
	//inserta(docselm, cpfirstselm, doctxcurrent, 0, maccp-1);
	replacea(docselm,cpfirstselm,cplastselm-cpfirstselm+1,
	 doctxcurrent,0,maccp)
	]
SetRegionSys(risyspast, risearch);
updatedisplay( );
ab= find(doctx3, 0, rgmaccp ! doctx3-1, docselm, tcp, rgmaccp ! docselm-dcpendofdoc) 
if ab ne abnil then 
	[
	unless cf>>CF.frepeat do
	 setsel(sel, cpfirstselm, cpfirstselm+maccp-1)
	resultis ab;
	]
setsel(sel, vcpfirst, vcplast);
tcp = vcplast+1;
cpvisible(wwselm, vcpfirst);
chcom = $f;
resultis abnil
]


// D E L I N K B D B U F
// Checks keyboard buffer- returns pointer to last DEL in buffer, 0 if none
// if fflush then flush up to and including last DEL

and DelInKbdBuf(fflush) = valof
[
let p= 0

let pIn= OsBuffer>>BUF.In
let pOut= OsBuffer>>BUF.Out
let pFirst= OsBuffer>>BUF.First
let pLast= OsBuffer>>BUF.Last

test pOut gr pIn ifso
	[
	for i= pOut to pLast-1 do  if ((rv i) eq chdel) then p=i 
	for i= pFirst to pIn-1 do  if ((rv i) eq chdel) then p=i 
	]
ifnot for i= pOut to pIn-1 do  if ((rv i) eq chdel) then p=i 

if fflush & (p ne 0) then 
	[
	OsBuffer>>BUF.Out= p
	getchar()
	]

resultis p
]