// write.sr

// Last modified October 25, 1979  6:54 PM by Taft

get "BRAVO1.DF";
get "MSG.DF";
get "DISPLAY.DF";
get "ALTOFILESYS.D";
get "SELECT.DF";
get "FORMAT.DF";
get "VM.DF";
get "ST.DF";
get "DIR.DF";
get "COM.DF"
get "MEASURE.DF"

// Incoming procedures

external
	[
	array
	readsel
	ofnamfilter
	ClearBuf
	deleted
	stsize
	invalidatewindow
// 	TryOpenLog
	processtsesc
	FtyOpen
	ugt
	unparse
	setsel
	mapcp
	diskwritegroup
	errhlta
	puts
	trims
	ofilemessage
	deallocfn
	enww
	unsetdirty
	ReadDiskKd;
	WriteDiskKd;
	measurep;
	]


// Incoming statics

external
	[
	vfOldtabPrev
	vdxtbPrev
	ttblPrev
	vlook1old
	vlook2old
	mpWwWwd
	vdcb
	vdcblink
	tsread
	macbp
	sltrailer
	cchNilTrailer
	vextendof
	mpfnsb
	vcp
	vchremain
	vchremainput
	vcpput
	vmapstatus
	vnewpar
	vpw
	vlb
	vcuripar
	selmain
	rglastused
	lrutime
	vbp
	vlook1
	vchfrremain
	deltacp
	char
	mpfnof
	vlbput
	vpwput
	vestRun
	vmeasurestatus
	look1std
	look2std
	]


// Outgoing procedures

external
	[
	owritefile;
	owritefile1;
	]

// Outgoing statics

external
	[
	vFilePtr;
	]

// Outgoing statics

static
	[
	vFilePtr;
	]

manifest
	[ lFID = 3;
	maxch = 1001;		//also defined in UNPARSE.SR
	doctx3 = 3
	] 

//structure for region identifier
structure RID:
	[
	nrl	bit 5
	ri	bit 11
	]


// O W R I T E F I L E
// 
let owritefile(cf) = valof
[ 
vfOldtabPrev = true
vdxtbPrev = -1
ttblPrev = array(lnttblMax)
ttblPrev>>TTBL.cw = 1
let tmpitbxtb = lv ttblPrev>>TTBL.ampitbxtb
for titb = 0 to itbMax do
	tmpitbxtb ! titb = xtbNil
vlook1old = look1std
vlook2old = look2std

// old params: selfnam,docfnam,cpfirst,cplast
let selfnam = cf>>CF.selarg
let sel = cf>>CF.sel
let docfnam = sel>>SEL.doc
let cpfirst = sel>>SEL.cpfirst
let cplast = sel>>SEL.cplast
let ab = nil
let pdcb = (mpWwWwd ! (wwsys+1))>>WWD.dcbFirst;
let pdcblink = pdcb >> DCB.next;
vdcb= pdcb
vdcblink= pdcblink
pdcb >> DCB.next = 0;
let sbfnam = vec (sbfnaml+1);
readsel(sbfnam,selfnam >> SEL.doc,selfnam >> SEL.cpfirst,selfnam >> SEL.cplast,(sbfnaml lshift 1)-1);
let legalsiz = ofnamfilter(sbfnam);
if legalsiz eq mastx-3 then
	[
	ab<<AB.crid = 2		//Filename too long -
	ab<<AB.nrid = 0
	ClearBuf(3);
	deleted(doctx3);
	pdcb >> DCB.next = pdcblink;
	resultis ab
	]
if legalsiz ne stsize(sbfnam) then
	[
	ab<<AB.crid = 2		//Illegal character in filename -
	ab<<AB.nrid = 2
	ClearBuf(3);
	deleted(doctx3);
	pdcb >> DCB.next = pdcblink;
	resultis ab
	] 
ab = owritefile1(sbfnam,docfnam,cpfirst,cplast)
if ab ne abnil then cf>>CF.fRestoreSysWw = true;
pdcb >> DCB.next = pdcblink;
vdcb= vdcbnil
invalidatewindow(wwsys+1)
resultis ab eq abnil ? abmsg, ab
] 


