// QCOMMAND.SR

get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF"

// Incoming Procedures

external [
	setpcsiz
	putvch
	getvch
	prevscrvch
	mapscrcp
	pollinput
	finddl
	insertb
	inserta
	setsel
	deletea
	updatedisplay
	marks
	cpvisible
	swat
	readsel
	cpmax
	cpmin
	visible
	invalidatedisplay
	invalidatedisplayk
	invalidatewindow
	invalidateband
	invalidatedoc
	invalidatesel
	selectsel
	cpseeable
	splitpara
	mergeparas
	cpparabounds
	parabounds
	finserta
	fdeletea
	finsertk
	cppara
	formatx
	macpara
	lastparacp
	finsertparastring
	paracp
	setmessage
	wholeparas
	prevunpointablecp
	getchar
	endofkeystream
	hidemark
	cpc
	setformata
	];

// Incoming Statics

external [
	selaux
	selection
	cpscrt
	selarg
	rgmaccp
	vchremain
	vdoc
	vcp
	vrgcc
	vdlhint
	rgpctb
	rgcp
	vpc
	vdcborig
	cominstream
	rgdllast
	rgdlfirst
	rgxlast
	vww
	rgcpfdispl
	rgcplast
	rgupdate
	rgcpfirst
	rgdoc
	comt
	rgsdoc
	rgsfile
	ddoc
	ybug
	pzone
	xbias
	ybias
	deltacp
	inword
	inwordnext
	cpfirstinl
	vwwcurrent
	sww
	sdoc
	rgpara
	rgview
	vcpfinsert
	vcpatx
	vx
	vcpfirst
	rgprogram
	vcpput
	rgfcode
	];

// Outgoing Procedures

external [
	paste;
	cut
	insert
	coleft
	coleftword
	coright
	placeleft
	placeright
	cutpaste
	exchange
	paragraph
	carrier
	tabulator
	];

// Outgoing Statics

external [
	cblind;
	vinsertk
	];

// Local

static [
	cblind;
	vinsertk
	];

let insert(char) = valof
[
let cpfirsttarget = selection >> SEL.cpfirst;
let cplasttarget = selection >> SEL.cplast;
let doctarget = selection >> SEL.doc;
let wwtarget = selection >> SEL.ww;
if cpc(cplasttarget, cpfirsttarget) ge 0 then // overtype
	if wholeparas(doctarget, cpfirsttarget, cplasttarget) then
		[
		cut1(selection)
		resultis insert(char)
		]
hidemark() ;
let tcp=initinsertk(wwtarget, cpfirsttarget)
adjustsel(selection, cpfirsttarget, cplasttarget, tcp+maxcblind)
let tchar=insertk(wwtarget, tcp, vpc, char)
resultis tchar
]

and initinsertk(ww,cp)=valof
[
let doc=rgdoc ! ww
invalidatedisplay(doc,cp,-1);
cp = finsertk(doc,cp,maxcblind);
vinsertk = true
let ppcd = vec 2
let vpa,tpc = nil,nil
vcpput = cpscrt;
for i = 0 to maxcblind-1 do putvch(chblind);
cblind = maxcblind;
vpa << VPA.fn = fnscr;
vpa << VPA.fp = cpscrt << PCD.p;
ppcd >> PCD.vpaddr = vpa;
ppcd >> PCD.rc = cpscrt << PCD.rc;
ppcd >> PCD.live = 0;
insertb(doc,cp,ppcd,maxcblind)
tpc=vpc
unless visible(ww,cp) do cpvisible(ww,cp)
vpc=tpc
resultis cp
]

and continueinsertk(doc, cp, char) be
[
test (vrgcc+char) >> CC.breakchar ifso
	invalidatedisplay(doc,cp+deltacp,vdlhint)
ifnot	invalidatedisplayk(doc,cp+deltacp,vdlhint)
vcpput = cpscrt+deltacp;
]

