// TESLER changed Quit, Section -> Page, added "sel" args

// QDIRTY.SR

// N.B  bounds procedures return cp to start of text, cp to start of
// trailer, cp to end of trailer and
// macpara returns number of paras, para number macpara does
// not exist, -1 is fake for binsearcha, -2 is the dummy para at end

// $$ some procedures moved here from gmenu.sr

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

// Incoming Procedures

external [
	getvch
	deleteparas
	cppara
	paracp
	paraspec
	setformata
	parabounds
	stappend
	cpparabounds
	readsel
	setmessage
	invalidatedisplay
	fdeletea
	wipedoc
	getdoc
	qreadfile1
	resetmessage
	hpalloc
	selectsel
	stcopy
	stnum
	stsubstring
	finsertstring
	paranum
	stsize
	stget
	turntopage
	finserta
	invalidatedoc
	hidemark
	lastparacp
	pagecp
	makepage
	finishchanges
	establishww
	move
	qwritefile1
	stequal
	dirflip
	finsertk
	finsertparastring
	macpara
	insertparas
	specstate
	nextspecstate
	invalidateband
	movec
	hpfree
	gcspecs
// ** TESLER ADDED
	freedl
	];

// Incoming Statics

external [
	vcp
	vchremain
	rgpage
	rgcpfirst
	vwwcurrent
	ddoc
	vdlhint
	rgdirty
	vdoc
	vww
	rgsdoc
	sdoc
	rgmaccp
	rgdoc
	rgsfile
	pzone
	selection
	selaux
	sww
	vcpfinsert
	vdcborig
	macww
	rgprogram
	vlook
	vquad
	rgpctb
// ** TESLER ADDED
	rgdlfirst
	rgdllast
	vwindowstripe // %%
	];

// Outgoing Procedures

external [
	qturnto
	qparsename
	qaddpage
	qmakeversion
	qcreatedraft
	qfetch
	qfile
	qourfile
	qquit
	];

let qaddpage(char, sel) = valof
[
let snum = nil
let sbfnam = vec sbfnaml
let pnum = cppara(ddoc, char)
let cpfpara,cplpara,cptlr=nil,nil,nil
qparsename(ddoc, char, sbfnam, lv snum)
if paracp(ddoc, pnum+2)-paracp(ddoc, pnum+1) eq 2 then
	[
	setmessage(" First type label, then bug Insert")
	resultis true
	]
insertparas(ddoc, pnum+2, ddoc, macpara(ddoc)-2, macpara(ddoc)-2)
parabounds(ddoc, pnum+1, lv cpfpara, lv cplpara, lv cptlr)
invalidateband(ddoc, cpfpara, cplpara-1)
setformata(ddoc, cpfpara, cplpara-1, $b)
let tpnum = qmakesection(pnum+1, snum)
qreplacetext(pnum, "Insert a new",
				"Find the")
qmakeadd(pnum+2, snum+1)
makepage(ddoc, paracp(ddoc, tpnum+3))
rgdirty!ddoc = true
qfiledir()
resultis true
]

