diff options
Diffstat (limited to 'pkg/system/help/lroff')
32 files changed, 4398 insertions, 0 deletions
diff --git a/pkg/system/help/lroff/breakline.o b/pkg/system/help/lroff/breakline.o Binary files differnew file mode 100644 index 00000000..d0dceee2 --- /dev/null +++ b/pkg/system/help/lroff/breakline.o diff --git a/pkg/system/help/lroff/breakline.x b/pkg/system/help/lroff/breakline.x new file mode 100644 index 00000000..2be9f5a1 --- /dev/null +++ b/pkg/system/help/lroff/breakline.x @@ -0,0 +1,99 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include "lroff.h" + +define LEFT 1 +define RIGHT 2 + +# BREAKLINE -- Break the current output line and output with or without +# justification. The "current output line" is the set of NWORDS words +# pointed to by the WORDS array of word pointers. Copy the NWORDS words +# into the output buffer; do nothing if the word buffer is empty. If the +# OUTPUT buffer is not empty, append a newline, causing the buffer to be +# flushed. Breakline is called by textout() when enough words have been +# collected to fill an output line, or whenever it is desired to flush +# the output buffer. If both the word buffer and the output buffer are +# empty, breakline is essentially a nop. + +procedure breakline (out, justify_flag) + +extern out() +int justify_flag + +int w, i, end_to_fill_from, next_output_column +int nholes, nfill, n_per_hole, nextra, hole1, hole2 +errchk outstr, outc +include "lroff.com" +include "words.com" + +begin + if (wbuf == NULL || words == NULL) + call error (1, "No Lroff word buffer allocated") + + # First we flush the word buffer. + if (nwords > 0) { + # Strip any trailing whitespace from the line. + for (wp=wp-2; Memc[wp] == BLANK && wp > wbuf; wp=wp-1) + wcols = wcols - 1 + wp = wp + 1 + Memc[wp] = EOS + wp = wp + 1 + + # If justification is disabled or if there is only one word on + # the line, do not add spaces to right justify. + + if (justify_flag == NJ || justify == NO || nwords <= 1) { + for (w=1; w <= nwords; w=w+1) + call outstr (out, Memc[Memi[words+w-1]]) + + } else { + # To justify the line, determine the number of extra spaces + # needed to right justify the last character on the line. + # Determine the number of holes between words, and how many + # spaces to add to each. + + nholes = nwords - 1 + nfill = max (0, right_margin - left_margin + 1 - wcols) + n_per_hole = nfill / nholes + nextra = nfill - (n_per_hole * nholes) + + # Determine where the extra spaces need to be added. Add + # extra spaces from the left and then the right on succesive + # lines. + if (end_to_fill_from == LEFT) { + hole1 = 1 + hole2 = nextra + end_to_fill_from = RIGHT + } else { + hole1 = nwords - nextra + hole2 = nholes + end_to_fill_from = LEFT + } + + # Fill the output line. Move the word and then add the + # requisite number of blanks per hole, plus an extra if in + # the range hole1 to hole2 (at left or right). + + do w = 1, nwords { + call outstr (out, Memc[Memi[words+w-1]]) + do i = 1, n_per_hole + call outc (out, BLANK) + if (w >= hole1 && w <= hole2) + call outc (out, BLANK) + } + } + } + + + # If there is anything in the output buffer, append a newline, flushing + # the buffer. + + call getoutcol (next_output_column) + if (next_output_column > left_margin) + call outc (out, '\n') + + wp = wbuf # clear the word buffer + nwords = 0 + wcols = 0 +end diff --git a/pkg/system/help/lroff/center.o b/pkg/system/help/lroff/center.o Binary files differnew file mode 100644 index 00000000..6e3442d3 --- /dev/null +++ b/pkg/system/help/lroff/center.o diff --git a/pkg/system/help/lroff/center.x b/pkg/system/help/lroff/center.x new file mode 100644 index 00000000..b3581f3a --- /dev/null +++ b/pkg/system/help/lroff/center.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include "lroff.h" + +# CENTER_TEXT -- Center and output the next input line within the current +# left and right margins. The optional argument specifies the column +# (measured from the left margin) at which the text is to be centered. + +procedure center_text (in, out, linebuf, ip) + +extern in(), out() +char linebuf[ARB] +int ip + +int len_inputline, center_column, nblanks, i +int in(), input(), lgetarg() +errchk breakline, input, outc, outline +include "lroff.com" + +begin + call breakline (out, NJ) + center_column = lgetarg (linebuf, ip, (left_margin + right_margin) / 2) + len_inputline = input (in, linebuf) - 1 + + if (len_inputline != EOF) { + nblanks = center_column - (len_inputline / 2) - left_margin + for (i=1; i <= nblanks; i=i+1) + call outc (out, BLANK) + call outline (out, linebuf) + } +end diff --git a/pkg/system/help/lroff/dols.o b/pkg/system/help/lroff/dols.o Binary files differnew file mode 100644 index 00000000..55b5fbcd --- /dev/null +++ b/pkg/system/help/lroff/dols.o diff --git a/pkg/system/help/lroff/dols.x b/pkg/system/help/lroff/dols.x new file mode 100644 index 00000000..26ba165b --- /dev/null +++ b/pkg/system/help/lroff/dols.x @@ -0,0 +1,108 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include <error.h> +include "lroff.h" + +# DO_LS -- Depending on the action, push an LS block (print label and indent +# one level), or pop an LS block (restore the previous indent level). INIT_LS +# clears the LS stack. Called with the LS command line in "lbuf", minus +# the ".ls". The command line may consist of an argument specifying the number +# of spaces to indent, the label string, both, or neither. +# If the label string is shorter than the amount by which the block is indented, +# the text block will begin on the same line as the label, otherwise the line +# is broken and the text block begins on the following line. + +procedure do_LS (out, lbuf, action, last_command) + +extern out() +char lbuf[ARB] # ".ls [arg] [text]" +int action # LS or LE +int last_command + +int indent[MAX_NLS] +int n, ip, next_output_column +int lgetarg(), strlen() +errchk skiplines, outstr, outc, breakline +include "lroff.com" + +begin + switch (action) { + case LS: + # We normally skip a line when beginning an LS block. If two or + # more LS directives are given in a row, however, only skip a + # single line. + + call breakline (out, NJ) + if (last_command != LS) + call skiplines (out, 1) + call testpage (out, 3) + + # Push new LS block on stack. + nls = nls + 1 + if (nls > MAX_NLS) { + iferr (call error (1, "LS blocks nested too deep")) + call erract (EA_WARN) + nls = MAX_NLS + } + + # Get number of spaces to indent, if given. If arg is negative, + # do not remember the argument, otherwise make it the new default. + ip = 1 + n = lgetarg (lbuf, ip, ls_indent) + if (n < 0) + indent[nls] = -n + else { + ls_indent = n + indent[nls] = ls_indent + } + + # Copy the label, if any, into the output buffer. We must do this + # before we change the left margin since the label is not indented. + + call outstr (out, lbuf[ip]) + + # Try to adjust the left margin by the indicated amount. Save the + # actual indentation level for restoration by LE. + + indent[nls] = max (perm_left_margin, min (right_margin, + left_margin + indent[nls])) - left_margin + left_margin = left_margin + indent[nls] + + # If the length of the label string plus one blank does not leave + # space to start the first line of the text block on the same line, + # we must break the line and start the block on the next line. + # Otherwise, output spaces until the new left margin is reached. + + if (strlen (lbuf[ip]) >= indent[nls]) + call outc (out, '\n') + else { + call getoutcol (next_output_column) + while (next_output_column < left_margin) { + call outc (out, BLANK) + call getoutcol (next_output_column) + } + } + + case LE: # end LS block + call breakline (out, NJ) + if (nls >= 1) { + left_margin = left_margin - indent[nls] + nls = nls - 1 + } + + default: + call error (1, "do_LS") + } +end + + +# INIT_LS -- Set or clear any LS indentation. + +procedure init_ls() + +include "lroff.com" + +begin + nls = 0 +end diff --git a/pkg/system/help/lroff/getarg.o b/pkg/system/help/lroff/getarg.o Binary files differnew file mode 100644 index 00000000..fcfc8fd9 --- /dev/null +++ b/pkg/system/help/lroff/getarg.o diff --git a/pkg/system/help/lroff/getarg.x b/pkg/system/help/lroff/getarg.x new file mode 100644 index 00000000..b85c5462 --- /dev/null +++ b/pkg/system/help/lroff/getarg.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include "lroff.h" + +.help lgetarg +.nf _________________________________________________________________________ +LGETARG -- Get an integer argument to a directive. If no argument is found, +return the default value. We are called with IP pointing to the start of +the argument field to be searched. Leave IP pointing to the next argument +field. +.endhelp ____________________________________________________________________ + +int procedure lgetarg (input_line, ip, default_value) + +char input_line[ARB] +int ip, default_value +int argument +int ctoi() + +begin + if (ctoi (input_line, ip, argument) == 0) + argument = default_value + + # Eat comma argument delimiter, if multiple arguments. Also eat + # trailing whitespace, in case a string argument follows. + while (input_line[ip] == BLANK) + ip = ip + 1 + if (input_line[ip] == ',') + ip = ip + 1 + while (input_line[ip] == BLANK) + ip = ip + 1 + + return (argument) +end diff --git a/pkg/system/help/lroff/indent.o b/pkg/system/help/lroff/indent.o Binary files differnew file mode 100644 index 00000000..b2f75a10 --- /dev/null +++ b/pkg/system/help/lroff/indent.o diff --git a/pkg/system/help/lroff/indent.x b/pkg/system/help/lroff/indent.x new file mode 100644 index 00000000..6857e315 --- /dev/null +++ b/pkg/system/help/lroff/indent.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "lroff.h" + +# INDENT_LEFT_MARGIN -- Execute a relative indent of the left margin. + +procedure indent_left_margin (in, out, number_of_spaces) + +extern in(), out() +int in(), number_of_spaces +include "lroff.com" + +begin + call breakline (out, NJ) + left_margin = max (perm_left_margin, min (right_margin, + left_margin + number_of_spaces)) +end diff --git a/pkg/system/help/lroff/input.o b/pkg/system/help/lroff/input.o Binary files differnew file mode 100644 index 00000000..80ef4865 --- /dev/null +++ b/pkg/system/help/lroff/input.o diff --git a/pkg/system/help/lroff/input.x b/pkg/system/help/lroff/input.x new file mode 100644 index 00000000..908bd81d --- /dev/null +++ b/pkg/system/help/lroff/input.x @@ -0,0 +1,123 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <chars.h> +include "lroff.h" + +.help input +.nf ___________________________________________________________________________ +INPUT -- Read a line of text into the user supplied input buffer. Convert +any tabs therein to spaces to simplify further processing. If generation +of standout mode control chars is enabled, map "\f[BIR]" sequences into the +appropriate control chars (defined in <chars.h>), otherwise delete any such +sequences found (these control chars are later mapped by HELP, PAGE, LPRINT +etc. into whatever sequence the actual output device requires). Return the +number of PRINTABLE chars in the input line. Control characters are not +counted, but are copied to the output line. The trailing newline is stripped; +Lroff deals mainly with words, not lines. Only printable characters are made +to "stand out", i.e., standout mode is always turned off between words and at +the end of a line. +.endhelp ______________________________________________________________________ + +int procedure input (in, userbuf) + +extern in() +char userbuf[ARB] + +bool standout_mode_in_effect +char ch +int len_inputline, ocol +pointer sp, lbuf, ip, op +int stridx(), in() +errchk salloc, in +include "lroff.com" + +begin + call smark (sp) + call salloc (lbuf, SZ_IBUF, TY_CHAR) + + # Get input line and deal with any tab characters therein. + if (in (in_magic_arg, Memc[lbuf]) == EOF) { + call sfree (sp) + return (EOF) + } + + standout_mode_in_effect = false + len_inputline = 0 + ip = lbuf + op = 1 + ocol = 0 + + # Process the input buffer, converting any "\f?" font escape sequences + # found. Terminate when newline is reached. Delete the newline. + # Expand all tabs. + + for (ch=Memc[ip]; ch != '\n' && ch != EOS; ch=Memc[ip]) { + if (ch == '\\') + if (Memc[ip+1] == 'f' && stridx (Memc[ip+2], "BIR") > 0) { + # Turn standout mode on or off. Can only be turned on + # if "soflag" is YES. + switch (Memc[ip+2]) { + case 'B', 'I': # bold, italic + if (soflag == YES) + standout_mode_enabled = true + case 'R': # roman + if (standout_mode_in_effect) { + userbuf[op] = SO_OFF + op = op + 1 + standout_mode_in_effect = false + } + standout_mode_enabled = false + } + ip = ip + 3 # \f? = 3 + next + } + + # Only make alphanumeric chars "stand out". + + if (IS_ALNUM(ch)) { + len_inputline = len_inputline + 1 + ocol = ocol + 1 + if (standout_mode_enabled && !standout_mode_in_effect) { + userbuf[op] = SO_ON + op = op + 1 + standout_mode_in_effect = true + } + + } else if (ch == '\t') { + repeat { + userbuf[op] = ' ' + op = op + 1 + ocol = ocol + 1 + len_inputline = len_inputline + 1 + } until (ocol > 1 && mod (ocol, TABSIZE) == 0) + ip = ip + 1 + next + + } else { + if (IS_PRINT(ch)) { + len_inputline = len_inputline + 1 + ocol = ocol + 1 + } + if (standout_mode_in_effect) { + userbuf[op] = SO_OFF + op = op + 1 + standout_mode_in_effect = false + } + } + + userbuf[op] = ch + op = op + 1 + ip = ip + 1 + } + + if (standout_mode_in_effect) { + userbuf[op] = SO_OFF + op = op + 1 + standout_mode_in_effect = false + } + userbuf[op] = EOS + + call sfree (sp) + return (len_inputline) +end diff --git a/pkg/system/help/lroff/justify.o b/pkg/system/help/lroff/justify.o Binary files differnew file mode 100644 index 00000000..db814dfb --- /dev/null +++ b/pkg/system/help/lroff/justify.o diff --git a/pkg/system/help/lroff/justify.x b/pkg/system/help/lroff/justify.x new file mode 100644 index 00000000..8085ca6b --- /dev/null +++ b/pkg/system/help/lroff/justify.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include "lroff.h" + +# RIGHT_JUSTIFY -- Right justify the text string argument in LINEBUF on the +# next input line, and write to the output. + +procedure right_justify (in, out, linebuf, ip) + +extern in(), out() +char linebuf[ARB] +int ip +pointer sp, rjbuf +int in(), input() +errchk salloc, breakline, input, rjline +include "lroff.com" + +begin + call smark (sp) + call salloc (rjbuf, SZ_IBUF, TY_CHAR) + + call breakline (out, NJ) + if (input (in, Memc[rjbuf]) != EOF) + call rjline (out, Memc[rjbuf], linebuf[ip]) + + call sfree (sp) +end + + + +# RJLINE -- Right justify a text string on an unfilled input line and +# send it out. + +procedure rjline (out, input_line, rjtext) + +extern out() +char input_line[ARB] # unfilled input line +char rjtext[ARB] # string to be right justified on same line + +int i, nblanks, len_rjtext, next_output_column +int textlen() +errchk outstr, outc, outline +include "lroff.com" + +begin + # Breakline should already have been called by the time we get here. + # Output the input line at the left margin without filling. + + call outstr (out, input_line) + + # Determine the (printable) length of the rjtext string, and space + # over so that it comes out right justified. Always output at least + # one space. Exceed the right margin if necessary. + + call getoutcol (next_output_column) + len_rjtext = textlen (rjtext) + nblanks = max (1, right_margin - (next_output_column + len_rjtext) + 1) + do i = 1, nblanks + call outc (out, BLANK) + + call outline (out, rjtext) +end diff --git a/pkg/system/help/lroff/lroff.com b/pkg/system/help/lroff/lroff.com new file mode 100644 index 00000000..1e64173c --- /dev/null +++ b/pkg/system/help/lroff/lroff.com @@ -0,0 +1,24 @@ +# Common for the Lroff text formatter. + +int right_margin # working margins +int left_margin +int perm_right_margin # permanent margins +int perm_left_margin +int in_magic_arg # magic args for in/out procedures +int out_magic_arg +int soflag # if YES, output standout mode chars +int foflag # if YES, output forms mode chars +int justify # right justify text +int nls # .LS nesting level +int ls_indent # .LS, def number of spaces to indent +int sh_nskip # .SH, def nlines to skip +int ih_nskip # .IH, def nlines to skip +int ih_indent # .IH, def nspaces to indent +int nh_nskip # .NH, def nlines to skip +int nh_level[MAX_NHLEVEL] # .NH, section level numbers +bool standout_mode_enabled # see input() + +common /lrfcom/ right_margin, left_margin, perm_right_margin, + perm_left_margin, in_magic_arg, out_magic_arg, soflag, + foflag, justify, nls, ls_indent, sh_nskip, ih_nskip, ih_indent, + nh_nskip, nh_level, standout_mode_enabled diff --git a/pkg/system/help/lroff/lroff.h b/pkg/system/help/lroff/lroff.h new file mode 100644 index 00000000..5111fcd0 --- /dev/null +++ b/pkg/system/help/lroff/lroff.h @@ -0,0 +1,41 @@ +# Input buffer must allow space for tab expansion and standout mode control +# characters. Word and output buffer dimensions depend on margins. + +define SZ_IBUF (2*SZ_LINE) +define MAX_NLS 20 # nesting level for LS +define MAX_NHLEVEL 10 # max level for numbered sections + +# Default formatter parameters. +define DEF_IHINDENT 4 # .ih indent level +define DEF_LSINDENT 4 # .ls indent level +define DEF_IHNSKIP 2 # .ih number of lines to skip +define DEF_NHNSKIP 2 # .nh number of lines to skip +define DEF_SHNSKIP 2 # .sh number of lines to skip +define DEF_TPNLINES 2 # .tp nlines left on page + +define TABSIZE 8 +define INVISIBLE ($1 < BLANK) + +# Lroff Directive Opcodes. +define FI 1 # enter fill mode +define NF 2 # leave fill mode (nofill) +define JU 3 # enter line justification mode +define NJ 4 # leave line justification mode +define RJ 5 # right justify text on nf,nj line +define SH 6 # section heading +define IH 7 # indented section heading +define NH 8 # numbered section heading +define BR 9 # break line +define CE 10 # center next line +define SP 11 # break, space N spaces on output +define IN 12 # indent +/- N spaces +define LS 13 # begin labelled section +define LE 14 # end labelled section +define BP 15 # break page +define TP 16 # test space left on page +define KS 17 # start floating keep +define KE 18 # end floating keep +define HR 19 # HTML href tag +define HN 20 # HTML name tag +define ENDHELP 21 # end of help block +define HELP 22 # start of help block diff --git a/pkg/system/help/lroff/lroff.hlp b/pkg/system/help/lroff/lroff.hlp new file mode 100644 index 00000000..6607977b --- /dev/null +++ b/pkg/system/help/lroff/lroff.hlp @@ -0,0 +1,258 @@ +.help lroff Nov83 "Online Help Utilities" +.ih +NAME +\fBlroff\fR -- line oriented text formatter +.ih +PURPOSE +\fBLroff\fR is a simple text formatter used by the IRAF on-line Help command, +and other utilities (MANPAGE, LIST), to format text. +\fBLroff\fR style documentation text may be embedded in program source files. +\fBlroff\fR is line oriented, rather than page oriented, +and is implemented as a library procedure rather than as a task. +.ih +USAGE +status = lroff (input, output, left_margin, right_margin) +.ih +PARAMETERS +.ls input +An integer procedure, called by \fBlroff\fR to get lines of input, +which takes the \fBlroff\fR input buffer as an argument, +and which returns EOF upon End of File (like GETLINE). +Each line of input must be terminated by a newline and an EOS +(End Of String marker). +.le +.ls output +A procedure, called by \fBlroff\fR to output formatted lines of text, +which takes the \fBlroff\fR output buffer as an argument ("output (buffer)"). +.le +.ls left_margin +The first column to be filled (>= 1). +.le +.ls right_margin +The last column to be filled. +.le +.ls status +ERR is returned if meaningless margins are specified, or if an unrecoverable +error occurs during processing. +.le +.ih +DESCRIPTION +\fBLroff\fR input may be bracketed by ".help" and ".endhelp" directives in +the actual source file of the program being documented (if intended as input +to the \fBhelp\fR utility), or may be in a separate file. +The input text consists +of a mixture of lines of text and \fBlroff\fR directives. +\fBLroff\fR recognizes only a few directives, +summarized in the "Request Summary" below. Whenever a directive +performs the same function as a UNIX TROFF directive, the name is the same. +Unrecognized directives are ignored, and are not passed on to the output. +Directives must be left justified and preceeded by a period. + +Help text need not be formatted unless desired. Filling and justification +are NOT ENABLED unless a legal directive (other than ".nf") is given on the +line immediately following the ".help" directive. + +While filling, embedded whitespace in text IS significant to \fBlroff\fR, +except at the end of a line. +\fBlroff\fR recognizes no special characters. +Blank lines cause a break, and are passed on to the output (a blank line +is equivalent to ".sp"). +Case is not significant in command directives. +Control characters embedded in text will be passed on to the output. + +Since both whitespace and blank lines are significant, \fBlroff\fR will properly +format ordinary paragraphs of text, and single line section headers, +without need for embedded directives. + +Since the i/o routines used by \fBlroff\fR are parameterized, pagination can be +achieved by having the user supplied OUTPUT procedure count output lines. +Similarly, pagination control directives can be added to the list of +\fBlroff\fR directives, to be intercepted by the user supplied INPUT procedure. +See the Manpage command for an example. + + +DIRECTIVES + +Most of the \fBlroff\fR directives function the same as in the UNIX text +formatters. For the benefit of readers without experience with UNIX, +"filling" means collecting words of text until an output line has been +filled, and "justification" refers to adding extra spaces between words +to cause the output line to be both left and right justified (as in this +paragraph). Filling is disabled with NF, and resumes following a FI. +While filling is disabled, only the control directives FI and RJ will be +recognized. Justification is enabled with JU, and disabled with NJ. +The filling of an output line may be stopped, and the line output, with BR. +SP (or a blank line) does the same thing, outputting one or more blank +lines as well. CE causes the current line to be broken, and outputs the +next line of input, centered. + +The directive ".rj text" breaks the current line, and outputs the next +line of input, unfilled, with "text" right justified on the same line. +RJ is especially useful for numbering equations. The RJ directive is +recognized whether or not filling is in effect. + +SH and IH may be used for section headers. Both cause a break, followed +by a couple blank lines, followed by the next line of input, +left justified on the output line. The left margin is reset to its +initial value. If IH is used, the text following the section header will +be indented one level in from the left margin. +The number of lines of blank lines before the heading, +and the amount of indentation, are optional arguments. +The default values are shown in the request summary below. If values +other than the defaults are desired, they need only be supplied as arguments +once. Succeeding calls will continue to use the new values. + +The IH and LS directives are especially useful in help text (manual pages). +LS with a label string is useful for parameter lists, +as shown in the example below. +LS without a label string is used for relative indenting. +A following LE restores the previous level of indentation. + +The LS directive has the form ".ls [n] [stuff]", where "n" (optional) +is the amount by which the following text is to be indented, +and "stuff" is the (optional) label for the indented text block. +LS causes a break, followed by one blank line, then the label string (if given), +left justified. +If the length of "stuff" is less than N-1 characters, the text +block will start filling on the same line, otherwise on the next line. +The indented text block may contain anything, including additional LS +directives if nesting is desired. A matching LE eventually terminates the +block, restoring the previous level of indentation. + +The LS directive takes the most recent argument as the new default +indentation, allowing the argument to be omitted in subsequent calls. +To keep the current default value from being changed, use a negative +argument. + +.ih +EXAMPLE +.sp +Many examples of the use of the \fBlroff\fR command directives in help text +can be found by browsing about in source listings. +A brief example is included here for convenient reference. +.sp +The ".help" directive, used to mark the beginning +of a block of help text, is used by HELP and MANPAGE rather than \fBlroff\fR. +The (optional) arguments to ".help" are the keyword name of the help +text block, and two strings. +The keyword argument may be a list of the form ".help keyw1, +keyw2, ..., keywn", if more than one keyword is appropriate. +The first keyword in the list is placed in the header of a manual page, +followed by the first string, in parenthesis. The second string, +if given, is centered in the header line. The strings need not be +delimited unless they contain whitespace. +.sp +The \fBlroff\fR-format help text fragment +.sp +.ls +.nf +.help stcopy 2 "string utilities" +.ih +NAME +stcopy -- copy a string. +.ih +PURPOSE +Stcopy is used to copy an EOS delimited character +string. The EOS delimiter MUST be present. +.ih +USAGE +stcopy (from, to, maxchar) +.ih +PARAMETERS +.ls from +The input string. +.le +.ls to +The output string, of length no less than "maxchar" +characters (excluding the EOS). +.le +.ls maxchar +The maximum number of characters to be copied. +Note that "maxchar" does not include the EOS. +Thus, the destination string must contain storage +for at least (maxchar + 1) characters. +.le +.ih +DESCRIPTION +.fi +.sp 2 +.le +would be converted by \fBlroff\fR (as called from Help) into something like +the following. Remember that the margins are runtime arguments to \fBlroff\fR. +Help does not print a header line, or break pages. +.sp 2 +.in 8 +NAME +.in 5 +stcopy -- copy a string. +.in -5 +.sp 2 +PURPOSE +.in 5 +Stcopy is used to copy an EOS delimited character +string. The EOS delimiter MUST be present. +.in -5 +.sp 2 +USAGE +.in 5 +stcopy (from, to, maxchar) +.in -5 +.sp 2 +PARAMETERS +.in 5 +.ls from +The input string. +.le +.ls to +The output string, of length no less than "maxchar" +characters (excluding the EOS). +.le +.ls maxchar +The maximum number of characters to be copied. +Note that "maxchar" does not include the EOS. +Thus, the destination string must contain storage +for at least (maxchar + 1) characters. +.le +.in -5 +.sp 2 +DESCRIPTION +.sp +.ih +SEE ALSO +help + +The reader should note that MANPAGE, which is page oriented, +recognizes the following directives in addition to those recognized +by \fBlroff\fR: BP (break page), and KS, KE (start and end keep). MANPAGE also +omits blank lines at the top of a page. These directives may safely +be included in \fBlroff\fR text, as they will be ignored by \fBlroff\fR if not +intercepted by the procedure calling \fBlroff\fR. + +.ih +REQUEST SUMMARY +.sp +.nf +Request Initial Default Break Meaning + + .fi yes yes Begin filling output lines. + .nf no yes Stop filling output lines. + .ju yes no Right justify output lines. + .nj no no Don't right justify. + .rj text yes Rt justify text on next line. + .sh n n=2 yes Skip n lines, start section. + .ih m n m=2,n=5 yes Like SH, but indent n spaces. + .br yes Stop filling current line. + .ce yes Center following line. + .sp n n=1 yes Space "n" lines. + .in n n=0 n=0 yes Set left margin to "current+n". + .ls n label n=8 yes Begin labeled text block. + .le yes End labeled text block. + +additional directives provided by MANPAGE: + + .bp yes Start a new page of output. + .tp n n=4 yes Break page if < n lines left. + .ks yes Begin saving output. + .ke yes Output saved text all on one page. +.fi +.endhelp diff --git a/pkg/system/help/lroff/lroff.o b/pkg/system/help/lroff/lroff.o Binary files differnew file mode 100644 index 00000000..4151c327 --- /dev/null +++ b/pkg/system/help/lroff/lroff.o diff --git a/pkg/system/help/lroff/lroff.x b/pkg/system/help/lroff/lroff.x new file mode 100644 index 00000000..e9624827 --- /dev/null +++ b/pkg/system/help/lroff/lroff.x @@ -0,0 +1,220 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include <ctype.h> +include "lroff.h" + +.help lroff +.nf ___________________________________________________________________________ +Source for the LROFF line-oriented text formatter. LROFF is a simple text +formatter patterned after the NROFF formatter of UNIX. LROFF is unusual in +that it is a "numerical" library procedure which does not directly do any +i/o (except for buffer allocation and use of ERROR). + +LROFF -- The main entry point. Lroff reads lines with the input procedure, +performs the format conversion, and writes lines with the output procedure, +both of which are passed as arguments. Conversion proceeds until the .endhelp +directive or EOF is reached. The calling sequences for the input and output +procedures are as follows: + + stat = inproc (inarg, linebuf) + outproc (outarg, linebuf) + +where "inarg" and "outarg" are magic integer arguments which Lroff merely +passes on to the input and output procedures when they are called. + +Other arguments to Lroff include PLM and PRM, the permanent left and right +margins for the output text, and SOFLAG, set to YES if "standout mode" control +chars are permitted in the output text. + +The forms control directives BP, TP, KS, and KE are ignored unless forms mode +is enabled (foflag=YES). If forms control is enabled these directives cause +a breakline followed by output of a special control character forms directive, +used to control the layout of text on a page. When forms mode is in effect +the section header directives also cause output of a TP (test page) directive +before the section. Processing of forms control characters is left to the +program that reads lroff output. +.endhelp ______________________________________________________________________ + +procedure lroff (in, in_arg, out, out_arg, plm, prm, soflag_val, foflag_val) + +extern in() # called to get lines of input text +int in_arg # magic argument for in() +extern out() # called to output formatted lines of text +int out_arg # magic argument for out() +int plm, prm # permanent left and right margins +int soflag_val # output standout mode control chars? +int foflag_val # output form control chars? + +char ctrlstr[2] +pointer sp, ibuf +int ip, command, last_command +int in(), nextcmd(), lgetarg(), input(), nofill() + +errchk input, textout, nofill, rawcopy, skiplines, breakline, right_justify +errchk salloc, new_section, new_indented_section, center_text, init_ls +errchk init_nh, indent_left_margin, do_LS, textout, set_wordbuf, set_outbuf +include "lroff.com" + +define text_ 98 + +begin + call smark (sp) + call salloc (ibuf, SZ_IBUF, TY_CHAR) + + if (plm > prm || plm < 1) + call error (1, "Lroff called with invalid margins") + + # General initialization. Set up the Lroff common. Call the various + # initialization procedures to initialize the directives and to + # set up the word buffer and output buffer, the size of which depends + # on the margins. + + justify = YES + perm_left_margin = plm + perm_right_margin = prm + left_margin = plm + right_margin = prm + last_command = NULL + in_magic_arg = in_arg + out_magic_arg = out_arg + soflag = soflag_val + foflag = foflag_val + standout_mode_enabled = false + + ls_indent = DEF_LSINDENT + ih_indent = DEF_IHINDENT + sh_nskip = DEF_SHNSKIP + nh_nskip = DEF_NHNSKIP + ih_nskip = DEF_IHNSKIP + + call init_ls() + call init_nh() + call set_wordbuf (prm - plm + 2) + call set_outbuf (max (SZ_LINE, 2 * (prm - plm + 1))) + + # If the first line of text is not an Lroff directive, we copy the + # input to the output without modification, except for moving the text + # to the desired left margin, stopping only at EOF or .endhelp. + # If any directive is given, the default mode is justify+fill. + + if (input (in, Memc[ibuf]) == EOF) { + call sfree (sp) + return + } else if (nextcmd (Memc[ibuf], ip) < 0) { + call rawcopy (in, out, Memc[ibuf]) + call sfree (sp) + return + } + + + # The main Lroff interpreter loop. Get input line: if directive, + # execute directive; else call textout() to process a line of text. + # The basic idea is to break the input stream up into words, saving + # these until we have one more than needed to fill the output line. + # The words are then copied into the output line, starting at the left + # margin, adding spaces as needed to right justify the line. Many + # commands cause the "current output line" to be broken, forcing + # whatever has been accumulated out without right justification. + + repeat { + command = nextcmd (Memc[ibuf], ip) + switch (command) { + case FI: + call breakline (out, NJ) + case NF: + call breakline (out, NJ) + if (nofill (in, out, Memc[ibuf]) == ENDHELP) + break + case JU: + justify = YES + case NJ: + justify = NO + case RJ: + call right_justify (in, out, Memc[ibuf], ip) + case SH: + call new_section (in, out, Memc[ibuf], ip) + case IH: + call new_indented_section (in, out, Memc[ibuf], ip) + case NH: + call new_numbered_section (in, out, Memc[ibuf], ip) + case BR: + call breakline (out, NJ) + case CE: + call center_text (in, out, Memc[ibuf], ip) + case SP: + call skiplines (out, lgetarg(Memc[ibuf],ip,1)) + case IN: + call indent_left_margin (in, out, lgetarg(Memc[ibuf],ip,0)) + case LS, LE: + call do_LS (out, Memc[ibuf+ip-1], command, last_command) + + case HR: + # HTML href target of the form ".hr <href> <text>", we skip + # ahead to the <text> and process as a normal line. + while (IS_WHITE(Memc[ibuf+ip])) # skip space + ip = ip + 1 + while (!IS_WHITE(Memc[ibuf+ip])) # skip <href> + ip = ip + 1 + call amovc (Memc[ibuf+ip+1], Memc[ibuf], SZ_IBUF) + ip = 0 + goto text_ + + case HN: + # HTML name target of the form ".hn <name>", ignore. + next + + # The following cases are for forms control. + case BP: + call breakline (out, NJ) + if (foflag == YES) + call outcc (out, FC_BREAKPAGE) + case TP: + call breakline (out, NJ) + if (foflag == YES) { + ctrlstr[1] = FC_TESTPAGE + ctrlstr[2] = lgetarg (Memc[ibuf], ip, DEF_TPNLINES) + ctrlstr[3] = EOS + call out (out_magic_arg, ctrlstr) + } + case KS: + call breakline (out, NJ) + if (foflag == YES) + call outcc (out, FC_STARTKEEP) + case KE: + call breakline (out, NJ) + if (foflag == YES) + call outcc (out, FC_ENDKEEP) + + case ENDHELP: # normal exit point + break + + default: # ordinary line of text +text_ if (Memc[ibuf] == '.') { + # Ignore unrecognized directives. + next + } else { + # Determine if line is blank; skip a line if so, otherwise + # process a normal line of text. + for (ip=0; Memc[ibuf+ip] == BLANK; ip=ip+1) + ; + if (Memc[ibuf+ip] == EOS) + call skiplines (out, 1) + else if (Memc[ibuf] == '\\') + call textout (out, Memc[ibuf+1]) + else + call textout (out, Memc[ibuf]) + } + } + + last_command = command + + } until (input (in, Memc[ibuf]) == EOF) + + +99 call breakline (out, NJ) + call set_wordbuf (0) + call set_outbuf (0) + + call sfree (sp) +end diff --git a/pkg/system/help/lroff/lroff2html.c b/pkg/system/help/lroff/lroff2html.c new file mode 100644 index 00000000..26cf8227 --- /dev/null +++ b/pkg/system/help/lroff/lroff2html.c @@ -0,0 +1,1381 @@ +/* lroff2html.x -- translated by f2c (version 20100827). + You must link the resulting object file with libf2c: + on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm + or, if you install libf2c.a in a standard place, with -lf2c -lm + -- in that order, at the end of the command line, as in + cc *.o -lf2c -lm + Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., + + http://www.netlib.org/f2c/libf2c.zip +*/ + +#include "f2c.h" + +/* Common Block Declarations */ + +struct { + doublereal memd[1]; +} mem_; + +#define mem_1 mem_ + +struct { + integer rightn, leftmn, permrn, permln, inmagg, outmag, soflag, foflag, + justiy, nls, lsindt, shnskp, ihnskp, ihindt, nhnskp, nhlevl[10]; + logical standd; +} lrfcom_; + +#define lrfcom_1 lrfcom_ + +struct { + logical xerflg, xerpad[84]; +} xercom_; + +#define xercom_1 xercom_ + +/* Table of constant values */ + +static integer c__2046 = 2046; +static integer c__2 = 2; +static integer c__1023 = 1023; +static integer c__255 = 255; +static integer c__256 = 256; +static integer c__9 = 9; +static integer c__0 = 0; +static integer c__10 = 10; +static integer c__1 = 1; +static logical c_true = TRUE_; +static integer c__3 = 3; + +/* Subroutine */ int lroffl_(in, out, module, parstr, center, lsblok, sectin) +integer *in, *out; +shortint *module, *parstr, *center, *lsblok, *sectin; +{ + /* Initialized data */ + + static shortint st0003[5] = { 60,80,62,10,0 }; + static shortint st0004[7] = { 94,46,104,101,108,112,0 }; + static shortint st0005[8] = { 60,47,80,82,69,62,10,0 }; + static shortint st0006[7] = { 60,80,82,69,62,10,0 }; + static shortint st0007[13] = { 60,47,68,68,62,10,60,47,68,76,62,10,0 }; + static shortint st0008[13] = { 60,47,68,68,62,10,60,47,68,76,62,10,0 }; + static shortint st0009[2] = { 124,0 }; + static shortint st0010[13] = { 60,47,68,68,62,10,60,47,68,76,62,10,0 }; + static shortint st0011[25] = { 60,67,69,78,84,69,82,62,37,115,60,47,67,69, + 78,84,69,82,62,60,66,82,62,10,0 }; + static shortint st0012[6] = { 60,66,82,62,10,0 }; + static shortint st0013[6] = { 60,66,82,62,10,0 }; + static shortint st0014[6] = { 60,66,82,62,10,0 }; + static shortint st0015[13] = { 60,68,76,62,10,60,68,84,62,60,66,62,0 }; + static shortint st0016[22] = { 60,65,32,78,65,77,69,61,34,108,95,37,115, + 34,62,37,115,60,47,65,62,0 }; + static shortint st0017[11] = { 60,47,66,62,60,47,68,84,62,10,0 }; + static shortint st0018[46] = { 60,33,32,83,101,99,61,37,115,32,76,101,118, + 101,108,61,37,100,32,76,97,98,101,108,61,39,37,115,39,32,76,105, + 110,101,61,39,37,115,39,62,10,60,68,68,62,0 }; + static shortint st0019[5] = { 78,111,110,101,0 }; + static shortint st0020[2] = { 32,0 }; + static shortint st0021[13] = { 60,47,68,68,62,10,60,47,68,76,62,10,0 }; + static shortint st0022[21] = { 60,65,32,72,82,69,70,61,34,37,115,34,62,37, + 115,60,47,65,62,10,0 }; + static shortint st0023[19] = { 60,65,32,78,65,77,69,61,34,37,115,34,62,60, + 47,65,62,10,0 }; + static shortint st0024[7] = { 60,80,82,69,62,10,0 }; + static shortint st0025[8] = { 60,47,80,82,69,62,10,0 }; + static shortint st0026[5] = { 39,37,115,39,0 }; + static shortint st0027[7] = { 60,47,85,76,62,10,0 }; + static shortint st0028[22] = { 60,33,32,69,110,100,83,101,99,116,105,111, + 110,58,32,32,32,37,115,62,10,0 }; + static shortint st0029[32] = { 60,72,50,62,60,65,32,78,65,77,69,61,34,115, + 95,37,115,34,62,37,115,60,47,65,62,60,47,72,50,62,10,0 }; + static shortint st0030[35] = { 60,72,50,62,60,65,32,78,65,77,69,61,34,115, + 95,37,115,34,62,37,115,32,37,115,60,47,65,62,60,47,72,50,62,10,0 } + ; + static shortint st0031[24] = { 60,33,32,66,101,103,105,110,83,101,99,116, + 105,111,110,58,32,39,37,115,39,62,10,0 }; + static shortint st0032[6] = { 60,85,76,62,10,0 }; + static shortint st0033[3] = { 37,115,0 }; + static shortint st0034[30] = { 60,47,85,76,62,10,60,33,32,69,110,100,83, + 101,99,116,105,111,110,58,32,32,32,32,37,115,62,10,10,0 }; + static shortint st0035[14] = { 60,33,32,67,111,110,116,101,110,116,115,58, + 32,0 }; + static shortint st0036[4] = { 37,115,32,0 }; + static shortint st0037[5] = { 32,62,10,10,0 }; + static shortint st0038[17] = { 60,47,66,79,68,89,62,10,60,47,72,84,77,76, + 62,10,0 }; + static shortint st0001[24] = { 60,84,73,84,76,69,62,37,115,60,47,84,73,84, + 76,69,62,10,60,85,76,62,10,0 }; + static shortint st0002[2] = { 32,0 }; + + /* System generated locals */ + integer i__1; + + /* Local variables */ + static integer i__, ip, sp, cmd, arg; +#define memb ((logical *)&mem_1) +#define memc ((shortint *)&mem_1) + static integer name__, ibuf; +#define memi ((integer *)&mem_1) + static integer nsec; +#define meml ((integer *)&mem_1) + static integer sw0001, sw0002; +#define memr ((real *)&mem_1) +#define mems ((shortint *)&mem_1) +#define memx ((complex *)&mem_1) + static integer font, sptr; + extern /* Subroutine */ int aclrc_(), pargi_(), sfree_(); + static integer level, unesc; + extern /* Subroutine */ int smark_(); + static integer indend; + extern integer lgetag_(); + extern /* Subroutine */ int lhesce_(); + static logical formad; + extern integer getlie_(), lhfink_(), lhfinn_(); + extern /* Subroutine */ int salloc_(), lhmkne_(); + static integer lastle; + static logical format, quitae, quitah; + extern integer nextcd_(), strmah_(); + static integer lslevl; + extern integer strids_(); + extern /* Subroutine */ int amovki_(), ungete_(), lhprog_(), fprinf_(), + pargsr_(), lhsetl_(), sprinf_(), xffluh_(), zzepro_(); + extern integer xstrln_(); + extern /* Subroutine */ int xstrcy_(); + + /* Parameter adjustments */ + --sectin; + --lsblok; + --center; + --parstr; + --module; + + /* Function Body */ + smark_(&sp); + salloc_(&ibuf, &c__2046, &c__2); + salloc_(&unesc, &c__2046, &c__2); + salloc_(&name__, &c__1023, &c__2); + salloc_(&level, &c__255, &c__2); + salloc_(&sptr, &c__256, &c__9); + aclrc_(&memc[ibuf - 1], &c__2046); + aclrc_(&memc[name__ - 1], &c__1023); + aclrc_(&memc[unesc - 1], &c__2046); + aclrc_(&memc[level - 1], &c__255); + lastle = 3; + font = 1; + indend = 1; + nsec = 0; + lslevl = 0; + format = TRUE_; + quitae = FALSE_; + quitah = FALSE_; + formad = FALSE_; + amovki_(&c__0, lrfcom_1.nhlevl, &c__10); +L110: + if (! (getlie_(in, &memc[ibuf - 1]) == -2)) { + goto L120; + } + goto L98; +L120: + ip = 1; +L130: + if (! (memc[ibuf + ip - 2] == 32 || memc[ibuf + ip - 2] == 9)) { + goto L132; + } +/* L131: */ + ++ip; + goto L130; +L132: +/* L111: */ + if (! (memc[ibuf + ip - 2] != 10)) { + goto L110; + } +/* L112: */ + ungete_(in, &memc[ibuf - 1]); + if (! (memc[ibuf - 1] == 46)) { + goto L140; + } + formad = TRUE_; +L140: + if (! (sectin[1] != 0)) { + goto L150; + } + if (! (lhfinn_(in, &formad, §in[1]) == -2)) { + goto L160; + } + goto L98; +L160: + goto L151; +L150: + if (! (lsblok[1] != 0)) { + goto L170; + } + if (! (lhfink_(in, &formad, &lsblok[1]) == -2)) { + goto L180; + } + goto L98; +L180: + quitae = TRUE_; +L170: +L151: + lhprog_(out, &module[1], &parstr[1], ¢er[1]); + fprinf_(out, st0001); + if (! (lsblok[1] != 0)) { + goto L190; + } + pargsr_(&lsblok[1]); + goto L191; +L190: + if (! (sectin[1] != 0)) { + goto L200; + } + pargsr_(§in[1]); + goto L201; +L200: + if (! (module[1] != 0)) { + goto L210; + } + pargsr_(&module[1]); + goto L211; +L210: + pargsr_(st0002); +L211: +L201: +L191: +L220: + if (! (getlie_(in, &memc[ibuf - 1]) != -2)) { + goto L221; + } + memc[ibuf + xstrln_(&memc[ibuf - 1]) - 2] = 0; + xstrcy_(&memc[ibuf - 1], &memc[unesc - 1], &c__1023); + lhesce_(&memc[ibuf - 1], &font, &format, &c__0, &c__1023); + sw0001 = memc[ibuf - 1]; + goto L230; +L240: + fprinf_(out, st0003); + goto L231; +L250: + if (! (strmah_(&memc[ibuf - 1], st0004) > 0)) { + goto L260; + } + goto L220; +L260: + ip = 1; + lastle = 3; + cmd = nextcd_(&memc[ibuf - 1], &ip); +L270: + if (! (memc[ibuf + ip - 1] == 32 || memc[ibuf + ip - 1] == 9)) { + goto L271; + } + ++ip; + goto L270; +L271: + sw0002 = cmd; + goto L280; +L290: + fprinf_(out, st0005); + format = TRUE_; + goto L281; +L300: + fprinf_(out, st0006); + format = FALSE_; + goto L281; +L310: + goto L220; +L320: + goto L220; +L330: + goto L220; +L340: + if (! (lslevl > 0)) { + goto L350; + } + fprinf_(out, st0007); + lslevl = 0; +L350: + lastle = 1; + memc[level - 1] = 0; + goto L220; +L360: + if (! (lslevl > 0)) { + goto L370; + } + fprinf_(out, st0008); + lslevl = 0; +L370: + lastle = 1; + memc[level - 1] = 0; + if (! quitah) { + goto L380; + } + if (! (strids_(st0009, §in[1]) > 0)) { + goto L390; + } + quitah = FALSE_; + ungete_(in, &memc[ibuf - 1]); + if (! (lhfinn_(in, &formad, §in[1]) == -2)) { + goto L400; + } + goto L221; +L400: + goto L391; +L390: + goto L221; +L391: +L380: + goto L220; +L410: + if (! (lslevl > 0)) { + goto L420; + } + fprinf_(out, st0010); + lslevl = 0; +L420: + i__1 = lgetag_(&memc[ibuf - 1], &ip, &c__1); + lhsetl_(&i__1, &memc[level - 1]); + lastle = 1; + goto L220; +L430: + if (! (getlie_(in, &memc[ibuf - 1]) == -2)) { + goto L440; + } + goto L221; +L440: + lhesce_(&memc[ibuf - 1], &font, &c_true, &c__0, &c__1023); + fprinf_(out, st0011); + pargsr_(&memc[ibuf - 1]); +/* L441: */ + goto L281; +L450: + fprinf_(out, st0012); + goto L281; +L460: + arg = lgetag_(&memc[ibuf - 1], &ip, &c__1); + fprinf_(out, st0013); + i__ = 1; +L470: + if (! (i__ < arg)) { + goto L472; + } + fprinf_(out, st0014); +/* L471: */ + ++i__; + goto L470; +L472: + goto L281; +L480: + goto L220; +L490: + arg = lgetag_(&memc[ibuf - 1], &ip, &c__0); + if (! (arg == 0)) { + goto L500; + } + ip = 5; +L500: + xstrcy_(&memc[ibuf + ip - 2], &memc[name__ - 1], &c__1023); + i__ = 0; +L510: + if (! (memc[name__ + i__ - 1] >= 65 && memc[name__ + i__ - 1] <= 90 || + memc[name__ + i__ - 1] >= 97 && memc[name__ + i__ - 1] <= 122 || + memc[name__ + i__ - 1] >= 48 && memc[name__ + i__ - 1] <= 57 || + memc[name__ + i__ - 1] == 95)) { + goto L512; + } +/* L511: */ + ++i__; + goto L510; +L512: + memc[name__ + i__ - 1] = 0; + memc[ibuf + ip + xstrln_(&memc[ibuf + ip - 1]) - 2] = 0; + fprinf_(out, st0015); + fprinf_(out, st0016); + pargsr_(&memc[name__ - 1]); + pargsr_(&memc[ibuf + ip - 2]); + fprinf_(out, st0017); + lhesce_(&memc[unesc + ip - 2], &font, &c_true, &c__1, &c__1023); + memc[unesc + xstrln_(&memc[unesc - 1]) - 2] = 0; + fprinf_(out, st0018); + if (! (nsec > 0)) { + goto L520; + } + pargsr_(&memc[memi[sptr + nsec - 2] - 1]); + goto L521; +L520: + pargsr_(st0019); +L521: + pargi_(&lslevl); + pargsr_(&memc[name__ - 1]); + if (! (memc[unesc + ip - 2] == 10)) { + goto L530; + } + pargsr_(st0020); + goto L531; +L530: + pargsr_(&memc[unesc + ip - 2]); +L531: + ++lslevl; + goto L281; +L540: + fprinf_(out, st0021); + --lslevl; + if (! quitae) { + goto L550; + } + goto L221; +L550: + goto L281; +L560: + memc[ibuf + ip + xstrln_(&memc[ibuf + ip - 1]) - 2] = 0; + i__ = 0; +L570: + if (memc[ibuf + ip - 1] == 32 || memc[ibuf + ip - 1] == 9) { + goto L572; + } + memc[name__ + i__ - 1] = memc[ibuf + ip - 1]; + ++i__; +/* L571: */ + ++ip; + goto L570; +L572: + memc[name__ + i__ - 1] = 0; + fprinf_(out, st0022); + pargsr_(&memc[name__ - 1]); + pargsr_(&memc[ibuf + ip]); + goto L281; +L580: + memc[ibuf + ip + xstrln_(&memc[ibuf + ip - 1]) - 2] = 0; + fprinf_(out, st0023); + pargsr_(&memc[ibuf + ip - 1]); + goto L281; +L590: + goto L220; +L600: + goto L220; +L610: + fprinf_(out, st0024); + format = FALSE_; + goto L281; +L620: + fprinf_(out, st0025); + format = TRUE_; + goto L281; +L630: + goto L221; +L280: + if (sw0002 < 1 || sw0002 > 21) { + goto L281; + } + switch ((int)sw0002) { + case 1: goto L290; + case 2: goto L300; + case 3: goto L310; + case 4: goto L320; + case 5: goto L330; + case 6: goto L340; + case 7: goto L360; + case 8: goto L410; + case 9: goto L450; + case 10: goto L430; + case 11: goto L460; + case 12: goto L480; + case 13: goto L490; + case 14: goto L540; + case 15: goto L590; + case 16: goto L600; + case 17: goto L610; + case 18: goto L620; + case 19: goto L560; + case 20: goto L580; + case 21: goto L630; + } +L281: + goto L231; +L640: + if (! (lastle == 1)) { + goto L650; + } + salloc_(&memi[sptr + nsec - 1], &c__1023, &c__2); + aclrc_(&memc[memi[sptr + nsec - 1] - 1], &c__1023); + memc[ibuf + xstrln_(&memc[ibuf - 1]) - 2] = 0; + sprinf_(&memc[memi[sptr + nsec - 1] - 1], &c__1023, st0026); + pargsr_(&memc[ibuf - 1]); + if (! (indend == 1)) { + goto L660; + } + fprinf_(out, st0027); +L660: + if (! (nsec > 0)) { + goto L670; + } + fprinf_(out, st0028); + pargsr_(&memc[memi[sptr + nsec - 2] - 1]); +L670: + lhmkne_(&memc[ibuf - 1], &memc[name__ - 1]); + if (! (memc[level - 1] == 0)) { + goto L680; + } + fprinf_(out, st0029); + pargsr_(&memc[name__ - 1]); + pargsr_(&memc[ibuf - 1]); + goto L681; +L680: + fprinf_(out, st0030); + pargsr_(&memc[name__ - 1]); + pargsr_(&memc[level - 1]); + pargsr_(&memc[ibuf - 1]); + memc[level - 1] = 0; +L681: + fprinf_(out, st0031); + pargsr_(&memc[ibuf - 1]); + if (! (indend == 1)) { + goto L690; + } + fprinf_(out, st0032); +L690: + lastle = 2; + ++nsec; + if (! (sectin[1] != 0)) { + goto L700; + } + quitah = TRUE_; +L700: + goto L651; +L650: +/* L99: */ + fprinf_(out, st0033); + pargsr_(&memc[ibuf - 1]); + lastle = 3; +L651: + goto L231; +L230: + if (sw0001 == 10) { + goto L240; + } + if (sw0001 == 46) { + goto L250; + } + goto L640; +L231: + aclrc_(&memc[ibuf - 1], &c__2046); + aclrc_(&memc[unesc - 1], &c__2046); + aclrc_(&memc[name__ - 1], &c__1023); + goto L220; +L221: + if (! (nsec > 0)) { + goto L710; + } + fprinf_(out, st0034); + pargsr_(&memc[memi[sptr + nsec - 2] - 1]); +L710: + fprinf_(out, st0035); + i__ = 0; +L720: + if (! (i__ < nsec)) { + goto L722; + } + fprinf_(out, st0036); + pargsr_(&memc[memi[sptr + i__ - 1] - 1]); +/* L721: */ + ++i__; + goto L720; +L722: + fprinf_(out, st0037); + fprinf_(out, st0038); + xffluh_(out); +L98: + sfree_(&sp); +/* L100: */ + zzepro_(); + return 0; +} /* lroffl_ */ + +#undef memx +#undef mems +#undef memr +#undef meml +#undef memi +#undef memc +#undef memb + + +/* Subroutine */ int lhprog_(fd, mod, date, title) +integer *fd; +shortint *mod, *date, *title; +{ + /* Initialized data */ + + static shortint st0001[15] = { 60,72,84,77,76,62,10,60,66,79,68,89,62,10, + 0 }; + static shortint st0002[36] = { 60,84,65,66,76,69,32,87,73,68,84,72,61,34, + 49,48,48,37,37,34,32,66,79,82,68,69,82,61,48,62,60,84,82,62,10,0 } + ; + static shortint st0003[30] = { 60,84,68,32,65,76,73,71,78,61,76,69,70,84, + 62,60,70,79,78,84,32,83,73,90,69,61,52,62,10,0 }; + static shortint st0004[10] = { 60,66,62,37,115,60,47,66,62,0 }; + static shortint st0005[15] = { 60,66,62,37,115,32,40,37,115,41,60,47,66, + 62,0 }; + static shortint st0006[14] = { 60,47,70,79,78,84,62,60,47,84,68,62,10,0 }; + static shortint st0007[32] = { 60,84,68,32,65,76,73,71,78,61,67,69,78,84, + 69,82,62,60,70,79,78,84,32,83,73,90,69,61,52,62,10,0 }; + static shortint st0008[11] = { 60,66,62,37,115,60,47,66,62,10,0 }; + static shortint st0009[14] = { 60,47,70,79,78,84,62,60,47,84,68,62,10,0 }; + static shortint st0010[31] = { 60,84,68,32,65,76,73,71,78,61,82,73,71,72, + 84,62,60,70,79,78,84,32,83,73,90,69,61,52,62,10,0 }; + static shortint st0011[10] = { 60,66,62,37,115,60,47,66,62,0 }; + static shortint st0012[15] = { 60,66,62,37,115,32,40,37,115,41,60,47,66, + 62,0 }; + static shortint st0013[14] = { 60,47,70,79,78,84,62,60,47,84,68,62,10,0 }; + static shortint st0014[18] = { 60,47,84,82,62,60,47,84,65,66,76,69,62,60, + 80,62,10,0 }; + + extern /* Subroutine */ int fprinf_(), pargsr_(), zzepro_(); + + /* Parameter adjustments */ + --title; + --date; + --mod; + + /* Function Body */ + fprinf_(fd, st0001); + if (! (date[1] == 0 && title[1] == 0)) { + goto L110; + } + goto L100; +L110: + fprinf_(fd, st0002); + fprinf_(fd, st0003); + if (! (date[1] == 0)) { + goto L120; + } + fprinf_(fd, st0004); + pargsr_(&mod[1]); + goto L121; +L120: + fprinf_(fd, st0005); + pargsr_(&mod[1]); + pargsr_(&date[1]); +L121: + fprinf_(fd, st0006); + if (! (title[1] != 0)) { + goto L130; + } + fprinf_(fd, st0007); + fprinf_(fd, st0008); + pargsr_(&title[1]); + fprinf_(fd, st0009); +L130: + fprinf_(fd, st0010); + if (! (date[1] == 0)) { + goto L140; + } + fprinf_(fd, st0011); + pargsr_(&mod[1]); + goto L141; +L140: + fprinf_(fd, st0012); + pargsr_(&mod[1]); + pargsr_(&date[1]); +L141: + fprinf_(fd, st0013); + fprinf_(fd, st0014); +L100: + zzepro_(); + return 0; +} /* lhprog_ */ + +/* Subroutine */ int lhesce_(str, font, format, speciy, maxch) +shortint *str; +integer *font; +logical *format; +integer *speciy, *maxch; +{ + /* Initialized data */ + + static shortint st0013[5] = { 60,47,66,62,0 }; + static shortint st0014[4] = { 60,73,62,0 }; + static shortint st0015[5] = { 60,47,66,62,0 }; + static shortint st0016[5] = { 60,47,73,62,0 }; + static shortint st0017[5] = { 60,47,66,62,0 }; + static shortint st0018[5] = { 60,47,73,62,0 }; + static shortint st0019[5] = { 60,66,82,62,0 }; + static shortint st0020[3] = { 10,0,0 }; + static shortint st0001[4] = { 60,62,38,0 }; + static shortint st0002[5] = { 38,108,116,59,0 }; + static shortint st0003[5] = { 38,103,116,59,0 }; + static shortint st0004[6] = { 38,97,109,112,59,0 }; + static shortint st0005[5] = { 60,84,84,62,0 }; + static shortint st0006[6] = { 60,47,84,84,62,0 }; + static shortint st0007[5] = { 60,84,84,62,0 }; + static shortint st0008[6] = { 60,47,84,84,62,0 }; + static shortint st0009[7] = { 60,47,84,84,62,34,0 }; + static shortint st0010[6] = { 34,60,84,84,62,0 }; + static shortint st0011[5] = { 60,47,73,62,0 }; + static shortint st0012[4] = { 60,66,62,0 }; + + /* Local variables */ + static integer i__, ip, sp, buf; +#define memb ((logical *)&mem_1) +#define memc ((shortint *)&mem_1) +#define memi ((integer *)&mem_1) +#define meml ((integer *)&mem_1) + static integer sw0001; +#define memr ((real *)&mem_1) +#define mems ((shortint *)&mem_1) +#define memx ((complex *)&mem_1) + extern /* Subroutine */ int aclrc_(), sfree_(), amovc_(), smark_(), + salloc_(); + static integer keywod; + extern integer gstrcy_(), stridx_(); + extern /* Subroutine */ int zzepro_(); + + /* Parameter adjustments */ + --str; + + /* Function Body */ + smark_(&sp); + salloc_(&buf, maxch, &c__2); + salloc_(&keywod, maxch, &c__2); + aclrc_(&memc[buf - 1], maxch); + aclrc_(&memc[keywod - 1], maxch); + ip = buf; + i__ = 1; +L110: + if (! (str[i__] != 0 && i__ <= *maxch)) { + goto L112; + } + if (! (*speciy == 1 && stridx_(&str[i__], st0001) == 0)) { + goto L120; + } + goto L90; +L120: + sw0001 = str[i__]; + goto L130; +L140: + ip += gstrcy_(st0002, &memc[ip - 1], &c__1023); + goto L131; +L150: + ip += gstrcy_(st0003, &memc[ip - 1], &c__1023); + goto L131; +L160: + ip += gstrcy_(st0004, &memc[ip - 1], &c__1023); + goto L131; +L170: + if (! (str[i__ + 2] == 39)) { + goto L180; + } + ip += gstrcy_(st0005, &memc[ip - 1], &c__1023); + ip += gstrcy_(&str[i__], &memc[ip - 1], &c__3); + ip += gstrcy_(st0006, &memc[ip - 1], &c__1023); + i__ += 2; + goto L181; +L180: + goto L90; +L181: + goto L131; +L190: + if (! (str[i__ + 2] == 96 || str[i__ + 2] == 39)) { + goto L200; + } + ip += gstrcy_(st0007, &memc[ip - 1], &c__1023); + ip += gstrcy_(&str[i__], &memc[ip - 1], &c__3); + ip += gstrcy_(st0008, &memc[ip - 1], &c__1023); + i__ += 2; + goto L201; +L200: + goto L90; +L201: + goto L131; +L210: + if (! (*format && str[i__ + 1] != 47 && str[i__ + 2] != 47)) { + goto L220; + } + if (! (*font == 5)) { + goto L230; + } + ip += gstrcy_(st0009, &memc[ip - 1], &c__1023); + *font = 1; + goto L231; +L230: + if (! (*font == 1)) { + goto L240; + } + ip += gstrcy_(st0010, &memc[ip - 1], &c__1023); + *font = 5; + goto L241; +L240: + goto L90; +L241: +L231: + goto L221; +L220: + goto L90; +L221: + goto L131; +L250: + if (! (str[i__ + 1] == 102)) { + goto L260; + } + if (! (str[i__ + 2] == 66)) { + goto L270; + } + if (! (*font == 3)) { + goto L280; + } + goto L111; +L280: + if (! (*font == 2)) { + goto L290; + } + ip += gstrcy_(st0011, &memc[ip - 1], &c__1023); +L290: + ip += gstrcy_(st0012, &memc[ip - 1], &c__1023); + *font = 3; + goto L271; +L270: + if (! (str[i__ + 2] == 73)) { + goto L300; + } + if (! (*font == 2)) { + goto L310; + } + goto L111; +L310: + if (! (*font == 3)) { + goto L320; + } + ip += gstrcy_(st0013, &memc[ip - 1], &c__1023); +L320: + ip += gstrcy_(st0014, &memc[ip - 1], &c__1023); + *font = 2; + goto L301; +L300: + if (! (str[i__ + 2] == 82)) { + goto L330; + } + if (! (*font == 3)) { + goto L340; + } + ip += gstrcy_(st0015, &memc[ip - 1], &c__1023); + goto L341; +L340: + if (! (*font == 2)) { + goto L350; + } + ip += gstrcy_(st0016, &memc[ip - 1], &c__1023); +L350: +L341: + *font = 1; + goto L331; +L330: + if (! (str[i__ + 2] == 80)) { + goto L360; + } + if (! (*font == 3)) { + goto L370; + } + ip += gstrcy_(st0017, &memc[ip - 1], &c__1023); + goto L371; +L370: + if (! (*font == 2)) { + goto L380; + } + ip += gstrcy_(st0018, &memc[ip - 1], &c__1023); +L380: +L371: + *font = 1; +L360: +L331: +L301: +L271: + i__ += 2; + goto L261; +L260: + if (! (str[i__ + 1] == 10 || str[i__ + 1] == 0)) { + goto L390; + } + memc[ip - 1] = str[i__]; + ++ip; + ++i__; + ip += gstrcy_(st0019, &memc[ip - 1], &c__1023); + goto L391; +L390: + goto L90; +L391: +L261: + goto L131; +L400: +L90: + memc[ip - 1] = str[i__]; + ++ip; + goto L131; +L130: + if (sw0001 == 34) { + goto L210; + } + if (sw0001 == 38) { + goto L160; + } + if (sw0001 == 39) { + goto L170; + } + if (sw0001 == 60) { + goto L140; + } + if (sw0001 == 62) { + goto L150; + } + if (sw0001 == 92) { + goto L250; + } + if (sw0001 == 96) { + goto L190; + } + goto L400; +L131: +L111: + ++i__; + goto L110; +L112: + ip += gstrcy_(st0020, &memc[ip - 1], &c__1023); + amovc_(&memc[buf - 1], &str[1], maxch); + sfree_(&sp); +/* L100: */ + zzepro_(); + return 0; +} /* lhesce_ */ + +#undef memx +#undef mems +#undef memr +#undef meml +#undef memi +#undef memc +#undef memb + + +/* Subroutine */ int lhsetl_(n, level) +integer *n; +shortint *level; +{ + /* Initialized data */ + + static shortint st0001[4] = { 37,100,46,0 }; + + /* System generated locals */ + integer i__1; + + /* Local variables */ + static integer i__; + extern /* Subroutine */ int pargi_(), amovki_(), sprinf_(), zzepro_(); + extern integer xstrln_(); + + /* Parameter adjustments */ + --level; + + /* Function Body */ + ++lrfcom_1.nhlevl[(60 + (0 + (*n - 1 << 2)) - 60) / 4]; + i__1 = 10 - *n; + amovki_(&c__0, &lrfcom_1.nhlevl[*n], &i__1); + level[1] = 0; + i__1 = *n; + for (i__ = 1; i__ <= i__1; ++i__) { + sprinf_(&level[xstrln_(&level[1]) + 1], &c__2046, st0001); + pargi_(&lrfcom_1.nhlevl[i__ - 1]); +/* L110: */ + } +/* L111: */ + if (! (*n > 1 && level[xstrln_(&level[1])] == 46)) { + goto L120; + } + level[xstrln_(&level[1])] = 0; +L120: +/* L100: */ + zzepro_(); + return 0; +} /* lhsetl_ */ + +integer lhfink_(fd, formad, param) +integer *fd; +logical *formad; +shortint *param; +{ + /* Initialized data */ + + static shortint st0001[5] = { 123,37,115,125,0 }; + static shortint st0002[7] = { 94,46,123,108,115,125,0 }; + static shortint st0003[7] = { 94,35,123,37,115,125,0 }; + + /* System generated locals */ + integer ret_val; + + /* Local variables */ + static integer sp, len; +#define memb ((logical *)&mem_1) +#define memc ((shortint *)&mem_1) +#define memi ((integer *)&mem_1) + static integer lbuf; +#define meml ((integer *)&mem_1) +#define memr ((real *)&mem_1) +#define mems ((shortint *)&mem_1) +#define memx ((complex *)&mem_1) + extern /* Subroutine */ int sfree_(), smark_(); + static logical matchd; + extern integer getlie_(); + extern /* Subroutine */ int salloc_(), ungete_(); + static integer patten; + extern integer strmah_(); + extern /* Subroutine */ int pargsr_(), sprinf_(), zzepro_(); + extern integer xstrln_(); + + /* Parameter adjustments */ + --param; + + /* Function Body */ + smark_(&sp); + salloc_(&patten, &c__255, &c__2); + salloc_(&lbuf, &c__1023, &c__2); + matchd = FALSE_; + if (! (getlie_(fd, &memc[lbuf - 1]) == -2) && ! xercom_1.xerflg) { + goto L110; + } + if (xercom_1.xerflg) { + goto L100; + } + goto L90; +L110: + if (! (*formad)) { + goto L120; + } + sprinf_(&memc[patten - 1], &c__255, st0001); + pargsr_(¶m[1]); +L130: + if (! (strmah_(&memc[lbuf - 1], st0002) > 0)) { + goto L140; + } + if (! (strmah_(&memc[lbuf - 1], &memc[patten - 1]) > 0)) { + goto L150; + } + matchd = TRUE_; + goto L132; +L150: +L140: +/* L131: */ + if (! (getlie_(fd, &memc[lbuf - 1]) == -2) && ! xercom_1.xerflg) { + goto L130; + } + if (xercom_1.xerflg) { + goto L100; + } +L132: + goto L121; +L120: + sprinf_(&memc[patten - 1], &c__255, st0003); + pargsr_(¶m[1]); +L160: + if (! (strmah_(&memc[lbuf - 1], &memc[patten - 1]) > 0)) { + goto L170; + } + matchd = TRUE_; + goto L162; +L170: +/* L161: */ + if (! (getlie_(fd, &memc[lbuf - 1]) == -2) && ! xercom_1.xerflg) { + goto L160; + } + if (xercom_1.xerflg) { + goto L100; + } +L162: +L121: + ungete_(fd, &memc[lbuf - 1]); +L90: + len = xstrln_(&memc[lbuf - 1]); + sfree_(&sp); + if (! matchd) { + goto L180; + } + ret_val = len; + goto L100; +L180: + ret_val = -2; + goto L100; +/* L181: */ +L100: + zzepro_(); + return ret_val; +} /* lhfink_ */ + +#undef memx +#undef mems +#undef memr +#undef meml +#undef memi +#undef memc +#undef memb + + +integer lhfinn_(fd, formad, sectis) +integer *fd; +logical *formad; +shortint *sectis; +{ + /* Initialized data */ + + static shortint st0001[7] = { 94,46,123,105,104,125,0 }; + static shortint st0002[5] = { 46,105,104,10,0 }; + + /* System generated locals */ + integer ret_val, i__1, i__2; + + /* Local variables */ + static integer ip, op, sp; +#define memb ((logical *)&mem_1) +#define memc ((shortint *)&mem_1) +#define memi ((integer *)&mem_1) + static shortint lbuf[1024]; +#define meml ((integer *)&mem_1) + static integer sw0001; +#define memr ((real *)&mem_1) +#define mems ((shortint *)&mem_1) + static integer npat; +#define memx ((complex *)&mem_1) + extern /* Subroutine */ int sfree_(), smark_(); + static logical matchd; + extern integer getlie_(); + extern logical lhmath_(); + static integer patoff[10]; + extern /* Subroutine */ int salloc_(); + static integer patbuf; + extern /* Subroutine */ int ungete_(); + extern integer strmah_(); + extern /* Subroutine */ int zzepro_(); + + /* Parameter adjustments */ + --sectis; + + /* Function Body */ + smark_(&sp); + salloc_(&patbuf, &c__1023, &c__2); + npat = 1; + op = patbuf; + patoff[0] = op; + if (! (getlie_(fd, lbuf) == -2) && ! xercom_1.xerflg) { + goto L110; + } + if (xercom_1.xerflg) { + goto L100; + } + goto L91; +L110: + ip = 1; +L120: + if (! (sectis[ip] != 0)) { + goto L122; + } + sw0001 = sectis[ip]; + goto L130; +L140: + memc[op - 1] = 0; + ++op; +/* Computing MIN */ + i__1 = 10, i__2 = npat + 1; + npat = min(i__1,i__2); + patoff[npat - 1] = op; + goto L131; +L150: + memc[op - 1] = sectis[ip]; + ++op; + goto L131; +L130: + if (sw0001 == 124) { + goto L140; + } + goto L150; +L131: +/* L121: */ + ++ip; + goto L120; +L122: + memc[op - 1] = 0; + matchd = FALSE_; + if (! (*formad)) { + goto L160; + } +L170: + if (! (strmah_(lbuf, st0001) > 0)) { + goto L180; + } + if (! (getlie_(fd, lbuf) != -2) && ! xercom_1.xerflg) { + goto L190; + } + if (xercom_1.xerflg) { + goto L100; + } + matchd = lhmath_(lbuf, patoff, &npat); + if (! matchd) { + goto L200; + } + goto L172; +L200: +L190: +L180: +/* L171: */ + if (! (getlie_(fd, lbuf) == -2) && ! xercom_1.xerflg) { + goto L170; + } + if (xercom_1.xerflg) { + goto L100; + } +L172: + ungete_(fd, lbuf); + ungete_(fd, st0002); + goto L161; +L160: +L210: + matchd = lhmath_(lbuf, patoff, &npat); + if (! matchd) { + goto L220; + } + goto L212; +L220: +/* L211: */ + if (! (getlie_(fd, lbuf) == -2) && ! xercom_1.xerflg) { + goto L210; + } + if (xercom_1.xerflg) { + goto L100; + } +L212: + ungete_(fd, lbuf); +L161: +L91: + sfree_(&sp); + if (! matchd) { + goto L230; + } + ret_val = 0; + goto L100; +L230: + ret_val = -2; + goto L100; +/* L231: */ +L100: + zzepro_(); + return ret_val; +} /* lhfinn_ */ + +#undef memx +#undef mems +#undef memr +#undef meml +#undef memi +#undef memc +#undef memb + + +logical lhmath_(lbuf, patoff, npat) +shortint *lbuf; +integer *patoff, *npat; +{ + /* Initialized data */ + + static shortint st0001[6] = { 94,123,37,115,125,0 }; + + /* System generated locals */ + logical ret_val; + + /* Local variables */ + static integer sp, pat; +#define memb ((logical *)&mem_1) +#define memc ((shortint *)&mem_1) +#define memi ((integer *)&mem_1) +#define meml ((integer *)&mem_1) +#define memr ((real *)&mem_1) +#define mems ((shortint *)&mem_1) +#define memx ((complex *)&mem_1) + extern /* Subroutine */ int sfree_(), smark_(), salloc_(); + static integer patten; + extern integer strmah_(); + extern /* Subroutine */ int pargsr_(), sprinf_(), zzepro_(); + + /* Parameter adjustments */ + --lbuf; + --patoff; + + /* Function Body */ + smark_(&sp); + salloc_(&patten, &c__255, &c__2); + pat = 1; +L110: + if (! (pat <= *npat)) { + goto L112; + } + sprinf_(&memc[patten - 1], &c__255, st0001); + pargsr_(&memc[patoff[pat] - 1]); + if (! (strmah_(&lbuf[1], &memc[patten - 1]) > 0)) { + goto L120; + } + sfree_(&sp); + ret_val = TRUE_; + goto L100; +L120: +/* L111: */ + ++pat; + goto L110; +L112: + sfree_(&sp); + ret_val = FALSE_; + goto L100; +L100: + zzepro_(); + return ret_val; +} /* lhmath_ */ + +#undef memx +#undef mems +#undef memr +#undef meml +#undef memi +#undef memc +#undef memb + + +/* Subroutine */ int lhmkne_(instr, outstr) +shortint *instr, *outstr; +{ + static integer i__; + extern /* Subroutine */ int zzepro_(), xstrcy_(), strlwr_(); + + /* Parameter adjustments */ + --outstr; + --instr; + + /* Function Body */ + xstrcy_(&instr[1], &outstr[1], &c__1023); + strlwr_(&outstr[1]); + i__ = 1; +L110: + if (! (i__ < 1023)) { + goto L112; + } + if (! (outstr[i__] == 0 || outstr[i__] == 10)) { + goto L120; + } + goto L112; +L120: + if (outstr[i__] >= 65 && outstr[i__] <= 90 || outstr[i__] >= 97 && outstr[ + i__] <= 122 || outstr[i__] >= 48 && outstr[i__] <= 57) { + goto L130; + } + outstr[i__] = 95; +L130: +/* L121: */ +/* L111: */ + ++i__; + goto L110; +L112: +/* L100: */ + zzepro_(); + return 0; +} /* lhmkne_ */ + diff --git a/pkg/system/help/lroff/lroff2html.x b/pkg/system/help/lroff/lroff2html.x new file mode 100644 index 00000000..1e3815ae --- /dev/null +++ b/pkg/system/help/lroff/lroff2html.x @@ -0,0 +1,781 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include "lroff.h" + +define DIRECTIVE 1 # processing codes +define NAME 2 +define TEXT 3 + +define F_ROMAN 1 # font changes +define F_ITALIC 2 +define F_BOLD 3 +define F_PREVIOUS 4 +define F_TELETYPE 5 # HTML-specific font + +define SPTR Memi[$1+$2] +define SECTION Memc[SPTR($1,$2)] +define MAX_SECTIONS 256 + + +# LROFF2HTML -- Convert LROFF text to HTML. By default we process the +# entire file however we allow for the printing of only a particular section +# or labelled text block to be compatible with the HELP task options. +# If a section name is given that section will be printed and and .ls +# block request will be ignored. + +procedure lroff2html (in, out, module, parstr, center, ls_block, section) + +int in #I input file descriptor +int out #I output file descriptor +char module[ARB] #I .help module name +char parstr[ARB] #I .help optional keyword 2 +char center[ARB] #I .help optional keyword 3 +char ls_block[ARB] #I .ls block to search for +char section[ARB] #I section to print + +pointer sp, ip, sptr +pointer ibuf, unesc, name, level +int lastline, font, indented, ls_level +int i, arg, nsec, cmd +bool format, quit_at_le, quit_at_ih, formatted + +int lh_findsection(), lh_findblock(), nextcmd() +int stridxs(), getline(), strlen(), strmatch(), lgetarg() + +define text_ 99 +define err_ 98 + +include "lroff.com" + +begin + call smark (sp) + call salloc (ibuf, SZ_IBUF, TY_CHAR) + call salloc (unesc, SZ_IBUF, TY_CHAR) + call salloc (name, SZ_LINE, TY_CHAR) + call salloc (level, SZ_FNAME, TY_CHAR) + call salloc (sptr, MAX_SECTIONS, TY_POINTER) + + call aclrc (Memc[ibuf], SZ_IBUF) + call aclrc (Memc[name], SZ_LINE) + call aclrc (Memc[unesc], SZ_IBUF) + call aclrc (Memc[level], SZ_FNAME) + + # Initialize. + lastline = TEXT + font = F_ROMAN + indented = YES + nsec = 0 + ls_level = 0 + format = true + quit_at_le = false + quit_at_ih = false + formatted = false + + # Initialize the section numbering. + call amovki (0, nh_level, MAX_NHLEVEL) + + # Determine whether or not the text is formatted. + repeat { + if (getline (in, Memc[ibuf]) == EOF) + goto err_ + for (ip=1; IS_WHITE(Memc[ibuf+ip-1]); ip=ip+1) + ; + } until (Memc[ibuf+ip-1] != '\n') + call ungetline (in, Memc[ibuf]) + if (Memc[ibuf] == '.') + formatted = true + + # Scan forward if searching for and item. + if (section[1] != EOS) { + if (lh_findsection (in, formatted, section) == EOF) + goto err_ + } else if (ls_block[1] != EOS) { + if (lh_findblock (in, formatted, ls_block) == EOF) + goto err_ + quit_at_le = true + } + + # Begin the output. + call lh_prolog (out, module, parstr, center) + call fprintf (out, "<TITLE>%s</TITLE>\n<UL>\n") + if (ls_block[1] != EOS) + call pargstr (ls_block) + else if (section[1] != EOS) + call pargstr (section) + else if (module[1] != EOS) + call pargstr (module) + else + call pargstr (" ") + + + # Process the file. + while (getline (in, Memc[ibuf]) != EOF) { + + # Make a copy of the raw line minus the newline char, we may need + # this to extract comments later. + Memc[ibuf+strlen(Memc[ibuf])-1] = EOS + call strcpy (Memc[ibuf], Memc[unesc], SZ_LINE) + + + # Escape problem chars for HTML and handle font changes. Changes + # are done in-place. + call lh_escape (Memc[ibuf], font, format, NO, SZ_LINE) + + switch (Memc[ibuf]) { + case '\n': + call fprintf (out, "<P>\n") + + case '.': + # Swallow any help strings if present. + if (strmatch (Memc[ibuf], "^.help") > 0) + next + + ip = 1 + lastline = TEXT + + # Process the directive, position the ip at the beginning + # of any argument. + cmd = nextcmd (Memc[ibuf], ip) + while (IS_WHITE(Memc[ibuf+ip])) # skip spaces + ip = ip + 1 + + switch (cmd) { + case FI: # enter fill mode + call fprintf (out, "</PRE>\n") + format = true + case NF: # leave fill mode (nofill) + call fprintf (out, "<PRE>\n") + format = false + case JU: # enter line justification mode + # no-op + next + case NJ: # leave line justification mode + # no-op + next + case RJ: # right justify text on nf,nj line + # no-op + next + + case SH: # section heading + if (ls_level > 0) { # for missing .le statements + call fprintf (out, "</DD>\n</DL>\n") + ls_level = 0 + } + lastline = DIRECTIVE + Memc[level] = EOS + next + case IH: # indented section heading + if (ls_level > 0) { # for missing .le statements + call fprintf (out, "</DD>\n</DL>\n") + ls_level = 0 + } + lastline = DIRECTIVE + Memc[level] = EOS + if (quit_at_ih) + if (stridxs ("|", section) > 0) { + quit_at_ih = false + call ungetline (in, Memc[ibuf]) + if (lh_findsection (in, formatted, section) == EOF) + break + } else + break + next + case NH: # numbered section heading + if (ls_level > 0) { # for missing .le statements + call fprintf (out, "</DD>\n</DL>\n") + ls_level = 0 + } + call lh_set_level (lgetarg(Memc[ibuf],ip,1), Memc[level]) + lastline = DIRECTIVE + next + + case CE: # center next line + if (getline (in, Memc[ibuf]) == EOF) + break + else { + call lh_escape (Memc[ibuf], font, true, NO, SZ_LINE) + call fprintf (out, "<CENTER>%s</CENTER><BR>\n") + call pargstr (Memc[ibuf]) + } + + case BR: # break line + call fprintf (out, "<BR>\n") + case SP: # break, space N spaces on output + arg = lgetarg (Memc[ibuf], ip, 1) + call fprintf (out, "<BR>\n") + for (i=1; i < arg; i = i + 1) + call fprintf (out, "<BR>\n") + case IN: # indent +/- N spaces + # no-op + next + + case LS: # begin labelled section + arg = lgetarg (Memc[ibuf], ip, 0) + if (arg == 0) + ip = 5 + + # Generate a HREF of the label, we use only the first word. + call strcpy (Memc[ibuf+ip-1], Memc[name], SZ_LINE) + for (i=0; IS_ALNUM(Memc[name+i]) || + Memc[name+i] == '_'; i=i+1) + ; + Memc[name+i] = EOS + Memc[ibuf+ip+strlen(Memc[ibuf+ip])-1] = EOS + + call fprintf (out, "<DL>\n<DT><B>") + call fprintf (out,"<A NAME=\"l_%s\">%s</A>") + call pargstr (Memc[name]) + call pargstr (Memc[ibuf+ip-1]) + call fprintf (out, "</B></DT>\n") + + # Write out a comment line for the GUI to use. + call lh_escape(Memc[unesc+ip-1], font, true, YES, SZ_LINE) + Memc[unesc+strlen(Memc[unesc])-1] = EOS + call fprintf (out, + "<! Sec=%s Level=%d Label=\'%s\' Line=\'%s\'>\n<DD>") + if (nsec > 0) + call pargstr (SECTION(sptr, nsec-1)) + else + call pargstr ("None") + call pargi (ls_level) + call pargstr (Memc[name]) + if (Memc[unesc+ip-1] == '\n') + call pargstr (" ") + else + call pargstr (Memc[unesc+ip-1]) + ls_level = ls_level + 1 + + case LE: # end labelled section + call fprintf (out, "</DD>\n</DL>\n") + ls_level = ls_level - 1 + if (quit_at_le) + break + + case HR: # HREF anchor + # HTML href anchor of the form ".hr <href> <anch_text>", + # we skip ahead to the <text> and process as a normal line. + Memc[ibuf+ip+strlen(Memc[ibuf+ip])-1] = EOS + for (i=0; !IS_WHITE(Memc[ibuf+ip]); ip=ip+1) { + Memc[name+i] = Memc[ibuf+ip] + i = i + 1 + } + Memc[name+i] = EOS + + call fprintf (out, "<A HREF=\"%s\">%s</A>\n") + call pargstr (Memc[name]) + call pargstr (Memc[ibuf+ip+1]) + + case HN: # NAME target + # HTML name target of the form ".hn <name>", strip the + # newline added in the escape routine. + Memc[ibuf+ip+strlen(Memc[ibuf+ip])-1] = EOS + call fprintf (out, "<A NAME=\"%s\"></A>\n") + call pargstr (Memc[ibuf+ip]) + + case BP: # break page + # no-op + next + case TP: # test space left on page + # no-op + next + case KS: # start floating keep + call fprintf (out, "<PRE>\n") + format = false + case KE: # end floating keep + call fprintf (out, "</PRE>\n") + format = true + case ENDHELP: # end of help block + break + } + + default: + if (lastline == DIRECTIVE) { + + # Section directive name. For certain standard sections + # we'll force an indention to make the output look better, + # everything else gets written normally. + + # Save the section name. + call salloc (SPTR(sptr,nsec), SZ_LINE, TY_CHAR) + call aclrc (SECTION(sptr,nsec), SZ_LINE) + Memc[ibuf+strlen(Memc[ibuf])-1] = EOS + call sprintf (SECTION(sptr,nsec), SZ_LINE, "\'%s\'") + call pargstr (Memc[ibuf]) + + if (indented == YES) + call fprintf (out, "</UL>\n") + if (nsec > 0) { + call fprintf (out, "<! EndSection: %s>\n") + call pargstr (SECTION(sptr,nsec-1)) + } + + # Make the section name a URL target. + call lh_mkname (Memc[ibuf], Memc[name]) + if (Memc[level] == EOS) { + call fprintf (out, "<H2><A NAME=\"s_%s\">%s</A></H2>\n") + call pargstr (Memc[name]) + call pargstr (Memc[ibuf]) + } else { + call fprintf (out, + "<H2><A NAME=\"s_%s\">%s %s</A></H2>\n") + call pargstr (Memc[name]) + call pargstr (Memc[level]) + call pargstr (Memc[ibuf]) + Memc[level] = EOS + } + + call fprintf (out, "<! BeginSection: \'%s\'>\n") + call pargstr (Memc[ibuf]) + if (indented == YES) + call fprintf (out, "<UL>\n") + + lastline = NAME + nsec = nsec + 1 + if (section[1] != EOS) + quit_at_ih = true + + } else { + # Ordinary text line. +text_ call fprintf (out, "%s") + call pargstr (Memc[ibuf]) + lastline = TEXT + } + } + + call aclrc (Memc[ibuf], SZ_IBUF) + call aclrc (Memc[unesc], SZ_IBUF) + call aclrc (Memc[name], SZ_LINE) + } + + # Close the last section. + if (nsec > 0) { + call fprintf (out, "</UL>\n<! EndSection: %s>\n\n") + call pargstr (SECTION(sptr,nsec-1)) + } + + # Write out an HTML comment giving the document section names. + call fprintf (out, "<! Contents: ") + for (i=0; i < nsec; i=i+1) { + call fprintf (out, "%s ") + call pargstr (SECTION(sptr,i)) + } + call fprintf (out, " >\n\n") + call fprintf (out, "</BODY>\n</HTML>\n") + + call flush (out) +err_ call sfree (sp) +end + + +# LH_PROLOG -- Begin the HTML output, print the header table for a help +# page if we have the information. + +procedure lh_prolog (fd, mod, date, title) + +int fd #I output file descriptor +char mod[ARB] #I .help module name +char date[ARB] #I .help keyword 2 +char title[ARB] #I .help keyword 3 + +begin + call fprintf (fd, "<HTML>\n<BODY>\n") + + # If we only have the module name don't bother with header. + if (date[1] == EOS && title[1] == EOS) + return + + # Begin the HTML output prolog. + call fprintf (fd, "<TABLE WIDTH=\"100%%\" BORDER=0><TR>\n") + + # Left side page header. + call fprintf (fd, "<TD ALIGN=LEFT><FONT SIZE=4>\n") + if (date[1] == EOS) { + call fprintf (fd, "<B>%s</B>") + call pargstr (mod) + } else { + call fprintf (fd, "<B>%s (%s)</B>") + call pargstr (mod) + call pargstr (date) + } + call fprintf (fd, "</FONT></TD>\n") + + # Center page header. + if (title[1] != EOS) { + call fprintf (fd, "<TD ALIGN=CENTER><FONT SIZE=4>\n") + call fprintf (fd, "<B>%s</B>\n") + call pargstr (title) + call fprintf (fd, "</FONT></TD>\n") + } + + # Right side page header. + call fprintf (fd, "<TD ALIGN=RIGHT><FONT SIZE=4>\n") + if (date[1] == EOS) { + call fprintf (fd, "<B>%s</B>") + call pargstr (mod) + } else { + call fprintf (fd, "<B>%s (%s)</B>") + call pargstr (mod) + call pargstr (date) + } + call fprintf (fd, "</FONT></TD>\n") + + call fprintf (fd, "</TR></TABLE><P>\n") +end + + +# LH_ESCAPE -- Escape any HTML problem characters in the line ('<','>','&') +# as well as the font changes. + +procedure lh_escape (str, font, format, special_only, maxch) + +char str[ARB] #I string to edit +int font #U current font +bool format #I formatting flag +int special_only #I escape only special chars? +int maxch #I max length of string + +pointer sp, ip, buf, keyword +int i, gstrcpy(), stridx() + +define copy_ 90 + +begin + call smark (sp) + call salloc (buf, maxch, TY_CHAR) + call salloc (keyword, maxch, TY_CHAR) + call aclrc (Memc[buf], maxch) + call aclrc (Memc[keyword], maxch) + + ip = buf + for (i=1; str[i] != EOS && i <= maxch; i = i + 1) { + + if (special_only == YES && stridx (str[i], "<>&") == 0) + goto copy_ + + switch (str[i]) { + + # Handle special chars. + case '<': + ip = ip + gstrcpy ("<", Memc[ip], SZ_LINE) + case '>': + ip = ip + gstrcpy (">", Memc[ip], SZ_LINE) + case '&': + ip = ip + gstrcpy ("&", Memc[ip], SZ_LINE) + + # Quoted single chars and strings get a special font. + case '\'': + if (str[i+2] == '\'') { + ip = ip + gstrcpy ("<TT>", Memc[ip], SZ_LINE) + ip = ip + gstrcpy (str[i], Memc[ip], 3) + ip = ip + gstrcpy ("</TT>", Memc[ip], SZ_LINE) + i = i + 2 + } else + goto copy_ + case '`': + if (str[i+2] == '`' || str[i+2] == '\'') { + ip = ip + gstrcpy ("<TT>", Memc[ip], SZ_LINE) + ip = ip + gstrcpy (str[i], Memc[ip], 3) + ip = ip + gstrcpy ("</TT>", Memc[ip], SZ_LINE) + i = i + 2 + } else + goto copy_ + case '"': + if (format && str[i+1] != '/' && str[i+2] != '/') { + if (font == F_TELETYPE) { + # Do a closing quote. + ip = ip + gstrcpy ("</TT>\"", Memc[ip], SZ_LINE) + font = F_ROMAN + } else if (font == F_ROMAN) { + # Do an opening quote. + ip = ip + gstrcpy ("\"<TT>", Memc[ip], SZ_LINE) + font = F_TELETYPE + } else + goto copy_ + } else + goto copy_ + + # Process font changes. + case '\\': + if (str[i+1] == 'f') { + if (str[i+2] == 'B') { + if (font == F_BOLD) + next + if (font == F_ITALIC) + ip = ip + gstrcpy ("</I>", Memc[ip], SZ_LINE) + ip = ip + gstrcpy ("<B>", Memc[ip], SZ_LINE) + font = F_BOLD + + } else if (str[i+2] == 'I') { + if (font == F_ITALIC) + next + if (font == F_BOLD) + ip = ip + gstrcpy ("</B>", Memc[ip], SZ_LINE) + ip = ip + gstrcpy ("<I>", Memc[ip], SZ_LINE) + font = F_ITALIC + + } else if (str[i+2] == 'R') { + if (font == F_BOLD) + ip = ip + gstrcpy ("</B>", Memc[ip], SZ_LINE) + else if (font == F_ITALIC) + ip = ip + gstrcpy ("</I>", Memc[ip], SZ_LINE) + font = F_ROMAN + + } else if (str[i+2] == 'P') { + if (font == F_BOLD) { + ip = ip + gstrcpy ("</B>", Memc[ip], SZ_LINE) + } else if (font == F_ITALIC) { + ip = ip + gstrcpy ("</I>", Memc[ip], SZ_LINE) + } + font = F_ROMAN + } + i = i + 2 + } else if (str[i+1] == '\n' || str[i+1] == EOS) { + Memc[ip] = str[i] + ip = ip + 1 + i = i + 1 + ip = ip + gstrcpy ("<BR>", Memc[ip], SZ_LINE) + } else + goto copy_ + + default: +copy_ Memc[ip] = str[i] + ip = ip + 1 + } + } + + # Add the trailing newline we stripped above. + ip = ip + gstrcpy ("\n\0", Memc[ip], SZ_LINE) + + # Move the string back. + call amovc (Memc[buf], str, maxch) + + call sfree (sp) +end + + +# LH_SET_LEVEL -- Increment the level number of a numbered header. + +procedure lh_set_level (n, level) + +int n #I level number +char level[ARB] #U level string + +int i, strlen() +include "lroff.com" + +begin + # Increment the desired section number; zero all higher + # numbered section counters. + nh_level[n] = nh_level[n] + 1 + call amovki (0, nh_level[n+1], MAX_NHLEVEL - n) + + # Output the section number followed by a blank and then + # the section label. + level[1] = EOS + do i = 1, n { + call sprintf (level[strlen(level)+1], SZ_IBUF, "%d.") + call pargi (nh_level[i]) + } + + # Cancel the final "." if subsection heading. Add a blank. + if (n > 1 && level[strlen(level)] == '.') + level[strlen(level)] = EOS +end + + +# LH_FINDBLOCK -- If text contains format directives, eat input lines until +# a ".ls" directive is found which contains the block name as a substring. +# If the text is not formatted, search for a line beginning with the pattern. + +int procedure lh_findblock (fd, formatted, param) + +int fd +bool formatted +char param[ARB] + +bool match_found +pointer sp, lbuf, pattern +int len +int getline(), strmatch(), strlen() +errchk getline + +define err_ 90 + +begin + call smark (sp) + call salloc (pattern, SZ_FNAME, TY_CHAR) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + match_found = false + + # Get the first line. + if (getline (fd, Memc[lbuf]) == EOF) + goto err_ + + if (formatted) { + call sprintf (Memc[pattern], SZ_FNAME, "{%s}") + call pargstr (param) + repeat { + if (strmatch (Memc[lbuf], "^.{ls}") > 0) + if (strmatch (Memc[lbuf], Memc[pattern]) > 0) { + match_found = true + break + } + } until (getline (fd, Memc[lbuf]) == EOF) + + } else { + call sprintf (Memc[pattern], SZ_FNAME, "^#{%s}") + call pargstr (param) + repeat { + if (strmatch (Memc[lbuf], Memc[pattern]) > 0) { + match_found = true + break + } + } until (getline (fd, Memc[lbuf]) == EOF) + } + call ungetline (fd, Memc[lbuf]) + +err_ len = strlen (Memc[lbuf]) + call sfree (sp) + if (match_found) + return (len) + else + return (EOF) +end + + +# LH_FINDSECTION -- If text contains format directives, eat input lines until +# a ".ih" directive is found for the named section. If the text is not +# formatted, search for a line beginning with the section name. + +define MAXPAT 10 + +int procedure lh_findsection (fd, formatted, sections) + +int fd # input file +bool formatted # is help block formatted +char sections[ARB] # list of sections "a|b|c" + +bool match_found +int npat, ip +pointer sp, patbuf, patoff[MAXPAT], op +char lbuf[SZ_LINE] + +bool lh_match() +int getline(), strmatch() +errchk getline + +define err_ 91 + +begin + call smark (sp) + call salloc (patbuf, SZ_LINE, TY_CHAR) + + # Process the list of sections into patbuf and patoff, i.e., into a + # list of EOS delimited strings in the string buffer patbuf. Each + # section name or abbreviation is delimited by '|' (or). + + npat = 1 + op = patbuf + patoff[1] = op + + # Get the first line. + if (getline (fd, lbuf) == EOF) + goto err_ + + for (ip=1; sections[ip] != EOS; ip=ip+1) + switch (sections[ip]) { + case '|': + Memc[op] = EOS + op = op + 1 + npat = min (MAXPAT, npat + 1) + patoff[npat] = op + default: + Memc[op] = sections[ip] + op = op + 1 + } + Memc[op] = EOS + + match_found = false + + if (formatted) { + repeat { + if (strmatch (lbuf, "^.{ih}") > 0) + if (getline (fd, lbuf) != EOF) { + match_found = lh_match (lbuf, patoff, npat) + if (match_found) + break + } + } until (getline (fd, lbuf) == EOF) + call ungetline (fd, lbuf) + call ungetline (fd, ".ih\n") + + } else { + repeat { + match_found = lh_match (lbuf, patoff, npat) + if (match_found) + break + } until (getline (fd, lbuf) == EOF) + call ungetline (fd, lbuf) + } + +err_ call sfree (sp) + if (match_found) + return (OK) + else + return (EOF) +end + + +# LH_MATCH -- Match a set of patterns against a line of test, matching only +# at the beginning of line in either case. + +bool procedure lh_match (lbuf, patoff, npat) + +char lbuf[ARB] # line of text +pointer patoff[npat] # pointers to pattern strings +int npat # number of patterns + +int pat +pointer sp, pattern +int strmatch() + +begin + call smark (sp) + call salloc (pattern, SZ_FNAME, TY_CHAR) + + for (pat=1; pat <= npat; pat=pat+1) { + call sprintf (Memc[pattern], SZ_FNAME, "^{%s}") + call pargstr (Memc[patoff[pat]]) + if (strmatch (lbuf, Memc[pattern]) > 0) { + call sfree (sp) + return (true) + } + } + + call sfree (sp) + return (false) +end + + +# LH_MKNAME -- Given a string make it suitable for use as an HREF name. + +procedure lh_mkname (instr, outstr) + +char instr[ARB] +char outstr[ARB] + +int i + +begin + # Make it a URL. First convert the section name to a + # lower-case string and replace the blanks. + call strcpy (instr, outstr, SZ_LINE) + call strlwr (outstr) + for (i=1; i < SZ_LINE; i=i+1) + if (outstr[i] == EOS || outstr[i] == '\n') + break + else if (!IS_ALNUM(outstr[i])) + outstr[i] = '_' +end diff --git a/pkg/system/help/lroff/lroff2ps.x b/pkg/system/help/lroff/lroff2ps.x new file mode 100644 index 00000000..a782ca21 --- /dev/null +++ b/pkg/system/help/lroff/lroff2ps.x @@ -0,0 +1,460 @@ +include <syserr.h> +include <ctype.h> +include <psset.h> +include "lroff.h" + + +define DIRECTIVE 1 # processing codes +define NAME 2 +define TEXT 3 +define NEWLINE 4 + +define INDENT 5 # size of indentitudedness + + +# LROFF2PS -- Convert LROFF text to Postscript. By default we process the +# entire file however we allow for the printing of only a particular section +# or labelled text block to be compatible with the HELP task options. +# If a section name is given that section will be printed and and .ls +# block request will be ignored. + +procedure lroff2ps (in, out, psptr, ls_block, section) + +int in #i input file descriptor +int out #i output file descriptor +pointer psptr #i PSIO pointer +char ls_block[ARB] #i .ls block to search for +char section[ARB] #i section to print + +pointer sp, ip, ps +pointer ibuf, line, level +int lastline, font, indent, ls_level +int i, arg, nsec, cmd, last_cmd +bool format, quit_at_le, quit_at_ih, formatted + +pointer ps_open() +int lh_findsection(), lh_findblock(), nextcmd() +int stridxs(), getline(), strlen(), strmatch(), lgetarg() + +define text_ 99 +define err_ 98 + +include "lroff.com" + +begin + call smark (sp) + call salloc (ibuf, SZ_IBUF, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (level, SZ_FNAME, TY_CHAR) + + call aclrc (Memc[ibuf], SZ_LINE) + call aclrc (Memc[line], SZ_LINE) + call aclrc (Memc[level], SZ_LINE) + + # Initialize. + lastline = TEXT + font = F_ROMAN + indent = 0 + nsec = 0 + ls_level = 0 + format = true + quit_at_le = false + quit_at_ih = false + formatted = false + + # Initialize the section numbering. + call amovki (0, nh_level, MAX_NHLEVEL) + + # Determine whether or not the text is formatted. + repeat { + if (getline (in, Memc[ibuf]) == EOF) + goto err_ + for (ip=1; IS_WHITE(Memc[ibuf+ip-1]); ip=ip+1) + ; + } until (Memc[ibuf+ip-1] != '\n') + call ungetline (in, Memc[ibuf]) + if (Memc[ibuf] == '.') + formatted = true + + # Scan forward if searching for and item. + if (section[1] != EOS) { + if (lh_findsection (in, formatted, section) == EOF) + goto err_ + } else if (ls_block[1] != EOS) { + if (lh_findblock (in, formatted, ls_block) == EOF) + goto err_ + quit_at_le = true + } + + # Begin the output is we aren't passed a pointer that may have + # already set up headers, page parameters, etc. + if (psptr == NULL) + ps = ps_open (out, YES) + else + ps = psptr + call ps_write_prolog (ps) + + # Process the file. + while (getline (in, Memc[ibuf]) != EOF) { + + # Escape the line, inserting special font changes for quotes + # chars and strings. + call lp_escape (Memc[ibuf], font, format, SZ_LINE) + + switch (Memc[ibuf]) { + case '\n': + if (lastline != NEWLINE) + call ps_linebreak (ps, NO) + call ps_newline (ps) + lastline = NEWLINE + + case '.': + # Swallow any help strings if present. + if (strmatch (Memc[ibuf], "^.{help}") > 0) + next + + # Stomp the newline. + Memc[ibuf+strlen(Memc[ibuf])-1] = EOS + + # Process the directive, position the ip at the beginning + # of any argument. + ip = 1 + cmd = nextcmd (Memc[ibuf], ip) + while (IS_WHITE(Memc[ibuf+ip])) # skip spaces + ip = ip + 1 + + switch (cmd) { + case FI, KE: # enter fill mode + call ps_setfont (ps, F_ROMAN) + call ps_set_justify (ps, YES) + lastline = NEWLINE + format = true + case NF, KS: # leave fill mode (nofill) + if (lastline != NEWLINE && last_cmd != KS && last_cmd != NF) + call ps_linebreak (ps, NO) + call ps_setfont (ps, F_TELETYPE) + call ps_set_justify (ps, NO) + lastline = NEWLINE + format = false + case JU: # enter line justification mode + call ps_set_justify (ps, YES) + next + case NJ: # leave line justification mode + call ps_set_justify (ps, NO) + next + case RJ: # right justify text on next line + call ps_linebreak (ps, NO) + call strcpy (Memc[ibuf+4], Memc[line], SZ_FNAME) + Memc[line+strlen(Memc[line])-1] = EOS + if (getline (in, Memc[ibuf]) != EOF) { + call ps_output (ps, Memc[ibuf], NO) + call ps_rightjustify (ps, Memc[line]) + } + next + + case SH: # section heading + if (ls_level > 0) { # for missing .le statements + ls_level = 0 + indent = 0 + } + if (nsec > 0) { + call ps_linebreak (ps, NO) + call ps_linebreak (ps, NO) + } + lastline = DIRECTIVE + Memc[level] = EOS + next + case IH: # indented section heading + if (ls_level > 0) { # for missing .le statements + ls_level = 0 + indent = 0 + } + + if (nsec > 0) + call ps_linebreak (ps, NO) + if (lastline == TEXT) + call ps_linebreak (ps, NO) + lastline = DIRECTIVE + Memc[level] = EOS + if (quit_at_ih) + if (stridxs ("|", section) > 0) { + quit_at_ih = false + call ungetline (in, Memc[ibuf]) + if (lh_findsection (in, formatted, section) == EOF) + break + } else + break + next + case NH: # numbered section heading + if (ls_level > 0) { # for missing .le statements + ls_level = 0 + indent = 0 + } + call lh_set_level (lgetarg(Memc[ibuf],ip,1), Memc[level]) + if (nsec > 0) { + call ps_linebreak (ps, NO) + call ps_linebreak (ps, NO) + } + lastline = DIRECTIVE + next + + case CE: # center next line + if (getline (in, Memc[ibuf]) != EOF) { + call lp_escape (Memc[ibuf], font, true, SZ_LINE) + call ps_linebreak (ps, NO) + call ps_center (ps, Memc[ibuf]) + } + + case BR: # break line + call ps_linebreak (ps, NO) + case SP: # break, space N spaces on output + arg = lgetarg (Memc[ibuf], ip, 1) + call ps_linebreak (ps, NO) + for (i=1; i < arg; i = i + 1) + call ps_linebreak (ps, NO) + case IN: # indent +/- N spaces + arg = lgetarg (Memc[ibuf], ip, 0) + call ps_indent (ps, arg) + next + + case LS: # begin labelled section + arg = lgetarg (Memc[ibuf], ip, INDENT) + if (arg == 0) + ip = 5 + + if (lastline == TEXT) + call ps_linebreak (ps, NO) + call ps_testpage (ps, 2) + if (ls_level < 1 || (last_cmd == LS && lastline == TEXT)) + call ps_linebreak (ps, NO) + call ps_spfont (ps, F_BOLD) + call ps_output (ps, Memc[ibuf+ip-1], NO) + if (strlen (Memc[ibuf+ip-1]) > (INDENT-1)) + call ps_linebreak (ps, NO) + call ps_spfont (ps, NULL) + call ps_setfont (ps, F_ROMAN) + + indent = max (0, indent + INDENT) + call ps_indent (ps, indent) + ls_level = ls_level + 1 + + case LE: # end labelled section + if (last_cmd != LE || (last_cmd == LE && lastline == TEXT)) + call ps_linebreak (ps, NO) + indent = max (0, indent - INDENT) + call ps_indent (ps, indent) + ls_level = ls_level - 1 + lastline = NEWLINE + if (quit_at_le) + break + + case HR: # HREF anchor + # HTML href anchor of the form ".hr <href> <anch_text>", + # we skip ahead to the <text> and process as a normal line. + for (i=0; !IS_WHITE(Memc[ibuf+ip]); ip=ip+1) + i = i + 1 + call ps_deposit (ps, Memc[ibuf+ip+1]) + + case HN: # NAME target + # HTML name target of the form ".hn <name>". + # no-op + + case BP: # break page + call ps_linebreak (ps, NO) + call ps_pagebreak (ps) + next + case TP: # test space left on page + # no-op + next + case ENDHELP: # end of help block + break + } + last_cmd = cmd + + default: + # Stomp the newline. + Memc[ibuf+strlen(Memc[ibuf])-1] = EOS + + if (lastline == DIRECTIVE) { + + # Section directive name. For certain standard sections + # we'll force an indention to make the output look better, + # everything else gets written normally. + + indent = max (0, indent - INDENT) + call ps_indent (ps, indent) + + call ps_setfont (ps, F_BOLD) + call ps_testpage (ps, 3) + if (Memc[level] == EOS) { + call ps_output (ps, Memc[ibuf], NO) + } else { + call sprintf (Memc[line], SZ_LINE, "%s %s") + call pargstr (Memc[level]) + call pargstr (Memc[ibuf]) + + call ps_output (ps, Memc[line], NO) + Memc[level] = EOS + } + call ps_setfont (ps, F_ROMAN) + call ps_linebreak (ps, NO) + + indent = max (0, indent + INDENT) + call ps_indent (ps, indent) + + lastline = NAME + nsec = nsec + 1 + if (section[1] != EOS) + quit_at_ih = true + + } else { + # Ordinary text line. +text_ if (format) { + call ps_deposit (ps, Memc[ibuf]) + } else { + call lp_strdetab (Memc[ibuf], Memc[line], SZ_LINE) + call ps_output (ps, Memc[line], NO) + call ps_linebreak (ps, NO) + } + lastline = TEXT + } + } + + call aclrc (Memc[ibuf], SZ_LINE) + call aclrc (Memc[line], SZ_LINE) + } + + # Close the last section. + call ps_linebreak (ps, NO) + call ps_close (ps) + + call flush (out) +err_ call sfree (sp) +end + + +# LP_ESCAPE -- Escape any HTML problem characters in the line ('<','>','&') +# as well as the font changes. + +procedure lp_escape (str, font, format, maxch) + +char str[ARB] #i string to edit +int font #u current font +bool format #i formatting flag +int maxch #i max length of string + +pointer sp, ip, buf, keyword +int i, strmatch(), gstrcpy() +bool is_ls + +define copy_ 90 + +begin + call smark (sp) + call salloc (buf, maxch, TY_CHAR) + call salloc (keyword, maxch, TY_CHAR) + call aclrc (Memc[buf], maxch) + call aclrc (Memc[keyword], maxch) + + ip = buf + is_ls = FALSE + if (strmatch (str, "^.{ls}") > 0) + is_ls = TRUE + + for (i=1; str[i] != EOS && i <= maxch; i = i + 1) { + + switch (str[i]) { + + # Quoted single chars and strings get a special font. + case '\'', '`': + if (str[i+2] == '`' || str[i+2] == '\'') { + if (format) + ip = ip + gstrcpy ("\\fT", Memc[ip], SZ_LINE) + ip = ip + gstrcpy (str[i], Memc[ip], 3) + if (format) { + if (is_ls) + ip = ip + gstrcpy ("\\fB", Memc[ip], SZ_LINE) + else { + switch (font) { + case F_ROMAN: + ip = ip + gstrcpy ("\\fR", Memc[ip], SZ_LINE) + case F_BOLD: + ip = ip + gstrcpy ("\\fB", Memc[ip], SZ_LINE) + case F_ITALIC: + ip = ip + gstrcpy ("\\fI", Memc[ip], SZ_LINE) + case F_TELETYPE: + ip = ip + gstrcpy ("\\fT", Memc[ip], SZ_LINE) + default: + ip = ip + gstrcpy ("\\fR", Memc[ip], SZ_LINE) + } + } + } + i = i + 2 + } else + goto copy_ + case '"': + if (format && str[i+1] != '/' && str[i+2] != '/') { + if (font == F_TELETYPE) { + # Do a closing quote. + if (format) { + if (is_ls) + ip = ip + gstrcpy ("\"\\fB", Memc[ip], SZ_LINE) + else + ip = ip + gstrcpy ("\"\\fR", Memc[ip], SZ_LINE) + } + font = F_ROMAN + } else if (font == F_ROMAN) { + # Do an opening quote. + if (format) + ip = ip + gstrcpy ("\\fT\"", Memc[ip], SZ_LINE) + font = F_TELETYPE + } else + goto copy_ + } else + goto copy_ + + default: +copy_ Memc[ip] = str[i] + ip = ip + 1 + } + } + + # Add the trailing newline we stripped above. + ip = ip + gstrcpy ("\n\0", Memc[ip], SZ_LINE) + + # Move the string back. + call amovc (Memc[buf], str, maxch) + + call sfree (sp) +end + + +# LP_STRDETAB -- Procedure to remove tabs from a line of text. + +procedure lp_strdetab (line, outline, maxch) + +char line[ARB], outline[ARB] +int maxch + +int ip, op + +begin + ip = 1 + op = 1 + + while (line[ip] != EOS && op <= maxch) { + if (line[ip] == '\t') { + repeat { + outline[op] = ' ' + op = op + 1 + } until (mod(op,8) == 0 || op > maxch) + ip = ip + 1 + } else { + outline[op] = line [ip] + ip = ip + 1 + op = op + 1 + } + } + + outline[op] = EOS +end diff --git a/pkg/system/help/lroff/mkpkg b/pkg/system/help/lroff/mkpkg new file mode 100644 index 00000000..73a157d4 --- /dev/null +++ b/pkg/system/help/lroff/mkpkg @@ -0,0 +1,27 @@ +# Make the LROFF line-oriented text formatter. + +$checkout libpkg.a ../../ +$update libpkg.a +$checkin libpkg.a ../../ +$exit + +libpkg.a: + breakline.x lroff.com lroff.h words.com <chars.h> + center.x lroff.com lroff.h <chars.h> + dols.x lroff.com lroff.h <chars.h> <error.h> + getarg.x lroff.h <chars.h> + indent.x lroff.com lroff.h + input.x lroff.com lroff.h <chars.h> <ctype.h> + justify.x lroff.com lroff.h <chars.h> + lroff.x lroff.com lroff.h <chars.h> <ctype.h> + lroff2html.x lroff.com lroff.h <ctype.h> + lroff2ps.x lroff.com lroff.h <psset.h> <ctype.h> + nextcmd.x lroff.h <ctype.h> + nofill.x lroff.com lroff.h + output.x lroff.com lroff.h <chars.h> <mach.h> + rawcopy.x lroff.com lroff.h + section.x lroff.com lroff.h <chars.h> <ctype.h> + skiplines.x lroff.h + textlen.x lroff.h <chars.h> + textout.x lroff.com lroff.h words.com <chars.h> + ; diff --git a/pkg/system/help/lroff/nextcmd.x b/pkg/system/help/lroff/nextcmd.x new file mode 100644 index 00000000..d4b09f44 --- /dev/null +++ b/pkg/system/help/lroff/nextcmd.x @@ -0,0 +1,56 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include "lroff.h" + +.help nextcmd +.nf ________________________________________________________________________ +NEXTCMD -- Examine the input line; if it is an Lroff directive, return +the integer code of the directive, otherwise NULL. Leave IP pointing +to the argument field if a command, otherwise leave it pointing at the +first char of the text line. Note that the "directives" string must +match the opcode definitions given in lroff.h +.endhelp ___________________________________________________________________ + +define SZ_OPCODE 2 + +int procedure nextcmd (linebuf, ip) + +char linebuf[ARB] +int ip, op +char opcode[SZ_OPCODE] +int command, kwp, strmatch(), strncmp() +string directives "finfjunjrjshihnhbrcespinlslebptpkskehrhn" + +begin + if (linebuf[1] != '.') # not a command line? + return (NULL) + if (strmatch (linebuf, "^.endhelp") > 0) + return (ENDHELP) + ip = 2 # skip the '.' + + # Directives may be either upper or lower case. + for (op=1; op <= SZ_OPCODE; op=op+1) { + opcode[op] = linebuf[ip] + if (IS_UPPER (opcode[op])) + opcode[op] = TO_LOWER (opcode[op]) + ip = ip + 1 + } + + # Just in case a directive happens to be longer than 2 chars, make + # sure IP points past the directive name. + while (IS_ALPHA (linebuf[ip])) + ip = ip + 1 + + # Lookup directive, return opcode number if found. + command = NULL + for (kwp=1; directives[kwp] != EOS; kwp=kwp+SZ_OPCODE) + if (strncmp (opcode, directives[kwp], SZ_OPCODE) == 0) { + command = (kwp+1) / SZ_OPCODE + break + } + + if (command == NULL) # unrecognized directive + ip = 1 + return (command) +end diff --git a/pkg/system/help/lroff/nofill.x b/pkg/system/help/lroff/nofill.x new file mode 100644 index 00000000..f81b0d88 --- /dev/null +++ b/pkg/system/help/lroff/nofill.x @@ -0,0 +1,45 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "lroff.h" + +.help nofill +.nf __________________________________________________________________________ +NOFILL -- Copy a block of text in ".nf" (nofill) mode, leaving the text +alone except for left justification. The only directives recognized in +a nofill block are FI (resume filling) and RJ (right justify). +.endhelp _____________________________________________________________________ + +int procedure nofill (in, out, linebuf) + +extern in(), out() +char linebuf[ARB] +int ip, command +pointer sp, rjbuf +int in(), input(), nextcmd() +errchk salloc, breakline, input, rjline, outline +include "lroff.com" + +begin + call smark (sp) + call salloc (rjbuf, SZ_IBUF, TY_CHAR) + + call breakline (out, NJ) + + while (input (in, linebuf) != EOF) { + command = nextcmd (linebuf, ip) + switch (command) { + case FI, ENDHELP: + call sfree (sp) + return (command) + case RJ: # right justify text + if (input (in, Memc[rjbuf]) == EOF) + break + call rjline (out, Memc[rjbuf], linebuf[ip]) + default: + call outline (out, linebuf) + } + } + + call sfree (sp) + return (ENDHELP) +end diff --git a/pkg/system/help/lroff/output.x b/pkg/system/help/lroff/output.x new file mode 100644 index 00000000..84ebea0d --- /dev/null +++ b/pkg/system/help/lroff/output.x @@ -0,0 +1,190 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <chars.h> +include "lroff.h" + +.help outstr, outc, getoutcol, set_outbuf +.nf __________________________________________________________________________ +OUTSTR, OUTC, OUTCOL -- Routines for buffering the output line. An output +line is built up with calls to OUTPUT to pass strings, and to OUTC to pass +characters. OUTCOL may be called to determine the index of the PRINTABLE +column at which the next character will be deposited (this is unaffected by +control chars in the output stream). + +The output buffer is flushed when OUTC is called to deposit a newline +character, by calling the user supplied output procedure. The output column +pointer is reset to the CURRENT left margin when the first character of the +new line is deposited. Any changes to the left margin made after the first +character is deposited do not take effect until the next line. OUTCOL returns +the value of the current left margin if called when the buffer is empty. + +NOTE: set_outbuf() must be called during Lroff startup and shutdown to +allocate the output buffer, the size of which depends on the maximum output +line length. +.endhelp _____________________________________________________________________ + + +# SET_OUTBUF -- Allocate and initialize the output buffer. + +procedure set_outbuf (outbuf_size) + +int outbuf_size # new buffer size in chars + +include "lroff.com" +errchk malloc, out +bool first_time +data first_time /true/ + +pointer obuf, op, otop +int col, old_left_margin, buffer_empty +common /lroout/ obuf, op, otop, col, old_left_margin, buffer_empty + +begin + if (first_time) { + obuf = NULL + buffer_empty = YES + first_time = false + } + + if (outbuf_size <= 0 && obuf != NULL) + call mfree (obuf, TY_CHAR) + else { + call malloc (obuf, outbuf_size, TY_CHAR) + otop = obuf + outbuf_size - 1 + op = obuf + buffer_empty = YES + old_left_margin = 1 + } +end + + +# OUTC -- Output a single character. Note that the character value is +# passed as an integer. + +procedure outc (out, ch) + +extern out() # user line output procedure +int ch # character to be output + +char text[1] +data text[1] /EOS/ + +begin + text[1] = ch + call outstr (out, text) +end + + +# OUTSTR -- Output a text string. + +procedure outstr (out, text) + +extern out() # user line output procedure +char text[ARB] # text string to be output + +int ch, ip, i +pointer obuf, op, otop +int col, old_left_margin, buffer_empty +common /lroout/ obuf, op, otop, col, old_left_margin, buffer_empty +include "lroff.com" + +begin + for (ip=1; text[ip] != EOS; ) { + if (buffer_empty == YES) { + if (obuf == NULL) + call error (1, "No Lroff output buffer allocated") + + # If left margin has been moved inward, blank out the unused + # columns. + + if (left_margin != old_left_margin) { + for (i=old_left_margin; i < left_margin; i=i+1) + Memc[obuf+i-1] = BLANK + old_left_margin = left_margin + } + + op = obuf + left_margin - 1 + col = left_margin + buffer_empty = NO + } + + # Move the text string into the buffer. The string may contain + # more than one line of text. + + for (; text[ip] != EOS; ip=ip+1) { + ch = text[ip] + Memc[op] = ch + op = op + 1 + + if (INVISIBLE(ch) || op > otop) { + if (ch == '\r' || ch == '\n') { + # Flush the buffer. + Memc[op] = EOS + call out (out_magic_arg, Memc[obuf]) + buffer_empty = YES + + # If all text data has not been copied (buffer overflow + # or newline embedded in the text), we must reinit the + # buffer and copy the remaining data. Otherwise we must + # return without calling the buffer_empty code to give + # the caller a chance to change the left margin. + + if (text[ip+1] == EOS) + return + } + } else + col = col + 1 + } + } +end + + +# GETOUTCOL -- Return the index of the next column of output. + +procedure getoutcol (next_column) + +int next_column # next col to be written (output) +pointer obuf, op, otop +int col, old_left_margin, buffer_empty +common /lroout/ obuf, op, otop, col, old_left_margin, buffer_empty +include "lroff.com" + +begin + if (buffer_empty == YES) + next_column = left_margin + else + next_column = col +end + + +# OUTCC -- Output a control sequence, i.e., a forms control sequence. +# Called only after a line has already been output. Does not interfere +# with output buffer. Sequence is not newline terminated. + +procedure outcc (out, ctrlchar) + +extern out() # user supplied line output procedure +int ctrlchar # character to be output (INT) +char ctrlstr[1] +include "lroff.com" + +begin + ctrlstr[1] = ctrlchar + ctrlstr[2] = EOS + call out (out_magic_arg, ctrlstr) +end + + +# OUTLINE -- Output a string and append a newline to flush the output buffer. + +procedure outline (out, text) + +extern out() +char text[ARB] +errchk outstr + +begin + call outstr (out, text) + call outc (out, '\n') +end diff --git a/pkg/system/help/lroff/rawcopy.x b/pkg/system/help/lroff/rawcopy.x new file mode 100644 index 00000000..d303b96e --- /dev/null +++ b/pkg/system/help/lroff/rawcopy.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "lroff.h" + +.help rawcopy +.nf ________________________________________________________________________ +RAWCOPY -- Copy an unformatted help block without modification, except +for moving to the desired left margin. Stop only when the .endhelp +directive is seen, or at EOF. Ignore all other directives. +.endhelp ___________________________________________________________________ + +procedure rawcopy (in, out, linebuf) + +extern in(), out() +char linebuf[ARB] +int ip, in(), input(), nextcmd() +errchk input, outline +include "lroff.com" + +begin + while (input (in, linebuf) != EOF) + if (nextcmd (linebuf, ip) == ENDHELP) + break + else + call outline (out, linebuf) +end diff --git a/pkg/system/help/lroff/section.x b/pkg/system/help/lroff/section.x new file mode 100644 index 00000000..3df732c8 --- /dev/null +++ b/pkg/system/help/lroff/section.x @@ -0,0 +1,224 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include <ctype.h> +include "lroff.h" + +# NEW_SECTION -- Begin a section heading. Argument is the number of lines +# to skip. Output section heading string given on next input line. Reset left +# margin and cancel out any LS indents. + +procedure new_section (in, out, linebuf, ip) + +extern in(), out() +char linebuf[ARB] +int ip + +int inbold(), in(), lgetarg() +errchk skiplines, inbold, outline +include "lroff.com" + +begin + sh_nskip = lgetarg (linebuf, ip, sh_nskip) + call skiplines (out, sh_nskip) + left_margin = perm_left_margin + call testpage (out, DEF_TPNLINES) + + if (inbold (in, linebuf) != EOF) + call outline (out, linebuf) + + call init_ls() +end + + +# NEW_NUMBERED_SECTION -- Begin a numbered section heading. Arguments are +# the number of lines to skip and the section level to be incremented (default +# is 1). If only one arg is given, we assume it is the section level. +# Output section number followed by section heading string given on next input +# line. Reset left margin and cancel out any LS indents. + +procedure new_numbered_section (in, out, linebuf, ip) + +extern in(), out() +char linebuf[ARB] +int ip + +int i, n +int inbold(), in(), lgetarg(), strlen() +errchk skiplines, sprintf, pargi, outstr, outc, inbold, outline +include "lroff.com" + +begin + # Get level, nskip arguments. + n = max (1, min (MAX_NHLEVEL, lgetarg (linebuf, ip, 1))) + nh_nskip = lgetarg (linebuf, ip, nh_nskip) + + call skiplines (out, nh_nskip) + left_margin = perm_left_margin + call testpage (out, DEF_TPNLINES) + + # Increment the desired section number; zero all higher numbered + # section counters. + + nh_level[n] = nh_level[n] + 1 + call amovki (0, nh_level[n+1], MAX_NHLEVEL - n) + + # Output the section number followed by a blank and then the section + # label. + + linebuf[1] = EOS + do i = 1, n { + call sprintf (linebuf[strlen(linebuf)+1], SZ_IBUF, "%d.") + call pargi (nh_level[i]) + } + + # Cancel the final "." if subsection heading. Add a blank. + if (n > 1 && linebuf[strlen(linebuf)] == '.') + linebuf[strlen(linebuf)] = EOS + call outstr (out, linebuf) + call outc (out, BLANK) + + # Get section label from next input line, write that out on the same + # line in standout mode, then terminate the line. + + if (inbold (in, linebuf) != EOF) + call outline (out, linebuf) + + call init_ls() +end + + +# INIT_NH -- Initialize section numbering. + +procedure init_nh() + +include "lroff.com" + +begin + call amovki (0, nh_level, MAX_NHLEVEL) +end + + +# NEW_INDENTED_SECTION -- Begin an indented section heading. Optional +# arguments are the number of spaces to indent subsequent text and the number +# of lines to skip. Output section heading string given on next input line. +# Reset left margin and cancel out any LS indents. + +procedure new_indented_section (in, out, linebuf, ip) + +extern in(), out() +char linebuf[ARB] +int ip + +int inbold(), in(), lgetarg() +errchk skiplines, inbold, outline +include "lroff.com" + +begin + ih_indent = lgetarg (linebuf, ip, ih_indent) + ih_nskip = lgetarg (linebuf, ip, ih_nskip) + + call skiplines (out, ih_nskip) + left_margin = perm_left_margin + call testpage (out, DEF_TPNLINES) + + # Read in and output the section heading in boldface. + if (inbold (in, linebuf) != EOF) + call outline (out, linebuf) + + # Reset the left margin and cancel out any LS indents. + left_margin = max (perm_left_margin, min (right_margin, + perm_left_margin + ih_indent)) + + call init_ls() +end + + +# INBOLD -- Input a line in standout mode. If the line is already all in +# upper case, do not use standout mode. The input procedure processes +# all font escape sequences. We must get the raw input line by calling the +# user input procedure, then pass it on to input() enclosed in \fB...\fR +# font escape sequences, to enable standout mode. + +int procedure inbold (in, user_linebuf) + +extern in() +int in() +char user_linebuf[ARB] + +pointer sp, ip, lbuf, first +int save_in_magic_arg, status +int stropen(), input() +extern getline() +errchk salloc, stropen, input +include "lroff.com" + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE + 3 + 3, TY_CHAR) + + # Deposit escape sequence to turn bold on. + call strcpy ("\\fB", Memc[lbuf], ARB) + + # Read in the input line after the three char escape sequence. + if (in (in_magic_arg, Memc[lbuf+3]) == EOF) { + call sfree (sp) + return (EOF) + } + + # Scan the line to see if there are any lower case characters. + # If all upper case, omit the mode control sequences (this procedure + # becomes equivalent to input()). + + first = lbuf + 3 + for (ip=lbuf+3; Memc[ip] != EOS; ip=ip+1) + if (IS_LOWER (Memc[ip])) { + first = lbuf + break + } + + # Step on the newline if there is one, then add the \fR + # sequence to turn bold off. + if (first == lbuf) { + for (ip=lbuf; Memc[ip] != EOS; ip=ip+1) + ; + if (Memc[ip-1] == '\n') + Memc[ip-1] = EOS + call strcat ("\\fR\n", Memc[lbuf], ARB) + } + + # Now open the string as a file and call input to process it + # into our caller's buffer. We must save and restore the input + # magic argument, set to the fd of the string file when input is + # called. This is a good example of the disadvantages of commons... + + save_in_magic_arg = in_magic_arg + in_magic_arg = stropen (Memc[first], ARB, READ_ONLY) + status = input (getline, user_linebuf) + call close (in_magic_arg) + in_magic_arg = save_in_magic_arg + + call sfree (sp) + return (status) +end + + +# TESTPAGE -- If forms mode is enabled, output the control code for a test +# page followed by the number of lines to test for. Test page tests if the +# specified number of lines are left on a page, and breaks the page if not. + +procedure testpage (out, nlines) + +extern out() +int nlines +char ctrlstr[2] +include "lroff.com" + +begin + if (foflag == YES) { + ctrlstr[1] = FC_TESTPAGE + ctrlstr[2] = nlines + ctrlstr[3] = EOS + call out (out_magic_arg, ctrlstr) + } +end diff --git a/pkg/system/help/lroff/skiplines.x b/pkg/system/help/lroff/skiplines.x new file mode 100644 index 00000000..0449dc50 --- /dev/null +++ b/pkg/system/help/lroff/skiplines.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "lroff.h" + +# SKIPLINES -- Skip one or more lines on the output, i.e., break the current +# output line and add a few empty lines. + +procedure skiplines (out, nlines) + +extern out() +int nlines, i +errchk breakline, outc + +begin + call breakline (out, NJ) + + do i = 1, nlines + call outc (out, '\n') +end diff --git a/pkg/system/help/lroff/textlen.x b/pkg/system/help/lroff/textlen.x new file mode 100644 index 00000000..e192314f --- /dev/null +++ b/pkg/system/help/lroff/textlen.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include "lroff.h" + +# TEXTLEN -- Return the number of printable characters in a text string. + +int procedure textlen (text_string) + +char text_string[ARB] +int ip, nchars + +begin + nchars = 0 + for (ip=1; text_string[ip] != EOS; ip=ip+1) + if (!INVISIBLE (text_string[ip])) + nchars = nchars + 1 + + return (nchars) +end diff --git a/pkg/system/help/lroff/textout.x b/pkg/system/help/lroff/textout.x new file mode 100644 index 00000000..663bccc8 --- /dev/null +++ b/pkg/system/help/lroff/textout.x @@ -0,0 +1,140 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <chars.h> +include "lroff.h" + +# TEXTOUT -- Process a line of text. Move words from the text buffer into +# the word buffer WBUF, maintaining an array of pointers to the words, until +# an output line has been filled. Leading whitespace is part of the word, +# if it is the first word on a line (thus we get paragraph indents). +# Thereafter only trailing whitespace is included in the word. The last word +# on a line gets one trailing space, unless the last char is a period, in which +# case it gets two. Otherwise whitespace at the end of the input text line is +# stripped. BREAKLINE is subsequently called to reassemble the words to form +# an output line. +# +# WBUF is the word buffer (a set of strings separated by EOS markers). WP is +# a pointer to the next available char in WBUF. NWORDS is the number of words +# in the buffer. WORDS is a pointer to the array of word pointers. We do not +# check for word buffer overflow because the word buffer is allocated large +# enough to accommodate the worst case (the buffer is flushed when an output +# line is filled, which always happens before the buffer overflows). WCOLS is +# the number of printable characters in the word buffer. The word buffer +# variables are all stored in the "words" common for use by TEXTOUT and +# BREAKLINE. Set_wordbuf() must be called upon startup and shutdown to +# allocate/deallocate the word buffer. + +procedure set_wordbuf (max_words) + +int max_words #I output word buffer size + +int word_buffer_size +errchk malloc + +include "lroff.com" +include "words.com" + +begin + word_buffer_size = (max_words * 2) + SZ_LINE # worst case + if (max_words <= 0 && words != NULL) { + call mfree (wbuf, TY_CHAR) + call mfree (words, TY_POINTER) + } else { + call malloc (wbuf, word_buffer_size, TY_CHAR) + call malloc (words, max_words, TY_POINTER) + wp = wbuf + nwords = 0 + wcols = 0 + } +end + + +# TEXTOUT -- Output a newline delimited line of text. + +procedure textout (out, text) + +extern out() +char text[1] + +char ch +int ip_save, wcols_save, ip +errchk breakline +include "lroff.com" +include "words.com" + +begin + if (wbuf == NULL || words == NULL) + call error (1, "No Lroff word buffer allocated") + + for (ip=1; text[ip] != EOS; ) { + # Set up descriptors of new word. Save the input pointer in case + # the output line fills and we have to "put the word back". + + Memi[words+nwords] = wp # word pointer + ip_save = ip + wcols_save = wcols + + # The following is a nop except at the beginning of a line. + for (; text[ip] == BLANK; ip=ip+1) { + Memc[wp] = BLANK + wp = wp + 1 + wcols = wcols + 1 + } + + # Copy the word itself. + for (ch=text[ip]; ch != BLANK && ch != EOS; ch=text[ip]) { + Memc[wp] = ch + wp = wp + 1 + if (!INVISIBLE (ch)) + wcols = wcols + 1 + ip = ip + 1 + } + + # And then any trailing whitespace. + for (; text[ip] == BLANK; ip=ip+1) { + Memc[wp] = BLANK + wp = wp + 1 + wcols = wcols + 1 + } + + # End of word string. + Memc[wp] = EOS + wp = wp + 1 + + # If line has been filled, call breakline to format output line + # and send it out. Put word which caused break back for next line. + # Do not put word back if it is the first word, or we will have + # an infinite loop. + if (wcols > (right_margin - left_margin + 1) && nwords > 0) { + ip = ip_save + wcols = wcols_save + wp = Memi[words+nwords] + call breakline (out, JU) + } else + nwords = nwords + 1 + } + + # Strip trailing whitespace at the end of an input line. If input + # line ends with a period, assume it is a sentence and add a blank. + # Otherwise add a blank to separate words when output line is filled. + # If a sentence ends within a line, the user is responsible for placing + # two spaces after the period. + + if (nwords > 0) { + for (wp=wp-2; Memc[wp] == BLANK && wp > wbuf; wp=wp-1) + wcols = wcols - 1 + if (Memc[wp] == '.') { + wp = wp + 1 + Memc[wp] = BLANK + wcols = wcols + 1 + } + wp = wp + 1 # point to next avail + + Memc[wp] = BLANK # need at least one + wp = wp + 1 + wcols = wcols + 1 + + Memc[wp] = EOS + wp = wp + 1 + } +end diff --git a/pkg/system/help/lroff/words.com b/pkg/system/help/lroff/words.com new file mode 100644 index 00000000..d0c220da --- /dev/null +++ b/pkg/system/help/lroff/words.com @@ -0,0 +1,9 @@ +# Common for Textout()/Breakline(). + +pointer wbuf # the word buffer, a string buffer +pointer wp # pointer to next available char in word buffer +pointer words # array of word pointers +int nwords # number of words in word buffer +int wcols # number of printable columns in word buffer + +common /wrdcom/ wbuf, wp, words, nwords, wcols |