// GPARSE.SR Paragraph parsing and unparsing
get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF"
get "DISPLAY.DF"
get "HEAP.DF"
// Incoming procedures
external
[
bsearch
getint
binsearcha
getvch
putvch
mapscrcp
errhlt
stcopy
stnum
stappend
stsize
insertstring
deletea
hpalloca
hpalloc
move
movec
enww
ugt
ult
readsel
stequal
cpadjust2
invalidatedisplay
receivechange
backscan
specstate
nextspecstate
gcspecs
freespec
ckspecs
cpadjustlist
wipedoc
makepara
deletepara
createdocp
bubblesegs
growlist
discardspecs
acquirespecs
replacespec
forgetspec
nulltrailer
uadjust
specdetails
setpagecp
pagecp
cppage
macpage
makepage
makespec
cpc
]
// Incoming statics
external
[
xleftmargstd
xrightmargstd
rgpara
rgspec
rgdlfirst
rgdllast
rgmaxdl
macww
rgdoc
vdoc
vcp
vchremain
rgmaccp
rgcpfdispl
rgcplast
vxleftmarg
vxrightmarg
cpscrt
vdlhint
vinsertk
mdoc
mphd
rgfcode
rgview
rgprogram
vmakelock
vpzone
]
// Outgoing procedures
external
[
parsespec
unparsespec
cppara
cpparabounds
parabounds
paradetails
setparacp
paracp
setparaspec
gotparaspec
paraspec
macpara
lastparacp
wholeparas
]
// Outgoing statics
// Local statics
// Paragraph format is <body><trailer> where <body> has no CRs
// and trailer format is ctrlZ then "jn7b12B14u7bU" then CR
// means 5 changes starting with Justified text,
// 7 chars later turn on Bold
// 12 chars later turn off bold
// 14 chars later turn on Ul
// 7 chars later turn on Bold and turn off ul
// n means no change since last version; N means has changed
// there is an optional change count in front of the trailer;
// if not present it is estimated
let parsespec(doc, para, mail, okrobdisplay; numargs N) = valof
[
let num = nil
let tex, b, e = nil, nil, nil
tex = paracp(doc, para)
e = paracp(doc, para+1) - 1
unless backscan(doc, e, true, chtrailer) do errhlt("MTR")
b = vcp
if ult(b, tex) then errhlt("MTX")
vcp = b + 1
vchremain = 0 ;
vdoc = doc ;
let char = getvch() ;
let siz = $0 le char & char le $9? 3 + getint(doc, 10, char, lv char), (e-b+1) rshift 1
let lim = siz + 2
if vmakelock then
if ugt((2*lim+specbase)*(mail? 3,2)+displaybuf,
vpzone >> ZONE.cfree) then
resultis -1
let spec = makespec(lim, N eq 4 & okrobdisplay)
spec >> SPEC.trailerlength = e + 1 - b
setparaspec(doc, para, spec)
spec >> SPEC.dent = 0
spec >> SPEC.lmarg = 0
spec >> SPEC.rmarg = 0
let info = spec + firstformat
let looks = spec + specbase
let changes = looks + lim
let tfs = 0
let tlook = 0
[
let fcode = 0 le char & char le 127? rgfcode ! char, -1
let w = fcode << FCODE.wordn
let bn = fcode << FCODE.bitn
let m = #100000 rshift bn
let un = fcode << FCODE.un
switchon fcode << FCODE.kind into
[
case knormal:
spec >> SPEC.marker = un ;
char = getvch() ; loop
case kdigit:
num = getint(doc, 10, char, lv char) ;
looks ! tfs = tlook
tfs = tfs + 1
if tfs ge siz then errhlt("TMS")
looks ! tfs = tlook
changes ! tfs = num + changes ! (tfs-1)
loop
case kcr: break
case klook: tlook = un? tlook & not m, tlook % m
endcase
case kquad: info ! w = bn ; endcase
case kmeasure:
num = getint(doc,10,$0,lv char)
info ! w = num
loop // $$ bug fix
default: errhlt("UFC")
]
char = getvch() ;
] repeat
looks ! tfs = tlook
siz = tex eq b? 2, tfs+3
if siz gr lim then errhlt("TmS") ;
spec >> LIST.siz = siz
changes ! (siz-2) = b-tex
changes ! (siz-1) = e+1-tex
if mail then receivechange(mail, doc, para)
resultis gotparaspec(doc, para)
]
and unparsespec(doc, para, spec) = valof
[
if vinsertk % not spec >> SPEC.dirty % rgprogram ! doc then
resultis spec
spec >> SPEC.dirty = 0
let str = vec (maxtrailerl+1)/2 ;
let stn = vec (maxtrailerl+1)/2 +4 ;
stcopy(str, "") ;
let siz, looks, changes = nil, nil, nil
specdetails(spec, lv siz)
let rcpold = 0 ;
let tfold = 0 ;
let tfnew, tfdif, rcpnew = nil,nil,nil
unparsespec2(spec >> SPEC.dent, "d", str, stn)
unparsespec2(spec >> SPEC.lmarg, "l", str, stn)
unparsespec2(spec >> SPEC.rmarg, "r", str, stn)
unparsespec3(spec >> SPEC.quad, 0, table[ 0; $j; $c ] , str)
stappend(str, "N");
let last = siz - 3;
for tfs = 0 to last do
[
rcpnew = changes ! tfs ;
tfnew = looks ! tfs ;
tfdif = tfnew xor tfold ;
if tfdif then
[
if tfs then
[
stnum(stn, rcpnew - rcpold)
stappend(str, stn) ;
]
for char = $A to $z do
if (rgfcode ! char) << FCODE.kind eq klook then
[
let fcode = rgfcode ! char
let m = #100000 rshift (fcode << FCODE.bitn)
let un = fcode << FCODE.un? 0, m
if (tfdif & m) ne 0 & (tfnew & m) eq un then
[
let onecharstring = #400 + char
stappend(str, lv onecharstring)
]
]
tfold = tfnew
rcpold = rcpnew ;
]
]
let tex, b, e = nil, nil, nil
parabounds(doc, para, lv tex, lv b, lv e)
let hstart = b+1
let hfinish = e-1
let newhlen = stsize(str) + 2
if newhlen eq spec >> SPEC.trailerlength then
[
if newhlen eq 2 then resultis spec
readsel(stn, doc, hstart, hfinish, maxtrailerl)
if stequal(str, stn) then resultis spec
]
if ((rgview ! doc) & looktrailermask) ne 0 then
invalidatedisplay(doc, b, vdlhint)
if cpc(hstart, hfinish) le 0 then deletea(doc, hstart, hfinish)
insertstring(doc, hstart, str)
spec = gotparaspec(doc, para)
spec >> SPEC.trailerlength = newhlen
specdetails(spec, lv siz)
changes ! (siz-1) = newhlen + b-tex
resultis spec
]
and unparsespec2(relativevalue, char, str, stn) be
[
if relativevalue eq 0 then return
stappend(str, char)
stnum(stn, relativevalue)
stappend(str, stn)
]
and unparsespec3(itsfmt, stdfmt, chartable, str) be
[
if itsfmt eq stdfmt then return
let x = "X"
x >> rh = chartable!itsfmt
stappend(str, x)
]
and cppara(doc, cp) = bsearch(rgpara ! doc, cp)
and cpparabounds(doc, cp, ptextstart, ptrailerstart, ptrailerend) =
parabounds(doc, cppara(doc, cp),
ptextstart, ptrailerstart, ptrailerend)
and parabounds(doc, para, ptextstart, ptrailerstart, ptrailerend) = valof
[
let spec = paraspec(doc, para)
@ptextstart = paracp(doc, para)
@ptrailerend = paracp(doc, para+1) - 1
@ptrailerstart = @ptrailerend - spec >> SPEC.trailerlength + 1
resultis para
]
and paradetails(doc, para, vector, cp1, cp2, cp3, cp4;numargs N) be
[
// To use:
// let spec,siz,looks,changes[,rcp1,r1[,rcp2,r2[,...]]] = nil,nil,...,nil
// paradetails(doc,para,lv spec[,cp1[,cp2[,...]]])
// r ge siz-2 means rcp is in the trailer
let tex = paracp(doc, para)
let spec = paraspec(doc, para)
vector ! 0 = spec
let siz = specdetails(spec, vector+1)
let j = 4
for i = 0 to N-3 do
[
let rcp = ((lv cp1)!i) - tex
vector ! j = rcp
vector ! (j+1) = rcp ls 0? 0, binsearcha(vector!3, siz-1, rcp)
j = j + 2
]
]
and setparacp(doc, para, cp) be
(rgpara ! doc) ! (para + listbase) = cp
and paracp(doc, para) = valof
[
// Inverse of cppara
// Given a para, find the cp of the start of its text
resultis (rgpara ! doc) ! (para + listbase)
]
and setparaspec(doc, para, spec) be
[
if spec & not spec << odd then
[
spec >> SPEC.doc = doc
spec >> SPEC.para = para
]
(rgspec ! doc) ! (para + listbase) = spec
]
and gotparaspec(doc, para) = (rgspec ! doc) ! (para + listbase)
and paraspec(doc, para) = valof
[
// Given a paragraph number within a document, find its spec --
// if none exists, invoke a parse to create one.
let w = (rgspec!doc)!(para+listbase) ;
if w & not w << odd then resultis w ;
resultis parsespec(doc, para, w)
]
and macpara(doc) = (rgpara ! doc) >> LIST.siz
and lastparacp(doc) = paracp(doc, macpara(doc)-2)
and wholeparas(doc, cp1, cp2) =
cp1 eq paracp(doc, cppara(doc, cp1)) &
cp2+1 eq paracp(doc, cppara(doc, cp2+1))? -1, 0