home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
intel86.tar.gz
/
intel86.tar
/
help.p86
next >
Wrap
Text File
|
1986-06-06
|
25KB
|
608 lines
$large
help: do;
/*
* HELP Utility Program
* by Albert J. Goodman; Edit date: 6-June-85
*
* Gives help on a topic specified on the command line. The
* format of the command line is one or more keywords (separated
* by one or more spaces and/or tabs), where each keyword after
* the first is treated as a subtopic of topic specified by the
* preceeding keyword(s). Topic keywords may be abbreviated by any
* amount; if an abbreviation is given which matches the beginning
* of more than one topic in the help library file, the first matching
* topic will be displayed. If the first keyword begins with an
* at-sign (@) the remainder of it is assumed to be the complete
* pathname of the help library to be used for the source of the
* help information. If the command line does not begin with an
* at-sign, the default help library will be used, which has the
* same name (presumably HELP) and directory as this program with
* the extension ".HLP". The information required to create a
* help library file is given below:
*
* A help library is conceptually a tree structure, with a root
* help message and a list of subtopics, and similarly a help
* message and a list of sub-subtopics for each of the subtopics,
* and so on. The structure of a help library file is defined by
* control lines beginning with a delimiter character (which may
* nevertheless be used freely within help text if not at the
* beginning of a line). Each help file has its own delimiter
* character (which may be any character desired, but should not
* be a digit because it's used to delimit numbers), defined by the
* first character of the file. The remainder of the first line
* of the file is ignored (thus it may be used for identification
* of author, date, or other comments). Normal control lines each
* begin with the delmiter, followed by a (decimal) number indicating
* the nesting level of the help which follows this control line,
* followed by the delimiter again to mark the end of the number.
* A nesting level of one means a subtopic of the root; in other words,
* the nesting level is the position of the associated keyword in a
* command line (which may range from 1 to MAX$KEYWORDS minus one).
* The rest of the control line contains the (sub)topic keyword for that
* level which identifies the help text which follows this control line.
* Thus the file begins with the delimiter on a line the rest of which
* is ignored; following that comes zero or more lines of root help
* text, terminated by the next line beginning with the delimiter; this
* should contain the first subtopic keyword and a nesting level of
* one. All sub-subtopic control lines are taken to be subtopics of
* the most recent previous control line with a nesting level one
* lower than theirs. Finally, the last help text in the file (for
* the deepest nested help under the last keyword at each level above
* it) must be terminated by a special control line consisting of the
* delimiter followed by the word END (in upper or lower case) followed
* by a final occurrence of the delimter. This marks the end of the help
* library file as far as the HELP program is concerned: anything in
* the file after this control line will be ignored, and if the physical
* end-of-file is encountered before this control line an error message
* will be generated. Also, the HELP program will indent all help text
* by an amount determined by its nesting level, so there is no need for
* indentation in the help library file. Similarly, blank lines between
* the control lines and the help text are supplied and thus need not be
* in the file.
*/
/* Get all iRMX 86 system call external declarations */
$include(:I:RMX.EXT)
declare
MAX$KEYWORDS literally '9', /* Maximum topic keywords + 1 */
MAX$KEYWORD$LEN literally '23', /* Maximum length of a keyword */
boolean literally 'byte', /* Another useful type */
TRUE literally '0FFh', /* Boolean constant */
FALSE literally '000h', /* ditto */
CR literally '0Dh', /* ASCII Carriage-return */
LF literally '0Ah', /* ASCII Line-feed character */
HT literally '09h', /* ASCII tab character */
status word, /* Used for every system call */
file$token token, /* Connection to the help library file */
delim byte, /* Special delimiter character in help file */
level byte, /* Current nesting level being scanned for */
char byte, /* Current character being scanned */
( i, j ) byte, /* General-purpose array index or counters */
finished boolean, /* Whether finished giving help */
file$name structure( /* Buffer for help library file name */
len byte,
ch( 50 ) byte),
num$keywords byte, /* Number of keywords in KEYWORD buffer */
keyword( MAX$KEYWORDS ) structure( /* Buffer for topic keywords */
len byte,
ch( MAX$KEYWORD$LEN ) byte),
line$buffer structure( /* General-purpose line buffer */
len byte,
ch( 80 ) byte);
/*
*
* System-dependent utility procedures.
*
*/
print: procedure( string$ptr );
/*
* Print a string (length byte followed by that many
* characters) on the console.
*/
declare
string$ptr pointer;
call rq$c$send$co$response( 0, 0, string$ptr, @status );
end print;
new$line: procedure;
/*
* Get the cursor to a new line (i.e. print CR/LF).
*/
call print( @( 2,CR,LF ) );
end new$line;
print$char: procedure( char );
/*
* Print a single character (since PRINT only prints a string).
*/
declare
char byte,
string structure(
len byte,
ch byte);
string.len = 1; /* Form a one-character string */
string.ch = char;
call print( @string ); /* and print it */
end print$char;
abort$program: procedure( error$msg$ptr, file$name$ptr );
/*
* Abort the program, displaying the error message pointed to
* by ERROR$MSG$PTR, followed by the string pointed to by
* FILE$NAME$PTR in quotes, followed by " -- HELP aborted."
* If FILE$NAME$PTR is zero then it is skipped (including the
* quotes), and if ERROR$MSG$PTR is zero no message is displayed.
*/
declare
( error$msg$ptr, file$name$ptr ) pointer;
if ( error$msg$ptr <> 0 ) then /* If we have an error message */
do;
call print( error$msg$ptr ); /* Print error message */
if ( file$name$ptr <> 0 ) then /* we have a filename also */
do;
call print( @( 2,' "' ) ); /* open quote */
call print( file$name$ptr ); /* the filename */
call print$char( '"' ); /* close quote */
end;
call print( @( 17,' -- HELP aborted.' ) );
end; /* if ( error$msg$ptr <> 0 ) */
call new$line; /* Get to a new line to tidy up display */
call rq$exit$io$job( 0, 0, @status ); /* And exit the program */
end abort$program;
check$status: procedure;
/*
* Check the exception code returned by a system call to the global
* variable STATUS. If it is not E$OK, display the exception code
* and mnemonic at the console and abort the program.
*/
if ( status <> E$OK ) then
do; /* Handle an exceptional condition */
/* Get the exception code and mnemonic into the line buffer */
line$buffer.len = 0; /* Init to null string */
call rq$c$format$exception( @line$buffer, size( line$buffer ),
status, 1, @status );
/* Display the error message and abort the program */
call abort$program( @line$buffer, 0 );
end; /* if ( status <> E$OK ) */
end check$status;
disable$exception$handler: procedure;
/*
* Disable the default exception handler, to prevent it from gaining
* control and aborting the program as soon as any exception occurs.
*/
declare
exception$handler$info structure(
offset word,
base word,
mode byte);
exception$handler$info.offset = 0;
exception$handler$info.base = 0;
exception$handler$info.mode = 0; /* Never pass control to EH */
call rq$set$exception$handler( @exception$handler$info, @status );
call check$status;
end disable$exception$handler;
open$file: procedure( name$ptr ) boolean;
/*
* Open the file specified in the string (length byte followed
* by the characters of the name) pointed to by NAME$PTR, which is
* assumed to already exist, for reading. Sets the global FILE$TOKEN.
* Returns TRUE if the open was successful, otherwise it prints
* an error message on the console describing the problem
* encountered and returns FALSE.
*/
declare
name$ptr pointer;
/* Try to open the file */
file$token = rq$c$get$input$connection( name$ptr, @status );
if ( status = E$OK ) then /* we were successful */
return( TRUE );
else /* the operation failed */
return( FALSE ); /* an error message has already been displayed */
end open$file;
read$char: procedure byte;
/*
* Return the next character from the file specified by the global
* token FILE$TOKEN (which must be open for reading).
* If end-of-file is encountered, it aborts the program with an
* error message.
*/
declare
bytes$read word,
ch byte;
/* Read the next byte from the file */
bytes$read = rq$s$read$move( file$token, @ch, 1, @status );
call check$status;
if ( bytes$read = 0 ) then /* we ran into end-of-file */
call abort$program( @( 25,'Unexpected end-of-file in' ), @file$name );
else /* we got a character */
return( ch ); /* so return it */
end read$char;
upcase: procedure( x ) byte;
/*
* Force an ASCII letter to upper-case;
* a non-letter is returned unchanged.
*/
declare
x byte;
if ( ( x >= 'a' ) and ( x <= 'z' ) ) then /* it was lower-case */
return( x - 'a' + 'A' ); /* return the upper-case equivalent */
else /* it was anything else */
return( x ); /* just return it unchanged */
end upcase;
read$number: procedure byte;
/*
* Read a number from the file, terminated by the delimiter.
* If the characters up to the next delimiter do not form an
* integer (i.e. contain a non-digit--other than the word END--
* or contain no characters at all), abort with an appropriate
* error message; otherwise, return the value of the number.
* The file pointer is left after the terminating delimiter.
* If the "number" consists of the word END, zero is returned.
* (Otherwise the number is in base 10.) If the number has
* more than 8 characters it will be truncated.
*/
declare
num byte,
i byte,
string structure(
len byte,
ch( 8 ) byte);
string.len = 0;
string.ch( string.len ) = read$char; /* Read first char of number */
do while ( string.ch( string.len ) <> delim ); /* Read rest of number */
if ( string.len < last( string.ch ) ) then /* room for more digits */
string.len = ( string.len + 1 ); /* move to next digit */
string.ch( string.len ) = read$char; /* Read next character */
end; /* do while ( string.ch( string.len ) <> delim ) */
num = 0; /* Init number to zero */
if ( string.len = 0 ) then /* we got nothing at all */
call abort$program( @( 17,'Missing number in' ), @file$name );
else if ( ( string.len <> 3 ) or
( upcase( string.ch( 0 ) ) <> 'E' ) or
( upcase( string.ch( 1 ) ) <> 'N' ) or
( upcase( string.ch( 2 ) ) <> 'D' ) ) then /* it's not END */
do i = 0 to ( string.len - 1 ); /* for each digit */
if ( ( string.ch( i ) < '0' ) or ( string.ch( i ) > '9' ) ) then
do; /* Handle error of non-digit */
call print( @( 16,'Invalid number "' ) );
call print( @string ); /* show what we got */
call abort$program( @( 4,'" in' ), @file$name );
end; /* if ... -- it's not a digit */
/* Combine this digit into the number */
num = ( ( num * 10 ) + ( string.ch( i ) - '0' ) );
end; /* do i = 0 to ( string.len - 1 ) */
return( num ); /* Return the number we got (zero if it was END) */
end read$number;
read$line: procedure;
/*
* Read the current line from the file into the global LINE$BUFFER
* up to the next LF (line-feed) character.
*/
declare
ch byte;
line$buffer.len = 0;
line$buffer.ch( line$buffer.len ) = read$char; /* Read first char */
do while ( line$buffer.ch( line$buffer.len ) <> LF );
if ( line$buffer.len < last( line$buffer.ch ) ) then
line$buffer.len = ( line$buffer.len + 1 ); /* Bump len if room */
line$buffer.ch( line$buffer.len ) = read$char; /* Read next char */
end; /* do while ( line$buffer.ch( line$buffer.len ) <> LF ) */
line$buffer.len = ( line$buffer.len + 1 ); /* Count final char (LF) */
end read$line;
skip$text: procedure;
/*
* Skip a single help text entry. That is, read and discard lines
* from the file until reaching a line which begins with DELIM.
* The file pointer will be left just after this character, i.e.
* the second character of the control line. If the first character
* read at the current position is DELIM, only that character will
* be read (i.e. it is assumed that we are at the beginning of a
* line now).
*/
declare
ch byte;
ch = read$char; /* Get first character of this line */
do while ( ch <> delim ); /* As long as it's not a control line */
call read$line; /* Skip that line */
ch = read$char; /* And check on the next one */
end; /* do while ( ch <> delim ) */
end skip$text;
keyword$match: procedure( knum ) boolean;
/*
* Compare KEYWORD( KNUM ) with the contents of LINE$BUFFER.
* Return TRUE if they match (the keyword may be an abbreviation
* of LINE$BUFFER), FALSE otherwise.
*/
declare
( knum, i ) byte;
i = 0;
do while ( ( i < keyword( knum ).len ) and
( i < line$buffer.len ) and
( line$buffer.ch( i ) <> CR ) );
if keyword( knum ).ch( i ) <> upcase( line$buffer.ch( i ) ) then
return( FALSE ); /* Don't match */
i = ( i + 1 ); /* check next character */
end; /* do while ... */
if ( i < keyword( knum ).len ) then /* keyword too long */
return( FALSE );
else /* It matches */
return( TRUE );
end keyword$match;
print$spaces: procedure( num );
/*
* Print NUM spaces (i.e. indent by that many characters).
* NUM must be no more than 20 unless the length of SPACES
* (below) is increased.
*/
declare
num byte,
spaces(*) byte data( 20,' ' ),
count byte at ( @spaces );
count = num; /* Set the length to be printed this time */
call print( @spaces ); /* Print COUNT spaces */
end print$spaces;
show$line: procedure( level, char, line$ptr );
/*
* Display the string pointed to by LINE$PTR, preceeded by the
* character CHAR, indented appropriately for LEVEL of nesting.
*/
declare
( level, char ) byte,
line$ptr pointer;
call print$spaces( 2 * level ); /* Indent two spaces per level */
if ( char <> 0 ) then /* if we got a leading charcter */
call print$char( char ); /* Display it */
call print( line$ptr ); /* And print the line */
end show$line;
/*
*
* Main program -- HELP
*
*/
call new$line; /* Leave a blank line */
call disable$exception$handler;
/* Parse the command line */
char = ' '; /* Insure at least one pass through the WHILE loop: */
do while ( char = ' ' ); /* Until we get the first non-space */
char = rq$c$get$char( @status ); /* Get next char from command line */
call check$status;
end; /* do while ( char = ' ' ) */
if ( char = '@' ) then /* We have a help library filespec */
do; /* Get the filespec into the filename buffer */
call rq$c$get$input$path$name( @file$name, size( file$name ), @status );
call check$status;
if ( file$name.len = 0 ) then /* no pathname there */
call abort$program( @( 34,'No help library pathname follows @' ), 0 );
char = rq$c$get$char( @status ); /* And get next character */
call check$status;
end; /* if ( char = '@' ) */
else /* No at-sign, so use default help library */
do; /* Get its name into the filename buffer */
/* Get the name of the file containing this program */
call rq$c$get$command$name( @file$name, size( file$name ), @status );
call check$status;
/* Append the .HLP suffix to it, forming the name of the help library */
call movb( @( '.HLP' ), @file$name.ch( filename.len ), 4 );
file$name.len = ( file$name.len + 4 );
end; /* else -- no at-sign */
if ( open$file( @file$name ) ) then /* Open the help library file */
do; /* Successfully opened, so parse rest of command line and give help */
i = 0; /* Start with the first keyword */
keyword( i ).len = 0; /* Init first keyword to null */
do while ( ( char <> 0 ) and ( char <> CR ) ); /* until end of line */
if ( ( char = HT ) or ( char = ' ' ) ) then /* it's a space or tab */
do;
if ( keyword( i ).len > 0 ) then /* end of this keyword */
do;
if ( i < last( keyword ) ) then
i = ( i + 1 ); /* Move to next keyword */
keyword( i ).len = 0; /* and init it to null */
end; /* if ( keyword( i ).len > 0 ) */
/* else ignore redundant space or tab */
end; /* if ( ( char = HT ) or ( char = ' ' ) ) */
else /* non-space and non-tab character */
do;
if ( keyword( i ).len < size( keyword.ch ) ) then
do;
/* Store character of keyword, capitalized */
keyword( i ).ch( keyword( i ).len ) = upcase( char );
keyword( i ).len = ( keyword( i ).len + 1 );
end; /* if ( keyword( i ).len < size( keyword.ch ) ) */
end; /* else -- non-space and non-tab character */
char = rq$c$get$char( @status ); /* Get the next character */
end; /* do while ( ( char <> 0 ) and ( char <> CR ) ) */
if ( ( keyword( i ).len > 0 ) and ( i < last( keyword ) ) ) then
i = ( i + 1 ); /* Count final keyword */
num$keywords = i; /* Save number of keywords we got */
/* Begin reading help library file */
char = read$char; /* Get first character of file (special delimiter) */
delim = char; /* Save special delimiter for this file */
call read$line; /* Discard the rest of the first line */
level = 1; /* Init level number we're looking for */
finished = FALSE; /* not finished yet */
do while ( not finished ); /* until we're finished giving help */
if ( num$keywords >= level ) then /* got a keyword for this level */
do;
call skip$text; /* Skip previous entry */
i = read$number; /* Get nesting level for next entry */
call read$line; /* And read its keyword */
if ( i < level ) then /* found an entry at a lower level */
do;
call show$line( level, 0,
@( 28,'Sorry, no help available on' ) );
do i = 0 to ( level - 1 );
call print$char( ' ' );
call print( @keyword( i ) );
end; /* do i = 0 to ( level - 1 ) */
call new$line;
finished = TRUE; /* No more help to give on this topic */
end; /* if ( i < level ) */
else if ( i = level ) then /* found entry for level we want */
do;
if keyword$match( level - 1 ) then /* keyword matches */
do; /* Show matching keyword */
call show$line( level, 0, @line$buffer );
call new$line; /* And leave a blank line */
level = ( level + 1 ); /* And go to next lower level */
end; /* if keyword$match( level - 1 ) */
end; /* if ( i = level ) */
end; /* if ( num$keywords >= level ) */
else if ( num$keywords = ( level - 1 ) ) then
do; /* Display selected help text */
char = read$char; /* Get first char */
do while ( char <> delim ); /* Until next control line */
call read$line; /* Read the rest of this line of text */
call show$line( level, char, @line$buffer ); /* show it */
char = read$char; /* Read first char of next line */
end; /* do while ( char <> delim ) */
i = read$number; /* Get level of next entry */
if ( i < level ) then /* not a subtopic of selected entry */
finished = TRUE; /* no subtopics, so nothing more to do */
else /* we have subtopic(s) to list */
do;
call new$line; /* Leave a blank line */
call show$line( level, 0,
@( 28,'Further help available on:',CR,LF ) );
call new$line; /* And leave another blank line */
level = ( level + 1 ); /* Set level to list subtopics */
call read$line; /* Read first subtopic keyword */
line$buffer.len = ( line$buffer.len - 2 ); /* Remove CR/LF */
j = line$buffer.len; /* Save chars so far on this line */
call show$line( level, 0, @line$buffer ); /* show keyword */
end; /* else -- we have to list subtopics */
end; /* if ( num$keywords = ( level - 1 ) ) */
else /* we must be listing subtopics */
do;
call skip$text; /* Skip previous entry */
i = read$number; /* Get nesting level for next entry */
call read$line; /* Read its keyword */
line$buffer.len = ( line$buffer.len - 2 ); /* And remove CR/LF */
if ( i < ( level - 1 ) ) then /* found entry at a lower level */
do; /* So no more subtopics of selected entry */
call new$line; /* Finish last line of list */
finished = TRUE; /* And we're all done */
end; /* if ( i < ( level - 1 ) ) */
else if ( i = ( level - 1 ) ) then /* found right level entry */
do; /* Show another subtopic keyword */
if ( j > 60 ) then /* time to start a new line (60=4*15) */
do;
call new$line;
call show$line( level, 0, @line$buffer );
j = line$buffer.len; /* Count chars on this line */
end; /* if ( j > 48 ) */
else /* Make another entry on this line */
do;
call print$spaces( 15 - ( j mod 15 ) ); /* align columns */
j = ( j + ( 15 - ( j mod 15 ) ) + line$buffer.len );
call print( @line$buffer );
end; /* else -- continue this line */
end; /* if ( i = ( level - 1 ) ) */
end; /* else -- listing subtopics */
end; /* do while ( not finished ) */
/* Finished giving help on the selected topic */
end; /* if ( open$file( @file$name ) ) */
else /* Error occurred when opening file, abort with message. */
call abort$program( @( 30,'Can''t access help library file' ),
@file$name );
call abort$program( 0, 0 ); /* Exit with no error message */
end help;