!****************************************************************
!*                                                              *
!*     Simple emulation of EMAS VIEW for VAX/VMS and APM        *
!*                   Hamish Dewar  April 1983                   *
!*                                                              *
!*                  Version 1.15   5 Nov 1987                   *
!*                                                              *
!****************************************************************

!  Modified JHB 1984
!  Modified JHB Oct 1986 (-t and -d parameters)
!  Modified RWT Jun 1987 (rearranged to make available as external for SM)
!  Modified JHB Nov 1987 (added !{...} construct to allow embedded comments)
!  Modified JHB Dec 1987 !FILE - hook to allow pointers to other files
!  in mid-hack but harmless
!  only basic facilities implemented - uses text file: index generated on fly
!
!Parameters are [-d=<directory>][-t=<deftopic>][<param>][,<topic>]
!
!1) <param> # null:                If <param> contains a colon it is taken to
!   be a filename otherwise it is a topic to be looked up in 0INDEX to get th
!   filename and possibly section number.
!   A search is then performed for <topic> if <topic> # null.
!2) <param> = null <topic> # null: <param> is assumed to refer to DEFAULTFILE
!   and topic is searched for as in 1)
!3) <param> = null <topic> = null: HELP displays a menu and prompts user.

!If -d is specified the default directory (VIEW:) will be replaced by <directory>.
!If -t is specified the default topic ("APM") will be replaced by <deftopic>.

option  "-low-nodiag-nocheck"
include  "inc:fs.imp"
include  "inc:util.imp"
include  "inc:vtlib.imp"
!
ownstring (255) DEFAULTDIR="view:"
ownstring (255) DEFAULTTOPIC="apm"
conststring  (7) indexfile = "0index"
!time statistics variables
owninteger  timstrt, timscon, timecon, timinit, timssrch, timesrch

externalroutine  VIEW(string (255) param,topic)

{frig for look-ahead input}

integerfn  getsym
integer  k
  readsymbol(k); result  = k
end 

routine  readsymbol(integername  sym)
integer  k
ownbytearray  b(1:80)
owninteger  p=0,l=0
constinteger  bs=8
  routine  delete
    returnif  l=0
    printsymbol(bs); printsymbol(' '); printsymbol(bs)
    l = l-1
  end 
  if  p=l start 
    p = 0; l = 0
    cycle 
      k = getsym
      if  k=127 start 
        delete
        continue 
      finish 
      if  k='X'&31 or  k='U'&31 or  k=bs start 
        delete while  l>0
        continue 
      finish 
      if  k>=128 or  k<' ' start 
        l = l+1; b(l) = k; exit 
      finish 
      l = l+1; b(l) = k
      printsymbol(k)
      exitif  l=80
      exitif  l=1 and  (k='!' or  k='?' or  k='-') {*"immediate" chars*}
    repeat 
  finish 
  p = p+1; sym = b(p)
end 

constinteger  header=0
string  (63) currentfile = "", key = "", topkey
!
!Current status variables:
constinteger  esc=27
constinteger  MAXLINE=20, MAXCOL=80, LET=32
owninteger  COL=0, SKIPPING=0, LINE=0, MORE=0
integer  IDENT,PAGE,TEXTAD,SIZE
owninteger  STARTAD,LIMAD,FLAG,FOUND,FINISHED = 0
!Directive index:
constinteger  DIRBOUND=1000, PAGEBOUND=100
integer  DIRMAX,PAGEMAX,MAXPAGE,MAXTEXTPAGE
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)
integerarray  foundad(1:maxline)
constinteger  EVEN=¬1

constinteger  max entries = 128
owninteger  top entries = 0, top ptr = -1
recordformat  entry fm(string  (127) key, file, integer  depth,
integerarray  path(0:31))
record  (entry fm) array  top index(0: max entries-1)

routine  wait(integer  msec)
   msec = cputime + msec
   while  cputime <= msec cycle ; repeat 
end 

routine  status line(string  (255) s, integer  delay)
   !Print the text on the status line and pause 1/4 sec to let him read it
   vtat(23, 0)
   printstring(s)
   clear line
   wait(delay)
end 

routine  prompt line(string  (255) s)
   !Print the text on the prompt line (22)
   vtat(22, 0)
   printstring(s)
   clear line
end 


