//
// Subroutines for Find subsystem
// last edited October 3, 1980  2:47 PM
//
// Copyright Xerox Corporation 1979

	get "findpkgdefs.d"
	get "streams.d"

external	// entries
[	Usc2	// (v1, v2) -> -1, 0, 1
	occlim	// (st, posv, begv, endv, ppos, plen, chtab)
	linedelim	// (st, posv, begv, endv, maxll, maxnl) -> nl
	paradelim	// (st, posv, begv, endv, maxll, maxnl) -> nl
	breakdelim	// (st, posv, begv, endv, maxll, maxnl) -> nl
	nonbravo	// (st, posv, begv, endv)
	copyseg	// (st, outs, begv, endv) -> lastchar
	splitstream	// (s, s1, s2)
	boldstream	// (s, s1)
	readstring	// (msg, ds, s, ccproc(ds, ch) -> true/false)
	ReadChar	// (ds, width, wait)
]


external
[		// OS
	CharWidth
	DoubleAdd
	Endofs; EraseBits
	FilePos
	GetBitPos; GetLinePos; GetLmarg; Gets
	keys
	MoveBlock
	Puts
	SetBitPos; SetFilePos; SetLinePos
	Timer
	Usc
	Wss
]


manifest
[	charBravo = 32b	// ↑Z, signals Bravo format trailer
]

structure BS:
[	length byte
	char↑1,255 byte
]


//
// Miscellaneous
//

let Usc2(v1, v2) = (v1!0 eq v2!0? Usc(v1!1, v2!1), Usc(v1!0, v2!0))


//
// Delimitation and output
//

and occlim(st, posv, begv, endv, ppos, plen, chtab) be
[	begv!0, begv!1 = posv!0, posv!1
	while ppos gr 0 do
	 [ DoubleAdd(begv, table[ -1; -1])
	   SetFilePos(st, begv)
	   if chtab!(Gets(st)) ne classSkip then ppos = ppos-1
	 ]
	SetFilePos(st, begv)
	while (plen gr 0) & (Endofs(st) eq false) do
	  if chtab!(Gets(st)) ne classSkip then plen = plen-1
	FilePos(st, endv)
]

and findbeg(st, posv, begv, max, ch) = valof
[	begv!0, begv!1 = posv!0, posv!1
	let i = 0
	until ((i ge max) & (max ne -1)) % ((begv!0 eq 0) & (begv!1 eq 0)) do
	 [ DoubleAdd(begv, table[ -1; -1 ])
	   SetFilePos(st, begv)
	   if Gets(st) eq ch then
	   [ DoubleAdd(begv, table[ 0; 1 ]); resultis true ]
	   i = i+1
	 ]
	resultis false
]

and findend(st, posv, endv, max, ch) = valof
[	let found = false
	SetFilePos(st, posv)
	let i = 1
	while (i le max) % (max eq -1) do
	 [ if Endofs(st) break
	   found = Gets(st) eq ch
	   if found break
	   i = i+1
	 ]
	FilePos(st, endv)
	resultis found
]

and linedelim(st, posv, begv, endv, maxll, maxnl) = valof
// Delimit a line
[	findbeg(st, posv, begv, maxll, $*N)
	findend(st, posv, endv, maxll, $*N)
	resultis 1
]

and paradelim(st, posv, begv, endv, maxll, maxnl) = valof
// Delimit a Bravo paragraph
[	let maxpl = (maxnl eq -1? -1, maxll*maxnl)
	findbeg(st, posv, begv, maxpl, charBravo)
	findend(st, begv, endv, maxpl, $*N)
	if Usc2(posv, endv) ge 0 then	// not a match inside a trailer
	[ MoveBlock(begv, endv, 2)
	  if findend(st, posv, endv, maxpl, charBravo) then
	    findend(st, endv, endv, -1, $*N)
	]
	resultis (endv!1-begv!1)/70+1
]

and breakdelim(st, posv, begv, endv, maxll, maxnl) = valof
// Delimit an item set off by blank lines
[	let nl = 1
	findbeg(st, posv, begv, maxll, $*N)
	[ let prev = begv!1
	  DoubleAdd(begv, table[ -1; -1])
	  unless findbeg(st, begv, begv, maxll, $*N) break
	  if begv!1 eq prev-1 then [ begv!1 = prev; break]
	  nl = nl+1
	] repeatwhile nl ls maxnl
	findend(st, posv, endv, maxll, $*N)
	[ let prev = endv!1
	  unless findend(st, endv, endv, maxll, $*N) break
	  if endv!1 eq prev+1 then [ endv!1 = prev; break]
	  nl = nl+1
	] repeatwhile nl ls maxnl
	resultis nl
]

