//  look2.sr
// last modified September 21, 1977  4:41 PM  -- RML

get "BRAVO1.DF";
get "CHAR.DF";
get "ST.DF";
get "NEWMSG.DF";
get "SELECT.DF";
get "DOC.DF";
get "RN1.DF";
get "COM.DF";
get "LOOK.DF";


// Incoming procedures

external	[
	FAdjustSelEod
	FChInSb
	uc
	stput
	SetRegionW
	SetRegionSys
	replacea
	InsertBuf
	invalidateband
	bravochar
	augmentomseq
	FopLookAux
	deactivateomseq
	AbGetArg
	Query
	FMagnifyWw
	cpparabounds
	ult
	invalidatesel
	invalidateipar
	MakeCurrentBuf
	array
	MufopFromFop
	MufopConcat
	FopFromMufop
	]

// Incoming statics

external	[
	vundocom
	vrlwsys
	rgmaccp
	mpfunfd
	vxrightmargstd
	vxleftmargstd
	vxleftmargfstd
	vfDiablomode
	mpIffFfp
	dcpendofdoc
	vcuripar
	rgpctb
	]

// Outgoing procedures

external	[
	olcompcs;
	]

// Outgoing statics

external	[
	vfwheel;
	vofsetstd
	vldlnstd
	vldhdrstd
	]

// Local statics

static	[
	vfwheel
	vofsetstd
	vldlnstd
	vldhdrstd
	]


// Local manifests

manifest	[
//	pidPfop = 1
//	pidFUndo = 2
//	pidFParop = 3
//	pidCwMax = 4
//	pidMufop = 5

	pidPfop = 3
	pidFUndo = 4
	pidFParop = 6
	pidCwMax = 7
	pidMufop = 8
	]


// O L C O M P C S
// cf>>CF.w0 = ch of Look subcommand
// cf>>CF.w1 etc = the fop

