// QMENU.SR

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

// Incoming Procedures

external [
	movec
	codechange
	changeformata
	marks
	invalidateband
	invalidatesel
	turntopage
	overlay
	macpage
	pollkeyboard
	max
	min
	cpparabounds
	qparsename
	invalidatewindow
	pagenumcp
	stget
	getvch
	setmenu
	stripeline
	stripewindow
	stripenone
	stripefly
	stripemenu
	bugmenu
	qdprint
	readsel
	stequal
	qquit
	qfile
	qfetch
	qaddsection
	qcreatedraft
	qmakeversion
	setmessage
	nextpointablespan
	cpc
	find
	fdeletea
	finserta
	visible
	selectsel
	hidemark
	cpvisible
	stcopy
	stnum
	stappend
	invalidatedoc
	lastparacp
	finddl
	backnlines
	updatedisplay
	pointable
	resetmessage
	pollstripe
	pollmouse
	invalidatedisplay
	setformata
	dirflip
	];

// Incoming Statics

external [
	vcasson
	vww
	ddoc
	vturning
	vchremain
	comt
	vdoc
	vstripe
	vcpfirst
	vcplast
	rgmenu
	selection
	selaux
	mdoc
	sdoc
	vcpfinsert
	rgcpfdispl
	mww
	vwwcurrent
	rgdoc
	rgdlfirst
	rgcplast
	vdl
	rgupdate
	vcp
	vdpstop
	vdpon
	];

// Outgoing Procedures
external [
	qlevel
	qpageto
	qscan
	qsubstitute
	qdouble
	qheadings
	qpagenums
	qrepaginate
	qall
	qcontinue
	qcancel
	qdirectory
	qdrawer // %%
	];

// Outgoing statics
external
	[
	vdpspacing
	vdpheadings
	vdppagenums
	vdprepaginate
	]

// Local statics
static
	[
	vdpspacing
	vdpheadings
	vdppagenums
	vdprepaginate
	]

let qsubstitute(cpmenu, sel) = valof
[
if selection>>SEL.doc eq mdoc % selection>>SEL.doc eq sdoc
	% cpc(selection>>SEL.cplast, selection>>SEL.cpfirst) ls 0 then
	[
	setmessage(" First black-out the target, then bug Substitute") // $$
	resultis 1
	]
let cpfold,cplold,cpfnew,cplnew=nil,nil,nil,nil
nextpointablespan(mdoc,cpmenu,lv cpfnew,lv cplnew)
nextpointablespan(mdoc,cplnew+1,lv cpfold,lv cplold)
if cpc(cplold, cpfold) ls 0 then resultis 1
setmessage(" Substituting...")
let tww = selection>>SEL.ww
let tdoc = selection>>SEL.doc
let tcpfirst = selection >> SEL.cpfirst
let tcplast = selection >> SEL.cplast
let ns = 0
until cpc(tcpfirst, tcplast) gr 0 do
	[
	unless find(mdoc,cpfold,cplold,tdoc,tcpfirst,tcplast) do break
	ns = ns + 1
	vcpfirst = fdeletea(tdoc,vcpfirst,vcplast)
	if cpc(cplnew, cpfnew) ge 0 do
		finserta(tdoc,vcpfirst,mdoc,cpfnew,cplnew)
	tcpfirst = vcpfinsert
	tcplast = selection>>SEL.cplast
	]
qsubstmessage(tdoc, ns) // $$
//test selaux eq selection
//ifso	test visible(tww, selaux >> SEL.cpfirst)
//	ifso selectsel(selaux, tww, selaux >> SEL.cpfirst)
//	ifnot selectsel(selaux, tww, rgcpfdispl ! tww)
//ifnot	hidemark()
cpvisible(mww,0)
resultis 1
]

and qsubstmessage(doc, n) be
[
let stn = vec 5
let str = vec 15
stcopy(str, " ")
stcopy(stn, "")
stnum(stn, n)
stappend(str, stn)
stappend(str, " substitutions made")
invalidatedoc(doc)
setmessage(str)
]