// O W R I T E F I L E 1
//
and owritefile1(sbFile,docfnam,cpfirst,cplast) = valof
[ 
// TryOpenLog()
if tsread then processtsesc($P,sbFile);
let cpfirstcur,cplastcur = nil,nil
let ab,trid = nil,nil
let tcp = nil;
let tchremain = 0;
let vpa,fnget,bplock,cpage,macbpput = nil,nil,0,0,macbp-7;
sltrailer = array(maxch/2+2);
vextendof = false;
// let wf = true;
// test (vmeasurestatus << MEASURESTATUS.p eq true) & (overwrite eq false) ifso
// 	wf = false
// ifnot	wf = true
let nmd = vec lnmdMax; let nmdDollar = vec lnmdMax; 
ReadDiskKd();
let fty = FtyOpen(fnput,sbFile,true,false,vcNew);
if fty eq ftyNil then
	[
// Could not open filename - Command terminated
//	SetRegionW(vrlwsys,0,sbFile)
//	trid<<RID.nrl = 1;	trid<<RID.ri = 0
//	SetRegionSys(risyspast,98,trid,50)
	unless tsread then processtsesc($P,sbFile);
	resultis AbReturnWrite(abmsg)
	] 
unless tsread then processtsesc($P,mpfnsb ! fnput);
vcp = cpfirst;
vchremain = 0;
vchremainput = 0;
let fpfirst = 0;
vcpput = 0;
let status = nil;
vmapstatus = statusblind;
vnewpar = true;
let puttingtrailer = false;
let ftrailerlastneeded = false;
let fcase = false
let fupper = nil
	[ if vchremain eq 0 then
		[ if puttingtrailer then
			[ vcp = tcp;
			vmapstatus = statusblind;
			vnewpar = true;
// moved for end case	puttingtrailer = false;
			] 
		test ugt(vcp,cplast) ifso
			test (ftrailerlastneeded & not puttingtrailer)
			    % (sltrailer>>SL.cch gr cchNilTrailer) ifso
				[
				unparse(true);
				vchremain = sltrailer >> SL.cch;
				vcp = vcp-vchremain;
				vpw = sltrailer+1;
				vlb = true;
				if sltrailer >> SL.cch ge maxch then
					[
					cpfirstcur = vcuripar>>IPAR.cpfirst
					cplastcur = vcuripar>>IPAR.cplast
					setsel(selmain,cpfirstcur,cplastcur)
					ab<<AB.crid = 1
					ab<<AB.nrid = 4
//Trailer too long - Please split your longest paragraph and try again
					resultis AbReturnWrite(ab)
					] 
				sltrailer >> SL.cch = 0
				ftrailerlastneeded = false;
			 	] 
			ifnot	break;
		ifnot	[ puttingtrailer = false;
			rglastused ! bplock = lrutime;
			status = vmapstatus;
			mapcp(docfnam,vcp,vnewpar);
			bplock = vbp;
			rglastused ! bplock = -1;
			fcase = vlook1<<LOOK1.cases
			fupper = vlook1<<LOOK1.uppercase
			if ugt(vcp+vchremain-1,cplast) then
				vchremain = cplast+1-vcp;
			test vestRun ifso
				[ if unparse(vlook1 << LOOK1.trailer) then
					[ ftrailerlastneeded = true;
					while ugt(vchfrremain,vchremain) do
						[ vcp = vcp+vchremain;
						mapcp(docfnam,vcp);
						] 
					if sltrailer >> SL.cch ge maxch then
						[
						cpfirstcur = vcuripar>>IPAR.cpfirst
						cplastcur = vcuripar>>IPAR.cplast
						setsel(selmain, cpfirstcur, cplastcur)
						ab<<AB.crid = 1
						ab<<AB.nrid = 4
//Trailer too long - Please split your longest paragraph and try again
						resultis AbReturnWrite(ab)
						] 
					tcp = vcp+vchremain;
					vpw = sltrailer+1;
					vlb = true;
					vchremain = sltrailer >> SL.cch;
					puttingtrailer = true;
					sltrailer >> SL.cch = 0
					] 
				] 
			ifnot	deltacp = deltacp+vchremain;
			] 
		] 
	test vlb ifso
		[ char = vpw >> lh;
		vlb = false;
		] 
	ifnot	[ char = vpw >> rh;
		vlb = true;
		vpw = vpw+1;
		] 
	if fcase & not puttingtrailer then
		test fupper ifso
			if char ge $a & char le $z then 
				char = char - #40
		ifnot
			if char ge $A & char le $Z then 
				char = char + #40
	if vchremainput eq 0 then
		[ test cpage eq macbpput ifso
			[ diskwritegroup(fnput,fpfirst,fpfirst+cpage-1,#1000);
			cpage = 1;
			fpfirst = vcpput << PCD.p;
			] 
		ifnot	cpage = cpage+1;
		if vcpput << PCD.rc then errhlta(80);
		(mpfnof ! fnput) >> OF.pos = vcpput;
		(mpfnof ! fnput) >> OF.macpos = vcpput;
		puts(fnput,char);
		rglastused ! vbp = -1;
		] 
	test vlbput ifso
		[ vpwput >> lh = char;
		vlbput = false;
		] 
	ifnot	[ vpwput >> rh = char;
		vlbput = true;
		vpwput = vpwput+1;
		] 
	vchremainput = vchremainput-1;
	vcpput = vcpput+1;
	vcp = vcp+1;
	vchremain = vchremain-1;
	] repeat
writedone:
rglastused ! bplock = 0;
(mpfnof ! fnput) >> OF.macpos = vcpput;
diskwritegroup(fnput,fpfirst,vcpput << PCD.p,vcpput << PCD.rc)
trims(fnput);
if vmeasurestatus << MEASURESTATUS.p then
	measurep(docfnam,fnput,sbFile);
ofilemessage(mpfnsb ! fnput,(mpfnof ! fnput) >> OF.macpos,true,fty);
// A
deallocfn(fnput);
deallocfn(fndir);
enww(unsetdirty,docfnam);
resultis AbReturnWrite(abnil)
] 

and AbReturnWrite(ab) = valof
[ WriteDiskKd();
resultis ab
];
// A
// if overwrite then
// 	[ leaderpage(tfn, sbfnamnorm) // **
// 	leaderpage(fnput, mpfnsb ! tfn) // **
// 	bMakeLogEntry(typLogRenameFile, tfn)
// 	bMakeLogEntry(typLogRenameFile, fnput)
// 	updateFilePtr(tfn,fnput)
// 	dirlkup(mpfnsb ! tfn);
// 	(mpfnof ! fndir) >> OF.pos = vpos+2;
// 	(mpfnof ! fndir) >> OF.wf = true;
// 	puts(fndir,tsn1);
// 	puts(fndir,tsn2);
// 	puts(fndir,tversion);
// 	puts(fndir,0);
// 	puts(fndir,VirtualDA(tda));
// 	(mpfnof ! fndir) >> OF.pos = tpos+2;
// 	puts(fndir,vsn1);
// 	puts(fndir,vsn2);
// 	puts(fndir,vversion);
// 	puts(fndir,0);
// 	puts(fndir,VirtualDA(vda));
// 	flushfn(fndir);
// 	(mpfnof ! fndir) >> OF.wf = false;
// 	stcopy(mpfnsb ! tfn,sbfnamnorm);
// 	]