and qmakeversion(char, sel) = valof
[
let cptlr,cpfpara,cplpara = nil,nil,nil
let snum,vnum = nil,nil
let nxtvernam = vec sbfnaml
let draftnam = vec sbfnaml
let pnum = cppara(ddoc, char)
qparsename(ddoc, char, nxtvernam, lv snum, lv vnum)
if paracp(ddoc, pnum+2)-paracp(ddoc, pnum+1) eq 2 then
	[
	setmessage(" First type title, then bug Copy")
	resultis true
	]
insertparas(ddoc, pnum+2, ddoc, macpara(ddoc)-2, macpara(ddoc)-2)
qreplacetext(pnum,
"Copy the Working Draft to a new",
"Fetch the")
parabounds(ddoc, pnum+1, lv cpfpara, lv cplpara, lv cptlr)
invalidateband(ddoc, cpfpara, cplpara-1)
setformata(ddoc, cpfpara, cplpara-1, $b)
qmakemake(pnum+2, snum, vnum+1)
	[
	pnum = pnum-1
	parabounds(ddoc, pnum, lv cpfpara, lv cplpara, lv cptlr)
	specstate(ddoc, cpfpara, pnum)
	nextspecstate()
	if (vlook & mmenu) ne 0 then break
	] repeat
qparsename(ddoc, cpfpara, draftnam, lv snum, lv vnum)
deleteparas(ddoc, pnum, pnum+1)
qfetch1(draftnam, false)
qfile1(rgsdoc!vwwcurrent, vwwcurrent, nxtvernam)
qfiledir()
hpfree(rgsfile ! (rgsdoc ! vwwcurrent))
rgsfile ! (rgsdoc ! vwwcurrent) = 0
resultis true
]

and qcreatedraft(char, sel) = true

and qfiledir() be
[
let sbfnam = vec sbfnaml
setmessage(" Updating file cabinet...") // %%
finishchanges(ddoc)
establishww(vwwcurrent)
stcopy(sbfnam, "GYPSY.DIRECTORY")
qwritefile1(sbfnam,ddoc,0,rgmaccp!ddoc-1,false)
resetmessage()
rgdirty ! ddoc = false
]

and qfetch(char, sel) = valof
[
let sbfnam = vec sbfnaml
let snum,vnum=nil,nil
qparsename(ddoc, char, sbfnam, lv snum, lv vnum)
resultis qfetch1(sbfnam, true)
]

and qfetch1(sbfnam, turntoit) = valof
[
let tww = vww
wipedoc(rgsdoc ! tww)
if turntoit then getdoc(tww,rgsdoc!tww)
invalidatedoc(sdoc) // LT
wipedoc(sdoc); // scratch pad too **
finsertk(sdoc, 0, 0) // LT
setmessage(" Fetching document...")
let doc = turntoit? rgdoc ! tww, rgsdoc ! tww
invalidatedoc(doc)
test qreadfile1(sbfnam, doc, 0) // **
ifso	[
	test rgprogram ! doc
	ifso	[
		setmessage(" Fetched unformatted document")
		vwindowstripe = true // %%
		]
	ifnot resetmessage()
	if rgsfile!doc eq 0 then
		rgsfile!doc = hpalloc(sbfnaml,pzone)
	stcopy(rgsfile!doc,sbfnam)
	]
ifnot	[
	setmessage(" Could not fetch document")
	getdoc(tww, ddoc)
	]
rgdirty ! doc = false
vwwcurrent = tww
selectsel(selection, tww, 0)
selectsel(selaux, sww, 0)
hidemark()
resultis 1
]

and qfile(char, sel) = valof
[
let tww = vwwcurrent
let tdoc=rgdoc!tww
if tdoc eq sdoc then resultis true
let tname =vec sbfnaml
move(rgsfile!tdoc,tname,sbfnaml)
resultis qfile1(tdoc, tww, tname)
]

and qourfile(char, sel) = valof
[
let tww = vwwcurrent
let tdoc=rgsdoc!tww
if tdoc eq sdoc then resultis true
let tname =vec sbfnaml
let dummy = nil
qparsename(ddoc, char, tname, lv dummy, lv dummy)
move(tname,rgsfile!tdoc,sbfnaml)
resultis qfile1(tdoc, tww, tname)
]

and qfile1(doc, ww, tname) = valof
[
setmessage(" Filing document...") // %% before finishchanges
finishchanges(doc)
establishww(ww)
qwritefile1(tname,doc,0,rgmaccp!doc-1,false)
resetmessage()
rgdirty ! doc = false
resultis true
]

