home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intel86b / help.p86 next >
Text File  |  2020-01-01  |  25KB  |  619 lines

  1. $large
  2.  
  3. help: do;
  4.  
  5. /*
  6.  *              HELP Utility Program
  7.  *  by Albert J. Goodman;  Edit date:  30-July-85
  8.  *
  9.  *  Gives help on a topic specified on the command line.  The
  10.  *  format of the command line is one or more keywords (separated
  11.  *  by one or more spaces and/or tabs), where each keyword after
  12.  *  the first is treated as a subtopic of topic specified by the
  13.  *  preceeding keyword(s).  Topic keywords may be abbreviated by any
  14.  *  amount; if an abbreviation is given which matches the beginning
  15.  *  of more than one topic in the help library file, the first matching
  16.  *  topic will be displayed.  If the first keyword begins with an
  17.  *  at-sign (@) the remainder of it is assumed to be the complete
  18.  *  pathname of the help library to be used for the source of the
  19.  *  help information.  If the command line does not begin with an
  20.  *  at-sign, the default help library will be used, which has the
  21.  *  same name (presumably HELP) and directory as this program with
  22.  *  the extension ".HLP".  The information required to create a
  23.  *  help library file is given below:
  24.  *
  25.  *  A help library is conceptually a tree structure, with a root
  26.  *  help message and a list of subtopics, and similarly a help
  27.  *  message and a list of sub-subtopics for each of the subtopics,
  28.  *  and so on.  The structure of a help library file is defined by
  29.  *  control lines beginning with a delimiter character (which may
  30.  *  nevertheless be used freely within help text if not at the
  31.  *  beginning of a line).  Each help file has its own delimiter
  32.  *  character (which may be any character desired, but should not
  33.  *  be a digit because it's used to delimit numbers), defined by the
  34.  *  first character of the file.  The remainder of the first line
  35.  *  of the file is ignored (thus it may be used for identification
  36.  *  of author, date, or other comments).  Normal control lines each
  37.  *  begin with the delmiter, followed by a (decimal) number indicating
  38.  *  the nesting level of the help which follows this control line,
  39.  *  followed by the delimiter again to mark the end of the number.
  40.  *  A nesting level of one means a subtopic of the root; in other words,
  41.  *  the nesting level is the position of the associated keyword in a
  42.  *  command line (which may range from 1 to MAX$KEYWORDS minus one).
  43.  *  The rest of the control line contains the (sub)topic keyword for that
  44.  *  level which identifies the help text which follows this control line.
  45.  *  Thus the file begins with the delimiter on a line the rest of which
  46.  *  is ignored; following that comes zero or more lines of root help
  47.  *  text, terminated by the next line beginning with the delimiter; this
  48.  *  should contain the first subtopic keyword and a nesting level of
  49.  *  one.  All sub-subtopic control lines are taken to be subtopics of
  50.  *  the most recent previous control line with a nesting level one
  51.  *  lower than theirs.  Finally, the last help text in the file (for
  52.  *  the deepest nested help under the last keyword at each level above
  53.  *  it) must be terminated by a special control line consisting of the
  54.  *  delimiter followed by the word END (in upper or lower case) followed
  55.  *  by a final occurrence of the delimter.  This marks the end of the help
  56.  *  library file as far as the HELP program is concerned:  anything in
  57.  *  the file after this control line will be ignored, and if the physical
  58.  *  end-of-file is encountered before this control line an error message
  59.  *  will be generated.  Also, the HELP program will indent all help text
  60.  *  by an amount determined by its nesting level, so there is no need for
  61.  *  indentation in the help library file.  Similarly, blank lines between
  62.  *  the control lines and the help text are supplied and thus need not be
  63.  *  in the file.
  64.  */
  65.  
  66.  
  67. /* Get the needed iRMX 86 system call external declarations */
  68. $include(:I:NEXCEP.LIT)
  69. $include(:I:LTKSEL.LIT)
  70. $include(:I:IEXIOJ.EXT)
  71. $include(:I:NSTEXH.EXT)
  72. $include(:I:HGTIPN.EXT)
  73. $include(:I:HGTICN.EXT)
  74. $include(:I:ISRDMV.EXT)
  75. $include(:I:HSNCOR.EXT)
  76. $include(:I:HFMTEX.EXT)
  77. $include(:I:HGTCHR.EXT)
  78. $include(:I:HGTCMD.EXT)
  79.  
  80. declare
  81.         MAX$KEYWORDS    literally   '9',    /* Maximum topic keywords + 1 */
  82.         MAX$KEYWORD$LEN literally   '23',   /* Maximum length of a keyword */
  83.         boolean         literally   'byte', /* Another useful type */
  84.         TRUE            literally   '0FFh', /* Boolean constant */
  85.         FALSE           literally   '000h', /* ditto */
  86.         CR              literally   '0Dh',  /* ASCII Carriage-return */
  87.         LF              literally   '0Ah',  /* ASCII Line-feed character */
  88.         HT              literally   '09h',  /* ASCII tab character */
  89.         status          word,   /* Used for every system call */
  90.         file$token      token,  /* Connection to the help library file */
  91.         delim           byte,   /* Special delimiter character in help file */
  92.         level           byte,   /* Current nesting level being scanned for */
  93.         char            byte,   /* Current character being scanned */
  94.         ( i, j )        byte,   /* General-purpose array index or counters */
  95.         finished        boolean,    /* Whether finished giving help */
  96.         file$name       structure(  /* Buffer for help library file name */
  97.                             len         byte,
  98.                             ch( 50 )    byte),
  99.         num$keywords    byte,   /* Number of keywords in KEYWORD buffer */
  100.         keyword( MAX$KEYWORDS ) structure(  /* Buffer for topic keywords */
  101.                             len                     byte,
  102.                             ch( MAX$KEYWORD$LEN )   byte),
  103.         line$buffer     structure(  /* General-purpose line buffer */
  104.                             len         byte,
  105.                             ch( 80 )    byte);
  106.  
  107.  
  108. /*
  109.  *
  110.  *      System-dependent utility procedures.
  111.  *
  112.  */
  113.  
  114.  
  115. print: procedure( string$ptr );
  116.  
  117.     /*
  118.      *  Print a string (length byte followed by that many
  119.      *  characters) on the console.
  120.      */
  121.  
  122.     declare
  123.         string$ptr  pointer;
  124.  
  125.     call rq$c$send$co$response( 0, 0, string$ptr, @status );
  126.  
  127. end print;
  128.  
  129.  
  130. new$line: procedure;
  131.  
  132.     /*
  133.      *  Get the cursor to a new line (i.e. print CR/LF).
  134.      */
  135.  
  136.     call print( @( 2,CR,LF ) );
  137.  
  138. end new$line;
  139.  
  140.  
  141. print$char: procedure( char );
  142.  
  143.     /*
  144.      *  Print a single character (since PRINT only prints a string).
  145.      */
  146.  
  147.     declare
  148.         char    byte,
  149.         string  structure(
  150.                     len     byte,
  151.                     ch      byte);
  152.  
  153.     string.len = 1;     /* Form a one-character string */
  154.     string.ch = char;
  155.     call print( @string );  /* and print it */
  156.  
  157. end print$char;
  158.  
  159.  
  160. abort$program: procedure( error$msg$ptr, file$name$ptr );
  161.  
  162.     /*
  163.      *  Abort the program, displaying the error message pointed to
  164.      *  by ERROR$MSG$PTR, followed by the string pointed to by
  165.      *  FILE$NAME$PTR in quotes, followed by " -- HELP aborted."
  166.      *  If FILE$NAME$PTR is zero then it is skipped (including the
  167.      *  quotes), and if ERROR$MSG$PTR is zero no message is displayed.
  168.      */
  169.  
  170.     declare
  171.         ( error$msg$ptr, file$name$ptr )    pointer;
  172.  
  173.     if ( error$msg$ptr <> 0 ) then  /* If we have an error message */
  174.       do;
  175.         call print( error$msg$ptr );    /* Print error message */
  176.         if ( file$name$ptr <> 0 ) then  /* we have a filename also */
  177.           do;
  178.             call print( @( 2,' "' ) );  /* open quote */
  179.             call print( file$name$ptr );    /* the filename */
  180.             call print$char( '"' );     /* close quote */
  181.           end;
  182.         call print( @( 17,' -- HELP aborted.' ) );
  183.       end;  /* if ( error$msg$ptr <> 0 ) */
  184.     call new$line;  /* Get to a new line to tidy up display */
  185.     call rq$exit$io$job( 0, 0, @status );   /* And exit the program */
  186.  
  187. end abort$program;
  188.  
  189.  
  190. check$status: procedure;
  191.  
  192.     /*
  193.      *  Check the exception code returned by a system call to the global
  194.      *  variable STATUS.  If it is not E$OK, display the exception code
  195.      *  and mnemonic at the console and abort the program.
  196.      */
  197.  
  198.     if ( status <> E$OK ) then
  199.       do;   /* Handle an exceptional condition */
  200.         /* Get the exception code and mnemonic into the line buffer */
  201.         line$buffer.len = 0;    /* Init to null string */
  202.         call rq$c$format$exception( @line$buffer, size( line$buffer ),
  203.                                         status, 1, @status );
  204.         /* Display the error message and abort the program */
  205.         call abort$program( @line$buffer, 0 );
  206.       end;  /* if ( status <> E$OK ) */
  207.  
  208. end check$status;
  209.  
  210.  
  211. disable$exception$handler: procedure;
  212.  
  213.     /*
  214.      *  Disable the default exception handler, to prevent it from gaining
  215.      *  control and aborting the program as soon as any exception occurs.
  216.      */
  217.  
  218.     declare
  219.         exception$handler$info  structure(
  220.                                     offset  word,
  221.                                     base    word,
  222.                                     mode    byte);
  223.  
  224.     exception$handler$info.offset = 0;
  225.     exception$handler$info.base = 0;
  226.     exception$handler$info.mode = 0;    /* Never pass control to EH */
  227.     call rq$set$exception$handler( @exception$handler$info, @status );
  228.     call check$status;
  229.  
  230. end disable$exception$handler;
  231.  
  232.  
  233. open$file: procedure( name$ptr ) boolean;
  234.  
  235.     /*
  236.      *  Open the file specified in the string (length byte followed
  237.      *  by the characters of the name) pointed to by NAME$PTR, which is
  238.      *  assumed to already exist, for reading.  Sets the global FILE$TOKEN.
  239.      *  Returns TRUE if the open was successful, otherwise it prints
  240.      *  an error message on the console describing the problem
  241.      *  encountered and returns FALSE.
  242.      */
  243.  
  244.     declare
  245.         name$ptr    pointer;
  246.  
  247.     /* Try to open the file */
  248.     file$token = rq$c$get$input$connection( name$ptr, @status );
  249.     if ( status = E$OK ) then   /* we were successful */
  250.         return( TRUE );
  251.     else    /* the operation failed */
  252.         return( FALSE );    /* an error message has already been displayed */
  253.  
  254. end open$file;
  255.  
  256.  
  257. read$char: procedure byte;
  258.  
  259.     /*
  260.      *  Return the next character from the file specified by the global
  261.      *  token FILE$TOKEN (which must be open for reading).
  262.      *  If end-of-file is encountered, it aborts the program with an
  263.      *  error message.
  264.      */
  265.  
  266.     declare
  267.         bytes$read              word,
  268.         ch                      byte;
  269.  
  270.     /* Read the next byte from the file */
  271.     bytes$read = rq$s$read$move( file$token, @ch, 1, @status );
  272.     call check$status;
  273.     if ( bytes$read = 0 ) then  /* we ran into end-of-file */
  274.         call abort$program( @( 25,'Unexpected end-of-file in' ), @file$name );
  275.     else    /* we got a character */
  276.         return( ch );       /* so return it */
  277.  
  278. end read$char;
  279.  
  280.  
  281. upcase: procedure( x ) byte;
  282.  
  283.     /*
  284.      *  Force an ASCII letter to upper-case;
  285.      *  a non-letter is returned unchanged.
  286.      */
  287.  
  288.     declare
  289.         x   byte;
  290.  
  291.     if ( ( x >= 'a' ) and ( x <= 'z' ) ) then   /* it was lower-case */
  292.         return( x - 'a' + 'A' );    /* return the upper-case equivalent */
  293.     else    /* it was anything else */
  294.         return( x );    /* just return it unchanged */
  295.  
  296. end upcase;
  297.  
  298.  
  299. read$number: procedure byte;
  300.  
  301.     /*
  302.      *  Read a number from the file, terminated by the delimiter.
  303.      *  If the characters up to the next delimiter do not form an
  304.      *  integer (i.e. contain a non-digit--other than the word END--
  305.      *  or contain no characters at all), abort with an appropriate
  306.      *  error message; otherwise, return the value of the number.
  307.      *  The file pointer is left after the terminating delimiter.
  308.      *  If the "number" consists of the word END, zero is returned.
  309.      *  (Otherwise the number is in base 10.)  If the number has
  310.      *  more than 8 characters it will be truncated.
  311.      */
  312.  
  313.     declare
  314.         num     byte,
  315.         i       byte,
  316.         string  structure(
  317.                     len     byte,
  318.                     ch( 8 ) byte);
  319.  
  320.     string.len = 0;
  321.     string.ch( string.len ) = read$char;    /* Read first char of number */
  322.     do while ( string.ch( string.len ) <> delim );  /* Read rest of number */
  323.         if ( string.len < last( string.ch ) ) then  /* room for more digits */
  324.             string.len = ( string.len + 1 );    /* move to next digit */
  325.         string.ch( string.len ) = read$char;    /* Read next character */
  326.     end;    /* do while ( string.ch( string.len ) <> delim ) */
  327.     num = 0;    /* Init number to zero */
  328.     if ( string.len = 0 ) then  /* we got nothing at all */
  329.         call abort$program( @( 17,'Missing number in' ), @file$name );
  330.     else if ( ( string.len <> 3 ) or
  331.                 ( upcase( string.ch( 0 ) ) <> 'E' ) or
  332.                 ( upcase( string.ch( 1 ) ) <> 'N' ) or
  333.                 ( upcase( string.ch( 2 ) ) <> 'D' ) ) then  /* it's not END */
  334.         do i = 0 to ( string.len - 1 );     /* for each digit */
  335.             if ( ( string.ch( i ) < '0' ) or ( string.ch( i ) > '9' ) ) then
  336.               do;   /* Handle error of non-digit */
  337.                 call print( @( 16,'Invalid number "' ) );
  338.                 call print( @string );  /* show what we got */
  339.                 call abort$program( @( 4,'" in' ), @file$name );
  340.               end;  /* if ... -- it's not a digit */
  341.             /* Combine this digit into the number */
  342.             num = ( ( num * 10 ) + ( string.ch( i ) - '0' ) );
  343.         end;    /* do i = 0 to ( string.len - 1 ) */
  344.     return( num );      /* Return the number we got (zero if it was END) */
  345.  
  346. end read$number;
  347.  
  348.  
  349. read$line: procedure;
  350.  
  351.     /*
  352.      *  Read the current line from the file into the global LINE$BUFFER
  353.      *  up to the next LF (line-feed) character.
  354.      */
  355.  
  356.     declare
  357.         ch      byte;
  358.  
  359.     line$buffer.len = 0;
  360.     line$buffer.ch( line$buffer.len ) = read$char;  /* Read first char */
  361.     do while ( line$buffer.ch( line$buffer.len ) <> LF );
  362.         if ( line$buffer.len < last( line$buffer.ch ) ) then
  363.             line$buffer.len = ( line$buffer.len + 1 );  /* Bump len if room */
  364.         line$buffer.ch( line$buffer.len ) = read$char;  /* Read next char */
  365.     end;    /* do while ( line$buffer.ch( line$buffer.len ) <> LF ) */
  366.     line$buffer.len = ( line$buffer.len + 1 );  /* Count final char (LF) */
  367.  
  368. end read$line;
  369.  
  370.  
  371. skip$text: procedure;
  372.  
  373.     /*
  374.      *  Skip a single help text entry.  That is, read and discard lines
  375.      *  from the file until reaching a line which begins with DELIM.
  376.      *  The file pointer will be left just after this character, i.e.
  377.      *  the second character of the control line.  If the first character
  378.      *  read at the current position is DELIM, only that character will
  379.      *  be read (i.e. it is assumed that we are at the beginning of a
  380.      *  line now).
  381.      */
  382.  
  383.     declare
  384.         ch      byte;
  385.  
  386.     ch = read$char;     /* Get first character of this line */
  387.     do while ( ch <> delim );   /* As long as it's not a control line */
  388.         call read$line;     /* Skip that line */
  389.         ch = read$char;     /* And check on the next one */
  390.     end;    /* do while ( ch <> delim ) */
  391.  
  392. end skip$text;
  393.  
  394.  
  395. keyword$match: procedure( knum ) boolean;
  396.  
  397.     /*
  398.      *  Compare KEYWORD( KNUM ) with the contents of LINE$BUFFER.
  399.      *  Return TRUE if they match (the keyword may be an abbreviation
  400.      *  of LINE$BUFFER), FALSE otherwise.
  401.      */
  402.  
  403.     declare
  404.         ( knum, i ) byte;
  405.  
  406.     i = 0;
  407.     do while ( ( i < keyword( knum ).len ) and
  408.                 ( i < line$buffer.len ) and
  409.                 ( line$buffer.ch( i ) <> CR ) );
  410.         if keyword( knum ).ch( i ) <> upcase( line$buffer.ch( i ) ) then
  411.             return( FALSE );    /* Don't match */
  412.         i = ( i + 1 );  /* check next character */
  413.     end;    /* do while ... */
  414.     if ( i < keyword( knum ).len ) then     /* keyword too long */
  415.         return( FALSE );
  416.     else    /* It matches */
  417.         return( TRUE );
  418.  
  419. end keyword$match;
  420.  
  421.  
  422. print$spaces: procedure( num );
  423.  
  424.     /*
  425.      *  Print NUM spaces (i.e. indent by that many characters).
  426.      *  NUM must be no more than 20 unless the length of SPACES
  427.      *  (below) is increased.
  428.      */
  429.  
  430.     declare
  431.         num         byte,
  432.         spaces(*)   byte data( 20,'                    ' ),
  433.         count       byte at ( @spaces );
  434.  
  435.     count = num;    /* Set the length to be printed this time */
  436.     call print( @spaces );  /* Print COUNT spaces */
  437.  
  438. end print$spaces;
  439.  
  440.  
  441. show$line: procedure( level, char, line$ptr );
  442.  
  443.     /*
  444.      *  Display the string pointed to by LINE$PTR, preceeded by the
  445.      *  character CHAR, indented appropriately for LEVEL of nesting.
  446.      */
  447.  
  448.     declare
  449.         ( level, char ) byte,
  450.         line$ptr        pointer;
  451.  
  452.     call print$spaces( 2 * level ); /* Indent two spaces per level */
  453.     if ( char <> 0 ) then   /* if we got a leading charcter */
  454.         call print$char( char );    /* Display it */
  455.     call print( line$ptr ); /* And print the line */
  456.  
  457. end show$line;
  458.  
  459.  
  460. /*
  461.  *
  462.  *      Main program -- HELP
  463.  *
  464.  */
  465.  
  466.  
  467. call new$line;  /* Leave a blank line */
  468. call disable$exception$handler;
  469.  
  470. /* Parse the command line */
  471. char = ' ';     /* Insure at least one pass through the WHILE loop: */
  472. do while ( char = ' ' );    /* Until we get the first non-space */
  473.     char = rq$c$get$char( @status );    /* Get next char from command line */
  474.     call check$status;
  475. end;    /* do while ( char = ' ' ) */
  476. if ( char = '@' ) then      /* We have a help library filespec */
  477.   do;   /* Get the filespec into the filename buffer */
  478.     call rq$c$get$input$path$name( @file$name, size( file$name ), @status );
  479.     call check$status;
  480.     if ( file$name.len = 0 ) then   /* no pathname there */
  481.         call abort$program( @( 34,'No help library pathname follows @' ), 0 );
  482.     char = rq$c$get$char( @status );    /* And get next character */
  483.     call check$status;
  484.   end;  /* if ( char = '@' ) */
  485. else    /* No at-sign, so use default help library */
  486.   do;   /* Get its name into the filename buffer */
  487.     /* Get the name of the file containing this program */
  488.     call rq$c$get$command$name( @file$name, size( file$name ), @status );
  489.     call check$status;
  490.     /* Append the .HLP suffix to it, forming the name of the help library */
  491.     call movb( @( '.HLP' ), @file$name.ch( filename.len ), 4 );
  492.     file$name.len = ( file$name.len + 4 );
  493.   end;  /* else -- no at-sign */
  494. if ( open$file( @file$name ) ) then   /* Open the help library file */
  495.   do;   /* Successfully opened, so parse rest of command line and give help */
  496.     i = 0;  /* Start with the first keyword */
  497.     keyword( i ).len = 0;   /* Init first keyword to null */
  498.     do while ( ( char <> 0 ) and ( char <> CR ) );  /* until end of line */
  499.         if ( ( char = HT ) or ( char = ' ' ) ) then /* it's a space or tab */
  500.           do;
  501.             if ( keyword( i ).len > 0 ) then    /* end of this keyword */
  502.               do;
  503.                 if ( i < last( keyword ) ) then
  504.                     i = ( i + 1 );      /* Move to next keyword */
  505.                 keyword( i ).len = 0;   /* and init it to null */
  506.               end;  /* if ( keyword( i ).len > 0 ) */
  507.             /* else ignore redundant space or tab */
  508.           end;  /* if ( ( char = HT ) or ( char = ' ' ) ) */
  509.         else    /* non-space and non-tab character */
  510.           do;
  511.             if ( keyword( i ).len < size( keyword.ch ) ) then
  512.               do;
  513.                 /* Store character of keyword, capitalized */
  514.                 keyword( i ).ch( keyword( i ).len ) = upcase( char );
  515.                 keyword( i ).len = ( keyword( i ).len + 1 );
  516.               end;  /* if ( keyword( i ).len < size( keyword.ch ) ) */
  517.           end;  /* else -- non-space and non-tab character */
  518.         char = rq$c$get$char( @status );    /* Get the next character */
  519.     end;    /* do while ( ( char <> 0 ) and ( char <> CR ) ) */
  520.     if ( ( keyword( i ).len > 0 ) and ( i < last( keyword ) ) ) then
  521.         i = ( i + 1 );      /* Count final keyword */
  522.     num$keywords = i;   /* Save number of keywords we got */
  523.  
  524.     /* Begin reading help library file */
  525.     char = read$char;   /* Get first character of file (special delimiter) */
  526.     delim = char;   /* Save special delimiter for this file */
  527.     call read$line; /* Discard the rest of the first line */
  528.     level = 1;      /* Init level number we're looking for */
  529.     finished = FALSE;   /* not finished yet */
  530.     do while ( not finished );      /* until we're finished giving help */
  531.         if ( num$keywords >= level ) then   /* got a keyword for this level */
  532.           do;
  533.             call skip$text;     /* Skip previous entry */
  534.             i = read$number;    /* Get nesting level for next entry */
  535.             call read$line;     /* And read its keyword */
  536.             if ( i < level ) then   /* found an entry at a lower level */
  537.               do;
  538.                 call show$line( level, 0,
  539.                             @( 28,'Sorry, no help available on' ) );
  540.                 do i = 0 to ( level - 1 );
  541.                     call print$char( ' ' );
  542.                     call print( @keyword( i ) );
  543.                 end;    /* do i = 0 to ( level - 1 ) */
  544.                 call new$line;
  545.                 finished = TRUE;    /* No more help to give on this topic */
  546.               end;  /* if ( i < level ) */
  547.             else if ( i = level ) then  /* found entry for level we want */
  548.               do;
  549.                 if keyword$match( level - 1 ) then  /* keyword matches */
  550.                   do;   /* Show matching keyword */
  551.                     call show$line( level, 0, @line$buffer );
  552.                     call new$line;      /* And leave a blank line */
  553.                     level = ( level + 1 );  /* And go to next lower level */
  554.                   end;  /* if keyword$match( level - 1 ) */
  555.               end;  /* if ( i = level ) */
  556.           end;  /* if ( num$keywords >= level ) */
  557.         else if ( num$keywords = ( level - 1 ) ) then
  558.           do;   /* Display selected help text */
  559.             char = read$char;   /* Get first char */
  560.             do while ( char <> delim ); /* Until next control line */
  561.                 call read$line; /* Read the rest of this line of text */
  562.                 call show$line( level, char, @line$buffer );    /* show it */
  563.                 char = read$char;   /* Read first char of next line */
  564.             end;    /* do while ( char <> delim ) */
  565.             i = read$number;    /* Get level of next entry */
  566.             if ( i < level ) then   /* not a subtopic of selected entry */
  567.                 finished = TRUE;    /* no subtopics, so nothing more to do */
  568.             else    /* we have subtopic(s) to list */
  569.               do;
  570.                 call new$line;  /* Leave a blank line */
  571.                 call show$line( level, 0,
  572.                             @( 28,'Further help available on:',CR,LF ) );
  573.                 call new$line;  /* And leave another blank line */
  574.                 level = ( level + 1 );  /* Set level to list subtopics */
  575.                 call read$line; /* Read first subtopic keyword */
  576.                 line$buffer.len = ( line$buffer.len - 2 );  /* Remove CR/LF */
  577.                 j = line$buffer.len;    /* Save chars so far on this line */
  578.                 call show$line( level, 0, @line$buffer ); /* show keyword */
  579.               end;  /* else -- we have to list subtopics */
  580.           end;  /* if ( num$keywords = ( level - 1 ) ) */
  581.         else    /* we must be listing subtopics */
  582.           do;
  583.             call skip$text;     /* Skip previous entry */
  584.             i = read$number;    /* Get nesting level for next entry */
  585.             call read$line;     /* Read its keyword */
  586.             line$buffer.len = ( line$buffer.len - 2 );  /* And remove CR/LF */
  587.             if ( i < ( level - 1 ) ) then   /* found entry at a lower level */
  588.               do;   /* So no more subtopics of selected entry */
  589.                 call new$line;  /* Finish last line of list */
  590.                 finished = TRUE;    /* And we're all done */
  591.               end;  /* if ( i < ( level - 1 ) ) */
  592.             else if ( i = ( level - 1 ) ) then  /* found right level entry */
  593.               do;   /* Show another subtopic keyword */
  594.                 if ( j > 60 ) then  /* time to start a new line (60=4*15) */
  595.                   do;
  596.                     call new$line;
  597.                     call show$line( level, 0, @line$buffer );
  598.                     j = line$buffer.len;    /* Count chars on this line */
  599.                   end;  /* if ( j > 48 ) */
  600.                 else    /* Make another entry on this line */
  601.                   do;
  602.                     call print$spaces( 15 - ( j mod 15 ) ); /* align columns */
  603.                     j = ( j + ( 15 - ( j mod 15 ) ) + line$buffer.len );
  604.                     call print( @line$buffer );
  605.                   end;  /* else -- continue this line */
  606.               end;  /* if ( i = ( level - 1 ) ) */
  607.           end;  /* else -- listing subtopics */
  608.     end;    /* do while ( not finished ) */
  609.     /* Finished giving help on the selected topic */
  610.   end;  /* if ( open$file( @file$name ) ) */
  611. else    /* Error occurred when opening file, abort with message. */
  612.     call abort$program( @( 30,'Can''t access help library file' ),
  613.                                             @file$name );
  614.  
  615. call abort$program( 0, 0 );     /* Exit with no error message */
  616.  
  617. end help;
  618.  
  619.