!!!!! Simple emulation of EMAS VIEW for VAX/VMS and APM !!!!!
!!!!!!!!! Hamish Dewar April 1983 !!!!!!!!!
!Implements VIEW commands on a VMS/APM text file:
! only basic commands implemented; index generated on fly
!
!$IF VAX
!%externalintegerfnspec CONNECT(%string(127) file,
! %integername start,length,%integer mode)
{\V10IMP %include "IMP_INCLUDE:CONNECT.INC"
{V10IMP} from IMP include connect
include "VTI.IMP"
!
externalroutine VIEW(string (255) filename)
owninteger MAXCOL=72
!$IF APM
{%routine CONNECT FILE(%string(127) file,%integer mode,
{ %integername start,len)
{%shortspec(16_35C4) uno
{%bytespec(16_372C) lockout
{%integer i,j,xno,blocks,bytes,size
{%string(255) fscomm
{%routine GET(%integername v)
{%integer k
{ v = 0
{ %cycle
{ i = i+1; k = charno(fscomm,i)
{ i = i-1 %if k < ' '
{ k = k-'0'
{ %return %if k < 0
{ v = v<<4+k
{ %repeat
{%end
{%routine READ
{ %cycle
{ size = 512; size = bytes %if bytes < 512
{ size = etherread(15,byteinteger(i),size)
{ i = i+size; bytes = bytes-size
{ %repeat %until size # 512
{ lockout = 0
{%end
{ %on %event 9 %start
{ lockout = 0
{ charno(fscomm,2) = size-2; printstring(string(addr(charno(fscomm,2))))
{ %signal 4
{ %finish
{ bytes = 0; blocks = 0
{ %if file # "" %start
{!Send Readfile request to filestore
{ lockout = 1
{ fscomm = "Z".tostring(uno+'0').file.tostring(nl)
{ etherwrite(15,charno(fscomm,1),length(fscomm))
{!Read response
{ size = etherread(15,charno(fscomm,1),255)
{ %signal 9 %if charno(fscomm,1) = '-'
{!Extract info
{ i = 0
{ get(blocks); get(bytes)
{ bytes = blocks<<9-bytes; !size of file in bytes
{ %finish
{ len = bytes
{ size = blocks<<9; !VM size
{!Allocate space
{ *MOVE D6,i; *MOVE A7,j; !**Heap -><- Stack **
{ %if i+size >= j %start; !no space
{ bytes = 0
{ read
{ printstring("*Insufficient space for file"); newline
{ %signal 4
{ %finish
{ i = i-256; !HP displaced by 256
{ start = i
{ *ADD size,D6
{ read %if bytes # 0
{%END
{!
{%begin
{%routine VIEW(%string(255) filename)
{%owninteger MAXCOL=80
!$FINISH
!
!Current status variables:
constinteger MAXLINE=20, LET=32
owninteger COL=0, SKIPPING=0, LINE=0
integer IDENT,PAGE,TEXTAD,LENGTH
integer STARTAD,LIMAD,FLAG,COMMAND,MORE,FOUND
!Directive index:
constinteger DIRBOUND=1000, PAGEBOUND=100
integer DIRMAX,PAGEMAX,MAXPAGE,MAXTEXTPAGE,CHARMAX
recordformat DIRINFO(integer address,
byteinteger level,number,
shortinteger parent,brother)
record (dirinfo)array DIR(0:dirbound)
!Page information for current section only
integerarray PSTART(1:pagebound)
integerarray FOUNDID(1:maxline)
byteintegerarray CHAR(1:127)
constinteger EVEN=\1
routine SKIP LINE
return if textad >= limad
!$IF VAX
textad = textad+(shortinteger(textad)+3)&even
!$IF APM
{ textad = textad+1 %until byteinteger(textad-1) < ' '
!$FINISH
end
routine CREATE DIRECTORY(integer parent,level)
! Set up DIR for all sections and sub-sections,
! TEXTAD pointing at first sub-section of PARENT
record (dirinfo)name d
integer num,code,p
num = 1
cycle
dirmax = dirmax+1; p = dirmax
d == dir(p)
d_address = textad
d_level = level; d_number = num
d_parent = parent
cycle
d_brother = -(dirmax+1)
cycle
skip line
return if textad >= limad
!$IF VAX
repeat until shortinteger(textad) >= 2 and byteinteger(textad+2) = '!'
code = byteinteger(textad+3)
!$IF APM
{ %repeat %until byteinteger(textad) = '!'
{ code = byteinteger(textad+1)
!$FINISH
if code = '>' start ; !end-of-section
return if p = 0
p = 0
finish
if code = '<' start
exit if p = 0; !brother
create directory(p,level+1); !sons
p = 0
finish
repeat
d_brother = dirmax+1; num = num+1
repeat
end ; !CREATE DIR
routine SEARCH FOR STRING
integer id
integerfn MATCHED
integer a,k,ad,lim
!$IF VAX
ad = dir(id)_address; lim = ad+shortinteger(ad)+2
ad = ad+4; !past length bytes & '!<'
while ad+charmax <= lim cycle
if byteinteger(ad)!let = command start ; !first char match
a = ad; k = 0
cycle
a = a+1; k = k+1
result = 1 if k > charmax
repeat until byteinteger(a)!let # char(k)
finish
ad = ad+1 until ad = lim or byteinteger(ad) = ' '
ad = ad+1
repeat
result = 0
!$IF APM
{ ad = dir(id)_address+2
{ %cycle
{ %while byteinteger(ad) <= ' ' %cycle
{ %result = 0 %if byteinteger(ad) < ' '
{ ad = ad+1
{ %repeat
{ %if byteinteger(ad)!let = command %start; !first char match
{ a = ad; k = 0
{ %cycle
{ a = a+1; k = k+1
{ %result = 1 %if k > charmax
{ %repeat %until byteinteger(a)!let # char(k)
{ %finish
{ ad = ad+1 %until byteinteger(ad) <= ' '
{ %repeat
!$FINISH
end
found = 0; id = 1
while id <= dirmax cycle
if matched # 0 start
found = found+1; foundid(found) = id
return if found = maxline-1
id = |dir(id)_brother|; !don't look at descendants too
finish else id = id+1
repeat
end ; !SEARCH FOR STRING
routine NEWLINE
print symbol(nl) if skipping = 0
line = line+1; col = 0
end
routine SPACES(integer n)
while n > 0 cycle
print symbol(' '); col = col+1; n = n-1
repeat
end
routine PUT NUM(integer n)
put num(n//10) and n = n-n//10*10 if n >= 10
print symbol(n+'0'); col = col+1
end
routine PRINT IDENT(integer id)
record (dirinfo)name d
d == dir(id)
if d_parent # 0 start
print ident(d_parent); print symbol('.'); col = col+1
finish
put num(d_number)
end
routine PRINT TITLE(integer id)
integer ad,length
!$IF VAX
ad = dir(id)_address; length = shortinteger(ad)-2
col = col+length
ad = ad+4; !past length bytes & '!<'
while length > 0 cycle
print symbol(byteinteger(ad))
ad = ad+1; length = length-1
repeat
!$IF APM
{ ad = dir(id)_address+2
{ %while byteinteger(ad) >= ' ' %cycle
{ print symbol(byteinteger(ad))
{ ad = ad+1; col = col+1
{ %repeat
!$FINISH
end
routine PRINT LINE
integer ad,length
!$IF VAX
ad = textad; length = shortinteger(ad)
textad = textad+(length+3)&even
ad = ad+2
while length > 0 cycle
print symbol(byteinteger(ad))
ad = ad+1; length = length-1
repeat
newline
!$IF APM
{ %cycle
{ print symbol(byteinteger(textad))
{ textad = textad+1
{ %repeat %until byteinteger(textad-1) < ' '
{ line = line+1; col = 0
!$FINISH
end
routine RULE LINE
integer i
!$IF VAX
print symbol('-') for i = 1,1,maxcol
!$IF APM
{ set shade(graphical+intense)
{ print symbol('`') %for i = 1,1,maxcol
{ set shade(0)
!$FINISH
newline
end
routine SET IDENT(integer i)
ident = i; page = 1
pagemax = 0; maxpage = 999; maxtextpage = 999
end
routine PRINT CONTENT(integer page)
owninteger max,maxid,maxnum
integer i,k,col1,blanks,code,id
record (dirinfo)name d
integerfn LINELENGTH(integer ad)
integer ad1
ad1 = ad
ad = ad+1 until byteinteger(ad-1) < ' '
result = ad-ad1-1
end
blanks = 0; more = 0; line = 0
if page <= maxtextpage start
textad = pstart(page)
cycle
return if textad >= limad
!$IF VAX
length = shortinteger(textad)
exit if length >= 2 and byteinteger(textad+2) = '!'
if length = 0 start
textad = textad+2; blanks = blanks+1
!$IF APM
{ %exit %if byteinteger(textad) = '!'
{ %if byteinteger(textad) < ' ' %start
{ textad = textad+1; blanks = blanks+1
!$FINISH
finish else start
more = textad and return if line+blanks+1 > maxline
if skipping = 0 start
newline and blanks = blanks-1 while blanks > 0
print line
finish else start
line = line+blanks+1; blanks = 0
skip line
finish
finish
repeat
!Directive located
!$IF VAX
code = byteinteger(textad+3)
!$IF APM
{ code = byteinteger(textad+1)
!$FINISH
if code!let = 'p' start ; !"!PAGE"
skip line; more = textad
return
finish
create directory(0,0) if ident = 0 and dirmax = 0
maxtextpage = page
return if ident = dirmax
id = ident+1
return if dir(id)_parent # ident; !no subsections
!Explore subsections to find number,maxwidth
d == dir(id)
!$IF VAX
max = shortinteger(d_address)
while d_brother > 0 cycle
d == dir(d_brother)
max = shortinteger(d_address) if shortinteger(d_address) > max
repeat
!$IF APM
{ max = linelength(d_address)
{ %while d_brother > 0 %cycle
{ d == dir(d_brother)
{ k = linelength(d_address)
{ max = k %if k > max
{ %repeat
{ max = max+2
!$FINISH
maxnum = d_number
maxid = d_level+d_level+3; maxid = maxid+1 if maxnum > 9
finish else id = pstart(page)
!Contents
col1 = 0
cycle
newline and blanks = 0 if blanks # 0; !restrict to 1
more = id and return if line >= maxline
col1 = col1+maxid
if skipping = 0 start
print ident(id)
spaces(col1-col)
print title(id)
finish
id = dir(id)_brother
exit if id <= 0
col1 = col1+max
if col1+maxid+max <= maxcol start
spaces(col1-col) if skipping = 0
finish else start
newline; col1 = 0
finish
repeat
newline
end ; !PRINT CONTENT
routine PRINT PAGE
integer length,blanks,code
while pagemax < page cycle
more = 0
if pagemax = 0 start
if ident = 0 then textad = startad c
else textad = dir(ident)_address and skip line
more = textad
finish else if pagemax # maxpage start
skipping = 1
print content(pagemax)
skipping = 0
finish
if more = 0 start
maxpage = pagemax; page = maxpage
exit
finish
pagemax = pagemax+1; pstart(pagemax) = more
repeat
at(0,0); clear frame
spaces(10); col = 10
if ident = 0 start ; !at start of file
print string(filename)
finish else start
print title(ident)
spaces(60-col)
print ident(ident)
print symbol('/') and put num(page) if page > 1
finish
newline
rule line
print content(page)
if more = 0 start
maxpage = pagemax
finish else if pagemax = page start
pagemax = pagemax+1; pstart(pagemax) = more
finish
end ; !PRINT PAGE
routine READ COMMAND
! Read command and adjust IDENT and PAGE for required page
integer i,sym,error
routine READ(integername j)
j = -1; return unless '0' <= sym <= '9'
j = 0
cycle
j = j*10+sym-'0'; j = 99 if j > 99
read symbol(sym)
repeat until not '0' <= sym <= '9'
end
routine READ IDENT
!First character in SYM
integer i,j
error = 1
if sym # '/' start
i = 0; i = ident if sym = '.'
cycle
read symbol(sym) if sym = '.'
read(j)
return if j < 0 or i >= dirmax or dir(i+1)_parent # i
i = i+1
cycle
j = j-1
exit if j <= 0
i = dir(i)_brother
return if i <= 0
repeat
repeat until sym # '.'
set ident(i)
finish
read symbol(sym) and read(page) if sym = '/'
error = 0 if page > 0
end
cycle
at(22,0)
if more # 0 then printstring("...more ") c
else if ident >= dirmax then printstring("End. ")
printstring("View:"); clear line
read symbol(sym) until sym # ' '
command = sym
command = command!let if 'A' <= command <= 'Z'
if sym < ' ' start ; !plain control key
command = 'q' and return if sym = 'z'&31; !^Z
if more # 0 then page = page+1 c
else if ident < dirmax then set ident(ident+1)
return
finish
if sym = '-' start
if page > 1 then page = page-1 c
else if ident # 0 then set ident(ident-1) and page = 99
read symbol(sym) while sym >= ' '
return
finish
if '0' <= sym <= '9' or sym = '.' or sym = '/' start
read ident
read symbol(sym) while sym >= ' '
return if error = 0
at(23,0); print string(" No such section"); clear line
finish else start
read symbol(sym); !second symbol
if sym < ' ' start
return if command = 'q'
set ident(0) and return if command = 't'
set ident(dir(ident)_parent) and return if command = 'u'
at(17,0); newline
printstring(" RETURN: next page -: previous page")
newline
printstring(" t: top of file u: up one level")
newline
printstring(" <n>: section <n> x...x: locate 'x...x'")
newline
printstring(" q: quit program")
newline
finish else start
charmax = 0
cycle
charmax = charmax+1; char(charmax) = sym
read symbol(sym)
repeat until sym < ' '
search for string
set ident(foundid(1)) and return if found = 1
if found = 0 start
at(23,0); print string("No references found"); clear line
finish else start
at(maxline+1-found,0); newline
for i = 1,1,found cycle
if i # maxline-1 start
spaces(2)
print ident(foundid(i))
spaces(10-col)
print title(foundid(i))
finish else print string(" and so on")
newline
repeat
finish
finish
finish
repeat
end ; !READ COMMAND
!Start of VIEW: connect file
on event 4,9 start
printstring("View fails"); newline
return
finish
connect file(filename,0,startad,limad)
limad = limad+startad
dir(0) = 0; dir(0)_address = startad
dirmax = 0
set ident(0)
cycle
print page
read command
repeat until command = 'q'
end ; !VIEW
!$IF VAX
!Final part only for compilation as runnable program
!{\V10IMP %externalstring(255)%fnspec CLIPARAM
!{V10IMP} %from imp %include pam
!%begin
! define video(-1)
! set video mode(screenmode)
! view(cliparam)
! set video mode(0)
!%end
endoffile
!$IF APM
{%integer k,dir
{%ownstring(255) s="VIEW:SYSTEM"
{ prompt("")
{ read symbol(k) %until k # ' '
{ %if k > ' ' %start
{ s = ""; dir = 0
{ %cycle
{ dir = 1 %if k = ':'
{ s = s.tostring(k)
{ read symbol(k)
{ %repeat %until k <= ' '
{ s = "VIEW:".s %if dir = 0
{ %finish
{ set video mode(screenmode&(\single))
{ view(s)
{ set video mode(0)
{ print ch(nl)
{%endofprogram
!$FINISH