and qquit(char, sel) = valof
[
for ww = 2 to macww-2 do
	[
	if rgdoc ! ww eq sdoc % rgdoc ! ww eq ddoc then loop ;
	if rgdirty ! (rgdoc ! ww) then
		[
		setmessage(" Before quitting, File or Cancel all documents")
		resultis 1
		]
	]
// TESLER REDID THE REST OF THIS PROCEDURE FOR COUNTERJUNTA:
if rgdirty ! ddoc then qfiledir()
// can not deletea LF pieces in docsys and mdoc!
for doc = 2 to maxdoc-1 do if rgpctb ! doc ne -1 then wipedoc(doc)
gcspecs()
for ww = 2 to macww-1 do
	[
	for dl = rgdlfirst ! ww + 1 to rgdllast ! ww do freedl(dl)
	rgdllast ! ww = rgdlfirst ! ww
	]
resultis false
]

and qreplacetext(pnum, oldtext, newtext) be
[
let cptlr,cpfpara,cplpara = nil,nil,nil
let len = stsize(oldtext)
let lenn = stsize(newtext)
let ch = nil
let cpl = -1
	[
	cpl = cpl+1
	ch = stget(newtext, cpl)
	] repeatuntil ch eq chsp % cpl eq lenn
parabounds(ddoc, pnum, lv cpfpara, lv cplpara, lv cptlr)
invalidatedisplay(ddoc, cpfpara, -1)
fdeletea(ddoc, cpfpara, cpfpara+len-1)
finsertstring(ddoc, cpfpara, newtext)
setformata(ddoc, cpfpara, cpfpara+cpl-1, $m, $i)
]

and qmakesection(pnum, snum) = valof
[
let para = vec paral
let tpnum = macpara(ddoc)-2
invalidatedisplay(ddoc, paracp(ddoc, tpnum), -1)
insertparas(ddoc, tpnum, ddoc, tpnum, tpnum)
invalidatedisplay(ddoc, paracp(ddoc, macpara(ddoc)-2), -1)
insertparas(ddoc, macpara(ddoc)-2, ddoc, pnum, pnum)
let cpfpara,cplpara,cptlr=nil,nil,nil
parabounds(ddoc, macpara(ddoc)-3, lv cpfpara, lv cplpara, lv cptlr)
invalidateband(ddoc, cpfpara, cplpara-1)
setformata(ddoc, cpfpara, cplpara-1, $c, $b) 
qmakemake(macpara(ddoc)-2, snum, 1)
resultis tpnum
]

and qmakeadd(pnum, snum) be
[
let para = vec paral
let cpfm = 0
stcopy(para, "Insert a new Folder labelled... ")
let cplm = stsize("Insert")-1
let cpfv = stsize(para)
qappendstrnum(para, "*T*T{S", snum, true)
stappend(para, "}")
let cplv = stsize(para)-1
qdomake(pnum, para, cpfm, cplm, cpfv, cplv)
]

and qmakemake(pnum, snum, vnum) be
[
let para = vec paral
let sbfnam = vec sbfnaml
let cplm = nil
let cpfm = 0
stcopy(sbfnam, "")
qappendstrnum(sbfnam, "GYPSY-S", snum, true)
stappend(sbfnam, "-V0")
stappend(sbfnam, ".FILE")
if vnum eq 1 then
	[
	let tdoc = rgsdoc ! vwwcurrent
	wipedoc(tdoc)
	for i = 1 to 5 do // %% create 32 blank paragraphs
		[
		invalidatedisplay(tdoc,
			paracp(tdoc, macpara(tdoc)-2), -1)
		insertparas(tdoc, macpara(tdoc)-2, tdoc,
			0, macpara(tdoc)-2) // %% 0
		]
	if rgsfile!tdoc eq 0 then rgsfile!tdoc =
		hpalloc(sbfnaml,pzone)
	move(sbfnam, rgsfile!tdoc, sbfnaml)
	qfile1(tdoc, vwwcurrent, sbfnam)
	]
stcopy(para, "Fetch the Working Draft ")
cplm = cpfm + stsize("Fetch")-1
let cpfv = stsize(para)
stappend(para,"*T*T{")
stappend(para,sbfnam)
stappend(para,"}")
let cplv = stsize(para)-1
qdomake(pnum, para, cpfm, cplm, cpfv, cplv)
stcopy(sbfnam, "")
qappendstrnum(sbfnam, "GYPSY-S", snum, true)
qappendstrnum(sbfnam, "-V", vnum, true)
stappend(sbfnam, ".FILE")
stcopy(para, "Copy the Working Draft to a new Draft titled... ")
cplm = cpfm + stsize("Fetch")-1
let cpfv = stsize(para)
stappend(para,"*T*T{")
stappend(para,sbfnam)
stappend(para,"}")
let cplv = stsize(para)-1
qdomake(pnum+2, para, cpfm, cplm, cpfv, cplv)
]

