!!!!! Simple emulation of EMAS VIEW for VAX/VMS and APM !!!!! !!!!!!!!! Hamish Dewar April 1983 !!!!!!!!! ! Modified JHB 1984, Oct 1986 (-t and -d parameters) ! Modified RWT June 1987 (rearranged to make available as external for SM) ! only basic facilities implemented ! uses VMS/APM text file: index generated on fly ! !Parameters are [-d=][-t=][][,] ! !1) # null: If 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 if # null. !2) = null # null: is assumed to refer to DEFAULTFILE ! and topic is searched for as in 1) !3) = null = null: HELP displays a menu and prompts user. !If -d is specified the default directory (VIEW:) will be replaced by . !If -t is specified the default topic ("APM") will be replaced by . %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(" : next page -: previous page") newline printstring(" : top of file : up one level") newline printstring(" : section : locate ") newline printstring(" '': locate 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 if in doubt.",0) nlc = 0 %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) 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 %exit %if byteinteger(textad) = '!' %if byteinteger(textad) < ' ' %start 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