and insertk(ww,cp,pcinsertk,char)=valof
[
cpseeable(ww, cp)
let doc=rgdoc ! ww
deltacp = 0;
vdlhint = 0;
let kind = nil // %%
	[
	switchon comt ! char into
		[
case slookey:	invalidatedisplay(doc,cp+deltacp,vdlhint);
		kind = (rgfcode ! (char-#200)) << FCODE.kind // %%
		test kind eq klook % kind eq knormal // %%
		ifso unless rgprogram ! doc do
			[
			let tcp = cp + deltacp
			setformata(doc, tcp, tcp+cblind-1, char-#200)
			selection>>SEL.xfirst=-1
			selection>>SEL.xlast=-1
			]
		ifnot break;
		endcase;
case scoleft:	test deltacp
		ifso	[
			continueinsertk(doc, cp, chsp)
			prevscrvch( )
			selection>>SEL.xfirst=-1
			selection>>SEL.xlast=-1
			]
		ifnot break;
		endcase;
case stabulator:
case scarrier:	unless rgprogram ! doc do break
case smapchar:	char = char eq shsp? chsp,
			char eq shcr? chcr,
			char eq shtab? chtab,
			char
case sinchar:	continueinsertk(doc, cp, char)
		putvch(char);
		unless operate(selection,1,0) do 
			[
			selection>>SEL.xfirst=-1
			selection>>SEL.xlast=-1
			]
		cblind = cblind-1;
		deltacp = deltacp+1;
		endcase;
default:	break
		] 
	if (cblind eq 0) % (cblind gr (maxcblind lshift 1)) then
		[
		vcpput = cpscrt+deltacp;
		for i = 0 to maxcblind-1 do putvch(chblind);
		cblind = maxcblind;
		cp = finsertk(doc, cp+deltacp, maxcblind) - deltacp
		setpcsiz(doc,pcinsertk,deltacp+maxcblind);
		] 
	test endofkeystream()
	ifso	[
		updatedisplay( );
		cpseeable(ww, cp+deltacp)
		marks(true)
		char=pollinput()
		marks(false)
		]
	ifnot char=getchar()
	] repeat
endinsertk(doc,cp,pcinsertk,cblind,deltacp)
resultis char
]

and endinsertk(doc,cp,pcinsertk,cblind,deltacp) be
[
test deltacp eq 0
ifso fdeletea(doc,cp,cp+cblind-1)
ifnot	[
	cpscrt = cpscrt+deltacp
	finsertk(doc, cp+deltacp, -cblind) // LT
	setpcsiz(doc,pcinsertk,deltacp);
	] 
vinsertk = false
]

and paste(cmdcode) = valof
[
let wwtarget=selection >> SEL.ww
let doctarget = selection >> SEL.doc;
let cpfirsttarget=selection >> SEL.cpfirst
let cplasttarget=selection >> SEL.cplast
let docrange=selaux >> SEL.doc;
let cpfirstrange = selaux >> SEL.cpfirst ;
let cplastrange= selaux >> SEL.cplast ;
if cpc(cpfirstrange, cplastrange) gr 0 then resultis 0
if docrange eq doctarget then
	[
	if cpc(cpfirsttarget, cplastrange) le 0 &
		cpc(cpfirsttarget, cpfirstrange) gr 0
	% cpc(cpfirstrange, cplasttarget) le 0 &
		cpc(cpfirstrange, cpfirsttarget) gr 0
	then	[
		setmessage(" Target and range overlap")
		resultis 0;
		]
	];
if rgprogram ! doctarget &
	wholeparas(docrange, cpfirstrange, cplastrange) then
		[
		setmessage(" Can't paste paragraphs in programs")
		resultis 0
		]
if cpc(cpfirsttarget, cplasttarget) le 0 then
	if wholeparas(doctarget, cpfirsttarget, cplasttarget) ne
	   wholeparas(docrange, cpfirstrange, cplastrange) then
		[
		setmessage(" Target or range is partial paragraph")
		resultis 0
		]
cpseeable(wwtarget, cpfirsttarget)
invalidatedisplay(doctarget,cpfirsttarget,vdlhint)
finserta(doctarget,cpfirsttarget,docrange,cpfirstrange,cplastrange);
adjustsel(selection, cpfirsttarget, cplasttarget, vcpfinsert)
test cmdcode eq -1
ifso	[ // exchange
	operate(selaux, -1, 0)
	updatedisplay()
	if cpc(cpfirsttarget, cplasttarget) le 0 then
		[
		cpfirsttarget = selection>>SEL.cpfirst
		cplasttarget = selection>>SEL.cplast
		invalidatedisplay(docrange, selaux>>SEL.cpfirst, vdlhint)
		finserta(docrange, selaux>>SEL.cpfirst,
			doctarget, cpfirsttarget, cplasttarget)
		cpfirsttarget = selection>>SEL.cpfirst
		cplasttarget = selection>>SEL.cplast
		adjustsel(selection, cpfirsttarget, cplasttarget,
		    fdeletea(doctarget, cpfirsttarget, cplasttarget))
		]
	hidemark()	
	selectsel(selection, wwtarget, 1 + selection>>SEL.cplast)
	]
ifnot	[ // paste
	operate(selection, -1, 1)
	if selaux>>SEL.doc ne sdoc then operate(selaux, 0, 2)
	]
updatedisplay()
cpseeable(wwtarget, selection >> SEL.cpfirst)
resultis 0;
] 

and cut(char) = valof
[
cpseeable(selection >> SEL.ww, selection >> SEL.cpfirst)
resultis cut1(selection)
]

and cut1(sel) = valof
[
operate(sel, -1, 2)
resultis 0;
]

and cutpaste(char) = valof
[
cut1(selaux)
paste(0)
] 

and exchange(char) = paste(-1)

and placeleft(cmdcode) = 0 //
// valof
//[
//let cpfirst = selection >> SEL.cpfirst ;
//let cplast = selection>>SEL.cplast
//if cpfirst eq 0 then resultis 0 ;
//resultis place(cpfirst,cplast,-1)
//]
 
and placeright(cmdcode) = 0
// valof
// [
// let cpfirst = selection >> SEL.cpfirst ;
// let cplast = selection >> SEL.cplast
// if cpc(cpfirst, rgmaccp!(selection>>SEL.doc)-1) ge 0 then resultis 0 ;
// resultis place(cpfirst,cplast,+1)
// ]
 
//and place(cpfirst,cplast,dir) = valof
//[
//findrealch(selection >> SEL.doc, cpfirst+dir, dir) ;
//setsel(selection, vcp, cpc(cplast,cpfirst) ls 0?vcp-1,cplast)
//resultis 0
//]
 
and coleft(cmdcode) = valof
[
hidemark()
let cpfirsttarget,doctarget,cplasttarget=nil,nil,nil;
doctarget = selection >> SEL.doc
cpfirsttarget = selection >> SEL.cpfirst
cplasttarget = selection >> SEL.cplast
if cpfirsttarget eq 0 then resultis 0;
let tex, b, e = nil, nil, nil
let para = cpparabounds(doctarget, cpfirsttarget, lv tex, lv b, lv e)
if para ge macpara(doctarget)-2 then
	[
	parabounds(doctarget, para-1, lv tex, lv b, lv e)
	selectsel(selection, selection >> SEL.ww, b)
	resultis 0
	]
cpfirsttarget = cpmin(cpfirsttarget, b) 
let limit = prevunpointablecp(doctarget, cpfirsttarget)
if cpc(cpfirsttarget-1, limit) le 0 then resultis 0
test cpc(cpfirsttarget, tex) gr 0
ifso	[
	let n = 1
	test cmdcode eq -1
	ifso	[ // coleftword
			[
			cpfirsttarget = cpfirsttarget-1
			vcp = cpfirsttarget
			vchremain = 0
			vdoc = doctarget
		 	] repeatwhile getvch() eq chsp &
			  	cpc(cpfirsttarget, tex) gr 0
		let wwtarget = selection >> SEL.ww
		let dltarget = finddl(wwtarget, cpfirsttarget)
		if dltarget ls 0 then
			[
			cpseeable(wwtarget, cpfirsttarget)
			dltarget = finddl(wwtarget, cpfirsttarget)
			]
		vcpatx = cpfirsttarget
		formatx(wwtarget,dltarget,0);
		formatx(wwtarget,dltarget,vx);
		vcpfirst = cpmax(vcpfirst, limit+1)
		n = selection >> SEL.cpfirst - vcpfirst
		selection >> SEL.cpfirst = vcpfirst
		]
	ifnot	selection>>SEL.cpfirst=cpfirsttarget-1
	correct(n)
	]
ifnot if para & cpc(cplasttarget, cpfirsttarget) ls 0 then
	[
	invalidateband(doctarget, tex-1, e)
	adjustsel(selection, cpfirsttarget, cplasttarget,
		mergeparas(doctarget, para-1, para))
	]
resultis 0
]

and correct(n) be
[
let cpfirst = selection >> SEL.cpfirst
let ww = selection >> SEL.ww
let scrback = cpc(cpfirst, rgcpfdispl ! ww + 1) ls 0 ? 1, 0
if cpc(selection >> SEL.cplast, cpfirst) ls 0 then
	selection >> SEL.cplast = cpfirst-1
operate(selection,n,0)
cpseeable(ww, cpmax(cpfirst-scrback, 0))
]

and coleftword(cmdchar) = coleft(-1)

and coright(cmdcode) = 0
// valof
// [
// let cpfirsttarget,doctarget,cplasttarget=nil,nil,nil;
// let eodcp =  rgmaccp ! (selection >> SEL.doc)-1 ;
// doctarget = selection >> SEL.doc
// cpfirsttarget = selection >> SEL.cpfirst
// cplasttarget = selection >> SEL.cplast
// if cpc(cpfirsttarget, eodcp) ge 0 then resultis 0 ;
// correct(1)
// resultis 0
//]
 
and operate(sel, op, scratch) = valof
[
//	op	-1	Delete whole selection
//		 0	Don't delete any of it
//		 n	Delete first n characters of it

//	scratch	 0	Don't scratch
//		 1	Scratch
//		 2	Scratch and set selaux there

let doc = sel>>SEL.doc
let cpfirst = sel>>SEL.cpfirst
let cplast = sel>>SEL.cplast
if cpc(cplast, cpfirst) ls 0 then resultis false
let cpend = cpc(op, 1) ls 0? cplast, cpfirst+op-1
let crossout = cpc(cplast, cpend) gr 0
let tex, b, e = nil, nil, nil
let teodc = lastparacp(sdoc);
if scratch then
	[
	invalidatedisplay(sdoc,teodc,-1);
	teodc = finserta(sdoc,teodc,doc,cpfirst,cpend);
	if scratch eq 2 then
		selectsel(selaux, sww, teodc, vcpfinsert-1)
	];
if op ne 0 then
	[
	invalidatedisplay(doc,cpfirst,-1);
	adjustsel(sel, cpfirst, cplast, fdeletea(doc,cpfirst,cpend));
	unless crossout do sel >> SEL.cplast = sel >> SEL.cpfirst - 1;
	]
if scratch then
	[
	rgupdate ! sww = true ;
	rgxlast ! (rgdlfirst ! sww) = -1 ;
	rgcpfdispl ! sww = teodc ;
	];
resultis true
]

//and findrealch(doc,cp,dir) be
//[
//let tex, b, e = nil, nil, nil
//cpparabounds(doc, cp, lv tex, lv b, lv e)
//vcp=cpc(tex, b+1) ls 0 & cpc(cp+1, tex) gr 0? cp,dir gr 0?e+1, b
//]
 
and paragraph(char) = valof
[
let doc = selection >> SEL.doc
if doc ne sdoc & not rgprogram ! doc then
	[
	let cpfirst = selection >> SEL.cpfirst
	let cplast = selection >> SEL.cplast
	if cpc(cplast, cpfirst) ls 0 then resultis 0
	invalidatesel(selection)
	invalidatesel(selaux)
	let eodc = lastparacp(doc) - 1
	invalidateband(doc, cpfirst, cplast)
	let para2 = cpc(cplast, eodc) ls 0?
			splitpara(doc, cplast+1, false) - 1,
		   	macpara(doc)-1
	let para1 = splitpara(doc, cpfirst, false)
	mergeparas(doc, para1, para2)
	hidemark()
	]
resultis 0
]

and adjustsel(selection, cpfirst, cplast, newcpfirst) be
	[
	selection >> SEL.cpfirst = newcpfirst
	if cpc(cplast, cpfirst) le 0 then
		selection >> SEL.cplast =
			cplast + newcpfirst - cpfirst
	]

and carrier(cmdcode) = valof
	[
	let doc = selection >> SEL.doc
	if rgprogram ! doc then resultis insert(cmdcode)
	hidemark()
	let cpfirst = selection >> SEL.cpfirst
	let cplast = selection >> SEL.cplast
	invalidatedisplay(doc, cpfirst, vdlhint)
	adjustsel(selection, cpfirst, cplast,
		paracp(doc, splitpara(doc, cpfirst, true)))
	updatedisplay()
	cpseeable(selection >> SEL.ww, selection >> SEL.cpfirst)
	resultis 0
	]

and tabulator(cmdcode) = valof
	[
	let doc = selection >> SEL.doc
	if rgprogram ! doc then resultis insert(cmdcode)
	// someday this will be a table command
	resultis 0
	]