routine  stop(string  (255) why)
   status line(why,0)
   stop 
end 


routine  RULE LINE
integer  i
{  print symbol('-') %for i = 1,1,maxcol
  set shade(graphical+intense)
  print symbol('`') for  i = 1,1,maxcol
  set shade(0)
  newline
end 

routine  clean up(string  (*) name  s)
   integer  i
   bytename  l,c
   !Lower case
   to lower(s)
   l == length(s); c == charno(s,1)
   !Strip trailing spaces
   l = l-1 while  s # "" and  charno(s,l)<= ' '
   !Strip leading spaces
   cycle 
      exit  if  l<2 or  c > ' '
      !Special attention to cursor commands
      if  c = esc then  s = "" else  s = substring(s,2,l)
   repeat 
   s = "" if  c <= ' '
end 


routine  explain
  vtat(16,0);  newline
  printstring(" <carriage-return>: next page       -:               previous page")
  newline
  printstring(" <cursor HOME>:     top of file     <cursor UP>:     up one level")
  newline
  printstring(" <n>:               section <n>     <topic>:         locate <topic>")
  newline
  printstring(" '<topic>':         locate <topic> in text")
  newline
  printstring(" ^Z:                quit program")
  newline
end 

routine  load top index
   !Load the HELP top index from default file. Entries are of form
   !KEYWORD      FILE       ENTRY POINT
   !There must be no leading spaces before KEYWORD and more than one between fields
   !FILE is the appropriate file. If null it is set to equal KEYWORD.
   !ENTRY POINT is the paragraph number (e.g. 1.7.4.5). paragraph numbers of 0
   !are ignored.  Top of file is indicated by a null field. 0 means "search
   !for it".

   routine  load entry(record  (entry fm) name  entry)
      string  (255) line, t, page
      integer  ptr
   
      routine  read field(string  (*) name  field)
         integer  sp, c
         field = ""
         sp = 0
         while  ptr <= length(line) cycle 
            c = charno(line, ptr); ptr = ptr + 1
            if  c = ' ' start 
               exit  if  sp # 0
               sp = 1
            else 
               if  sp # 0 then  field = field." " and  sp = 0
               field = field.tostring(c)
            finish 
         repeat 
         ptr = ptr + 1 while  ptr < length(line) and  charno(line, ptr) = ' '
      end 
   
      readline(line); entry = 0
      if  line -> line.("!").t start ; finish  ;!Anything following a '!' is a comment
      ptr = 1
      read field(entry_key)
      read field(entry_file); entry_file = entry_key if  entry_file = ""
      read field(page)
      if  page # "" start 
         while  page -> t.(".").page cycle 
            ptr = stoi(t)
            entry_path(entry_depth) = ptr
            entry_depth = entry_depth + 1 if  ptr > 0
         repeat 
         ptr = stoi(page)
         entry_path(entry_depth) = ptr
         if  ptr > 0 then  entry_depth = entry_depth + 1 else  entry_depth = -1
      finish 
   end  ;!of load entry (in load top index)

   on  3,9 start 
      select input(1)
      close input
      select input(0)
      return 
   finish 

   open input(1, defaultdir.indexfile); selectinput(1)
   top entries = 0
   cycle 
     load entry(top index(top entries))
     top entries = top entries + 1 unless  top index(top entries)_key = ""
   repeatuntil  top entries = max entries

end  ;!of load top index


routine  TELL JHB(string  (7) type, string  (*) name  topic)
!!   i = fcomm('Q'<<8, "INFO")
!!   open append(1, defaultdir."0failedrefs"); selectoutput(1)
!!   printstring(type."=".topic); newline
!!   close append
!!   selectoutput(0)
!!   i = fcomm('Q'<<8, "")
end  ;!of Tell JHB


routine  INIT
integer  i, nlc, sym
string (255) filename, s, t
  !On entry, PARAM is null or contains a file name. TOPIC is null or contains a
  !Topic. A Null PARAM invokes the help top level index. Topic is prompted for
  !if it wasn't supplied as a parameter.

   routine  display top index
      !Dump the top index.
      integer  i
      nlc = 0; !Note nlc is GLOBAL.
      clear frame; vtat(0, 0)
      printstring("APM Help Information is available on the following topics:")
      spaces(6); printstring("'?' for commands")
      newline
      rule line
   
      for  i = 0, 1, top entries-1 cycle 
        printstring(top index(i)_key)
        if  nlc = 5 then  newline and  nlc = 0 else  spaces(12-length(top index(i)_key)) and  nlc=nlc+1
      repeat 

      status line("Type <carriage-return> if in doubt.",0)
      nlc = 0
   end 

  routine  connect subfiles(integername  ad, len)
     !Take the data from AD, length LEN and scan it for !FILE directives.
     !Perform a direct substitution where we find one (leave the !FILE line)
     !This involves getting new heap space so we do a preliminary scan first
     !and only copy across when we know we have to.   Max 16 inclusions for now.

     string  (255) fn  get filename(integer  a)
        s=""
        a=a+1 while  byteinteger(a)=' '
        cycle 
           s=s.tostring(byteinteger(a))
           a=a+1
        repeatuntil  byteinteger(a) <= ' '
     end 

     integer  i,j
     recordformat  tagf(integer  ad, size, string  (255) name)
     record  (tagf) array  tag(0:15)
     string  (255) f
     return 
     t=0; i=ad
     cycle 
        !Skip till we hit "<return>!FILE"
        if  byteinteger(i  )= 10 and  byteinteger(i+1)='!' and  c 
            byteinteger(i+2)='F' and  byteinteger(i+3)='I' and  c 
            byteinteger(i+3)='L' and  byteinteger(i+4)='E' start 
            !Mark start of next line
            j=i; j=j+1 until  byteinteger(j)=10
            !It should be followed by a valid filename then a space or return
            f = get filename(i+5)
            if  exists(f) start 
               !If so, mark it.
               tag(t)_ad = j+1
               tag(t)_name = f
               tag(t)_size = filesize(f)
               t=t+1
            finish 
            i=j
         else 
            i=i+1
         finish 
      repeatuntil  i>=ad+len
  end 

  on  event  3,9 start 
     -> eof
  finish 

  nlc = 0; top ptr = -1
  !Outer layer entered by UP from top of file or by calling HELP with no parameter
  !or HELP with a filename/topic with no directory: on the front.

  vtat(0,0); clear frame; s = ""
  if  param = "" or  not  param -> s.(":").param or  finished = 2 start 
     !Top level index has been invoked. The index is displayed and a TOPIC read
     !if not supplied already. Force to lower case.

     if  param = "" then  display top index else  topic = param
     timinit = cputime
  
   eof:
!t!  printstring("Trapped on 3 or 9"); newline
     stop("") if  nlc < 0 ;!Ctrl-Z from user
     nlc = -1; top ptr = -1
  
     cycle 
       if  topic = "" start 
          prompt line("Topic:")
          set video mode(screenmode)
          readline(topic)
       finish 
       clean up(topic)
       topic = defaulttopic if  topic = ""
       filename = topic

       !TOPIC = '?'  provokes a brief HELP HELP summary. If topic is still null
       !enter the default HELP file. If it is otherwise not in the top index, 
       !prompt again. If it is in the top index, look up the appropriate FILE
       !and add the default directory to the front if none was specified.
   
       if  topic = "?" then  explain else  start 
          for  top ptr = 0, 1, top entries-1 cycle 
             topkey = top index(top ptr)_key; clean up(topkey)
             if  topic = topkey start 
                filename = top index(top ptr)_file
                filename = defaultdir.filename unless  filename ->s.(":").param
                -> found it if  exists(filename)
             finish 
          repeat 
          top ptr = -1 ;!We'll enter it at the top if at all
          filename = topic
          !He might have specified a file he knows about and we don't
          topic = "" and  -> found userfile if  exists(filename)
          stop("") if  topic = "q" or  topic = " quit"
          status line("Sorry, no information on ".topic,500)
          tell jhb("s", topic)
          display top index if  param # ""
       finish 
       topic = "" ;param = ""
     repeat 
  else 
     !got here by typing HELP dir:filename
     filename = param
     filename = s.":".param if  s # ""
  finish 
found it:
  filename = defaultdir.filename unless  filename -> s.(":").param
found userfile:
  param = filename unless  filename -> s.(defaultdir).param
  !Filename is now the full filename, PARAM is the filename but minus the default
  !Directory name if present, TOPIC is what the user asked for

  unless  filename = currentfile start 
     timscon = cputime
     if  exists(filename) start 
        status line("Reading...",0)
        connect file(filename,0,startad,limad) 
        connect subfiles(startad, limad)
        limad = limad+startad
        currentfile = filename
     else 
        stop("No access to ".filename)
     finish 
     timecon = cputime
  finish 
end 

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
      repeat  until  byteinteger(textad) = '!'
      code = byteinteger(textad+1+header)
      if  code = '>' start ;  !end-of-section
        return  if  p = 0
        p = 0
      elseif  code = '<'
        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  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,size
  ad = dir(id)_address+2
  while  byteinteger(ad) >= ' ' cycle 
    print symbol(byteinteger(ad))
    ad = ad+1;  col = col+1
  repeat 
end 

routine  PRINT LINE
integer  ad,size
  cycle 
    print symbol(byteinteger(textad))
    textad = textad+1
  repeat  until  byteinteger(textad-1) < ' '
  line = line+1;  col = 0
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  byteinteger(textad) = '!' start 
         !JHB ad-hoc convention: !{....} is a comment.
         !Used primarily to embed text formatting directives.
         if  byteinteger(textad+1) = '{' then  skip line else  exit 
      elseif  byteinteger(textad) < ' '
        textad = textad+1;  blanks = blanks+1
      else  
        more = textad and  return  if  line+blanks+1 > maxline
        if  skipping = 0 start 
          newline and  blanks = blanks-1 while  blanks > 0
          print line
        else 
          line = line+blanks+1;  blanks = 0
          skip line
        finish 
      finish 
    repeat 

   !Directive located
    code = byteinteger(textad+1+header)
    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 or  skipping < 0
    id = ident+1
    return  if  dir(id)_parent # ident;  !no subsections
   !Explore  subsections to find number,maxwidth
    d == dir(id)
    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
    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  size,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
    else  if  pagemax # maxpage
      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 

  vtat(0,0);  clear frame
  spaces(10);  col = 10
  if  ident = 0 start ;  !at start of file
    toupper(param)
    print string("HELP Information for ".param)
    spaces(20);printstring("'?' for commands")
  else 
    print title(ident)
    blanks = 59-col-length(param); blanks = 1 if  blanks < 1
    spaces(blanks); printstring("[".param."] ")
    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  SEARCH FOR STRING
   integer  id,i,len=length(topic),flen

   integerfn  MATCHED(integer  ad)
   integer  a,k,lim
     cycle 
       while  byteinteger(ad) <= ' ' cycle 
         result  = 0 if  byteinteger(ad) < ' '
         ad = ad+1
       repeat 
       if  byteinteger(ad)!let = charno(topic,1) start ;  !first char match
         if  len = 1 start ;  !one char -- partial match silly
           result  = 1 if  byteinteger(ad+1) <= ' '
         else 
           a = ad;  k = 1
           cycle 
             a = a+1;  k = k+1
             result  = 1 if  k > len
           repeat  until  byteinteger(a)!let # charno(topic,k)
         finish 
       finish 
       ad = ad+1 until  byteinteger(ad) <= ' '
     repeat 
   end 
   
   
   routine  search text
      integer  from, to

      integerfn  match string(integer  low, high, string  (255) Key)
         label  False, Case Ok, Compare, Next
         integer  Pattern, Len
   
         result  = 0 if  Key = "" or  low > high
         Len = length(key); Pattern = addr(Key) + 1
         !No need to TO LOWER it here *** to lower(key)
         *Move.L Low,     A0
   
      Next:
         *Move.L Pattern, A1
         *Move.L Len,     D0
   
      Compare:
         *Move.B (A0)+,   D1
         *Cmp.B  #'A',    D1
         *Blt             Case Ok
         *Cmp.B  #'Z',    D1
         *Bgt             Case Ok
         *Or.B   #' ',    D1
      Case Ok:
         *Move.B (A1)+,   D2
         *Cmp.B  D1,      D2
         *Bne             False
         *Subq   #1,      D0
         *Bne             Compare
   !      *DBne   D0, Compare
         result  = low
   
      False:
         *Move.L Low,     A0
         *Addi.L #1,      Low
         *Cmp.L  High,    A0
         *Bne             Next
         result  = 0
         
      end 


      found = 1; id = 0
      while  id <= dirmax cycle 
         if  id = dirmax then  to = limad else  to = dir(id+1)_address
         from = dir(id)_address+2; to = to-length(topic)

         cycle 
            foundad(found) = match string(from, to, topic)
            foundid(found) = id
            if  foundad(found) = 0 start  ;!Didn't find anything - try next page
               exit 
            else 
               !found something. Log it and keep looking.
               from = foundad(found)+length(topic)
               found = found + 1
               exit  if  from > to or  found = maxline
            finish 
         repeat 
         id=id+1
         exit  if  found = maxline
      repeat 
      found = (found-1) ! 16_80000000
   end 

      
   routine  print context(integer  id, p)
       string  (2) s
       integer  start, limit, t, u, i
       start = dir(id)_address+2
       if  id = dirmax then  limit = limad else  limit = dir(id+1)_address
       t = p-25
       if  t <= start then  spaces(start-t+2) and  t=start else  c 
       printstring("..")
       u = p+25
       if  u >= limit then  u=limit-1 and  s = "" else  s = ".."
       for  i = t, 1, u cycle 
          if  byteinteger(i) >= ' ' then  printsymbol(byteinteger(i)) c 
          else  printsymbol('/')
       repeat 
       printstring(s)
   end 

   timssrch = cputime
   timesrch = cputime and  return  if  topic = ""
   status line("Searching on "."""".topic."""...",500) unless  topic = "q" or  c 
   topic = "quit"

   found = 0;  id = 1

   if  charno(topic, 1) = '''' start 
      !Don't search titles if he (single) quoted it
      topic = substring(topic, 2, length(topic))
      found = -1 ;!A flag for a few lines down - don't treat like a failure
   else 
      !Scan titles
!t!   vtat(0,0); printstring("Scanning...")
      while  id <= dirmax cycle 
        if  matched(dir(id)_address+2) # 0 start 
           found = found+1;  foundid(found) = id
           exit  if  found = maxline-1
           id = |dir(id)_brother|;  !don't look at descendants too
        finish  else  id = id+1
      repeat 
   finish 

!t!vtat(0,0); printstring("Found "); write(found, 1)
   if  found = 1 start 
     set ident(foundid(1))
   else 
     if  skipping < 0 start 
       skipping = 0
       set ident(0);  print page
     finish 
     if  found <= 0 start  ;!Either the search failed or we never searched.
       if  found = 0 start  ;!Title search failed.
!t!       printstring("Quitted") %and newline %if topic = "q" %or topic = "quit"
          stop("") if  topic = "q" or  topic = "quit"
          status line("No references found for """.topic.c 
          """ - I'll search the text",500)
          tell jhb("t",topic)
       finish 
       search text
       if  found = 0 start 
          status line("No references found for """.topic."""",500)
          topic = ""; timesrch = cputime
          return 
       finish 
     finish 

       clear frame; vtat(23,0)
       if  found&255 = maxline-1 then  printstring(">=") else  spaces(2)
       write(found&255, 3)
       printstring(" match")
       if  found&255 = 1 then  spaces(2) else  printstring("es")
       if  found < 0 start 
          printstring(" in text")
          if  found&255 # 0 start 
             spaces(14)
             for  i = 1,1,length(topic) cycle ; printsymbol('^'); repeat 
          finish 
          clear line
       finish 
       vtat(maxline+1-found&255,0);  newline
       for  i = 1,1,found&255 cycle 
         if  i # maxline-1 start 
           spaces(2); col = 2
           print ident(foundid(i))
           spaces(10-col); col = 10
           if  found >= 0 then  print title(foundid(i)) else  c 
           print context(foundid(i), foundad(i))
         finish  else  print string("   and so on")
         newline
       repeat 
   finish 
   timesrch = cputime
end ;  !SEARCH FOR STRING

routine  READ COMMAND
   ! Read response and adjust IDENT and PAGE for required page
   integer  i,sym
   string  (63) prompt text
   on  event  3,9 start 
     finished = 1
     return 
   finish 

   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
   !Read in an ident of generic form mmmm.nnnn.ppp....      /page
   !Leading mmmm may be omitted.   JHB addition - "0" indicates top of file.
   !First character in SYM
   integer  i,j
     found = 0
     if  sym # '/' start 
       i = 0;  i = ident if  sym = '.'
       cycle 
         read symbol(sym) if  sym = '.'
         read(j)
         exit  if  j = 0
         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 = '/'
     found = 1 if  page > 0
   end 
   
   
   routine  top
     set ident(0)
   end 
   
   routine  up
     !Drop out if he tries to go up past the top
     finished = 2 and  return  if  ident = 0
     set ident(dir(ident)_parent)
   end 
   
   routine  on
     if  more # 0 then  page = page+1 c 
     else  if  ident < dirmax then  set ident(ident+1)
   end 
   
  cycle 
    if  more # 0 then  prompt text = "...more   " c 
    else  if  ident >= dirmax then  prompt text = "End.   " c 
    else  prompt text = ""
    prompt line(prompt text."View:")

    !Get next character typed by user.
    set video mode(screenmode+single+noecho)
    readsymbol(sym) until  sym#' '

    if  sym = '-' or  sym = 'D'+128 start 
      if  page > 1 then  page = page-1 c 
      else  if  ident # 0 then  set ident(ident-1) and  page = 99
      return 

    elseif  sym > 128;  !cursor movement
      up and  return  if  sym = 'A'+128 {up}
      set ident(0) and  return  if  sym = 'H'+128  {back to top}
      if  sym = 'B'+128 or  sym = 'C'+128 start  {down or right}
         on and  return  if  more#0 or  ident < dirmax
         status line("End of text", 0)
      finish 
      explain
      continue 

    elseif  sym < ' ';  !control key
      if  sym = 'z'&31 start   {CTRL+Z}
        finished = 1
        return 
      finish 
      on and  return  if  more#0 or  ident < dirmax
      status line("End of text", 0)
      explain
      continue 

    elseif  sym = '!' {statistics for development purposes}
      status line(itos(timinit-timstrt, 5).itos(timecon-timscon, 5).c 
      itos(timesrch-timssrch, 5), 500)
      while  testsymbol < 0 cycle ; repeat 
      return 

    elseif  '0' <= sym <= '9' or  sym = '.' or  sym = '/'
      read ident
      read symbol(sym) while  sym >= ' '
      return  if  found = 1
      status line(" No such section",0)
      continue 

    elseif  sym = '?'
      explain
      continue 
    finish 

    topic = ""
    cycle 
      topic = topic.tostring(sym)
      readsymbol(sym); exitif  sym<' '
    repeat 
    clean up(topic)

    search for string

    return  if  found = 1
  repeat 

end ;  !READ COMMAND

routine  goto ident(record  (entry fm) name  ent)
   integer  p, j, i
   vtat(23, 0)
   found = 0; i = 0; p = 0
   for  p = 0, 1, ent_depth-1 cycle 
      j = ent_path(p)
      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 
   found = 1
   set ident(i)
end 

!
!Start of VIEW: connect file

on  0,3,9 start 
  set video mode(0)
  newline
  return 
finish 

prompt("")
set video mode(screen mode)
param = defaulttopic if  param = "" and  topic # ""
key = topic; clean up(key)
!t!printstring(key); newline
load top index
cycle 
  init
  dir(0) = 0;  dir(0)_address = startad
  dirmax = 0
  set ident(0)
  found = 1;  finished = 0
  !Create directory
  more = startad
  skipping = -1
  cycle 
     pstart(page) = more
     print content(page)
  repeat  until  more = 0
  topic = key if  key # ""
!t!printstring(topic); newline
  set ident(0)
  if  top ptr >= 0 and  top index(top ptr)_depth >= 0 then  c 
  goto ident(top index(top ptr))
  search for string and  key = "" if  key # ""
  skipping = 0
  cycle 
    print page if  found = 1
    read command
    found = 1
  repeat  until  finished # 0
  topic = ""; param = ""
  status line("",0)
repeat  until  finished = 1

end ;  !VIEW

begin 

string (255) file,topic,junk
  timstrt = cputime; timscon = 0; timecon = 0; timssrch = 0; timesrch = 0
  file = cliparam
  unless  file -> junk.("-d=").defaultdir and  defaultdir -> defaultdir.(" ").file c 
  start ; finish 
  unless  file -> junk.("-t=").defaulttopic and  defaulttopic -> defaulttopic.(" ").file c 
  start ; finish 
  topic = "" unless  file -> file.(",").topic
  view(file,topic)
endofprogram