let olcompcs(cf) = valof
[
let pfop = lv cf>>CF.w1
let fUndo = false
let fParop = nil
// let cwMax = 150
// let mufop = nil

// pid manifests for above guys !!

let sel = cf>>CF.sel
let doc = sel>>SEL.doc;
let ww = sel>>SEL.ww

if sel>>SEL.type eq snone then
	resultis abSelEmp
unless FAdjustSelEod(sel, $r) do
	[
	sel>>SEL.cplast = sel>>SEL.cplast + 1
	resultis abSelEmp
	]

if vundocom then
	[
	if FChInSb(uc(cf>>CF.w0), "?HM") then
		[
		let tsb = vec 2
		stput(tsb, 0, chsp)
		stput(tsb, 1, cf>>CF.w0)
		tsb>>SB.cch = 2
		SetRegionW(vrlwsys, 0, tsb)
		let ridCh = nil
		ridCh<<RID.nrl = 1
		ridCh<<RID.ri = 0
//	"Can't undo Look <ch>"
		SetRegionSys(risyspast, 42, 20, ridCh)
		resultis abmsg
		]

	let cpfirst = sel>>SEL.cpfirst
	let dcp = (sel>>SEL.cplast + 1) - cpfirst

	replacea(doctx5, 0, rgmaccp ! doctx5, doctx1, 0, rgmaccp ! doctx1)
	replacea(doctx1, 0, rgmaccp ! doctx1, doc, cpfirst, dcp)
	InsertBuf(1, doc, cpfirst, dcp)
	replacea(doc, cpfirst, dcp, doctx5, 0, rgmaccp ! doctx5)
	invalidateband(doc, cpfirst, cpfirst + dcp - 1);
	replacea(doctx5, 0, rgmaccp ! doctx5, 0, 0, 0)
	resultis abnil
	]

let ab = abIllLook;
let ard = ardNil;
let fSwappedIn = false;
let ch = nil;

if cf>>CF.frepeat then
	[
	if rv pfop eq fopNil then
		resultis abIllLook;
	goto sendmsg;
	]


ch = bravochar();
cf>>CF.w0 = ch;

	[
	rv pfop = selecton ch into
		[
case chdel:
		valof	[
			ab = abComTerm;
			resultis fopNil;
			]

// case $>:	iffCase lshift 8 + 2
// case $<:	iffCase lshift 8 + 1

// case bs:	iffOvstrike lshift 8 + 1
// case shbs:	iffOvstrike lshift 8 + 0

case $-:		iffUl lshift 8 + 1
case #140:	iffUl lshift 8 + 0

case $w:	vfwheel ? iffVanish lshift 8 + 1, fopNil
case $W:	vfwheel ? iffVanish lshift 8 + 0, fopNil

case $b:	iffBold lshift 8 + 1
case $B:	iffBold lshift 8 + 0

case $i:		iffItalic lshift 8 + 1
case $I:		iffItalic lshift 8 + 0

case $g:		iffExt lshift 8 + 1
case $G:	iffExt lshift 8 + 0

case $v:		iffVisible lshift 8 + 1
case $V:	iffVisible lshift 8 + 0

case $0:
case $1:
case $2:
case $3:
case $4:
case $5:
case $6:
case $7:
case $8:
case $9:		valof	[
			let ffv = ch - $0
			if (mpfunfd ! ffv eq 0) then
				[
				ab = abIllParam
				resultis fopNil
				]
//			setmag(sel>>SEL.ww)
// 			getfontc(ffv)
			resultis iffFun lshift 8 + ffv
			]

case chtopblk:	iffProcClr lshift 8 + 0

case $n:	iffProcUp lshift 8 + ufopFIncrement + 0
case $N:	iffProcDown lshift 8 + ufopFIncrement + 0

case $;:		iffControl lshift 8 + 1
case $::		iffControl lshift 8 + 0

case $j:		iffRjCenter lshift 8 + 2
case $J:		iffRj lshift 8 + 0

case $c:		iffRjCenter lshift 8 + 1
case $C:	iffCenter lshift 8 + 0

case $^:	valof	[
			pfop ! 1 = vofsetstd
 			resultis iffSuper lshift 8
			]

case $_:	valof	[
			pfop ! 1 = vofsetstd
			resultis iffProcSub lshift 8
			]

case $R:	valof	[
			pfop ! 1 = vxrightmargstd
			ard = table
				[ 136 lshift 8 + 1 lshift 4 + 1;
				ardStdX;
				]
			resultis iffXrightmarg lshift 8
			]
case $P:	valof	[
			pfop ! 1 = vxleftmargstd
			ard = table
				[ 137 lshift 8 + 1 lshift 4 + 1;
				ardStdX;
				]
			resultis iffXleftmarg lshift 8
			]
case $F:	valof	[
			pfop ! 1 = vxleftmargfstd
			ard = table
				[ 138 lshift 8 + 1 lshift 4 + 1;
				ardStdX;
				]
			resultis iffXleftmargf lshift 8
			]
case $L:	valof	[
			pfop ! 1 = vxleftmargstd
			pfop ! 2 = vxleftmargfstd
			ard = table
				[ 137 lshift 8 + 1 lshift 4 + 2;
				ardStdX;
				]
			resultis iffProcLeftmarg lshift 8
			]

case $o:
case $O:	valof	[
			pfop ! 1 = (ch eq $o ? vldhdrstd, -vldhdrstd)
			resultis iffLdhdr lshift 8 + ufopFIncrement
			]
case $q:
case $Q:	valof	[
			pfop ! 1 = (ch eq $q ? vldhdrstd, -vldhdrstd)/2
			resultis iffLdhdr lshift 8 + ufopFIncrement
			]

default:		valof	[
			let tch = uc(ch);
//						"...\|T"
			if FChInSb(tch, ".,AS?HMUDZKXY*t") then
				[
				augmentomseq("]");
				fSwappedIn = true;
				resultis FopLookAux(lv ab, pfop, lv ard, ch);
				];
			if tch ne ch then
				[
				ch = tch;
				loop;
				];
			resultis fopNil;
			]
		];
	break;
	] repeat;

invalidatesel(sel);
if rv pfop eq fopNil then
	[
	if fSwappedIn then
		deactivateomseq("]", "]");
	resultis ab;
	];

if ard ne ardNil then
	[
	unless fSwappedIn do
		[
		augmentomseq("]");
		fSwappedIn = true;
		];
	let tab = AbGetArg(pfop, ard);
	if tab gr 0 then
		[
		cf>>CF.w1 = fopNil;
		deactivateomseq("]", "]");
		resultis tab;
		]
	]

if fSwappedIn then
	deactivateomseq("]", "]");


sendmsg:

let cpfirst = sel>>SEL.cpfirst;
let iff = pfop>>UFOP.iff
if iff eq iffQuery then
	[
	augmentomseq("\")
	Query(doc, cpfirst, sel>>SEL.type eq sph)
	cf>>CF.fRestoreSysWw = true;
	deactivateomseq("\", "\")
	resultis abnil
	]
if iff eq iffMagnify then
	[
	ab = abnil
	augmentomseq("\")
	unless FMagnifyWw(ww, pfop ! 1, vxleftmargstd) do
		[
		vfDiablomode = false
		ab = abDiabloFont
		]
	deactivateomseq("\", "\")
	resultis ab
	]

fParop = (mpIffFfp ! iff)<<FFP.fParop;

let cplast = sel>>SEL.cplast;
if fParop then
	[
	cpparabounds(doc, cpfirst, lv cpfirst, 0, 0);
	cpparabounds(doc, cplast, 0, 0, lv cplast);
	];

unless ult(cplast, rgmaccp ! doc - dcpendofdoc) do
	resultis abNoEdit

sel>>SEL.cpfirst = cpfirst;
sel>>SEL.cplast = cplast;
invalidatesel(sel);
if fParop then
	[
	invalidateipar(vcuripar, doc, cpfirst, cplast);
	sel>>SEL.type = sph
	];

let dcp = (cplast + 1) - cpfirst
replacea(doctx1, 0, rgmaccp ! doctx1, doc, cpfirst, dcp)
InsertBuf(1, doc, cpfirst, dcp)
MakeCurrentBuf(1);

// mufop = array(cwMax)
// replacea(doc, cpfirst, dcp, doctx1, 0, dcp, AppendUfop)
// invalidateband(doc, cpfirst, cplast);

SendFop(doc, cpfirst, dcp, pfop, fUndo);
resultis abnil
]


// S E N D   F O P

and SendFop(doc, cpFirst, dcp, pfop, fUndo; numargs carg) be
[
if carg ls 5 then fUndo = false;
let fParop = (mpIffFfp ! (pfop>>UFOP.iff))<<FFP.fParop;
let cwMax = 150;
let mufop = array(cwMax);

// pid manifests for above parameters !!

replacea(doctx5, 0, rgmaccp ! doctx5, doc, cpFirst, dcp)
replacea(doc, cpFirst, dcp, doctx5, 0, dcp, AppendUfop)
invalidateband(doc, cpFirst, cpFirst + dcp - 1);
replacea(doctx5, 0, dcp, 0, 0, 0)
]


// A P P E N D   U F O P

and AppendUfop(doc, pc, bpcd, fm) be
[
let pcd = rgpctb ! doc + bpcd
if fm ! pidFParop & not pcd>>PCD.paraend then return
let mufop = fm ! pidMufop
let cwMax = fm ! pidCwMax
MufopFromFop(pcd>>PCD.fop, mufop, cwMax)
MufopConcat(mufop, fm ! pidPfop, cwMax, fm ! pidFUndo)
(rgpctb ! doc + bpcd)>>PCD.fop = FopFromMufop(mufop)
] // end AppendUfop