and qscan(cpmenu, sel) = valof
[
let cpfirst,cplast,tcp=nil,nil,nil
let tww=vwwcurrent
let tdoc=rgdoc!tww
let tdl = rgdlfirst ! tww;
let tcp = 1 + rgcplast ! tdl
if cpc(tcp,lastparacp(tdoc)-1) gr 0 then resultis 1;
nextpointablespan(mdoc,cpmenu,lv cpfirst,lv cplast)
if cpc(cplast, cpfirst) ls 0 then resultis 1
setmessage(" Scanning...")
unless find(mdoc,cpfirst,cplast,tdoc,tcp,lastparacp(tdoc)-1) do
	[
	setmessage(" Not found")
	resultis 1
	];
let tcp = vcpfirst
let tcplast = vcplast
vdl = finddl(tww, tcp)
test vdl ls 0 % vdl-rgdlfirst!tww gr fardl
ifso	[
	backnlines(tww,tcp,0);
	rgupdate ! tww = true;
	vturning = true
	rgcpfdispl ! tww = vcp;
	]
ifnot	[
	vcp = rgcplast ! (rgdlfirst ! tww) + 1
	if cpc(tcp, vcp) ls 0 then break
	rgupdate ! tww = true;
	vturning = true
	rgcpfdispl ! tww = vcp;
	updatedisplay()
	] repeat
if sel & pointable(tdoc, tcp, tcplast) then // NEW
	selectsel(sel, tww, tcp, tcplast)
resetmessage()  // updates display
resultis 1
]

// $$[

and qdouble(char,sel) = valof
[
vdpspacing = vdpspacing eq 1? 2,1
resultis qboldmenuitem(vdpspacing eq 2)
]

and qheadings(char,sel) = valof
[
vdpheadings = not vdpheadings
resultis qboldmenuitem(vdpheadings)
]

and qpagenums(char,sel) = valof
[
vdppagenums = not vdppagenums
resultis qboldmenuitem(vdppagenums)
]

and qrepaginate(char,sel) = valof
[
vdprepaginate = not vdprepaginate
resultis qboldmenuitem(vdprepaginate)
]

and qboldmenuitem(bold) = valof
[
invalidatedisplay(mdoc, vcpfirst, -1)
setformata(vdoc, vcpfirst, vcplast, bold? $b,$B)
updatedisplay()
resultis 1
]

and qall(char, sel) = valof
[
selectsel(selection, vwwcurrent, 0, lastparacp(rgdoc!vwwcurrent)-1) ;
resultis 1 ;
]

and qcontinue(char, sel) = dirflip(vwwcurrent)

and qcancel(char, sel) = dirflip(vwwcurrent)

and qdirectory(char, sel) = dirflip(vwwcurrent)

and qdrawer(char, sel) = valof // %%
	[
	cpvisible(vwwcurrent, 0)
	resultis 1
	]

and qpageto(char) = valof
[
let zerofudge = #200+$0
let page = char-zerofudge
	[
	char = pollkeyboard()
	let sig = comt ! char
	test sig eq spageto
	ifso	page = page*10 + char-zerofudge
	ifnot	if (sig ne snone) %
			(((rv #177036) & #004000) ne 0) // ctrl up?
				then break
	] repeat
let doc = rgdoc ! vww
turntopage(doc, doc eq ddoc? page, max(0, page-1)) // $$ for now
resultis char
]

and qlevel(char) = valof
[
let tcpfirst, tcplast = nil, nil
let change = vec changel
movec(change, change+changel-1, 0)
let doc = selection>>SEL.doc
let llevel = 0
let rlevel = 0
	[
	let sig = comt ! char
	test sig eq slevel
	ifso
		[
		char = char - #200
		let reset = char eq $L % char eq $R
		let left = char eq $l % char eq $L
		llevel = llevel + (not reset & left? 1,0)
		rlevel = rlevel + (not reset & not left? 1,0)
		qlevelinval(lv tcpfirst, lv tcplast, doc)
		codechange(change, char + (reset? #40,0),
				reset? 0,(left? llevel,rlevel)
					*marglevel)
		changeformata(change, doc, tcpfirst, tcplast)
		movec(change, change+changel-1, 0)
		if reset then
			test left
			ifso	llevel = 0
			ifnot	rlevel = 0
		updatedisplay()
		marks(true)
		marks(false)
		]
	ifnot	if (sig ne snone) %
			(((rv #177036) & #004000) ne 0) // ctrl up?
				then break
	char = pollkeyboard()
	] repeat
resultis char
]

and qlevelinval(ptrtcpfirst, ptrtcplast, doc) be
[
let dum = nil
let tcpfirst = selection>>SEL.cpfirst
let tcplast = selection>>SEL.cplast
let tcplast1 = nil // %%
let band = cpc(tcplast, tcpfirst) ge 0
cpparabounds(doc, tcpfirst, lv tcpfirst, lv dum, lv tcplast1) // %%
test band
ifso cpparabounds(doc, tcplast, lv dum, lv dum, lv tcplast)
ifnot tcplast = tcplast1 // %%
invalidateband(doc, tcpfirst, tcplast)
invalidatesel(selection)
invalidatesel(selaux)
@ptrtcpfirst = tcpfirst
@ptrtcplast = tcplast
]


// $$]