and qdomake(pnum, para, cpfm, cplm, cpfv, cplv; numargs N) be
[
// cpfm always 0, vanish always to end of paragraph
invalidatedisplay(ddoc, paracp(ddoc, pnum), -1)
insertparas(ddoc, pnum, ddoc, macpara(ddoc)-2, macpara(ddoc)-2)
let tlr = vec 10
stcopy(tlr, "")
if N ge 6 then
	[
	qappendstrnum(tlr, "i", 2, false) // 2 is number changes
	stappend(tlr, "m")
	qappendstrnum(tlr, "I", cplm-cpfm+1, false)
	stappend(tlr, "M")
	qappendstrnum(tlr, "v", cpfv-cplm-1, false)
	]
invalidatedisplay(ddoc, paracp(ddoc, pnum+1), -1)
finsertparastring(ddoc, pnum+1, tlr, para)
invalidatedisplay(ddoc, paracp(ddoc, pnum+2), -1)
insertparas(ddoc, pnum+2, ddoc, macpara(ddoc)-2, macpara(ddoc)-2)
]

and qappendstrnum(para, str, num, order) be
[
let stn = vec 2
stnum(stn, num)
stappend(para, order? str,stn)
stappend(para, order? stn,str)
]

and qparsename(doc, cp, sbfnam, snum, vnum; numargs N) =valof
[
let cpf,cpl=nil,nil
qgetstring(doc,cp,leftdelim,rightdelim,lv cpf,lv cpl)
readsel(sbfnam,vdoc,cpf,cpl,(sbfnaml lshift 1)-1)
let cps = 0
@snum = qfindint(sbfnam, lv cps, cpl-cpf)
if N ge 5 then @vnum = qfindint(sbfnam, lv cps, cpl-cpf)
resultis cpl+2
]

and qturnto(char, sel) = valof
[
let sbfnam = vec sbfnaml
let snum,vnum = nil,nil
let cpfpara,cplpara,cptrlr = nil,nil,nil
cpparabounds(vdoc, char, lv cpfpara, lv cplpara, lv cptrlr)
qparsename(vdoc, cpfpara, sbfnam, lv snum)
turntopage(vdoc, snum)
resultis true
]

and qfindint(string, cpf, cpl) = valof
[
// returns value of first +ve integer in string starting from cp
// or -1 if none
// also resets cp to first char after number
let digit = nil
let int = 0
let i = @cpf
digit = stget(string, i)
while $0 gr digit % digit gr $9 do
	[
	if i eq cpl then resultis -1
	i = i+1
	digit = stget(string, i)
	]
while $0 le digit & digit le $9 do
	[
	int = (int*10) + digit-$0
	if i eq cpl then break
	i = i+1
	digit = stget(string, i)
	]
@cpf = i
resultis int
]

and qgetstring(doc,cp,left,right,cpfirst,cplast) be
[
vdoc=doc
vcp=cp
vchremain=0
until getvch() eq left do loop
rv cpfirst=vcp
until getvch() eq right do loop
rv cplast=vcp-2
]