and nonbravo(st, posv, begv, endv) be
[	findbeg(st, posv, begv, posv!1-begv!1, charBravo)
	if findend(st, posv, endv, endv!1-posv!1, charBravo) then
	  DoubleAdd(endv, table[ -1; -1])
]

and copyseg(st, outs, begv, endv) = valof
[	SetFilePos(st, begv)
	let ch = -1
	for i = 1 to (endv!1-begv!1) do
	[ ch = Gets(st)
	  Puts(outs, ch)
	]
	resultis ch
]

and splitstream(s, s1, s2) be
[	let bothPuts(st, ch) be
	 [ Puts(st>>ST.par1, ch)
	   Puts(st>>ST.par2, ch)
	 ]
	s>>ST.par1 = s1
	s>>ST.par2 = s2
	s>>ST.puts = bothPuts
]

and boldstream(s, s1) be
[	let samePuts(st, ch) be Puts(st>>ST.par1, ch)
	s>>ST.par1 = s1
	s>>ST.puts = (s1>>ST.type eq stTypeDisplay? boldPuts, samePuts)
]

and boldPuts(st, ch) be
[	let ds = st>>ST.par1
	let oldb, oldl = GetBitPos(ds), GetLinePos(ds)
	Puts(ds, ch)
	if GetLinePos(ds) eq oldl then	// first copy fit
	[ let newb = GetBitPos(ds)
	  if newb eq oldb return	// zero width
	  SetBitPos(ds, oldb+1)
	  Puts(ds, ch)
	  if GetLinePos(ds) eq oldl return	// second copy fit
	  // Erase first copy, treat second copy as first
	  SetLinePos(ds, oldl)
	  SetBitPos(ds, oldl)
	  EraseBits(ds, newb-oldb)
	  Puts(ds, $*N)
	  Puts(ds, ch)
	]
	let lmarg = GetLmarg(ds)	// first copy overflowed
	if GetBitPos(ds) ne lmarg then	// non-zero width
	[ SetBitPos(ds, lmarg+1)
	  Puts(ds, ch)
	]
]


//
// String input
//

and readstring(msg, ds, s, ccproc) = valof
[	let len = 0
	Puts(ds, $*N)
	let zpos = GetBitPos(ds)
	Wss(ds, msg)
   [	s>>BS.length = len
	let ch = ReadChar(ds, 5, 400)
	let back = nil
	if (ch ls 40b) & ccproc(ds, ch) then
	[ if GetBitPos(ds) ne zpos then Puts(ds, $*N)
	  Wss(ds, msg)
	  Wss(ds, s)
	  loop
	]
	switchon ch into
	[ case $*N: case 33b:	// <esc>
	   resultis ch
	  case 1b: case 10b:	// ↑A, <bs>
	   if len eq 0 loop
	   back = len-1
	   endcase
	  default:
	   if ch ls 40b loop	// control char.
	   len = len+1
	   s>>BS.char↑len = ch
	   Puts(ds, ch)
	   loop
	  case 177b:	// <del>
	   back = 0
	   endcase
	  case 27b:	// ↑W
	   back = len
	   while (back gr 0) & (s>>BS.char↑back eq $*S) do back = back-1
	   while (back gr 0) & (s>>BS.char↑back ne $*S) do back = back-1
	   endcase
	]
	while len ne back do
	 [ EraseBits(ds, -CharWidth(ds, s>>BS.char↑len))
	   len = len-1
	 ]
   ] repeat
]

and ReadChar(ds, width, wait) = valof
[	let t0 = vec 1
	Timer(t0)
	EraseBits(ds, width, 1)
	let on = width
	while Endofs(keys) do
	 [ let t = vec 1
	   Timer(t)
	   if Usc(t!1-t0!1, wait) ge 0 then
	    [ on = -on
	      EraseBits(ds, on, -1)
	      t0!1 = t!1
	    ]
	 ]
	if on gr 0 then EraseBits(ds, -width)
	resultis Gets(keys)
]