//
// File searching program
// last edited October 29, 1980 6:21 PM
//
// Copyright Xerox Corporation 1979, 1980
get "findpkgdefs.d"
get "streams.d"
get "altofilesys.d"
get "bcplfiles.d"
external
[ // GP
SetupReadParam
ReadParam
// MDI
LookupEntries
// findsub
Usc2
occlim
linedelim
paradelim
breakdelim
nonbravo
copyseg
splitstream
boldstream
readstring
ReadChar
// FindCompile
FindCompile
// FindNext
FindInitScan
FindNext
// Template
PutTemplate
// O.S.
Closes; CreateDiskStream; CreateDisplayStream
DoubleAdd; dsp
Endofs
FilePos; FinishScanStream; fpComCm; fpSysDir; Free
GetLinePos; Gets
keys
MoveBlock
OpenFile
Puts
Resets
SetBlock; SetFilePos; ShowDisplayStream; sysZone
Timer
Usc
Ws; Wss
Zero
]
manifest
[ bufsize = 77000b // buffer space
mbufsize = 800 // buffer for one-line message
displines = 45
savematches = 50 // remember position of this many matches
maxll = 100 // max line length
maxnl = 20 // max paragraph length
lvCodeTop = #335
lvDisplayHead = #420
dsoptions = DSstopbottom+DSstopright
mdsoptions = 0
]
structure BS:
[ length byte
char↑1,255 byte
]
structure MP: // match position
[ fid word // file number
fa word lFA = @FA
ppos word // position within pattern
]
manifest lMP = size MP/16
structure FF: // Find flags
[ itemproc word // item delimitation procedure
waf word // if true, write all matches to file (allf % writef)
allf word // All flag
casef word // Case flag
lstf word // List flag
multif word // Multiple flag
octalf word // Octal flag
spacef word // Space flag
verbatimf word // Verbatim flag
writef word // Write flag
]
manifest lFF = size FF/16
static
[ charExit = 177b
charWildCard = 1
flags // global flags, needed by ccproc
]
//
// Main program
//
let find(blv) be
[ let ff = vec lFF
SetBlock(ff, false, lFF)
let cpat = vec 30
ff>>FF.itemproc = linedelim
let com = OpenFile("Com.Cm", ksTypeReadOnly, charItem, 0, fpComCm)
let nv, swv = vec 128, vec 128
SetupReadParam(nv, swv, com, swv)
for j = 1 to swv!0 do
[ let ch = swv!j&137b
let off = getflag(ch)
test off ge 0
ifso ff!off = true
ifnot switchon ch into
[ case $B: ff>>FF.itemproc = breakdelim; endcase
case $L: ff>>FF.lstf = true; endcase
case $M: ff>>FF.multif = true; endcase
case $P: ff>>FF.itemproc = paradelim; endcase
]
]
if ff>>FF.writef then ff>>FF.waf = true
let buf = vec bufsize
let A = blv>>BLV.overlayAddress↑0
let B = blv>>BLV.overlayAddress↑1
let flist = A
addname("Find.Lst", lv flist)
addname("Find.Matches", lv flist)
[ if ReadParam($P, -1, nv, swv) eq -1 break
addname(nv, lv flist)
] repeatwhile ff>>FF.multif
let fnames = flist
let cfn = A
while cfn ne fnames do
[ @flist = cfn
flist = flist+1
cfn = cfn + cfn>>BS.length/2+1
]
let fdvs = flist
let nfiles = fdvs-fnames-2
flist = fdvs+(nfiles+2)*lDV
@lvCodeTop = flist
let dir = CreateDiskStream(fpSysDir, ksTypeReadOnly, wordItem)
if dir eq 0 then abor("Can't open SysDir")
LookupEntries(dir, fnames, fdvs, nfiles+2, true, buf, bufsize)
Closes(dir)
let len = 0
until Endofs(com) do
[ let ch = Gets(com)
if ch eq $*N break
len = len+1
cpat>>BS.char↑len = ch
]
cpat>>BS.length = len
Closes(com)
// Flush initialization code
MoveBlock(B, A, flist-A)
let disp = B-A
@lvCodeTop = flist+disp
fnames, fdvs = fnames+disp, fdvs+disp
for i = 0 to nfiles+1 do
fnames!i = fnames!i+disp
let miss = false
for i = 2 to nfiles+1 do
if fdvs!(i*lDV) eq 0 then
[ unless miss do
[ Ws("Can't find the following files:")
miss = true
]
Puts(dsp, $*S)
Ws(fnames!i)
]
if miss then abor("*N")
let lsts, mats = 0, 0
if ff>>FF.lstf then lsts = OpenFile(fnames!0, ksTypeWriteOnly, charItem, verLatestCreate, lv fdvs>>DV.fp)
mats = OpenFile(fnames!1, ksTypeWriteOnly, charItem, verLatestCreate, lv (fdvs+lDV)>>DV.fp)
flags = ff // set up static for ccproc
[ let r = nil
if len eq 0 then
[ readstring("Pattern: ", dsp, cpat, ccproc)
if cpat>>BS.length eq 0 break
]
ff>>FF.waf = ff>>FF.allf % ff>>FF.writef
r = findmain(fnames+2, fdvs+2*lDV, nfiles, cpat, ff, lsts, mats, buf, bufsize)
if lsts ne 0 then [ Closes(lsts); lsts = 0 ]
if r ne 0 then
[ PutTemplate(dsp, "**********$S*N", r) ]
] repeatwhile len eq 0
Closes(mats)
]
and addname(str, lvlst) be
[ let nw = str>>BS.length/2+1
MoveBlock(@lvlst, str, nw)
@lvlst = @lvlst+nw
]
and abor(s) be
[ Ws(s); finish ]
and ccproc(ds, ch) = valof
// Handle a control character during pattern input.
// The only character recognized is ↑S, which prompts for a
// switch to toggle, or ? meaning show the current state.
[ if ch ne $S-100b resultis false
Wss(ds, " Switch: ")
ch = ReadChar(ds, 5, 200)
let msg = nil
let off = getflag(ch, lv msg)
test off ne -1
ifso
[ flags!off = not flags!off
Wss(ds, msg)
Wss(ds, (flags!off? " -- on", " -- off"))
]
ifnot
test ch eq $?
ifso
[ Puts(ds, $*N)
for i = 0 to 5 do
[ off = getflag(table[ $A;$C;$O;$S;$V;$W ]!i, lv msg)
if flags!off then PutTemplate(ds, " $S*N", msg)
]
]
ifnot Wss(ds, " ???")
resultis true
]
and getflag(ch, lvMsg; numargs na) = valof
// Convert a global flag character to an index in the FF structure,
// or -1 if not recognized. If a second arg is supplied,
// store an explanatory message into it.
[ if na ls 2 then lvMsg = lv na
switchon (ch&137b) into // lower case = upper case
[ case $A: @lvMsg = "All to file"; resultis offset FF.allf/16
case $C: @lvMsg = "Case matters"; resultis offset FF.casef/16
case $O: @lvMsg = "Octal positions"; resultis offset FF.octalf/16
case $S: @lvMsg = "Spaces matter"; resultis offset FF.spacef/16
case $V: @lvMsg = "Verbatim"; resultis offset FF.verbatimf/16
case $W: @lvMsg = "Write only"; resultis offset FF.writef/16
]
resultis -1
]
//
// Main matching code
//
and findmain(fnames, fdvs, nfiles, upat, ff, lsts, mats, buf, bsize) = valof
[ let chtab = vec 200b
let tables = 0
let r = compat(upat, ff, lsts, chtab, lv tables)
if r ne 0 resultis r
let matchpos = vec (lMP*savematches)
let old = vec lMP
Zero(old, lMP)
let npages = 0
let dh = @lvDisplayHead
@lvDisplayHead = 0
let btime = vec 1
Timer(btime)
let nmatches = getmatches(fdvs, nfiles, buf, bsize, matchpos, lv npages, old)
let atime = vec 1
Timer(atime)
@lvDisplayHead = dh
let dtime = vec 1
dtime!0, dtime!1 = not btime!0, not btime!1
DoubleAdd(dtime, table[ 0; 1 ])
DoubleAdd(dtime, atime) // dtime ← atime-btime
PutTemplate(dsp, " $D matches, $ED ms, $D pages", nmatches, dtime, npages)
if nmatches gr savematches then nmatches = savematches
let first = true
let dbsize = (ff>>FF.writef? 0, bsize)
if nmatches ne 0 then
[ let last = nmatches ls savematches
let nm = showmatches(fnames, fdvs, mats, buf, dbsize, matchpos, nmatches, upat>>BS.length, chtab, first, last, ff)
if nm ls 0 then
[ unless ff>>FF.waf break
nm = -1-nm
if last & (nm eq nmatches) break // all done
dbsize = 0 // don't display any more
]
MoveBlock(old, matchpos+(nm-1)*lMP, lMP)
nmatches = getmatches(fdvs, nfiles, buf, bsize, matchpos, 0, old)
first = false
] repeat
if tables ne 0 then Free(sysZone, tables)
resultis 0
]
and compat(upat, ff, lsts, chtab, lvTables) = valof
[ // Decode user-specified pattern into string, wildcards, fuzz
SetBlock(chtab, classOther, 200b)
chtab!charExit = classExit
unless ff>>FF.spacef do chtab!$*S = classSkip
unless ff>>FF.casef do for ch = $a to $z do chtab!ch = ch+($A-$a)
let pat = upat
let len, fuzz = 0, 0
let quote = false
for i = 1 to upat>>BS.length do
[ let ch = upat>>BS.char↑i & 177b
if ch ls 40b resultis "Control char.s not allowed"
unless quote switchon ch into
[ case $~:
fuzz = fuzz+1
loop
case $':
quote = true
loop
case $*S:
if ff>>FF.spacef endcase
loop
case $#:
ch = charWildCard
]
len = len+1
pat>>BS.char↑len = ch
quote = false
]
pat>>BS.length = len
resultis FindCompile(pat, chtab, charWildCard, fuzz, lsts, true, 0, lvTables)
]
and getmatches(fdvs, nfiles, buf, bsize, matchpos, lvnp, old) = valof
// Returns # of matches
[ let nmatches = 0
let fa = vec lFA
let skip = lvnp eq 0 // skip all matches through old
for i = old>>MP.fid to nfiles-1 do
[ let st = CreateDiskStream(lv (fdvs+i*lDV)>>DV.fp, charItem, ksTypeReadOnly)
let ssd = FindInitScan(st, buf, bsize, fa)
[ let ppos = FindNext()
if ppos ls 0 then // end of file, ppos = not npages
[ if lvnp ne 0 then @lvnp = @lvnp + not ppos
break
]
if skip then
[ if (i eq old>>MP.fid) & (ppos eq old>>MP.ppos) &
(fa>>FA.pageNumber eq old>>MP.pageNumber) &
(fa>>FA.charPos eq old>>MP.charPos) then
skip = false
loop
]
test nmatches ls savematches
ifso // save position of match
[ let mp = matchpos+lMP*nmatches
mp>>MP.fid = i
mp>>MP.ppos = ppos
mp>>MP.da = fa>>FA.da
mp>>MP.pageNumber = fa>>FA.pageNumber
mp>>MP.charPos = fa>>FA.charPos
]
ifnot
if lvnp eq 0 then // quit now
[ FinishScanStream(ssd)
Closes(st)
resultis nmatches
]
nmatches = nmatches+1
] repeat
FinishScanStream(ssd)
Closes(st)
]
resultis nmatches
]
//
// Output results
//
and showmatches(fnames, fdvs, mats, db, bsize, matchpos, nmatches, patlen, chtab, first, last, ff) = valof
// Returns # of matches displayed normally, -1-# if aborted or done
[ let ds, mds, ms, bolds = nil, nil, vec lST, vec lST
test bsize eq 0
ifso // just copy matches, don't display
ds, ms = 0, mats
ifnot
[ ds = CreateDisplayStream(displines, db, bsize-mbufsize, 0, 0, dsoptions)
ShowDisplayStream(ds)
mds = CreateDisplayStream(2, db+bsize-mbufsize, mbufsize, 0, 0, mdsoptions)
ShowDisplayStream(mds, DSbelow, ds)
boldstream(bolds, ds)
splitstream(ms, ds, mats)
]
let ll, nl = nil, nil
test ff>>FF.waf
ifso ll, nl = -1, -1
ifnot ll, nl = maxll, maxnl
let para = ff>>FF.verbatimf & (ff>>FF.itemproc eq paradelim)
let eop = (para? "*032*N", "*N") // end of paragraph string
let lastfid = (first? -1, matchpos>>MP.fid-1)
let fs = (first? ms, ds)
let lim = nmatches-1
let st = 0
let i = 0
while i le lim do
[ let mp = matchpos+lMP*i
if mp>>MP.fid ne lastfid then
[ if st ne 0 then Closes(st)
while lastfid ne mp>>MP.fid do
[ lastfid = lastfid+1
if fs ne 0 then PutTemplate(fs, "****** $S$S", fnames!lastfid, eop)
]
fs = ms
st = CreateDiskStream(lv (fdvs+lastfid*lDV)>>DV.fp, ksTypeReadOnly, charItem)
]
let begv, mbegv, posv, mendv, endv = vec 1, vec 1, vec 1, vec 1, vec 1
let fa = lv mp>>MP.fa
let pn = fa>>FA.pageNumber-1
posv!0, posv!1 = pn rshift 7, pn lshift 9 + fa>>FA.charPos
occlim(st, posv, mbegv, mendv, mp>>MP.ppos, patlen, chtab)
let inl = ff>>FF.itemproc(st, mbegv, begv, endv, ll, nl)
unless ff>>FF.verbatimf do nonbravo(st, mbegv, begv, endv)
if ff>>FF.octalf then PutTemplate(mats, "$6EO$S", posv, (para? eop, " "))
if copyseg(st, mats, begv, endv) ne $*N then Wss(mats, eop)
if ds ne 0 then
[ PutTemplate(ds, "$6EO ", posv)
copyseg(st, ds, begv, mbegv)
let lastch = nil
test Usc2(endv, mendv) gr 0
ifso // normal case, match falls within delimited area
[ copyseg(st, bolds, mbegv, mendv)
lastch = copyseg(st, ds, mendv, endv)
]
ifnot // delimited area ends within match
lastch = copyseg(st, bolds, mbegv, endv)
if lastch ne $*N then Puts(ds, $*N)
if (GetLinePos(ds) ge displines-5) % (i eq lim) then
[ test (i eq lim) & last
ifso
[ Wss(mds, "*N*T*T----- <SP> to clear screen -----*N")
Gets(keys)
i = i+1
]
ifnot
[ Wss(mds, "*N*T*T----- <SP> for more, <DEL> to abort -----*N")
i = (Gets(keys) eq 177b? -i-2, i+1)
]
break
]
]
i = i+1
]
if st ne 0 then Closes(st)
if ds ne 0 then
[ ShowDisplayStream(mds, DSdelete)
ShowDisplayStream(ds, DSdelete)
]
resultis ((i eq nmatches) & last? -i-1, i)
]