// 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