!****************************************************************
!*                                                              *
!*     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