From d8bfced2b7d9f5a9f17f2e96127d3461b0569013 Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Mon, 13 Feb 2023 15:45:50 +0200 Subject: [PATCH] Extract unroff-1.0.tar.gz --- COPYRIGHT | 26 + INSTALL | 96 +++ PATCHLEVEL | 1 + README | 133 +++ doc/Makefile | 34 + doc/manual.ms | 1737 ++++++++++++++++++++++++++++++++++++++++ doc/tmac.hyper | 19 + doc/unroff-html-man.1 | 218 +++++ doc/unroff-html-ms.1 | 324 ++++++++ doc/unroff-html.1 | 671 ++++++++++++++++ doc/unroff.1 | 682 ++++++++++++++++ elk/README | 4 + elk/scm/debug.scm | 212 +++++ elk/scm/initscheme.scm | 81 ++ elk/scm/pp.scm | 117 +++ elk/scm/toplevel.scm | 110 +++ misc/sample.unroff | 14 + scm/html/common.scm | 597 ++++++++++++++ scm/html/m.scm | 26 + scm/html/man.scm | 316 ++++++++ scm/html/ms.scm | 628 +++++++++++++++ scm/misc/hyper.scm | 166 ++++ scm/troff.scm | 541 +++++++++++++ src/Makefile | 93 +++ src/args.c | 72 ++ src/args.h | 8 + src/buffer.c | 68 ++ src/buffer.h | 26 + src/config.h | 33 + src/elk-2.2-patch | 53 ++ src/error.c | 91 +++ src/error.h | 20 + src/event.c | 375 +++++++++ src/event.h | 33 + src/expr.c | 235 ++++++ src/expr.h | 4 + src/gcroot.c | 58 ++ src/gcroot.h | 7 + src/insert.c | 127 +++ src/insert.h | 4 + src/malloc.c | 37 + src/malloc.h | 7 + src/parse.c | 526 ++++++++++++ src/parse.h | 11 + src/prim.c | 382 +++++++++ src/prim.h | 4 + src/scmtable.c | 105 +++ src/scmtable.h | 4 + src/stream.c | 440 ++++++++++ src/stream.h | 17 + src/subst.c | 98 +++ src/subst.h | 4 + src/table.c | 101 +++ src/table.h | 21 + src/test.ms | 44 + src/test.scm | 63 ++ src/unroff.c | 231 ++++++ src/unroff.h | 69 ++ 58 files changed, 10224 insertions(+) create mode 100644 COPYRIGHT create mode 100644 INSTALL create mode 100644 PATCHLEVEL create mode 100644 README create mode 100644 doc/Makefile create mode 100644 doc/manual.ms create mode 100644 doc/tmac.hyper create mode 100644 doc/unroff-html-man.1 create mode 100644 doc/unroff-html-ms.1 create mode 100644 doc/unroff-html.1 create mode 100644 doc/unroff.1 create mode 100644 elk/README create mode 100644 elk/scm/debug.scm create mode 100644 elk/scm/initscheme.scm create mode 100644 elk/scm/pp.scm create mode 100644 elk/scm/toplevel.scm create mode 100644 misc/sample.unroff create mode 100644 scm/html/common.scm create mode 100644 scm/html/m.scm create mode 100644 scm/html/man.scm create mode 100644 scm/html/ms.scm create mode 100644 scm/misc/hyper.scm create mode 100644 scm/troff.scm create mode 100644 src/Makefile create mode 100644 src/args.c create mode 100644 src/args.h create mode 100644 src/buffer.c create mode 100644 src/buffer.h create mode 100644 src/config.h create mode 100644 src/elk-2.2-patch create mode 100644 src/error.c create mode 100644 src/error.h create mode 100644 src/event.c create mode 100644 src/event.h create mode 100644 src/expr.c create mode 100644 src/expr.h create mode 100644 src/gcroot.c create mode 100644 src/gcroot.h create mode 100644 src/insert.c create mode 100644 src/insert.h create mode 100644 src/malloc.c create mode 100644 src/malloc.h create mode 100644 src/parse.c create mode 100644 src/parse.h create mode 100644 src/prim.c create mode 100644 src/prim.h create mode 100644 src/scmtable.c create mode 100644 src/scmtable.h create mode 100644 src/stream.c create mode 100644 src/stream.h create mode 100644 src/subst.c create mode 100644 src/subst.h create mode 100644 src/table.c create mode 100644 src/table.h create mode 100644 src/test.ms create mode 100644 src/test.scm create mode 100644 src/unroff.c create mode 100644 src/unroff.h diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 index 0000000..be210ca --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,26 @@ +Copyright 1995 Oliver Laumann. All rights reserved. + +Not derived from licensed software. + +Permission is granted to use, copy, perform, display, modify, and +redistribute this software (including derivative works based on it) in +any form, subject to the following restrictions: + + i) Source distributions must be accompanied by this entire copyright + notice. + ii) Binary distributions must include the acknowledgement ``This + product includes software developed by Oliver Laumann'' in the + documentation or other materials provided with the distribution. + iii) The origin of this software must not be misrepresented, either + by explicit claim or by omission. + iv) Altered versions must be plainly marked as such in the source + and documentation and must not be misrepresented as being the + original software. + v) The author is not deemed to have made any representations as to + the suitability of this software for any purpose nor is held + responsible for any defects of this software. + THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE. + +Berlin, March 23, 1995 + +Oliver Laumann # $Revision: 1.2 $ diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..975f6b7 --- /dev/null +++ b/INSTALL @@ -0,0 +1,96 @@ +Installation Guide for the `unroff' Source Distribution +------------------------------------------------------- + +Requirements: you need Elk 2.2 or Elk 3.0 and an ANSI C compiler +to install unroff from the source distribution. If you don't have +Elk and don't want to install it, you may want to obtain the binary +unroff distribution instead. + +You can obtain Elk 3.0 in the World Wide Web at + + http://www.informatik.uni-bremen.de/~net/elk + +and from a number of FTP servers including these: + + ftp://ftp.x.org/contrib/devel_tools/elk-3.0.tar.gz + ftp://ftp.uni-bremen.de/pub/programming/languages/scheme/elk/elk-3.0.tar.gz + + + +o If you are still using Elk 2.2, you may have to apply a small patch to + your Elk installation. The patch is in the file src/elk-2.2-patch. + Assuming you have unpacked unroff under /usr/local/src/unroff-1.0, + change to the directory where the Elk "src" directory is located and call: + + patch < /usr/local/src/unroff-1.0/src/elk-2.2-patch + + If the patch program detects a `Reverse patch', the patch is not + required and you are done. If the patch succeeded, recompile the + interpreter by calling "make" and "make install" in the directory "src". + +o Go to the sub-directory "src" below the directory where you unpacked + unroff: + + cd /usr/local/src/unroff-1.0/src + + and edit the Makefile. Check the site and compiler dependencies at the + beginning of the Makefile and modify them if necessary. + + (Don't worry about DIR= if you just want to test unroff; you can + override the directory later by setting the environment variable + UNROFF_DIR before calling unroff.) + +o Call "make depend" and then "make". + +o You may want to remove the minimal Elk runtime environment contained + in the directory "elk" and replace it by a symbolic link to your + site's Elk runtime directory (i.e. the directory with sub-directories + "scm" and "obj"). + + +o Test unroff and the HTML back-end included in the distribution. + + For example, change to the directory "doc" and run "make" to convert + the manual pages and the Programmer's Manual to HTML. Then view the + resulting .html files with your favorite WWW browser. + + Test the supplementary -ms features by calling (still in "doc"): + + unroff -ms document=test split=1 hyper.scm manual.ms + + This creates several files beginning with "test". Load test.html + into your WWW browser; observe the automatically generated table of + contents and the hypertext links embedded in the document. When + finished, you may want to "rm test*". + + You can proceed by using unroff with a few troff documents of your + own. For example, try to convert a large manual page: + + unroff -man /usr/man/man1/csh.1 + + Don't worry if this displays numerous warning messages. unroff + usually produces good results even if many low-level troff requests + are ignored. Check csh.1.html with your WWW browser. + +o Read the documentation located in the directory "doc", in particular + the manual pages. + + You can convert the troff files to HTML and view them with your + WWW browser (as explained in the previous step), or typeset them + using your local troff and send the output to the printer, or read + them online using nroff or man. + +o You may want to place a number of default settings into an initialization + file ".unroff" in your home directory. There is a sample init file + "sample.unroff" in the directory "misc". If you decide to use this + file, replace the string "net@cs.tu-berlin.de" by your e-mail address. + +o If you find unroff useful, you may want to install it in a central + directory at your site. If so, install the executable, the contents + of the directory "scm", and the manual pages. + + +If you have any questions, problems, or suggestions send a message to +net@cs.tu-berlin.de. + +# $Revision: 1.6 $ diff --git a/PATCHLEVEL b/PATCHLEVEL new file mode 100644 index 0000000..0cfbf08 --- /dev/null +++ b/PATCHLEVEL @@ -0,0 +1 @@ +2 diff --git a/README b/README new file mode 100644 index 0000000..3237b86 --- /dev/null +++ b/README @@ -0,0 +1,133 @@ +This is version 1.0 of unroff. + +Unroff is a Scheme-based, programmable, extensible troff translator +with a back-end for the Hypertext Markup Language. Unroff is free +software and is distributed both as source and as precompiled binaries. + + +* Overview + + Unroff reads and parses UNIX troff documents and translates the embedded + markup into a different format. Neither the actual output format nor + any knowledge about particular troff macro sets (-man, -ms, etc.) are + hard-wired into unroff. Instead, the translation process is controlled + by a set of user-supplied procedures written in the Scheme programming + language. + + Translation rules for new output formats and troff macro packages can + be added easily by providing a corresponding set of Scheme procedures + (a `back-end'). Version 1.0 of unroff includes back-ends for translating + documents using the `man' and `ms' macros into the Hypertext Markup + Language (HTML) version 2.0. Additional requests facilitate use of + arbitrary hypertext links in troff documents. + + +* unroff and troff + + In contrast to conventional troff `converters' (usually Perl scripts + some of which process nroff output) unroff includes a full troff parser + and closely mimics the troff processing engine. + + This enables unroff to handle user-defined macros, strings, and + number registers, nested if-else requests, arbitrary fonts and font + positions, low-level formatting requests such as \l, \c, and \h, and + idiosyncrasies such as troff `copy mode' and the subtle differences + between request and macro invocations. + + Unroff has adopted a number of groff extensions, among them long names + for macros, strings, number registers, and special characters, and the + escape sequences \$@ and \$*. + + +* unroff and Scheme + + Unroff uses Elk, the Scheme-based Extension Language Kit, to achieve + programmability. It includes a full Scheme language implementation + with the usual amenities such as garbage collection, interactive + programming and testing, and dynamic loading. Standard Scheme has + been augmented by a set of new Scheme data types and primitives that + aid in writing new unroff back-ends. + + A new troff request and an extension to the `.ig' request allow for + Scheme code to be embedded in troff documents; the code is then + evaluated on the fly as the documents are processed by unroff. + + Unroff may be viewed as a prototype for hybrid applications that use + Scheme (in particular Elk) as their extension language. Approximately + half of its source consists of portable ANSI C code, and the other + half is written in Scheme and can be configured and tailored easily + without the need to recompile unroff. Authors of Elk-based applications + are encouraged to look into the source code or reuse parts of it for + their own projects. + + As the time-critical Scheme primitives provided of unroff have been + coded in (efficient) C, its performance comes close to that of nroff + processing the same troff input. + + +* unroff and hypertext + + troff documents that were originally written without intentions to + make them available in the World Wide Web (such as UNIX manual pages) + can easily be translated to the Hypertext Markup Language using the + predefined HTML back-ends. + + As unroff closely simulates ordinary troff, even large or complex + documents (like technical reports or theses with many user-defined + macros) can be translated to HTML automatically without having to + add any structural cues to the documents. + + The `-man' support has been tested with several hundred vendor- and + user-supplied manual pages and has produced good results in all but + less than a dozen cases (a few manual pages were found to make excessive + use of low-level troff constructs or to include tbl output verbatim). + + +* Managing hypertext documents with troff + + Authors can benefit from unroff not only as a converter for existing + documents, but also when writing new documents that must exist both + in high-quality paper form and in the World Wide Web as hypertext. + + Rather than writing hypertext documents directly in HTML (which is + cumbersome for long or complex texts), authors can continue using + ordinary troff together with the usual preprocessors and macro packages. + Unroff is then employed to produce the WWW form, while troff is used + in the normal way to typeset the same text, producing the printed + version (or, using nroff, an ASCII version if desired). + + In this way authors of hypertext documents can take full advantage of + the usual troff facilities such as user-defined macros, conditional text, + tables, equations, and drawings, automatic table of contents generation, + footnotes/endnotes, indexes, etc., none of which are available when + composing documents directly in plain HTML. + + Two new troff requests for embedding hypertext links in troff documents + are provided by the unroff HTML back-end. Arbitrary forward and backward + references using symbolic labels (rather than actual file names) among + groups of troff source files are supported. Another new request and + another extension to `.ig' allow for HTML code to be embedded directly + in troff documents. The hypertext capabilities are demonstrated by + the troff source of the Programmer's Manual that is part of the unroff + distribution. + + +* Availability + + The source distribution of unroff 1.0 as well as binary distributions + (with full Scheme source code and documentation) are available under: + + http://www.informatik.uni-bremen.de/~net/unroff/unroff.html#dist + + You can obtain Elk 3.0 from the same WWW server at: + + http://www.informatik.uni-bremen.de/~net/elk + + Elk 3.0 is also available from a number of FTP servers including these: + + ftp://ftp.x.org/contrib/devel_tools/elk-3.0.tar.gz + ftp://ftp.uni-bremen.de/pub/programming/languages/scheme/elk/elk-3.0.tar.gz + + +-- +Oliver Laumann # $Revision: 1.4 $ diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 0000000..7f6005a --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,34 @@ +# $Revision: 1.7 $ + +SHELL = /bin/sh +UNROFF = unroff + +TROFF = \ + unroff.1\ + unroff-html.1\ + unroff-html-man.1\ + unroff-html-ms.1\ + manual.ms + +HTML = \ + unroff.1.html\ + unroff-html.1.html\ + unroff-html-man.1.html\ + unroff-html-ms.1.html\ + manual.html + + +ALL = $(HTML) + +all: $(ALL) + +.SUFFIXES: .1 .1.html + +.1.1.html: + $(UNROFF) -man $< + +manual.html: manual.ms + $(UNROFF) -ms document=manual hyper.scm $? + +clean: + rm -f $(ALL) diff --git a/doc/manual.ms b/doc/manual.ms new file mode 100644 index 0000000..39b5fa5 --- /dev/null +++ b/doc/manual.ms @@ -0,0 +1,1737 @@ +.\" $Revision: 1.12 $ +. +.if !\n(.U .so tmac.hyper +. +.ds Ve 1.0 +.ds Sc http://www-swiss.ai.mit.edu/scheme-home.html +.ds Md . +. +.fp 5 C +.pl 11i +. +.de Es +.ie n .DS I 3n +.el .DS +.nr sF \\n(.f +.ft 5 +.ps -1 +.vs -1 +.. +. +.de Ee +.ft \\n(sF +.ps +.vs +.DE +.. +. +.de El +.sp .6 +.. +. +.nr P 0 +. +.de Ps +.nr P 1 1 +.SH +.. +.de Pe +.nr P 0 0 +.. +.de Pr +.ds xx " +.if \\n(.$>=2 .as xx " \f2\\$2\fP +.if \\n(.$>=3 .as xx " \f2\\$3\fP +.if \\n(.$>=4 .as xx " \f2\\$4\fP +.if \\n(.$>=5 .as xx " \f2\\$5\fP +.if \\n(.$>=6 .as xx " \f2\\$6\fP +.if \\n(.$>=7 .as xx " \f2\\$7\fP +.if \\n(.$>=8 .as xx " \f2\\$8\fP +.if \\n(.$>=9 .as xx " \f2\\$9\fP +.if !\\nP .SH +.if \\n+P>2 .br +(\\$1\\*(xx) +.. +.de Pa +.ds xx " +.if \\n(.$>=3 .as xx " \f2\\$3\fP +.if \\n(.$>=4 .as xx " \f2\\$4\fP +.if \\n(.$>=5 .as xx " \f2\\$5\fP +.if \\n(.$>=6 .as xx " \f2\\$6\fP +.if \\n(.$>=7 .as xx " \f2\\$7\fP +.if \\n(.$>=8 .as xx " \f2\\$8\fP +.if \\n(.$>=9 .as xx " \f2\\$9\fP +.if !\\nP .SH +.if \\n+P>2 .br +.Ha \\$1 "(\\$2\\*(xx)" +.. +. +.TL +unroff \*(Ve Programmer's Manual +.AU +Oliver Laumann +.AB no +.I unroff +is a programmable, extensible troff translator that useful for +converting documents with embedded troff markup into another +format. +Although +.I unroff +has been designed with higher-level, structure-oriented target +languages (such as SGML) in mind, it fully supports all constructs +and idiosyncrasies of ordinary troff, so that even low-level +formatting requests can be handled correctly if desired. +.PP +Translation rules for a specific output format and knowledge about +existing troff macro packages are not hard-wired in +.I unroff , +instead, the translation is controlled by a user-supplied set +of procedures written in the +.Hr -url \*(Sc "\f2Scheme\fP programming language" . +.Hr "\f2Scheme\fP programming language." +Interpretation of the procedures is facilitated by a full Scheme +interpreted embedded in +.I unroff . +This manual describes the Scheme primitives provided by +.I unroff +that can be used to customize the translation rules implemented +by existing back-ends and to write new ones for new output formats. +.AE +.NH +Additional Documentation +.PP +For a general overview of +.I unroff +and a description from the user's perspective, please read the +.Hr -url \*(Md/unroff.1.html "manual page" +.Hr "manual page" +.I unroff (1) +that accompanies the distribution. +In addition, there exists one manual page for each output format +for which a back-end is provided, and another one for each +combination of output format and troff macro package explaining +the translation rules associated with the individual macros. +For example, the back-end for the Hypertext Markup Language (HTML) +that is part of the distribution and that supports the +.B \-man +and +.B \-ms +macros comes with these manual pages: +.Es +.Hr -url \*(Md/unroff-html.1.html unroff-html(1) +.Hr -url \*(Md/unroff-html-man.1.html unroff-html-man(1) +.Hr -url \*(Md/unroff-html-ms.1.html unroff-html-ms(1) +.Hr unroff-html(1) +.Hr unroff-html-man(1) +.Hr unroff-html-ms(1) +.Ee +.PP +This text assumes familiarity with the basic troff and Scheme concepts. +For a troff manual, refer to the documentation provided by +your UNIX system's vendor. +As +.I unroff +supports a number of troff extensions introduced by the free +.I groff +formatter (which is part of the GNU project), you may want to read the +manual page +.I troff (1) +that is included in the groff distribution. +.PP +.I unroff +is centered around +.I Elk , +the Scheme-based Extension Language Kit. +For a description of the Elk-specific Scheme language features +please refer to the documentation included in the Elk distribution +(which is freely available). +An overview of Elk can be found in: +Oliver Laumann and Carsten Bormann, Elk: The Extension Language Kit, +.I "USENIX Computing Systems" , +vol. 7, no. 4, pp. 419\-449, 1994. +The Scheme language is described in several textbooks; and the +Revised^4 Report on the Algorithmic Language Scheme, on which +the IEEE Standard for Scheme is based, can be downloaded from +several major FTP sites. +.NH +Where to Place Scheme Code?\& +.PP +.I unroff +accepts Scheme code in a number of places. +First, a several Scheme files are loaded on startup: +.Es +scm/troff.scm +scm/\f2format\fP/common.scm +scm/\f2format\fP/\f2package\fP.scm +~/.unroff +.Ee +.PP +The first three path names are relative to a site-specific library +directory where the files have been installed by the system +administrator. +``troff.scm'' contains definitions that are independent of the +actual output format and troff macro-package; and the +file ``.unroff'' (loaded from the caller's home directory) typically +contains Scheme code to define user-preferences and to tailor +and extend the translation rules implemented by the files loaded +from a central location. +See the +.Hr -url \*(Md/unroff.1.html "manual page" +.Hr "manual page" +.I unroff (1) +for more information. +.PP +Additional files with user-supplied Scheme definitions +(e.\|g. translation rules for user-defined macros) can be passed to +.I unroff +by mentioning them in the command line. +In general, troff input files and Scheme source files can be mixed +arbitrarily when calling +.I unroff . +Finally, Scheme code can be embedded directly in the troff documents +by means of the new ``.##'' troff request and the corresponding +extension to the ``.ig'' request as explained in the +.Hr -url \*(Md/unroff.1.html "manual page" . +.Hr "manual page." +Such inline Scheme code is executed on-the-fly when it is encountered +by the parser while processing the document. +.NH +.Ha .events "Events and Event Handling" +.PP +.I unroff +interprets a troff document as a sequence of chunks of normal +text and interspersed ``events''. +Plain text is usually just copied to the current output (a file or +standard output). +The output produced for an event is determined by an ``event +handler'' (usually a Scheme procedure) that can be associated +with each event. +If no event handler can be found for an event encountered in the +currently processed document (with a few exceptions), a warning message +is displayed and the input that triggered the event is skipped +(in case of requests and macros) or treated like normal text. +For events such as troff requests, a separate Scheme procedure +can be defined for each request, and the name of the request that +triggered the event is then passed to the procedure as an argument. +An event handling procedure can be defined for +.if !\n(.U .RS +.IP \(bu +each troff request, including requests that perform intrinsic troff +functions, such as ``.de'' and ``.if'' +.IP \(bu +each troff macro, whether user-defined or part of a macro +package +.IP \(bu +each troff string +.IP \(bu +each number register +.IP \(bu +each special character +.IP \(bu +each escape sequence +.IP \(bu +each character (to provide character translations) +.IP \(bu +each inline equation enclosed by the current +.I eqn (1) +delimiter characters +.IP \(bu +each end of sentence (defined as a period, exclamation mark, or +question mark, followed by a newline). +.if !\n(.U .RE +.PP +When invoked, every Scheme procedure associated with one of +the above events receives one or more arguments. +For example, a procedure registered for the escape sequence `\eh' +(horizontal space) is passed the name of the escape sequence +(the letter `h') as well as the argument to `\eh' (i.\|e. the amount +of space). +Likewise, event handling procedures for requests and macros are +called with the name of the request or macro as well as any +arguments specified in the troff input. +The exact arguments passed to each type of event handler will be +explained below. +.PP +A Scheme procedure associated with an event must return a string +which is then output in place of whatever input triggered the +event. +Here, and in a number of other places, a Scheme symbol or a Scheme +is accepted as an alternative to a string return value. +Event handling procedures are free to directly produce output +in addition to returning it as a result. +As procedures associated with events frequently just return a +fixed text, the text itself may be defined as the event handler +in place of the procedure to save the overhead of the procedure +call. +.PP +Predefined Scheme procedures are supplied for events such as the +requests ``.de'', ``.nr'', ``.ds'', and the corresponding escape +sequences `\en' and `\e*' to support user-defined macros, strings, +and number registers. +In any case, specific event handlers registered for macros, +strings, and number registers supersede any user-supplied +definitions. +Thus, the author of a document can attach a +special translation rule to a macro, string, or number register +defined in the document to take effect when the document is processed by +.I unroff . +This is particularly important for high-level, structure-oriented +target languages like SGML, as the the micro-formatting +used by typical, more complex troff macros and by many low-level requests +may not be expressible in such languages. +As a case in point, it would obviously be impossible to translate, for +example, the ``.IP'' macro defined by the ``ms'' package to a +language such as HTML just by looking at the definition of the macro. +For this reason, +.I unroff +does not really load the actual macro definitions for a troff macro +package selected via the ``\-m'' option; instead, an event handler +is defined for each macro exported by the package to generate +whatever represents the corresponding macro's function in the +target language. +.NH +Defining Event Handlers +.PP +In the following list of Scheme primitives, the argument +.I name +denotes the name of a troff request, macro, escape sequence +etc. (without any initial period or escape character) and can be +supplied in form of a Scheme string, a Scheme symbol, or +a Scheme character: +.Es +(defrequest "ti" ...) +.El +(defrequest 'sp ...) +.El +(defescape #\eh ...) +.Ee +(the primitives +.I defrequest +and +.I defescape +will be introduced in a moment). +An argument named +.I handler +is either a procedure (usually a lambda expression) which returns +a string, a symbol, or a character; or +.I handler +can itself be specified as a string, symbol, or character. +In addition, the literal ``#f'' (false) can be supplied as a +.I handler +argument to remove any event handler that is currently associated with +that event. +Each of the ``def'' primitives listed below returns the handler +that was previously associated with the corresponding event, +or ``#f'' if the event was not handled. +.Pr defrequest name handler +.PP +Associates the given handler with the given troff request. +If +.I handler +is a procedure, it is passed the request's name and arguments +as strings when called later. +Passing the name of the request as the first argument aids in +associating the same procedure with several different requests. +.I unroff +does not limit the number of arguments to requests, thus, +an event handling procedure for a requests that takes a variable +number of arguments could be defined like this: +.Es +(defrequest 'rm + (lambda (rm . args) ...)) +.Ee +.LP +If the request is invoked with fewer arguments than the procedure +has formal arguments, the remaining arguments are bound to +the empty string. +If the request is invoked with +.I more +arguments than the procedure has formal arguments, the last lambda +variable is assigned a string consisting of the (space-delimited) +arguments left over after the other formal arguments have been bound to +the other actual arguments. +However, if +.I handler +has only one formal argument, an error message is displayed when the +request is called with any arguments at all and the event is skipped. +For example, consider the following handler for the (non-existing) +request ``xx'': +.Es +(defrequest 'xx + (lambda (name a b) ...)) +.Ee +The procedure's arguments +.I a +and +.I b +will be bound as follows when the request is invoked: +.Es +\&.xx foo name="xx" a="foo" b="" +.El +\&.xx foo bar baz name="xx" a="foo" b="bar baz" +.Ee +.Pr defmacro name handler +.PP +Associates +.I handler +with the given troff macro, superseding +any definition for this macro established by the ordinary ``.de'' +request. +The only difference between +.I defrequest +and +.I defmacro +is the way arguments are bound in case +.I handler +is a procedure +(troff employs slightly different rules when parsing the call +to a request and a macro invocation). +The quote character can be used in the latter case to surround +arguments containing spaces, while quote characters are treated as +normal characters in requests, which allows for the following +remarkable troff idiom: +.Es +\&.ds xy "hello +.Ee +In contrast to event handlers defined for requests, the formal +arguments of a handler procedure associated with a macro must +match the actual arguments in the normal way, that is, as if +the procedure were invoked from within Scheme. +A warning message is displayed if the number of macro arguments +does not match the number of formal procedure arguments, and +the event is skipped. +.Pr defspecial name handler +.PP +Associates +.I handler +with the special character whose name is +.I name . +The name must have a length of 2. +In addition, an empty name can be specified to define a +``fallback'' handler that is called for special characters +for which no handler exists. +Like all event handler procedures, +.I handler +can have arbitrary side-effects in addition to returning a +result; for example, the procedure may display a warning message +if the special character cannot be represented in the target +language and an approximation must be rendered instead. +.Pr defstring name handler +.PP +Associates a handler with the specified troff string. +As +.I unroff +provides a default handler for the request ``.ds'' to implement +used-defined strings, +.I defstring +is primarily used to give definitions for strings exported by +troff macro packages. +.Pr defnumreg name handler +.PP +This request behaves like +.I defstring , +except that it works on number registers. +Note that the Scheme primitive +.I number\(mi>string +may have to be used by +.I handler +(if it is a procedure) to convert a numeric result into a string +that can be returned from the handler. +.LP +In troff input, number registers as well as strings, special +characters, and escape sequences can be denoted using the groff +``long name'' syntax, unless troff compatibility has been enabled: +.Es +\en[numreg] \en[string] \ef[font] \e[em] ... +.Ee +.Pr defescape name handler +.PP +Associates an event handler with an escape sequence. +.I name +must have a length of 1, unless the empty string is +given to define a ``fallback'' event handler (as with +.I defspecial ). +Handlers defined for certain escape sequences are passed +a second argument in addition to the name of the escape sequence. +This is true for all escape sequences that have an argument +according to the troff specification: +.Es +\eb \ec \ef \eh \ek \el \en \eo \es \ev \ew \ex \ez +\e* \e$ \e" +.Ee +In addition, handlers for these groff escape sequences are passed an +additional argument unless troff compatibility is enabled: +.Es +\eA \eC \eL \eN \eR \eV \eY \eZ +.Ee +The form of an escape sequence argument is determined by the +troff specification and cannot be programmed; for example, the +handler for `\ez' is passed a character or a special character, +and the handler for `\e"' is invoked with the rest of the current +input line sans the terminating newline. +(The latter can be used to translate troff comments.) +.LP +Handlers registered for the escape sequences `\en' and '\es' are +passed an optional third argument, one of the Scheme characters +#\e+ and #\e\(mi, if the escape sequence argument begins with a sign. +The sign is then stripped from the actual argument. +.LP +As `\en' and `\e*' are treated as ordinary escape sequences, +handlers can be defined for them to achieve some form of fallback +for number register and strings. +.I unroff +provides suitable default handlers for `\en', `\e*', and '\e$' as part +of the implementation of user-defined number registers, strings, +and macros. +These handlers can be overridden if desired. +.Pr defchar name handler +.PP +Associates +.I handler +with a character. +.I name +must have a length of 1. +Each time the specified character is encountered in the troff +input, the result (or value) of +.I handler +is output in place of the character. +Character translations are not applied to the result of event +handlers; event procedures can use the Scheme primitive +.Hr -symbolic .translate \f2translate\fP +.Hr \f2translate\fP +(as described below) to execute the character translations +established by calls to +.I defchar +if desired. +.LP +.I defchar +currently has a number of weaknesses. +The argument cannot be a special character +(that is, +.I name +must be a plain character), and the mechanism cannot be used +to achieve true +.I output +translations as with the troff request ``.tr'' or the groff +request ``.char''. +.Pr defsentence handler +.PP +Defines a handler to be consulted on end of sentence. +If +.I handler +is a procedure, it is passed the punctuation mark ending the +sentence as its argument (in form of a Scheme character). +In any case, if an event handler has been specified, its result +(or value) is output in place of the end-of-sentence mark and +the newline character following it. +.Pr defequation handler +.PP +Defines a handler for +.I eqn +inline equations. +If +.I handler +is a procedure, it is passed the contents of the inline equation +(with the delimiters stripped) as an argument. +When an inline equation is encountered in the troff input and a handler +has been defined for inline equations, the handler's result (or value) +is output in place of the equation. +.LP +For inline equations to be recognized, delimiters must be defined first +by passing +.I eqn +input that includes a ``delim'' directive to the Scheme primitive +.Hr -symbolic .filter-eqn-line \f2filter-eqn-line\fP +.Hr \f2filter-eqn-line\fP +(explained below), as is usually done +by the event handler associated with the request ``.EQ''. +.NH +Querying Event Handlers +.PP +In addition to associating event handlers with events by means +of the ``def'' primitives, several primitives exist to query +the currently defined handler for a given event: +.Ps +.Pr requestdef name +.Pr macrodef name +.Pr specialdef name +.Pr stringdef name +.Pr numregdef name +.Pr escapedef name +.Pr chardef name +.Pr sentencedef +.Pr equationdef +.Pe +.PP +Observe that the name of each primitive is derived from the name +of the corresponding ``def'' primitive by exchanging the word +``def'' and the rest of the name. +Each +.I name +argument is subject to the constraints described under the +corresponding ``def'' primitive above. +Each primitive returns whatever object has been registered as +the event handler (procedure, string, symbol, character); +or #f if no handler has been defined for the event. +.NH +Event Procedures with Side-Effects +.PP +Besides the basic events described in the +.Hr -symbolic .events "preceding sections" , +.Hr "preceding sections," +another group of\*-slightly different\*-events exist and can +be handled by user-defined Scheme procedures. +These events are not related to troff functions, but to a number of +other conditions that are encountered when processing documents: +.if !\n(.U .RS +.IP \(bu +the end of an input line +.IP \(bu +the beginning of a troff input file processed by +.I unroff +.IP \(bu +the end of a troff input file +.IP \(bu +startup of the program +.IP \(bu +termination of the program +.IP \(bu +a keyword/value option encountered in the command line. +.if !\n(.U .RE +.PP +Among other tasks, these events can be used to generate a prologue and +epilogue for each input file. +In contrast to the events described in the previous section, handlers for +these events are called solely for their side-effects. +Each event handler must be a Scheme procedure. +Their results are ignored, thus the procedures must have side-effects +to be useful. +Another difference is that more than one event handler can be associated +with each request. +A numeric +.I level +(a small integer number) is specified together with each event handler, +and when the corresponding event is triggered, all procedures +defined for this event are executed in increasing order as indicated by +their levels. +.Pr defevent event level handler +.PP +Associates the procedure +.I handler +with an event and returns the previous event handler registered +for this combination of event and level. +.I level +is an integer between 0 and 99; +.I handler +is a procedure, or the literal #f to remove a previously defined handler. +.I event +indicates the type of event and is one of the following Scheme symbols: +.I line +(end of input line), +.I prolog +(beginning of input file), +.I epilog +(end of input file), +.I start +(program start), +.I exit +(program termination), +.I option +(keyword/value command line option). +.LP +Procedures defined for the events +.I prolog +and +.I epilog +are called with two string arguments: +the path name (as specified by the user) and the file name component of +the troff input file whose processing has just begun or finished, +or the string ``stdin'' if +.I unroff +is taking its input from standard input. +Procedures defined for the event +.I option +are passed the option's name and value as strings. +All other event procedures are invoked without arguments. +.I unroff +provides a default handler for +.I option +(see the +.Hr -symbolic .options "primitives for options" +.Hr "primitives for options" +below). +.LP +Example: +.Es +(defevent 'exit 50 ; cleanup on exit + (lambda () + ...)) +.Ee +The handler defined in this way will be executed on termination, +after any handlers with levels 0\-49. +.Pr eventdef event level +.PP +Returns the procedure defined as a handler for +.I event +and +.I level , +or #f if no such handler exists. +See +.I defevent +above for a description of the arguments. +.NH +How Troff Input is Processed +.PP +To be able to write non-trivial event handling procedures, it helps +to have a look at how troff input is processed, especially since +the parser of +.I unroff +works somewhat differently than ordinary troff. +In particular, the parser cannot blindly rescan the result of +handlers for escape sequences or special characters, as these +handlers will probably generate text in the +.I "target language" +that cannot be interpreted as troff input any longer. +Here is a brief overview of the parsing process. +.PP +Each input line is first scanned for references to troff strings and +number registers (this scanning pass will later be referred to as the +``expansion phase''). +For each `\e*' or `\en' sequence found in the input line, +.I unroff +checks whether a handler for the string or number register has +been defined with +.I defstring +or +.I defnumreg , +and if this is the case, replaces the string or number register +reference by the result (or value) of the handler. +Otherwise, if a handler for the escape sequence `\e*' or `\en' +proper has been defined, that handler is called. +Otherwise the reference is left untouched and scanning resumes +behind it\**. +.FS +Although the result of specific event handlers defined for +strings is not rescanned, the handler for `\e*' that is supplied by +.I unroff +to implement user-defined strings does rescan the contents of +a string when it is expanded. +.FE +Comments are recognized in this phase, too, by calling the handler +for the `\e"' escape sequence if there is one. +.PP +Next, the parser checks whether the result of the first phase +is a request or macro invocation (that is, begins with a period +or an apostrophe). +If this is the case, the arguments are parsed mimicking the +behavior of ordinary troff. +The rules for macro arguments are employed if +a handler has been defined +for the token after the period with +.I defmacro , +else the rules for requests are used. +The handler for the macro or request is then used, or applied +to the arguments if it is a procedure. +.PP +If the input line does not contain a request or macro invocation, +it is scanned a second time to take care of escape sequences +and special characters (for lack of a better term, we will call +this phase ``escape parsing''). +Every escape character reference, special character, and inline +equation is replaced by the result (or value) of the event +handler registered for it, or left in place if there is no handler. +Character translations defined by means of +.I defchar +are also executed in this phase. +.PP +Finally, the result of the escape parsing phase or of the request or +macro invocation is checked whether it constitutes the end of a +sentence, and if so, the handler for this event is called +(actually, in the former case, the check is applied before +.I and +after the escape parsing and must succeed both times). +As the final step the line is output, and any handlers for the +.I line +event are invoked. +.PP +An important thing to note is that the arguments passed to a handler +defined for a request or macro are not scanned for escape sequences +and special characters. +Therefore event procedures must explicitly parse their arguments if +desired by calling the Scheme primitive +.Hr -symbolic .parse \f2parse\fP +.Hr \f2parse\fP +(which will be described in the next section). +Consider, for example, an event procedure associated with a +macro ``IP'': +.Es +(defmacro 'IP + (lambda (IP tag . indent) + ...)) +.Ee +and a call to the macro with an argument containing a +special character: +.Es +\&.IP \e(bu +.Ee +As the argument to the event procedure is only scanned for +strings and number registers, the variable +.I tag +will be bound to the string ``\e(bu''. +Applying +.I parse +to the argument will turn it into whatever is the target language +representation for the special character ``\e(bu'' (that is, the +result of the event handler for the special character). +Whether or not arguments will have to be parsed depends on the +particular request or macro; the procedure implementing the request +``.tm'', for instance, will print its ``raw'' argument (a sample +event handler for the request ``.tm'' is supplied by +.I unroff ). +.NH +Calling the Parser +.PP +The following Scheme primitives are used by event procedures for +requests, macros, and escape characters to parse their arguments +or to parse lines of text that have been read from an input source. +Each of the primitives can be invoked with zero or more arguments +of type string, symbol, or character. +The arguments are concatenated to form a Scheme string which is then +passed to the parser, and the result is returned as a new string. +.Pa .parse parse . args +.PP +This primitive feeds its arguments to the ``escape parsing'' +pass as described in the previous section. +It scans its arguments for special characters and escape +sequences and replaces them by the corresponding event values +(or results), and it executes character translations. +.Pa .translate translate . args +.PP +Like +.I parse +above, except that only output character translations (defined by calls to +.I defchar ) +are executed. +.Pr parse-expand . args +.PP +This primitive applies the ``expansion parsing'' phase (as described in the +previous section) to its arguments. +Compared to +.I parse , +.I parse-expand +is only used rarely, as input lines read in the normal way are +scanned for string and number register references anyway. +The sample implementation supplied by +.I unroff +for the requests ``.ds'', ``.as'', and '\e*' makes use of this primitive +to rescan the contents of user-defined strings upon interpolation. +.Pr parse-line . args +.PP +This primitive parses an entire input line, which may contain a call +to a request or macro, as described in the previous section. +The line made up by the primitive's arguments is treated exactly as +it if were read from an input file, although it need not have a +terminating newline. +Two places where this primitive is required are the handler for +the request ``.so'' and the code that expands user-defined macros. +.Pr parse-copy-mode . args +.PP +The primitive +.I parse-copy-mode +parses its arguments in a manner similar to troff ``copy mode''. +In this mode, escape sequences beginning with '\e$' are dealt +with (by calling their event procedures), the sequence `\e\e' +is replaced by a single `\e', and each occurrence of `\e.' +is replaced by a period. +Macro bodies are parsed in copy mode during macro definition and again +when the macros are expanded. +.PP +The sample implementation of user-defined macros supplied by +.I unroff +defines suitable event handlers for the usual +.Es +\e$1 \e$2 ... +.Ee +escape sequences (there is no limit to the number of arguments, +and the groff long name convention may be used to denote an +argument number), and in addition for the groff extensions +.Es +\e$0 \e$* \e$@ +.Ee +as explained in the +.Hr -url \*(Md/unroff.1.html "manual page" +.Hr "manual page" +.I unroff (1). +.Ps +.Pr parse-expression expr fail scale +.Pr parse-expression-rest expr fail scale +.Pe +.PP +These primitives evaluate the numeric expression specified by +the string argument +.I expr +and return the result as an exact number. +The usual troff expression syntax, operators, and scale +indicators are supported. +If an error occurs during evaluation (for instance, if +.I expr +is not a syntactically valid expression), +a warning message is displayed and +.I fail +(which may be an arbitrary Scheme object) is returned. +The character argument +.I scale +is the default scale indicator, for example `#\em', or `#\eu' +for basic units. +.PP +The primitive +.I parse-expression-rest +is identical to +.I parse-expression , +except that its return value is a cons cell whose car consists +of the result of the evaluation and whose cdr is the rest of +.I expr +starting at the character position where parsing of the +expression stopped. +In other words, the primitive evaluates the portion of +.I expr +that constitutes a valid expression, and it returns the result +and whatever is left over. +Warning messages are also suppressed, except if an overflow occurs +during evaluation. +.I parse-expression-rest +is useful for tasks like parsing the argument of the escape +sequences `\el' and `\eL' where an expression is immediately +followed by another character. +Examples: +.Es +(parse-expression "(2+8)/5" 0 #\eu) \(rh 2 +(parse-expression "foo" #f #\eu) \(rh #f; prints warning +.El +(parse-expression-rest "1+1" #f #\eu) \(rh (2 . "") +(parse-expression-rest "(2+8)/5foo" 0 #\eu) \(rh (2 . "foo") +(parse-expression-rest "15\e&-" 0 #\eu) \(rh (15 . "\e&-") +.Ee +.Pr char-expression-delimiter? char +.PP +Returns #t if the character argument +.I char +is valid as the first character of a numeric expression (e.\|g. a digit), +otherwise #f. +.Ps +.Pr set-scaling! scale factor divisor +.Pr get-scaling scale +.Pe +.PP +These primitives set and read the scale factor and divisor for +the specified scale indicator. +.I scale +is the scale indicator (a character); +.I factor +and +.I divisor +are integers. +.I get-scaling +returns the scaling for the specified scale indicator as a pair +of integers. +The factors and divisors are initially set to 1 for all scale +indicators; they must be assigned useful values by each back-end. +.NH +Streams +.PP +Input, output, and storage of text lines in +.I unroff +are centered around a new Scheme data type named +.I stream +and a set of primitives that work on streams. +A stream can act as a source (input stream) or as a sink (output +stream) for lines of text. +Streams not only serve as the basis for input and output operations +and for the exchange of text with shell commands, but can also be used +to temporarily buffer lines of text (e.g. footnotes or tables of +contents) and to implement user-defined macros in a simple way. +Each input or output stream can be connected to one of the +following three types of +.I targets : +.if !\n(.U .RS +.IP \(bu +a file, or the program's standard input or standard output +.IP \(bu +a UNIX pipe connected to a shell running a shell command +.IP \(bu +an internal +.I buffer +whose lifetime is limited to that of the current invocation of +.I unroff . +.if !\n(.U .RE +.PP +Buffers act similar to (initially empty) files, except that +they are not visible from the outside and that they are destroyed +automatically on exit of the program. +Once a buffer has been filled with text through an output stream, +it can be reopened and read through an input stream multiple times. +However, if a buffer is currently written through an output stream, +no more streams may refer to the same buffer. +As the contents of buffers kept in memory, input and output operations +on buffers are fast. +The sample implementation of user-defined macros utilizes buffers +to store the macro bodies; a macro can then be expanded simply +by redirecting the current input source to the corresponding buffer +temporarily. +.PP +Both the parser and all input and output primitives operate on a +.I "current input stream" +and a +.I "current output stream" ; +input and output is always performed using these two streams. +On startup, +.I unroff +initializes the current output stream to either point to +standard output or to a newly created output file (usually depending on +the value of the +.B document +option). +If the current output stream is assigned the literal #f, +output is sent to standard output\**. +.FS +While #f indicates ``standard output'' when assigned to +the current output stream, it is an error to call an input primitive +after #f has been assigned to the current +.I input +stream. +This may be considered a mis-feature; the current input and +output streams should be treated similarly with respect to +standard input and standard output. +.FE +Likewise, for each input file mentioned in the command line, +a stream pointing to that file is created and assigned to +the current input stream before the parser starts processing +the file. +The rest of this section lists the Scheme primitives operating +on streams. +.Pr stream? obj +.PP +The type predicate for the new data type. +It returns #t if +.I obj +is a member of the type +.I stream , +otherwise #f. +.Ps +.Pr input-stream +.Pr output-stream +.Pe +.PP +Returns the current input stream, or output stream respectively. +.Ps +.Pr open-input-stream target +.Pr open-output-stream target +.Pr append-output-stream target +.Pe +.PP +These primitives create a new input stream or output stream pointing +to the specified target. +The argument +.I target +is a string or a symbol. +If the target is enclosed in square brackets, it names a buffer; +if it begins with the pipe symbol `|', a pipe to a shell running +the rest of the target as a shell command is established; otherwise +.I target +is interpreted as a file name. +.I append-output-stream +rewinds to the end of the specified output buffer or file before +the first output operation; it acts like +.I open-output-stream +in case of a pipe. +Examples: +.Es +(let* ((buffer (open-output-stream '[temp])) + (pipe (open-input-stream "|ls -l /usr/lib/tmac")) + (file (open-input-stream "/etc/passwd"))) + ...) +.Ee +.Ps +.Pr set-input-stream! stream +.Pr set-output-stream! stream +.Pe +.PP +These primitives make the specified stream the +.I current +input stream (or output stream respectively). +.I stream +must be the result of a call to one of the three primitives that +open a stream, or #f. +An error is signaled if +.I set-input-stream! +is applied to an output stream or vice versa, or if the stream +has been closed in the meantime. +.Pr close-stream stream +.PP +Closes the specified stream. +An error is signaled if the stream is still the current input +stream or current output stream. +Once an output stream pointing to a buffer has been closed, the +buffer can be reopened for reading. +A stream that is no longer reachable is closed automatically +during the next run of the garbage collector. +.Ps +.Pr stream-buffer? stream +.Pr stream-file? stream +.Pr stream-pipe? stream +.Pe +.PP +These predicates return #t if the specified stream points to a +buffer, a file, or a pipe respectively, otherwise #f. +.Pr stream-target stream +.PP +This primitive returns the target to which the specified stream +points. +The return value is a string. +In case of a pipe, the target is truncated at the first space, +that is, only the command name is included. +The target of the current input stream (together with the current +line number) is displayed as a prefix of error messages and +can also be obtained through the primitive +.Hr -symbolic .substitute \f2substitute\fP +.Hr \f2substitute\fP +described below. +.Pr stream-position stream +.PP +Returns the current character position of the specified output stream, +that is, the offset at which the next character will be written. +The return value for input streams is currently always zero. +This primitive is useful in conjunction with +.Hr -symbolic .file-insertions \f2file-insertions\fP +.Hr \f2file-insertions\fP +(described below). +.Pr stream\(mistring target +.PP +This primitive opens an input string to the specified target, +reads from the stream until end-of-stream is reached, closes +the stream, and returns the concatenation of all the lines that +have been read as a string\**. +.FS +.I stream\(mi>string +is a misnomer, because the argument of the primitive is not +a stream, nor does the primitive actually +.I convert +a stream to a string as suggested by the `\(mi>' sign. +.FE +.NH +Input and Output Primitives +.PP +.I unroff +provides one new input primitive and one new output primitive that +work with the current input stream and current output stream (and a +third primitive which is just an optimization of the latter, as +well as a few auxiliary functions). +.Pr emit . args +.PP +.I emit +is the only stream-based output primitive. +It receives any number of strings, symbols, and characters, +concatenates its arguments, and sends the resulting string to +the current output stream (to standard output if the the current +output stream has been assigned #f). +.I emit +is primarily used in situations where text has to +be output without rescanning it and without applying any +character translations. +It is also used from within the event procedures that are called +for their side-effects, for example, by the +.I prolog +and +.I epilog +event procedures to generate a header and trailer for each +output file. +The primitive returns the empty symbol so that it can be called +as the last form in an event procedure whose result is used. +.PP +Example: +the new troff request for transparent output, as explained in the +.Hr -url \*(Md/unroff.1.html "manual page" +.Hr "manual page" +.I unroff (1), +can be implement like this: +.Es +(defrequest '>> + (lambda (>> code) + (emit code #\enewline))) +.Ee +.Pr read-line +.PP +This primitive reads the next input line from the current input +stream and returns it as a string. +An error is signaled if the current input stream has been bound +to #f, which is the case, for example, when +.I unroff +has been called with the option +.B \-t +to start an interactive top level. +If an incomplete last line (i.\|e. a line without a terminating +newline) is returned by the target pointed to by the current +input stream, a newline is appended. +Thus, +.I read-line +always returns at least a string containing a newline character. +.Pr read-line-expand +.PP +This primitive is nothing more than an optimization for +.Es +(parse-expand (read-line)) +.Ee +which has been provided to speed up frequently used functions like +macro expansion. +.Pr unread-line string +.PP +This primitive pushes back an input line to the current input +stream, which will then be returned by the next call to +.I read-line +or +.I read-line-expand , +or it will be read by the parser in the normal way when processing +the current input file. +.I string +need not have a terminating newline. +Strings pushed back by multiple calls to +.I unread-line +are coalesced and returned as a whole by the next input operation. +.Pr error-port +.PP +Returns a Scheme output port that is bound to the program's +standard error output. +This primitive is used by the default Scheme error handler provided +by +.I unroff +and by the +.I warn +utility function\**. +.FS +The primitive +.I error-port +should actually be provided by Elk proper to avoid having to +reinvent it for each extensible application. +.FE +Note that +.I error-port +returns an ordinary Scheme port, not a stream. +.NH +String Functions +.PP +Most of the string handling primitives described in this section +could as well have been implemented in Scheme based on the standard +Scheme string primitives. +They are provided as built-in primitives by +.I unroff +mainly as optimizations or because writing them as Scheme +procedures would have been significantly more cumbersome. +All the string functions return new strings, that is, they +do not modify their arguments. +.Pr concat . args +.PP +.I concat +can be called with any number of Scheme strings, symbols, and +characters. +The primitive concatenates its arguments and returns the result +as a string. +.Pr spread +.PP +This primitive is identical to +.I concat , +except that it delimits its arguments by a space character. +For example, the event procedure for a macro that just +returns a line consisting of its arguments could be define like this: +.Es +(defmacro 'X + (lambda (X . words) + (parse (apply spread words) #\enewline))) +.Ee +.Pr repeat-string num string +.PP +Returns a string consisting of the string argument +.I string +repeated +.I num +times. +.Pr string-prune-left string prefix fail +.PP +This primitive checks whether +.I string +starts with the given string prefix, and if so, returns the rest of +.I string +beginning at the first character position after the initial prefix. +If the strings do not match, +.I fail +is returned (which may an arbitrary object). +Example: +.Es +(string-prune-left "+foo" "+" #f) \(rh "foo" +(string-prune-left "gulp" "+" #f) \(rh #f +.Ee +.Pr string-prune-right string suffix fail +.PP +This primitive is identical to +.I string-prune-left , +except that it checks for a suffix rather than a prefix, +that is, whether +.I string +ends with +.I suffix . +.Pr string-compose string1 string2 +.PP +If the argument +.I string2 +begins with a plus sign, +.I string-compose +returns the concatenation of +.I string1 +and +.I string2 +with the initial plus sign stripped. +If +.I string2 +begins with a minus sign, +it returns a string consisting of +.I string1 +with all characters occurring in +.I string2 +removed. +Otherwise, +.I string-compose +just returns +.I string2 . +This primitive is used for the implementation of the option type +.I dynstring . +.Pr parse-pair string +.PP +If +.I string +consists of two parts separated and enclosed by an arbitrary delimiter +character, +.I parse-pair +returns a cons cell holding the two substrings. +Otherwise, it returns #f. +Example: +.Es +(parse-pair "'foo'bar'") \(rh ("foo" . "bar") +(parse-pair "hello") \(rh #f +.Ee +.Pr parse-triple string +.PP +This primitive is identical to +.I parse-pair , +except that it breaks up a three-part string rather than a +two-part string and returns an improper list whose car, cadr, +and cddr consist of the three substrings\**. +.FS +The primitive +.I parse-triple +should probably return a proper list rather than an improper list. +.FE +.I parse-pair +and +.I parse-triple +are useful mainly for parsing the arguments to troff requests such +as ``.if'' and ``.tl''. +.Pa .substitute substitute string . args +.PP +This primitive returns a copy of +.I string +in which each sequence of a percent sign, a +.I "substitution specifier" , +and another percent sign is replaced by another string according +to the specifier. +Two adjacent percent signs are replaced by a single percent sign. +The following list describes all substitution specifiers together +with their respective replacements. +.IP \f3macros\fP +The name of the troff macro package whose macros are recognized, +that is, the argument to the option +.B \-m +(or the empty string if none was specified). +.IP \f3format\fP +The output format, that is, the argument to the option +.B \-f +(or the default output format if the option was omitted). +.IP \f3directory\fP +The name of the library directory from which +.I unroff +loads its Scheme files. +.IP \f3progname\fP +The name of the running program (this is used as a prefix in +error messages and warning messages). +.IP \f3filepos\fP +A space character followed by the target of the current input +stream, a colon, the number of the last input line read from +the stream, and another colon. +If the current input stream is bound to #f, the empty string +is substituted. +This specifier is useful for displaying error messages or warning messages. +.IP \f3tmpname\fP +A file name that can be used for a temporary file. +Each use of this specifier creates a new, unique file name. +.IP \f3version\fP +The program's major and minor version numbers separated by a period. +.IP \f3weekday\fP +The abbreviated weekday name. +.IP \f3weekday+\fP +The full weekday name. +.IP \f3weekdaynum\fP +The weekday (0\-6, Sunday is 0). +.IP \f3monthname\fP +The abbreviated month name. +.IP \f3monthname+\fP +The full monthname. +.IP \f3day\fP +The day of the month (01\-31). +.IP \f3month\fP +The month (01\-12). +.IP \f3year\fP +The year. +.IP \f3date\fP +The date (in the local environment's representation). +.IP \f3time\fP +The time (in the local environment's representation). +.IP "a positive number \f2n\fP" +The +.I n th +additional argument in the call to the +.I substitute +primitive, which must be a string. +.IP "a \f2string\fP" +.I string +is interpreted as the name of an environment variable, +and the value of this variable is substituted (or the empty +string if the environment variable is undefined). +.LP +Examples: +.Es +(substitute "%date% %HOME%") \(rh "04/09/95 /home/kbs/net" +.El +(substitute "%progname%:%filepos% %1%" "hello") + \(rh "unroff: manual.ms:21: hello" +.El +(load (substitute "%directory%/scm/%format%/m%macros%.scm")) +.Ee +.NH +Tables +.PP +.I unroff +provides simple hash tables as a new first class data type +.I table . +Each table entry associates an arbitrary Scheme object with +a key (a Scheme string or symbol). +Tables are useful for various purposes; for example, the Scheme code +delivered with +.I unroff +maintains hash tables to store information about number registers, +options, fonts, and for other bookkeeping tasks. +.Pr table? obj +.PP +The type predicate for the new type; it returns #t if +.I obj +is a member of the type +.I table , +otherwise #f. +.Pr make-table size +.PP +Returns a new table of the specified size. +.I size +is a positive integer. +The smaller the size, the more collisions occur as entries +are added to the table. +However, the hash function employed by the table primitives +ensures that no collisions occur in tables of size +256^\c +.I n +if all keys have a length less than or equal to +.I n . +.Pr table-store! table key obj +.PP +This primitive stores the Scheme object +.I obj +under the given +.I key +in the given +.I table . +The key argument must be a string or a symbol. +.Pr table-lookup table key +.PP +This primitive checks whether an object is stored in the given +.I table +under the specified +.I key , +and if so, returns the object. +If no object is stored under +.I key , +.I table-lookup +returns #f. +.Pr table-remove! table key +.PP +Removes the entry selected by +.I key +from the specified table. +.NH +Miscellaneous Primitives +.PP +The first two primitives described in this section are not essential, +as the same function could be achieved with pipe streams, +although with greater overhead. +The remaining primitives perform a number of troff-specific operations +and are only useful in a few specialized contexts. +.Pr shell-command command +.PP +Runs the specified +.I command +(which must be a string) as a shell command by passing it to a call to +.I system (3). +The return value is that of +.I system() +(an integer). +.Pr remove-file filename +.PP +Removes the specified file; +.I filename +must be a string or a symbol. +.Pr troff-compatible? +.PP +This predicate returns #t if troff compatibility mode has been +enabled (i.\|e. if the option +.B \-C +has been given), otherwise #f. +.Pr set-escape! char +.PP +Sets the troff escape character (initially `\e') to the specified +character argument. +This primitive is used to implement the ``.ec'' request. +.Pa .filter-eqn-line filter-eqn-line string +.PP +This primitive scans the string argument (which is supposed to +be passed to the +.I eqn +preprocessor afterwards) for occurrences of the ``delim'' directive. +If a ``delim'' directive is found, the current inline equation +delimiters maintained by the parser are changed or disabled as specified by +the directive. +The primitive returns #f if +.I string +is empty or consists just of white space, or if it contains +a valid ``delim'' or ``define'' directive, otherwise #t. +The inline equation delimiters are disabled initially. +.PP +The primitive is supposed to be used by implementations of +the request ``.EQ'' and inline equation event handlers to intercept the +.I eqn +input. +In this case, the +.I eqn +preprocessor need only be invoked if +.I filter-eqn-line +returned #t at least once. +.Pr skip-group +.PP +This primitive reads input lines from the current input stream +and scans them for the escape sequences `\e{' and `\e}' until +the nesting level of conditional input is balanced (i.\|e. until +a matching closing brace for an initial opening brace has been found). +The primitive is only useful for the implementation of the +troff requests for conditional input. +.NH +File Insertions +.PP +The primitive +.I file-insertions +is a general-purpose utility for inserting strings into files +at specified locations in a fast and robust way. +One application is to resolve forward references of any kind among +a group of files when all files have been processed. +In this case, the insertions would be executed by an +.I exit +event handler. +.Pa .file-insertions file-insertions insertions +.PP +.I insertions +is a list specifying the parameters for the file insertions. +Each element of the list is itself a list consisting +of a file name (a string), +a file offset (an integer between zero and the size of the file), +and a string to be inserted in the given file at the given offset. +.I file-insertions +sorts the list to ensure that each file is only processed once +and that the offsets for each file are in increasing order. +Then each file is copied to a temporary file +.Es +\f2filename\fP.new +.Ee +(where +.I filename +is the original file name), and the specified insertions are +carried out as the file is copied. +When processing of a file is finished, the temporary file is +renamed to its original name. +If there exist links to a file, a warning is displayed and the +insertion is skipped. +.NH +Utilities for Back-Ends +.PP +Writers of new back-ends (either for new output formats or for new +troff macro packages) can benefit from a number of Scheme procedures +and macros that are exported by the file ``scm/troff.scm'' which is +loaded from the library directory on startup. +The first two, +.I eval-if-mode +and +.I set-option! +are exceptions in that they are typically used by the user's +initialization file ``~/.unroff'' to customize +.I unroff , +rather than by programmers of +.I unroff . +.Pr set-option! name value +.PP +This procedure assigns +.I value +to the option +.I name . +The value must be appropriate for the option's type. +.Pr eval-if-mode mode . forms +.PP +This macro is typically used to evaluate a sequence of expressions, +.I forms , +depending on the output format and macro package specified in +the command line. +.I mode +is a list of two symbols, an output format and a macro package +name; the wildcard `*' can be used for both elements. +The +.I forms +are evaluated if the first symbol matches the value of the option +.B \-f +and the second symbol matches the value of the option +.B \-m ; +in this case the result of the last sub-expression is returned. +Otherwise the forms are ignored and #f is returned. +Example: +.Es +(eval-if-mode (* html) + (set-option! 'mail-address "net@cs.tu-berlin.de")) +.Ee +.Ps +.Pr quit message . args +.Pr warn message . args +.Pe +.PP +These procedures print +.I message +and the optional +.I args +on the port returned by +.I error-port +using the primitive +.I format . +The message is prefixed by the program name, current input file +name and line number, and, in case of +.I warn , +the word ``warning''. +A newline is appended. +.I quit +causes the program to exit with an exit code of 1, and +.I warn +returns the empty string (and can therefore be used as the last +form in event procedures). +.Pa .options option name +.PP +Returns the value of the specified option. +.Pr define-option name type initial +.PP +Defines a new option with the specified name, type, and initial +value. +.I name +and +.I type +are strings or symbols. +There exist a number of predefined, basic option types as +described in the +.Hr -url \*(Md/unroff.1.html "manual page" +.Hr "manual page" +.I unroff (1). +The initial value need not match the option's type; for example, +the following expression is valid: +.Es +(define-option 'author 'string #f) +.Ee +.Pr define-option-type name pre-check pre-msg converter post-check post-msg +.PP +This procedure defines a new option type named +.I name +which can then be used in calls to +.I define-option . +If an option of this type is specified in the command line, +the procedure +.I pre-check +is applied to the option's value (a string). +In this case, if +.I pre-check +returns #f, +.I quit +is called with an error message including the string +.I pre-msg , +which should describe the expected option value format +(e.\|g. ``a character''). +If the check succeeds, the procedure +.I converter +is called with the option's current value and with the string as given +in the command line. +The job of the converter procedure is to convert the option value +from a string representation to a Scheme object matching the option's +actual Scheme type. +.PP +Finally, the predicate +.I post-check +is applied either to the result of +.I converter +or, if the option was set through a call to +.I set-option! , +to this procedure's argument. +If the predicate returns #f, a error is signaled with an error +message including +.I post-msg +as described in the previous paragraph. +For example, the predefined option type ``boolean'' is defined as +follows: +.Es +(define-option-type 'boolean + (lambda (x) (member x '("0" "1"))) "0 or 1" + (lambda (old new) (string=? new "1")) + boolean? "a boolean") +.Ee +.Ps +.Pr with-input-from-stream target . forms +.Pr with-output-to-stream target . forms +.Pr with-output-appended-to-stream target . forms +.Pe +.PP +These macros open an input stream (first macro) or output stream to the +specified target and assign it to the current input stream (first +macro) or current output stream. +Then the specified +.I forms +are evaluated, the stream is reassigned its previous value, and +the result of the last sub-expression in +.I forms +is returned. +The macros recur on the primitives +.I open-input-stream , +.I open-output-stream , +and +.I append-output-stream , +respectively. +.Pr skip-lines stop +.PP +Reads input lines using +.I read-line-expand +until either end-of-stream is reached (in this case a warning +is displayed) or a line matching the string argument +.I stop +is encountered. diff --git a/doc/tmac.hyper b/doc/tmac.hyper new file mode 100644 index 0000000..f37c3a1 --- /dev/null +++ b/doc/tmac.hyper @@ -0,0 +1,19 @@ +.\" tmac.hyper: These macros implement hypertext links in troff, that is, +.\" they basically do nothing. See scm/misc/hyper.scm for the macros as +.\" implemented by unroff. +. +.ds pk tmac.hyper +. +.de Er +.tm \\*(pk: \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 +.. +. +.de Ha +.if !\\n(.$=2 .Er too few arguments for .Ha +\\$2\c +.. +. +.de Hr +.if \\n(.$<1 .Er too few arguments for .Hr +.if !'\\$1'-symbolic' .if !'\\$1'-url' \\$1 +.. diff --git a/doc/unroff-html-man.1 b/doc/unroff-html-man.1 new file mode 100644 index 0000000..e134372 --- /dev/null +++ b/doc/unroff-html-man.1 @@ -0,0 +1,218 @@ +.\" $Revision: 1.6 $ +.ds Ve 1.0 +.\" +.de Ex +.RS +.nf +.nr sf \\n(.f +.if !\\n(.U \{\ +. ft B +. if n .sp +. if t .sp .5 \} +.. +.de Ee +.if !\\n(.U \{\ +. ft \\n(sf +. if n .sp +. if t .sp .5 \} +.fi +.RE +.. +.\" +.de Sd +.ds Dt \\$2 +.. +.\" +.Sd $Date: 1995/08/23 12:07:31 $ +.TH unroff-html-man 1 "\*(Dt" +.SH NAME +unroff-html-man \- back-end to translate manual pages to HTML 2.0 +.SH SYNOPSIS +.B unroff +[ +.B \-fhtml +] [ +.B \-man +] [ +.IR file " | " option...\& +] +.SH OVERVIEW +When called with the +.B \-fhtml +and +.B \-man +options, the troff translator +.I unroff +loads the back-end for converting UNIX manual pages to the Hypertext +Markup Language (HTML) version 2.0. +.LP +Please read +.BR unroff (1) +first for an overview of the Scheme-based, programmable troff translator +and for a description of the generic options that exist in +addition to +.B \-f +and +.BR \-m . +The translation of basic troff requests, special characters, +escape sequences, etc. as well as the HTML-specific options +are described in +.BR unroff-html (1). +For information about extending and programming +.I unroff +also refer to the +.IR "Unroff Programmer's Manual" . +.SH OPTIONS +The +.B \-man +extension provides one new keyword/value option in addition to +those listed in +.BR unroff (1) +and +.BR unroff-html (1): +.TP +.BR do-signature " (boolean)" +If set to 1, a signature is appended to each output file. +The signature is composed of a horizontal rule and a one-line +message consisting of version information and date and time. +The default value of this option is 1. +.SH DESCRIPTION +.I unroff +reads and parses its input files (each containing a UNIX manual +page); the HTML output is written to a separate output file +for each input file. +The name of an output file is obtained by appending the +suffix \*(lq.html\*(rq to the name of the corresponding input +file. +Any +.B document +option is ignored if input files are named in the command line. +As usual, the special file name +.RB ` \- ' +can be used to interpolate standard input. +.LP +If no file name is given in the command line, a manual page +is read from standard input and sent to standard output, +unless the +.B document +option is given, in which case the HTML output is written +to the specified file (with \*(lq.html\*(rq appended). +Example: +this call to +.I unroff +translates two manual pages and creates two corresponding output files, +.B cc.1.html +and +.BR send.2.html : +.Ex + unroff \-fhtml \-man /usr/man/man1/cc.1 /usr/man/man2/send.2 +.Ee +.LP +The following +.B \-man +macros are recognized and translated (in addition to any user-defined macros): +.LP +.nf +.if !\n(.U .ta 8n 16n 24n 32n 40n 48n 56n + .TH .SH .SS .I .B .SB .SM + .BI .BR .IB .IR .RB .RI .TP + .IP .HP .RS .RE .LP .PP .P +.fi +.LP +In addition, the following Sun-specific macros are silently +ignored (.TX generates an informational message containing +its argument): +.LP +.nf + .TX .IX .DT .PD .UC +.fi +.LP +The following predefined troff strings are recognized +(\e*S expands to the empty string): +.LP +.nf + \e*R \e*S \e*(lq \e*(rq +.fi +.LP +The title of each HTML document generated is obtained by calling +the primitive +.I substitute +(as explained in the Programmer's Manual) with the value of the option +.B title +and the first and second arguments passed to the initial call to +.BR .TH . +Thus, the specifiers \*(lq%1%\*(rq and \*(lq%2%\*(rq can be used +in the option to interpolate the command (or whatever is documented +in the manual page) and the section number. +If +.B title +has not been specified, the string \*(lqManual page for %1%(%2%)\*(rq +is taken. +As generating the HTML title element is deferred until the call to +.BR .TH , +any macros or other troff requests that produce output must not be +used before the initial +.BR .TH . +.LP +HTML header elements

and

are created for +.B .SH +and +.B .SS +requests. +The markup created for the initial NAME section differs in that the +contents of the section (usually a single line) is itself placed +inside a header element. +.LP +The font switching macros are based on changes to the fonts `R', +`I', and `B', as explained under FONTS in +.BR unroff-html (1). +Of course, this fails if the fonts (which are mounted on startup) +are unmounted by explicit +.B .fp +requests. +As HTML is lacking the concept of text size, the macro +.B .SB +is just an alias for +.BR .B , +and +.B .SM +simply echoes its arguments. +.LP +The translation rules for +.B .TP +and +.B .IP +employ a heuristic to determine whether to generate a definition +list or an unordered list: +if the first in a sequence of tagged/indented paragraph macros is +called with a tag consisting of the special character \e(bu, a +definition list is begun, otherwise an unordered list. +Subsequent invocations cause the list style to change if appropriate. +Use of tagged paragraphs inside non-filled (pre-formatted) text +violates the HTML definition and should be avoided. +A warning message is printed in this and other questionable situations. +.LP +As hanging tags cannot be realized with HTML 2.0, +a kludge is used for the +.B .HP +(hanging paragraph) macro: +the macro starts a definition list (as does the ordinary +.BR .TP +macro), and everything up to the next request that causes a break +is placed inside the definition tag. +This method obviously fails if no break occurs in subsequent lines, +but it works for the common, idiomatic use of hanging paragraphs +in manual pages. +.SH "SEE ALSO" +.BR unroff (1), +.BR unroff-html (1), +.BR troff (1), +.BR man "(5 or 7)." +.LP +Unroff Programmer's Manual. +.LP +http://www.informatik.uni-bremen.de/~net/unroff +.LP +Berners-Lee, Connolly, et al., +HyperText Markup Language Specification\(em2.0, +Internet Draft, Internet Engineering Task Force. diff --git a/doc/unroff-html-ms.1 b/doc/unroff-html-ms.1 new file mode 100644 index 0000000..2d0019e --- /dev/null +++ b/doc/unroff-html-ms.1 @@ -0,0 +1,324 @@ +.\" $Revision: 1.8 $ +.ds Ve 1.0 +.\" +.de Ex +.RS +.nf +.nr sf \\n(.f +.if !\\n(.U \{\ +. ft B +. if n .sp +. if t .sp .5 \} +.. +.de Ee +.if !\\n(.U \{\ +. ft \\n(sf +. if n .sp +. if t .sp .5 \} +.fi +.RE +.. +.\" +.de Sd +.ds Dt \\$2 +.. +.\" +.Sd $Date: 1995/08/23 12:07:31 $ +.TH unroff-html-ms 1 "\*(Dt" +.SH NAME +unroff-html-ms \- back-end to translate `ms' documents to HTML 2.0 +.SH SYNOPSIS +.B unroff +[ +.B \-fhtml +] [ +.B \-ms +] [ +.IR file " | " option...\& +] +.SH OVERVIEW +When called with the +.B \-fhtml +and +.B \-ms +options, the troff translator +.I unroff +loads the back-end for converting \*(lqms\*(rq documents to the Hypertext +Markup Language (HTML) version 2.0. +.LP +Please read +.BR unroff (1) +first for an overview of the Scheme-based, programmable troff translator +and for a description of the generic options that exist in +addition to +.B \-f +and +.BR \-m . +The translation of basic troff requests, special characters, +escape sequences, etc. as well as the HTML-specific options +are described in +.BR unroff-html (1). +For information about extending and programming +.I unroff +also refer to the +.IR "Unroff Programmer's Manual" . +.SH OPTIONS +The +.B \-ms +extension provides a number of keyword/value options in addition to +those listed in +.BR unroff (1) +and +.BR unroff-html (1): +.TP +.BR signature " (string)" +If non-empty, the value of this option together with a
tag is +appended to each HTML output file created. +The +.I substitute +Scheme primitive (as described in the Programmer's Manual) is +applied to the value of the option, so that date, time, environment +variables, etc. can be interpolated. +.TP +.BR split " (integer)" +This option specifies whether to split the output document into +individual files for each major section. +If a positive integer +.I level +is assigned to the option, a new output file is opened for each +numbered header +.RB ( .NH +request) with a level equal to or numerically less than +.IR level . +Use of this feature requires that the +.B document +option has bee set, as otherwise the HTML document is sent +to standard output. +The default value is 0, i.\|e. all sections will be written to +a single file. +.TP +.BR toc " (boolean)" +If true, a table of contents with a hypertext link for each section +is generated automatically and inserted after the front matter +(title, author information, abstract) and before the first section. +Use of this feature requires a non-zero value for the +.B split +option. +The default is to produce a table of contents if +.B split +is non-zero. +.TP +.BR toc-header " (string)" +This option defines the contents of the

header element prepended to +an automatically generated table of contents. +Its value is subject to a call to +.IR substitute . +The default is the string \*(lqTable of Contents\*(rq. +.TP +.BR pp-indent " (integer)" +The number of non-breakable spaces (as specified by the predefined +Scheme variable +.IR nbsp ) +to generate for a paragraph created by the +.B .PP +macro. +The default is 3. +This option, as well as +.BR signature , +is typically set in the user-preferences file +.BR ~/.unroff , +or in a document-specific Scheme file or at the beginning of +the document proper. +.TP +.BR footnotes-header " (string)" +The contents of the

header element prepended to the footnotes +section that is appended to the document if any footnotes were used, +and that also appears in the automatically generated table of contents. +As with all string option listed in this section, the +.I substitute +primitive is applied to the option's value. +The default is the string \*(lqFootnotes\*(rq. +.TP +.BR footnote-reference " (string)" +This option controls the text generated by each use of the variable +\&`\e**', which produces a footnote (hypertext) reference. +Its value is passed to a call to +.I substitute +with the current footnote number as another argument, so that the +specifier \*(lq%1%\*(rq can be used to interpolate the footnote +number. +The default is the string \*(lq[note %1%]\*(rq. +.TP +.BR footnote-anchor " (string)" +This options specifies the footnote reference that appears at the +beginning of each footnote proper if +.B .FS +was called without an argument. +The option's value is passed to a call to +.I substitute +with the footnote number generated by the last use of `\e**' as +another argument. +The default is \*(lq[%1%]\*(rq. +.SH FILES +.I unroff +reads and parses an \*(rqms\*(lq document composed of one ore more +input files. +As usual, the special file name +.RB ` \- ' +can be used to interpolate standard input. +If no file name is given in the command line, +.I unroff +reads from standard input. +.LP +The resulting HTML document is sent to standard output, unless a +file name prefix is assigned to the +.B document +option. +In the latter case, the +.B split +option controls splitting of the output into separate files at +section boundaries as described under OPTIONS above. +A number of other features, such as footnotes, also require +that the +.B document +option is supplied, as separate output files are created for them +(regardless of the value of +.BR split ). +In any case, the name of each output file consists of the value of +.BR document , +followed by an optional suffix, followed by the extension \*(lq.html\*(rq. +.SH EXAMPLE +To translate an \*(lqms\*(rq document composed of several +input files, +.I unroff +could be invoked like this: +.Ex +.if n \{unroff \-fhtml \-ms document=thesis split=2\e + intro.ms 1.ms 2.ms 3.ms app.ms\} +.if !n unroff \-fhtml \-ms document=thesis split=2 intro.ms 1.ms 2.ms 3.ms app.ms +.Ee +The names of all output files will have the prefix \*(lqthesis\*(rq, +and the resulting HTML document will be split into separate files +at each level 1 section or level 2 section. +.SH DESCRIPTION +The following +.B \-ms +macros are translated (in addition to any user-defined macros): +.LP +.nf +.if !\n(.U .ta 8n 16n 24n 32n 40n 48n 56n + .AB .AE .AI .AU .B .B1 .B2 + .BD .BX .CD .DE .DS .FA .FE + .FS .I .ID .IP .LD .LG .LP + .NH .PP .PX .QP .R .RE .RS + .RT .SH .SM .TL .UL .UX .XA + .XE .XS +.fi +.LP +These predefined strings and number registers are recognized: +.LP +.nf + \e*- \e*(DY \e*(MO \e*Q \e*U \en(PN +.fi +.LP +In addition, a number of macros are either silently ignored +or cause a warning to be printed, because their function either +cannot be mapped to HTML 2.0 elements or assumes a page +structure: +.LP +.nf + .AM .BT .CM .CT .DA .EF .EH + .HD .KE .KF .KS .ND .NL .OF + .OH .P1 .PT .TM .MC .1C .2C +.fi +.LP +The font switching macros are based on changes to the fonts `R', +`I', and `B', as explained under FONTS in +.BR unroff-html (1). +Of course, this fails if the fonts (which are mounted on startup) +are unmounted by explicit +.B .fp +requests. +.LP +Upper or lower case letters are accepted as section numbers by +.B .NH +when the argument ``S'' is used to set new section numbers. +This is useful for appendices and similar constructs. +.LP +The translation rule for +.B .IP +employs a heuristic to determine whether to generate a definition +list or an unordered list: +if the first in a sequence of indented paragraph macros is +called with a tag consisting of one of the special character \e(bu +or \e(sq, a definition list is begun, otherwise an unordered list. +Since +.RI exdented[ sic ] +paragraphs cannot be expressed in HTML 2.0, a warning +message is printed when a call to the macro +.B .XP +is encountered. +.LP +All footnotes are concatenated and placed in a separate output file, +and a corresponding section (with a user-defined header) holding +the footnotes is appended to the document automatically. +Use of the string `\e**' generates a hypertext link to the beginning +of the footnote created by the next call to +.B .FS +and +.BR .FE . +The actual text generated by using `\e**' as well as the footnote +reference that appears in the footnote proper are controlled by +two options as explained under OPTIONS above. +A warning message is printed on termination if `\e**' has been +used but a corresponding footnote was not seen. +As an alternative to `\e**', the new request +.B .FA +can be used to produce a footnote anchor together with a hypertext +link; the anchor is the argument to the macro +(however, `\e**' itself must not be used in a call to +.BR .FA ). +.LP +Likewise, a hypertext reference is created for each use of the +table of contents macros +.BR .XS +and +.BR .XE +(optionally accompanied by calls to +.BR .XA ). +.SH "SEE ALSO" +.BR unroff (1), +.BR unroff-html (1), +.BR troff (1), +.BR ms "(5 or 7)." +.LP +Unroff Programmer's Manual. +.LP +http://www.informatik.uni-bremen.de/~net/unroff +.LP +Berners-Lee, Connolly, et al., +HyperText Markup Language Specification\(em2.0, +Internet Draft, Internet Engineering Task Force. +.SH BUGS +The macro +.B .UL +is currently mapped to a call to +.BR .I , +as underlining is not supported by the HTML back-end of +.I unroff +\*(Ve. +.LP +Footnote references and requests such as +.B .sp +that cause non-character-level markup to be generated must not +be used inside a numbered header. +.LP +When creating a hypertext anchor for +.B .XS +and +.BR .XE , +there is nothing to put inside the element; +therefore a non-breaking space is used. +.LP +Changing the number register format of `NH' to get roman or alphabetic +section numbers does not work, obviously. diff --git a/doc/unroff-html.1 b/doc/unroff-html.1 new file mode 100644 index 0000000..3250d84 --- /dev/null +++ b/doc/unroff-html.1 @@ -0,0 +1,671 @@ +.\" $Revision: 1.12 $ +.ds Ve 1.0 +.\" +.de Ex +.RS +.nf +.nr sf \\n(.f +.if !\\n(.U \{\ +. ft B +. if n .sp +. if t .sp .5 \} +.. +.de Ee +.if !\\n(.U \{\ +. ft \\n(sf +. if n .sp +. if t .sp .5 \} +.fi +.RE +.. +.\" +.de Sd +.ds Dt \\$2 +.. +.\" +.Sd $Date: 1995/08/23 12:07:31 $ +.TH unroff-html 1 "\*(Dt" +.SH NAME +unroff-html \- HTML 2.0 back-end for the programmable troff translator +.SH SYNOPSIS +.B unroff +[ +.B \-fhtml +] [ +.BI \-m package +] [ +.IR file " | " option...\& +] +.SH OVERVIEW +When called with the +.B \-fhtml +option, +.I unroff +loads the back-end for the Hypertext Markup Language (HTML) version 2.0. +Please read +.BR unroff (1) +first for an overview of the Scheme-based, programmable troff translator +and for a description of the generic options that exist in +addition to +.B \-f +and +.BR \-m . +For information about extending and programming +.I unroff +also refer to the +.IR "Unroff Programmer's Manual" . +.LP +.I unroff +is usually invoked with an additional +.BI \-m package +option (such as +.B \-ms +or +.BR \-man ) +to load the translation rules for the troff macros and other elements +defined by the macro package that is used to typeset the document. +If no +.B \-m +option is supplied, only the standard troff requests, special characters, +escape sequences, etc. are recognized and translated to HTML by +.I unroff +as described in this manual. +.SH OPTIONS +The following HTML-specific options can be specified in the command +line after the generic options. +See +.BR unroff (1) +for a general description of keyword/value options and their types +and for a list of options that are not specific to the target language. +.TP +.BR title " (string)" +The value to be used for the element in HTML output files. +This option may be ignored by the code implementing a specific +macro set, e.\|g. when special rules are employed to derive the title +from the contents of the troff input files. +Whether or not this option is required also depends on the specific +.B \-m +option used, but it may be omitted if no +.B \-m +option is given. +.TP +.BR document " (string)" +The prefix used for the names of all output files. +May be ignored depending on the macro package that has been selected. +.TP +.BR mail-address " (string)" +The caller's mail address; may be used for \*(lqmailto:\*(rq URLs, +in particular for the \*(lqhref\*(rq attribute of the <link> +element that is usually generated. +.TP +.BR tt-preformat " (boolean)" +If 1, font changes to a font that is mapped to the <tt> element +are honored inside non-filled text (as described below). +The default is 0, i.\|e. the font changes will be recorded, but no +corresponding HTML tags will be emitted for them. +.TP +.BR handle-eqn " (string)" +.TP +.BR handle-tbl " (string)" +.TP +.BR handle-pic " (string)" +These options specify how equations, tables, and pictures encountered +in the troff input are processed. +Possible values are \*(lqcopy\*(rq to include the raw eqn, tbl, or +pic commands as pre-formatted text, \*(lqtext\*(rq to run the +respective troff preprocessor (eqn, tbl, or pic) and include its output +as pre-formatted text, or \*(lqgif\*(rq to convert the preprocessor +output to a GIF image and include it in the HTML document as +an inline image. +The default is \*(lqtext\*(rq for +.BR handle-tbl , +\*(lqgif\*(rq for the other options. +See DESCRIPTION below for more information. +.TP +.BR eqn " (string)" +.TP +.BR tbl " (string)" +.TP +.BR pic " (string)" +These options specify the programs to invoke as the eqn, tbl, +and pic preprocessors. +The defaults are site-dependent. +.TP +.BR troff-to-text " (string)" +.TP +.BR troff-to-gif " (string)" +The programs to invoke for converting the output of a troff preprocessor +to plain text or to a GIF image. +The default values are site-dependent. +See DESCRIPTION below for more information on these options. +.SH FILES +If no +.B \-m +option is supplied, +.I unroff +reads the specified input files and sends the HTML document to +standard output, unless the +.B document +option is given, in which case its value together +with the suffix \*(lq.html\*(rq is used as the name of an +output file. +If no input files are specified, input is taken from standard input. +The output is enclosed by the usual HTML boiler-plate (<html>, <head>, +and <body> elements), a <title> element with the specified title +(or the value of +.B document +if no title has been given, or a default title if both are omitted), +a <link> element with rev= and href= attributes if +.B mail-address +has been set, and any pending end tags are generated on end of input. +.LP +Note that this is the default action that is performed in the +rare case when no macro package name has been specified, i.\|e. when +processing \*(lqbare\*(rq troff input. +Somewhat different rules may apply when processing, for +example, a group of UNIX manual pages +.RB ( \-man ). +.LP +See +.BR unroff (1) +for a list of Scheme files that are loaded on startup. +.SH DESCRIPTION +.SS "OUTPUT TRANSLATIONS" +The characters `<', `>', and `&' are replaced by the entities +`<', `>', and `&' on output. +In addition, the quote character is mapped to `"' where +appropriate. +New mappings can be added by means of the +.I defchar +Scheme primitive as explained in the Programmer's Manual. +.SS COMMENTS +each troff comment is translated to a corresponding HTML tag +followed by a newline; empty comments are ignored. +Comments are also ignored when appearing inside a macro body. +.SS "ESCAPE SEQUENCES" +The following is a list of troff escape sequences that are recognized +and the HTML output generated for them. +Any escape sequence that does not appear in the list +expands to the character after the escape character, and +a warning is printed in this case. +New definitions can be added and the predefined mappings can +be replaced by calling the +.I defescape +Scheme primitive in the user's initialization file, in a user-supplied +Scheme file, in a document, or on a site-wide basis by modifying +the file +.B scm/html/common.scm +in the installation directory. +.LP +.nf +.if !\n(.U .ta 8n 16n 24n 32n 40n 48n 56n + \e& nothing + \e- - + \e| nothing + \e^ nothing + \e\e \e + \e' ' + \e` ` + \e" rest of line as HTML comment tag + \e% nothing + \e{ conditional input begin + \e} conditional input end + \e* contents of string + \espace space + \e0 space + \ec nothing; eats following newline + \ee \e + \es nothing + \eu nothing, prints warning + \ed nothing, prints warning + \ev nothing, prints warning + \eo its argument, prints warning + \ez its argument, prints warning + \ek sets specified register to zero + \eh appropriate number of spaces for positive argument + \ew length of argument in units + \el repeats specified character, or <hr> + \en contents of number register + \ef see description of fonts below +.fi +.SS "SPECIAL CHARACTERS" +The following special characters are mapped to their equivalent +ISO-Latin 1 entities: +.LP +.nf + \e(12 \e(14 \e(34 \e(*b \e(*m \e(+- \e(:A + \e(:O \e(:U \e(:a \e(:o \e(:u \e(A: \e(Cs + \e(O: \e(Po \e(S1 \e(S2 \e(S3 \e(U: \e(Ye + \e(a: \e(bb \e(cd \e(co \e(ct \e(de \e(di + \e(es \e(hy \e(mu \e(no \e(o: \e(r! \e(r? + \e(rg \e(sc \e(ss \e(tm \e(u: +.fi +.LP +Heuristics have to be used for the following special characters: +.LP +.nf + \e(** * + \e(-> -> + \e(<- <- + \e(<= <= + \e(== == + \e(>= >= + \e(Fi ffi + \e(Fl ffl + \e(aa ' + \e(ap ~ + \e(br | + \e(bu + (prints a warning) + \e(bv | + \e(ci O + \e(dd *** (prints a warning) + \e(dg ** (prints a warning) + \e(em -- + \e(en - + \e(eq = + \e(ff ff + \e(fi fi + \e(fl fl + \e(fm ' + \e(ga ` + \e(lh <= + \e(lq `` + \e(mi - + \e(or | + \e(pl + + \e(rh => + \e(rq '' + \e(ru _ + \e(sl / + \e(sq o (prints a warning) + \e(ul _ + \e(~= ~ +.fi +.LP +A warning is printed to standard error output for any special +character not mentioned in this section. +To add new definitions, and to customize existing ones, the +.I defspecial +Scheme primitive can be used. +.SS "NON-FILLED TEXT" +The +.B .nf +and +.B .fi +troff requests generate pairs of <pre> and </pre> tags. +Nested requests are treated correctly, and currently +active character formatting elements such as <i> (resulting +from troff font changes) are temporarily disabled while +the <pre> or </pre> is emitted. +A warning is printed if a \*(lqtab\*(rq character is encountered +within filled text. +.SS FONTS +The `\ef' escape sequence and the requests +.B .ft +(change current font) and +.B .fp +(mount font at font position) are supported in the usual way, +both with numeric font positions as well as font names and +the special name `P' to denote the previous font. +The font position of the currently active font is available +through the read-only number register `.f'. +Initially, the font `R' is mounted on font positions 1 and 4, +font `I' on font position 2, and font `B' on position 3. +.LP +To map troff font names to HTML character formatting elements, +the \f2define-font\fP Scheme procedure is called with the name +of a troff font to be used in documents, and +HTML start and end tags to be emitted when changing to this font, +or when changing +.I from +this font to another font, respectively. +Whether <tt> and </tt> is generated inside non-filled (pre-formatted) +text for fixed-width fonts is controlled by the option +.BR tt-preformat . +The following calls to +.I define-font +are evaluated on startup: +.LP +.nf +.if !\n(.U \{\ +. ft C +. ps -1 +. vs -1 \} + (define-font "R" "" "") + (define-font "I" '<i> '</i>) + (define-font "B" '<b> '</b>) + (define-font "C" '<tt> '</tt>) + (define-font "CW" '<tt> '</tt>) + (define-font "CO" '<i> '</i>) ; kludge for Courier-Oblique +.if !\n(.U \{\ +. ft +. ps +. vs \} +.fi +.LP +Site administrators may add definitions here for fonts used +at their site. +Users can define mappings for new fonts by placing corresponding +definitions in their documents or document-specific Scheme files. +.SS "OTHER TROFF REQUESTS" +The +.B .br +request generates a <br> tag. +.LP +.B .sp +requires a positive argument and is mapped to the appropriate number +of <p> tags (or newline characters inside non-filled/pre-formatted +text). +Likewise, the request +.BR .ti , +when called with a positive indent, produces a <br> followed by the +appropriate number of non-breakable spaces. +.LP +The +.B .tl +requests justs emits the title parts delimited by spaces. +It is impossible to preserve the meaning of this request +in HTML 2.0. +.LP +The horizontal line drawing escape sequence `\el' just repeats +the specified character (or underline as default) to draw +a line. +If the given length looks like it could be the line length +(that is, if it exceeds a certain value), a <hr> tag +is produced instead. +Example: +.LP +.nf + \el'5c\e&-' + \el'60' +.fi +.LP +The first of these two requests +would produce a line of 20 dashes, while the second +request would generate a <hr> tag (the '\e&' is required +because the dash could be interpreted as a continuation of +the numeric expression). +.LP +Centering +.RB ( .ce ) +is simulated by producing a <br> at the end of each line, as +this functionality is not supported by HTML 2.0. +.LP +The following requests are silently ignored; as the corresponding +functions cannot be expressed in HTML 2.0 or are controlled by +the client. +Ignoring these requests most likely does no harm. +.LP +.nf + .ad .bp .ch .fl .hw .hy .lg + .na .ne .nh .ns .pl .ps .rs + .vs .wh +.fi +.LP +All troff requests not mentioned in this section by default +cause a warning message to be printed to standard error output, +except for these basic requests which have their usual +semantics: +.LP +.nf + .am .as .de .ds .ec .el .ie + .if .ig .nr .rm .rr .so .tm +.fi +.LP +The +.I defrequest +Scheme primitive is used to associate an event handling procedure +with a request as documented in the Programmer's Manual. +.SS "END OF SENTENCE" +The sequence \*(lq<tt>space</tt>\*(rq is produced at the end of +each sentence to provide additional space, except inside non-filled text. +A sentence is defined a sequence of characters followed by +a period, a question mark, or an exclamation mark, followed +by a newline. +The usual convention to suppress end-of-sentence recognition +by adding the escape sequence `\e&' is correctly implemented by +.IR unroff . +To change the end-of-sentence function, the +.I sentence-event +can be redefined from within Scheme code as described in +the Programmer's Manual. +.SS "SCALE INDICATORS" +As the notions of vertical spacing, character width, device +resolution, etc. do not exist in HTML, the scaling for the +usual troff scale indicators is defined once on startup and +then remains constant. +For simplicity, the scaling usually employed by +.BR nroff (1) +is taken. +.SS "EQUATIONS, TABLES, PICTURES" +Interpretation of embedded eqn, tbl, and pic preprocessor input +is controlled by the options +.BR handle-eqn , +.BR handle-tbl , +and +.B handle-pic +(see OPTIONS above). +These options affect the input lines from a starting +.BR .EQ , +.BR .TS , +or +.B .PS +request up to and including the matching +.BR .EN , +.BR .TE , +or +.B .PE +request, as well as text surrounded by the current eqn +inline equation delimiters. +Each of the options can have one the following values: +.TP +.B copy +The preprocessor input (including the enclosing requests) is +placed inside <pre> and </pre>. +If assigned to the option +.BR handle-eqn , +inline equations are rendered in the font currently mounted +on font position 2. +.TP +.B text +The input is sent to the respective preprocessor (as specified +by the options +.BR eqn , +.BR tbl , +or +.BR pic ), +and its result is piped to the shell command referred to by the +option +.BR troff-to-text , +which typically involves a call to +.BR nroff (1) +or an equivalent command. +As with \*(lqcopy\*(rq, the result is then placed inside +<pre> and </pre>, unless the source is an inline equation. +.IP +The value of +.B troff-to-text +is filtered through a call to the +.I substitute +Scheme primitive with the name of an output file as its argument; +this file name can be referenced from within the option's value +by the substitute specifier \*(lq%1%\*(rq (see the Programmer's +Manual for a description of +.I substitute +and a list of substitute specifiers). +Here is a typical value for the +.B troff-to-text +option: +.Ex +"groff \-Tascii | col \-b | sed '/^[ \et]*$/d' > %1%" +.Ee +.TP +.B gif +Input lines are preprocessed as described under \*(lqtext\*(rq, and +the result is piped to the shell command named by the option +.BR troff-to-gif . +The latter is subject to a call to +.I substitute +with the name of a temporary file (which may be used to store intermediate +PostScript output) and the name of the output file where the resulting +GIF image must be stored. +The entire preprocessor input is replaced by an <img> element with +a reference to the GIF file and a suitable \*(lqalt=\*(rq attribute. +Unless processing an inline equation, the <img> element is +surrounded by <p> tags. +.IP +The names of the files containing the GIF images are generated +from the value of the +.B document +option, a sequence number, and the suffix \*(lq.gif\*(rq. +Therefore, the +.B document +option must have been set when using the \*(lqgif\*(rq method, +otherwise a warning is printed and the preprocessor input +is skipped. +.LP +In any case, the output of a call to eqn is ignored if the +input consists of calls to \*(lqdelim\*(rq or \*(lqdefine\*(rq +and empty lines exclusively. +When processing eqn input, calls to \*(lqdelim\*(rq are intercepted by +.I unroff +to record changes of the inline equation delimiters. +.SS "HYPERTEXT LINKS" +The facilities for embedding arbitrary hypertext links in troff +documents are still experimental in this version of +.I unroff +and thus are likely to change in future releases. +To use them, mention the file name \*(lqhyper.scm\*(rq in the +command line before any troff source files. +At the beginning of the first troff file, source the file +\*(lqtmac.hyper\*(rq from the directory \*(lqdoc\*(rq like this: +.LP +.nf + .if !\en(.U .so tmac.hyper +.fi +.LP +The request +.B .Hr +can then be used to create a hypertext link. +Its usage is: +.LP +.nf + .Hr -url URL anchor-text [suffix] + .Hr -symbolic label anchor-text [suffix] + .Hr troff-text +.fi +.LP +The first two forms are recognized by +.I unroff +and the third form is recognized by troff. +The first form is used for links pointing to external resources, +and the second one is used for forward or backward links referencing +anchors defined in a file belonging to the same document. +An anchor is placed in the document by calling the request +.BR .Ha : +.LP +.nf + .Ha label anchor-text +.fi +.LP +The label specified in a call to +.B .Ha +can then be used in calls to +.BR ".Hr -symbolic" . +All symbolic references must have been resolved at the end of the document. +The \*(lqanchor-text\*(rq is placed between the tags <a> and </a>; +\*(lqsuffix\*(rq is appended to the closing </a> if present. +\*(lqtroff-text\*(rq is just formatted in the normal way. +Quotes must be used if any of the arguments contains spaces. +.LP +Use of the hypertext facilities is demonstrated by the troff source +of the Programmer's Manual that is included in the +.I unroff +distribution. +.SH "SCHEME PROCEDURES" +The following Scheme procedures, macros, and variables are defined +by the HTML 2.0 back-end and can be used from within user-supplied +Scheme code: +.TP +(\f2define-font name start-tag end-tag\fP) +Associates a HTML start tag and end tag (symbols) with a troff +font name (string) as explained under FONTS above. +The font name can then be used in +.BR .fp , +.BR .ft , +and `\ef' requests. +.TP +(\f2reset-font\fP) +Resets both the current and previous font to the font mounted +on position 1. +.TP +\f2current-font\fP +.TP +\f2previous-font\fP +These variables hold the current and previous font as +(integer) font positions. +.TP +(\f2with-font-preserved\fP . \f2body\fP) +This macro can be used to temporarily change to font \*(lqR\*(rq, +evaluate \f2body\fP, and revert to the font that has been +active when the form was entered. +The macro returns a string that can be output using the +primitive \f2emit\fP or returned from an event procedure. +.TP +(\f2preform enable?\fP) +If the argument is #t, pre-formatted text is enabled, otherwise disabled. +.TP +\f2preform?\fP +This boolean variable holds #t if pre-formatted text is enabled, +#f otherwise. +.TP +(\f2with-preform-preserved\fP . \f2body\fP) +A macro that can be used to temporarily disable pre-formatted +text, evaluate \f2body\fP, and then re-enable it if appropriate. +The macro expands to a string that must be output or returned from +an event procedure. +.TP +(\f2parse-unquote string\fP) +Temporarily establishes an output translation to map the quote +character to \*(lq"\*(rq, applies \f2parse\fP (explained +in the Programmer's Manual) to its argument, and returns the result. +.TP +(\f2center n\fP) +Centers the next \f2n\fP input lines (see description of +.B .ce +under TROFF REQUESTS above). +If \f2n\fP is zero, centering is stopped. +.TP +\f2nbsp\fP +A Scheme variable that holds a string interpreted as a non-breaking +space by HTML clients. +.SH "SEE ALSO" +.BR unroff (1), +.BR unroff-html-man (1), +.BR unroff-html-ms (1); +.br +.BR troff (1), +.BR nroff (1), +.BR groff (1), +.BR eqn (1), +.BR tbl (1), +.BR pic (1). +.LP +Unroff Programmer's Manual. +.LP +http://www.informatik.uni-bremen.de/~net/unroff +.LP +Berners-Lee, Connolly, et al., +HyperText Markup Language Specification\(em2.0, +Internet Draft, Internet Engineering Task Force. +.SH BUGS +The `\espace' escape sequence should be mapped to the   entity +(non-breaking space), but this entity is not supported by a number +of HTML clients. +.LP +Only the font positions 1 to 9 can currently be used. +There should be no limit. +.LP +The extra space generated for end of sentence should be configurable. +.LP +Underlining should be supported. diff --git a/doc/unroff.1 b/doc/unroff.1 new file mode 100644 index 0000000..9b3f35a --- /dev/null +++ b/doc/unroff.1 @@ -0,0 +1,682 @@ +.\" $Revision: 1.16 $ +.ds Ve 1.0 +.\" +.de Ex +.RS +.nf +.nr sf \\n(.f +.if !\\n(.U \{\ +. ft B +. if n .sp +. if t .sp .5 \} +.. +.de Ee +.if !\\n(.U \{\ +. ft \\n(sf +. if n .sp +. if t .sp .5 \} +.fi +.RE +.. +.\" +.de Sd +.ds Dt \\$2 +.. +.\" +.Sd $Date: 1995/08/23 12:07:31 $ +.TH unroff 1 "\*(Dt" +.SH NAME +unroff \- programmable, extensible troff translator +.SH SYNOPSIS +.B unroff +[ +.BI \-f format +] [ +.BI \-m package +] [ +.BI \-h heapsize +] [ +.B \-C +] +.if n .ti +0.5i +[ +.B \-t +] [ +.IR file " | " option...\& +] +.SH OVERVIEW +.I unroff +reads and parses documents with embedded troff markup +and translates them to a different format\(emtypically +to a different markup language such as SGML. +The actual output format is not hard-wired into +.IR unroff ; +instead, the translation is performed by a set of user-supplied rules +and functions written in the +.I Scheme +programming language. +.I unroff +employs the Extension Language Kit +.I Elk +to achieve programmability based on the Scheme language: +a fully-functional Scheme interpreter is embedded in the translator. +.LP +The documents that can be processed by +.I unroff +are not restricted to a specific troff macro set. +Translation rules for a new macro package can be added by supplying +a set of corresponding Scheme procedures (a \*(lqback-end\*(rq). +Predefined sets of such procedures exist for a number of combinations +of target language and troff macro package: +.I unroff +\*(Ve supports translation to the \*(lqHypertext Markup Language\*(rq +(HTML) version 2.0 for the +.B \-man +and +.B \-ms +macro packages as well as \*(lqbare\*(rq troff (see +.BR unroff-html (1), +.BR unroff-html-man (1), +and +.BR unroff-html-ms (1) +for a description). +.LP +Unlike conventional troff conversion tools, +.I unroff +includes a full troff parser and can therefore handle user-defined +macros, strings, and number registers, nested if-else requests +(with text blocks enclosed by `\e{' and `\e}' escape sequences), arbitrary +fonts and font positions, troff \*(lqcopy mode\*(rq, low-level formatting +requests such as `\el' and '\eh', and the subtle +differences between request and macro invocations that are inherent +in the troff processing model. +.I unroff +has adopted a number of troff extensions introduced by +.IR groff , +among them long names for macros, strings, number registers, and +special characters, and the `\e$@' and `\e$*' escape sequences. +.LP +.I unroff +interprets its input stream as a sequence of \*(lqevents\*(rq. +Events include the invocation of a troff request or macro, the use of a +troff escape sequence or special character, a troff string +or number register reference, end of sentence, start +of a new input file, and so on. +For each event encountered +.I unroff +invokes a Scheme procedure associated with that event. +Some types of events require a procedure that returns a string (or an +object that can be coerced into a string), +which is then interpolated into the input or output stream; +for other types of events, the event procedures are just called +for their side-effects. +.LP +The set of Scheme procedures to be used by +.I unroff +is determined by the output format and the name of the troff +macro package. +In addition, users can supply event procedures for their own macro +definitions (or replace existing ones) in form of a simple Scheme +program passed to +.I unroff +along with the troff input files; Scheme code can even be directly +embedded in the troff input as described below. +.LP +The full capabilities of +.IR unroff +and the Scheme primitives required to write extensions or support +for new output formats are described in the +.IR "Unroff Programmer's Manual" . +.SH "GENERIC OPTIONS" +.TP +.BI \-f format +Specifies the output format into which the troff input files are +translated. +If no +.B \-f +option is given, a default output format is used (for +.I unroff +version \*(Ve the default is +.B \-f\c +.IR html ). +This default can be overridden by setting the +.SB UNROFF_FORMAT +environment variable. +.TP +.BI \-m name +Specifies the name of the macro package that would be used by ordinary +troff to typeset the document. +In contrast to troff +.I unroff +does not actually load the macro package. +Instead, the specified name\-in combination with the specified output +format\-selects a set of Scheme files providing the procedure definitions +that control the translation process (see +.B FILES +below). +Therefore a corresponding +.B tmac +file need not exist for a given +.B \-m +option. +.TP +.BI \-h heapsize +This option can be used to specify a non-standard heap size (in Kbytes) +for the Scheme interpreter included in +.IR unroff ; +see +.BR elk (1). +.TP +.B \-C +Enables troff compatibility mode. +In compatibility mode certain +.I groff +extensions such as long names are not recognized. +.TP +.B \-t +Enables test mode. +Instead of processing troff input files, +.I unroff +enters an interactive Scheme top-level. +This can be useful to interactively experiment with the Scheme +primitives defined by +.I unroff +or to test or debug user-defined Scheme procedures. +.SH "KEYWORD/VALUE OPTIONS" +In addition to the generic options, a set of output-format-specific +options can be set from the command line and from within troff and +Scheme input files. +When specified on the command line, these options have the form +.Ex +\f2option\fP=\f2value\fP +.Ee +where the format of +.I value +depends on the +.I type +of the option. +For example, most output formats defines an option +.B document +whose value is used as a prefix for all output files created during +the translation. +The option is assigned a value by specifying a token such as +.Ex +document=thesis +.Ee +on the command line. +This option's value is interpreted as a plain string, i.\|e.\& +its type is +.BR string . +.LP +The Scheme back-ends and user-supplied extensions can define their +own option types, but at least the following types are recognized: +.TP 10n +.B integer +the option value is composed of an optional sign and an (arbitrary) +string of digits +.TP 10n +.B boolean +the option value must either be the character 1 (true) or the +character 0 (false) +.TP 10n +.B character +a single character must be specified as the option value +.TP 10n +.B string +an arbitrary string of characters can be specified +.TP 10n +.B dynstring +\*(lqdynamic string\*(rq; the option value is either +.RS +.TP +.I string +to assign a string to the option in the normal way, or +.TP +.BI + string +to append the characters after the plus sign +to the option's current value, or +.TP +.BI \- string +to remove the characters after the minus sign from the +option's current value. +.RE +.LP +These extension-specific options must appear after the generic +.I unroff +options and may be mixed with the file name arguments. +As the option assignments and specified input files are processed in +order, the value given for an option is in effect for all the input +files that appear on the command line to the right of the option. +.LP +The exact set of keyword/value options is determined by the +Scheme code loaded for a given combination of output format +and macro package name and is described in the corresponding +manuals. +The following few options can always be set, regardless of the +actual output format: +.TP +.BR include-files " (boolean)" +If true, +.B .so +requests are executed by +.I unroff +in the normal way (that is, the named input file is read and +parsed), otherwise +.B .so +requests are ignored. +The default value is 1. +.TP +.BR if-true " (dynstring)" +the specified characters are assigned to (appended to, removed from) +the set of one-character conditions that are regarded as true +by the +.B .if +and +.B .ie +requests. +The default value is "to". +.TP +.BR if-false " (dynstring)" +like +.BR if-true ; +specifies the one-character conditions regarded as false. +The default value is "ne". +.SH FILES +.SS "INPUT FILES" +On startup, +.I unroff +loads the Scheme source files that control the translation process. +All these files are loaded from subdirectories of a site-specific +\*(lqlibrary directory\*(rq, typically something like +.BR /usr/local/lib/unroff . +The directory is usually chosen by the system administrator when +installing the software and can be overridden by setting the +.SB UNROFF_DIR +environment variable. +The path names mentioned in the following are relative to this +library directory. +.LP +The first Scheme file loaded is +.B scm/troff.scm +which contains basic definitions such as the built-in options +and option types, implementations for troff requests that are +not output-format specific, and utility functions to be used +by the back-ends or by user-supplied extensions. +Next, the file +.BI scm/ format /common.scm +is loaded, where +.I format +is the value of the option +.B \-f +as given on the command line (or its default value). +The file implements the translation of the basic troff +requests, escape sequences, and special characters, etc. +The code dealing with macro invocations is loaded from +.BI scm/ format / package .scm +where +.I package +is the value of the option +.B \-m +with the letter `m' prepended. +.LP +Finally, the file +.B .unroff +is loaded from the caller's home directory if present. +Arbitrary Scheme code can be placed in this initialization file. +It is typically used to assign values to package-specific +keyword/value options according to the user's preferences +(by means of the +.I set-option! +Scheme primitive as explained in the Programmer's Manual). +.LP +When the initial files have been loaded, any troff input files specified +in the command line are read and parsed. +The special file name +.RB ` \- ' +can be used to indicate standard input (usually in combination with +ordinary file names). +If no file name is given, +.I unroff +reads from standard input. +.LP +In addition to troff input files, file containing Scheme code can +be mentioned in the command line. +Scheme files (which by convention end in +.BR .scm ) +are loaded into the Scheme interpreter and usually contain +used-defined Scheme procedures to translate specific macros or +to replace existing procedures, or other user-supplied extensions +of any kind. +Scheme files named in the command line (or loaded explicitly from +within other files) are resolved against the directory +.B scm/misc/ +which may hold site-specific extensions or other supplementary +packages. +troff files and Scheme files can be mixed freely in the command line. +.SS "OUTPUT FILES" +Whether +.I unroff +sends its output to standard output or produces one or more output +files is not hard-wired but determined by the combination of output +format and macro package. +Generally, if no troff input files are specified, output is directed +to standard output, but this rule is not mandatory and may +be overridden by specific back-ends. +The +.B document +option is usually honored, although other rules may be employed to +determine the names of output files (for example, the extension +that implements +.B \-man +for a given output format may derive the name of the output file +for a manual page from the input file name; see +.BR unroff-html-man (1)). +.LP +If +.I unroff +is interrupted or quits early, any output files produced so far may be +incomplete or may contain wrong or inconsistent data, because +several passes may be required to complete an output file (for example, +to resolve cross references between a set of files), or because +an output file is not necessarily produced as a whole, but +.I unroff +may work on several files simultaneously. +.SH EXAMPLES +.LP +To translate a troff document composed of two files and written with the +\*(lqms\*(rq macro package to HTML 2.0, +.I unroff +might be called like this: +.Ex +unroff \-fhtml \-ms doc.tr doc.tr +.Ee +Two options specific to the combination of +.B \-fhtml +and +.B \-ms +might be added to specify a prefix for output files and to have +the resulting output split into separate files after each section +(see +.BR unroff-html-ms (1)): +.Ex +unroff \-fhtml \-ms document=out/ split=1 doc.tr doc.tr +.Ee +Additional features may be loaded from Scheme files specified in the +command line, e.\|g.\& +.B hyper.scm +which implements general Hypertext requests (and gets loaded from +.BR scm/misc/ ) +and a user-supplied file in the current directory providing translation +rules for user-defined troff macros: +.Ex +.ne 2 +unroff \-fhtml \-ms document=out/ split=1 hyper.scm doc.scm\e + doc.tr doc.tr +.Ee +.SH "TROFF SUPPORT AND EXTENSIONS" +As +.I unroff +translates troff input into another language rather than typesetting +the text in the usual way, its processing model necessarily differs +from that of conventional troff. +For a detailed description refer to the Programmer's Manual. +.LP +In brief, +.I unroff +copies characters from input to output, optionally performing +target-language-specific character translations. +For each request or macro invocation, string or number register +reference, special character, escape sequence, sentence end, or +.BR eqn (1) +inline equation encountered in the input stream, +.I unroff +checks whether an \*(lqevent value\*(rq has been specified by +the Scheme code (user-supplied or part of the back-end). +An event value is either a plain string, which is then treated as +if it had been part of the input stream, or a Scheme procedure, +which is then invoked and must in turn return a string. +The Scheme procedures are passed arguments, e.\|g. the macro +or request arguments in case of a procedure attached to a macro +or request, or an escape sequence argument for functions such as +`\ef' or `\ew'. +.LP +If no event value has been associated with a particular macro, +string, or number register, +.I unroff +checks whether a definition has been supplied in the normal way, +i.\|e. by means of +.BR .de , +.BR .ds , +or +.BR .nr . +In this case, the value of the macro, string, or register is +interpolated as done by ordinary troff. +If no definition can be found, a fallback definition is looked up +as a last resort; and if everything fails, a warning is printed +and the event is ignored. +Similarly, event procedures are invoked at end of input line, +when an input file is opened or closed, at program start and +termination, and for each option specified in the command line; +but these procedures are called solely for their side-effects +(i.\|e. the return values are ignored). +.LP +Most Scheme procedures just emit the target language's representation +of the event with which they are associated. +Other procedures perform various kinds of bookkeeping; the procedure +associated with the +.B .de +request, for example, puts the text following +aside for later expansion, and the event procedures attached to +the requests +.B .ds +and +.B .nr +and to the escape sequences `\e*' and `\en' +implement troff strings and number registers. +This way, even basic troff functions need not be hard-wired and can +be altered or replaced freely without recompiling +.IR unroff . +.LP +The rule that an event value associated with a macro has precedence +over the actual macro definition accommodates higher-level, +structure-oriented target languages (such as SGML). +While the micro-formatting contained in a typical +.B \-ms +macro definition, for example, makes sense to an ordinary typesetting +program, it is usually impossible to infer the macro's +.I structural +function from it (new paragraph, quotation, etc.). +On the other hand, troff documents often define a few additional, +simple macros that just serve as an abbreviation for a sequence +of predefined macros; in this case event procedures need not +specified, as +.I unroff +will then perform normal macro expansion. +.LP +.I unroff +usually takes care to not rescan the characters returned by event +procedures as if their results had been normal input, because +most event procedures already return code in the target language rather +than troff input that can be rescanned. +This, however, cannot always be avoided; for example, if a troff string +reference occurs at macro definition time (because `\e*' is used rather +than `\e\e*'), the string value ends up in the macro body and will still +be rescanned when the macro is invoked. +A few other pitfalls caused by differences in the processing models of +troff and +.I unroff +are listed in the BUGS section below. +.LP +The scaling performed for the usual troff scale indicators +can be manipulated by a calling a Scheme primitive from within +the Scheme code implementing a particular back-end. +.SS "NEW TROFF REQUESTS" +To aid transparent output of code in the target language and +evaluation of inline Scheme code, +.I unroff +supports two new requests and two extensions to the +.B .ig +(ignore input lines) troff request. +.LP +If +.B .ig +is called with the symbol +.B >> +as its first argument, all input lines up to (but not including) +the terminating +.B .>> +are sent to the current output file. +Example: +when translating to the Hypertext Markup Language, the construct +could be used to emit literal HTML code like this: +.Ex +.ne 6 +\&.ig >> +<address> +Bart Simpson<br> +Springfield +</address> +\&.>> +.Ee +.LP +To produce a single line of output, the new request +.B .>> +can be used as in this HTML example: +.Ex +\&.>> "<code>result = i+1;</code>" +.Ee +.LP +If the +.B .ig +request is called with the argument +.BR ##, +everything up to the terminating +.B .## +is passed to the Scheme interpreter for evaluation. +This allows users to embed Scheme code in a troff document which +is executed when the document is processed by +.IR unroff . +One use of this construct is to provide a Scheme event procedure +for a user-defined macro by placing the corresponding Scheme +definition in the same source file right below the troff macro definition. +Similarly, the request +.B .## +can be used to evaluate a short S-expression; all arguments to +the request are concatenated and then passed to the Scheme +interpreter. +.LP +Note that inline Scheme code is a potentially dangerous feature, +as a document received by someone else may contain embedded code +that does something unexpected when the file is processed by +.I unroff +(but it is probably not more dangerous than the standard troff +.B .pi +request or the +.B .sy +request of +.IR ditroff ). +.LP +.I unroff +defines the following new read-only number registers: +.TP +.B .U +This register always expand to 1. +It can be used by macros to determine whether the document is +being processed by +.IR unroff . +.TP +.B .C +Expands to 1 if troff compatibility mode has been enabled +by using the option +.BR \-C , +to 0 otherwise. +.LP +The following new escape sequences are available in a macro +body during macro expansion: +.TP +.B $0 +The name of the current macro. +.TP +.B $* +The concatenation of all arguments, separated by spaces. +.TP +.B $@ +The concatenation of all arguments, separated by spaces, and +with each argument enclosed by double quotes. +.LP +The names of strings, macros, number registers, and fonts may be of +any length. +As in +.IR groff , +square brackets can be used for names of arbitrary length: +.Ex +\ef[font] \e*[string] \en[numreg] ... +.Ee +.LP +There is no limit on the number of macro arguments, and the following +syntax can be used to reference the 10th, 11th, etc. macro argument: +.Ex +\e$(12 \e$[12] \e$[123] +.Ee +.LP +Unless troff compatibility mode has been enabled, the arguments to the +.IR groff -specific +escape sequences `\eA', `\eC', '\eL', '\eN', '\eR', '\eV', '\eY', +and '\eZ' are recognized and parsed, so that event procedures +can be implemented correctly for these escape sequences. +.SH "SEE ALSO" +.BR unroff-html (1), +.BR unroff-html-man (1), +.BR unroff-html-ms (1); +.br +.BR troff (1), +.BR groff (1); +.BR elk (1). +.LP +Unroff Programmer's Manual. +.LP +http://www.informatik.uni-bremen.de/~net/unroff +.SH AUTHOR +Oliver Laumann, net@cs.tu-berlin.de +.SH BUGS +A number of low-level formatting features of troff (such as the +absolute position indicator in numerical expressions) +are not yet supported by +.I unroff +version \*(Ve, which is not critical for higher-level, +structure-oriented target languages such as the Hypertext +Markup Language. +.LP +Diversions are not supported, although specific back-ends are +free to add this functionality. +.LP +Special characters are not treated right in certain contexts; +in particular, special characters may not be used in place +of plain characters where the characters act as some kind of +delimiter as in +.Ex +\&.if \e(bsfoo\e(bsbar\e(bs ... +.Ee +.LP +Spaces in an +.B .if +condition do not work; e.\|g. the following fails: +.Ex +\&.if ' ' ' ... +.Ee +.LP +Conditional input is subject to string and number register +expansion even if the corresponding if-condition evaluates to false. +.LP +There are no number register formats, i.\|e. the request +.B .af +does not work. +.LP +The set of punctuation marks that indicate end of sentence +should be configurable. +.LP +Empty input lines and leading space should trigger a special +event, so that their break semantics can be implemented correctly. +.LP +A comment in a line by itself currently does not generate a +blank line. diff --git a/elk/README b/elk/README new file mode 100644 index 0000000..de1d852 --- /dev/null +++ b/elk/README @@ -0,0 +1,4 @@ +This directory holds a minimal, self-contained Elk runtime environment. +All the files have been copied from the Elk 3.0 distribution. If you +have Elk installed at your site, you can replace this directory by +a symbolic link to your site's Elk runtime directory. diff --git a/elk/scm/debug.scm b/elk/scm/debug.scm new file mode 100644 index 0000000..157535c --- /dev/null +++ b/elk/scm/debug.scm @@ -0,0 +1,212 @@ +;;; -*-Scheme-*- +;;; +;;; A simple debugger (improvements by Thomas M. Breuel <tmb@ai.mit.edu>). + +(define (backtrace . args) + (if (> (length args) 1) + (error 'backtrace "too many arguments")) + (if (not (null? args)) + (if (not (eq? (type (car args)) 'control-point)) + (error 'backtrace "argument must be a control point"))) + (let ((trace (apply backtrace-list args))) + (if (null? args) + (set! trace (cdddr trace))) + (show-backtrace trace 0 999999))) + +(define (show-backtrace trace start-frame end-frame) + (define (rjust n x) + (let* ((y (string-append (make-string n #\space) x)) + (l (string-length y))) + (substring y (- l n) l))) + (let ((maxlen 28)) + (let loop ((frames (list-tail trace start-frame)) (num start-frame)) + (if (or (null? frames) (>= num end-frame)) #v + (let ((frame (car frames))) + (let* ((func + (format #f "~s" (vector-ref frame 0))) + (indent + (- maxlen (+ 5 (string-length func))))) + (display (rjust 4 (number->string num))) + (display " ") + (display func) + (if (negative? indent) + (begin + (newline) + (set! indent maxlen))) + (do ((i indent (1- i))) + ((> 0 i)) + (display " "))) + (fluid-let + ((print-depth 2) + (print-length 3)) + (display (vector-ref frame 1))) + (newline)) + (loop (cdr frames) (1+ num)))))) + +(define (show-environment env) + (fluid-let + ((print-length 2) + (print-depth 2)) + (do ((f (environment->list env) (cdr f))) + ((null? f)) + (do ((b (car f) (cdr b))) + ((null? b)) + (format #t "~s\t~s~%" (caar b) (cdar b))) + (print '-------))) + #v) + +(define inspect) + +(let ((frame) + (trace) + (help-text + '("q -- quit inspector" + "f -- print current frame" + "u -- go up one frame" + "d -- go down one frame" + "^ -- go to top frame" + "$ -- go to bottom frame" + "g <n> -- goto to n-th frame" + "e -- eval expressions in environment" + "p -- pretty-print procedure" + "v -- show environment" + "<n> -- pretty-print n-th argument" + "b -- show backtrace starting at current frame" + "t -- show top of bracktrace starting at current frame" + "z -- show and move top of backtrace starting at current frame" + "o -- obarray information"))) + + (define (inspect-command-loop) + (let ((input) (done #f)) + (display "inspect> ") + (set! input (read)) + (case input + (q + (set! done #t)) + (? + (for-each + (lambda (msg) + (display msg) + (newline)) + help-text)) + (f + (print-frame)) + (^ + (set! frame 0) + (print-frame)) + ($ + (set! frame (1- (length trace))) + (print-frame)) + (u + (if (zero? frame) + (format #t "Already on top frame.~%") + (set! frame (1- frame)) + (print-frame))) + (d + (if (= frame (1- (length trace))) + (format #t "Already on bottom frame.~%") + (set! frame (1+ frame)) + (print-frame))) + (g + (set! input (read)) + (if (integer? input) + (set! frame + (cond ((negative? input) 0) + ((>= input (length trace)) (1- (length trace))) + (else input))) + (format #t "Frame number must be an integer.~%"))) + (v + (show-environment (vector-ref (list-ref trace frame) 2))) + (e + (format #t "Type ^D to return to Inspector.~%") + (let loop () + (display "eval> ") + (set! input (read)) + (if (not (eof-object? input)) + (begin + (write (eval input + (vector-ref (list-ref trace frame) 2))) + (newline) + (loop)))) + (newline)) + (p + (pp (vector-ref (list-ref trace frame) 0)) + (newline)) + (z + (show-backtrace trace frame (+ frame 10)) + (set! frame (+ frame 9)) + (if (>= frame (length trace)) (set! frame (1- (length trace))))) + (t + (show-backtrace trace frame (+ frame 10))) + (b + (show-backtrace trace frame 999999)) + (o + (let ((l (map length (oblist)))) + (let ((n 0)) + (for-each (lambda (x) (set! n (+ x n))) l) + (format #t "~s symbols " n) + (format #t "(maximum bucket: ~s).~%" (apply max l))))) + (else + (cond + ((integer? input) + (let ((args (vector-ref (list-ref trace frame) 1))) + (if (or (< input 1) (> input (length args))) + (format #t "No such argument.~%") + (pp (list-ref args (1- input))) + (newline)))) + ((eof-object? input) + (set! done #t)) + (else + (format #t "Invalid command. Type ? for help.~%"))))) + (if (not done) + (inspect-command-loop)))) + + (define (print-frame) + (format #t "~%Frame ~s of ~s:~%~%" frame (1- (length trace))) + (let* ((f (list-ref trace frame)) (args (vector-ref f 1))) + (format #t "Procedure: ~s~%" (vector-ref f 0)) + (format #t "Environment: ~s~%" (vector-ref f 2)) + (if (null? args) + (format #t "No arguments.~%") + (fluid-let + ((print-depth 2) + (print-length 3)) + (do ((i 1 (1+ i)) (args args (cdr args))) ((null? args)) + (format #t "Argument ~s: ~s~%" i (car args)))))) + (newline)) + + (define (find-frame proc) + (let loop ((l trace) (i 0)) + (cond ((null? l) -1) + ((eq? (vector-ref (car l) 0) proc) i) + (else (loop (cdr l) (1+ i)))))) + + (set! inspect + (lambda () + (set! trace (backtrace-list)) + (set! trace (cddr trace)) + (do ((t trace (cdr t)) (f 1 (1+ f))) ((null? t)) + (if (not (null? (vector-ref (car t) 1))) + (let ((last (last-pair (vector-ref (car t) 1)))) + (if (not (null? (cdr last))) + (begin + (format #t + "[inspector: fixing improper arglist in frame ~s]~%" f) + (set-cdr! last (cons (cdr last) '()))))))) + (set! frame (find-frame error-handler)) + (if (negative? frame) + (set! frame 0)) + (format #t "Inspector (type ? for help):~%") + (let loop () + (if (call-with-current-continuation + (lambda (control-point) + (push-frame control-point) + (inspect-command-loop) + #f)) + (begin + (pop-frame) + (loop)))) + (newline) + (pop-frame) + (let ((next-frame (car rep-frames))) + (next-frame #t))))) diff --git a/elk/scm/initscheme.scm b/elk/scm/initscheme.scm new file mode 100644 index 0000000..476de0f --- /dev/null +++ b/elk/scm/initscheme.scm @@ -0,0 +1,81 @@ +;;; -*-Scheme-*- +;;; +;;; Initialization code for the Elk interpreter kernel. +;;; +;;; This file is loaded on startup before the toplevel (or the file +;;; supplied along with the -l option) is loaded. +;;; +;;; If a garbage collection is triggered while loading this file, +;;; it is regarded as an indication that the heap size is too small +;;; and an error message is printed. + + +;;; Primitives that are part of the core functionality but are not +;;; implemented in C. This is a bad thing, because extension or +;;; application writers should be able to rely on P_Expt(). + +(define (expt x y) + + (define (square x) (* x x)) + + (define (integer-expt b n) + (cond ((= n 0) 1) + ((negative? n) (/ 1 (integer-expt b (abs n)))) + ((even? n) (square (integer-expt b (/ n 2)))) + (else (* b (integer-expt b (- n 1)))))) + + (cond ((zero? x) (if (zero? y) 1 0)) + ((integer? y) (integer-expt x y)) + (else (exp (* (log x) y))))) + + +;;; Synonyms: + +(define call/cc call-with-current-continuation) + + +;;; Backwards compatibility. These procedures are really obsolete; +;;; please do not use them any longer. + +(define (close-port p) + (if (input-port? p) (close-input-port p) (close-output-port p))) + +(define (void? x) (eq? x (string->symbol ""))) + +(define (re-entrant-continuations?) #t) + + +;;; Useful macros (these were loaded by the standard toplevel in +;;; earlier versions of Elk). They shouldn't really be here, but +;;; it's too late... + +(define (expand form) + (if (or (not (pair? form)) (null? form)) + form + (let ((head (expand (car form))) (args (expand (cdr form))) (result)) + (if (and (symbol? head) (bound? head)) + (begin + (set! result (macro-expand (cons head args))) + (if (not (equal? result form)) + (expand result) + result)) + (cons head args))))) + +(define-macro (unwind-protect body . unwind-forms) + `(dynamic-wind + (lambda () #f) + (lambda () ,body) + (lambda () ,@unwind-forms))) + +(define-macro (while test . body) + `(let loop () + (cond (,test ,@body (loop))))) + +(define-macro (when test . body) + `(cond (,test ,@body))) + +(define-macro (unless test . body) + `(when (not ,test) ,@body)) + +(define-macro (multiple-value-bind vars form . body) + `(apply (lambda ,vars ,@body) ,form)) diff --git a/elk/scm/pp.scm b/elk/scm/pp.scm new file mode 100644 index 0000000..05d8e8a --- /dev/null +++ b/elk/scm/pp.scm @@ -0,0 +1,117 @@ +;;; -*-Scheme-*- +;;; +;;; Trivial pretty-printer + +(provide 'pp) + +(define pp) + +(let ((max-pos 55) (pos 0) (tab-stop 8)) + + (put 'lambda 'special #t) + (put 'macro 'special #t) + (put 'define 'special #t) + (put 'define-macro 'special #t) + (put 'define-structure 'special #t) + (put 'fluid-let 'special #t) + (put 'let 'special #t) + (put 'let* 'special #t) + (put 'letrec 'special #t) + (put 'case 'special #t) + + (put 'call-with-current-continuation 'long #t) + + (put 'quote 'abbr "'") + (put 'quasiquote 'abbr "`") + (put 'unquote 'abbr ",") + (put 'unquote-splicing 'abbr ",@") + +(set! pp (lambda (x) + (set! pos 0) + (cond ((eq? (type x) 'compound) + (set! x (procedure-lambda x))) + ((eq? (type x) 'macro) + (set! x (macro-body x)))) + (fluid-let ((garbage-collect-notify? #f)) + (pp-object x)) + #v)) + +(define (flat-size s) + (fluid-let ((print-length 50) (print-depth 10)) + (string-length (format #f "~a" s)))) + +(define (pp-object x) + (if (or (null? x) (pair? x)) + (pp-list x) + (if (void? x) + (display "#v") + (write x)) + (set! pos (+ pos (flat-size x))))) + +(define (pp-list x) + (if (and (pair? x) + (symbol? (car x)) + (string? (get (car x) 'abbr)) + (= 2 (length x))) + (let ((abbr (get (car x) 'abbr))) + (display abbr) + (set! pos (+ pos (flat-size abbr))) + (pp-object (cadr x))) + (if (> (flat-size x) (- max-pos pos)) + (pp-list-vertically x) + (pp-list-horizontally x)))) + +(define (pp-list-vertically x) + (maybe-pp-list-vertically #t x)) + +(define (pp-list-horizontally x) + (maybe-pp-list-vertically #f x)) + +(define (maybe-pp-list-vertically vertical? list) + (display "(") + (set! pos (1+ pos)) + (if (null? list) + (begin + (display ")") + (set! pos (1+ pos))) + (let ((pos1 pos)) + (pp-object (car list)) + (if (and vertical? + (or + (and (pair? (car list)) + (not (null? (cdr list)))) + (and (symbol? (car list)) + (get (car list) 'long)))) + (indent-newline (1- pos1))) + (let ((pos2 (1+ pos)) (key (car list))) + (let tail ((flag #f) (l (cdr list))) + (cond ((pair? l) + (if flag + (indent-newline + (if (and (symbol? key) (get key 'special)) + (1+ pos1) + pos2)) + (display " ") + (set! pos (1+ pos))) + (pp-object (car l)) + (tail vertical? (cdr l))) + (else + (cond ((not (null? l)) + (display " . ") + (set! pos (+ pos 3)) + (if flag (indent-newline pos2)) + (pp-object l))) + (display ")") + (set! pos (1+ pos))))))))) + + (define (indent-newline x) + (newline) + (set! pos x) + (let loop ((i x)) + (cond ((>= i tab-stop) + (display "\t") + (loop (- i tab-stop))) + ((> i 0) + (display " ") + (loop (1- i))))))) + diff --git a/elk/scm/toplevel.scm b/elk/scm/toplevel.scm new file mode 100644 index 0000000..55edd9f --- /dev/null +++ b/elk/scm/toplevel.scm @@ -0,0 +1,110 @@ +;;; -*-Scheme-*- +;;; +;;; Read-eval-print loop and error handler + + +(autoload 'pp 'pp.scm) +(autoload 'apropos 'apropos.scm) +(autoload 'sort 'qsort.scm) +(autoload 'describe 'describe.scm) +(autoload 'backtrace 'debug.scm) +(autoload 'inspect 'debug.scm) + +(define ?) +(define ??) +(define ???) +(define !) +(define !!) +(define !!!) +(define &) + +(define (rep-loop env) + (define input) + (define value) + (let loop () + (set! ??? ??) + (set! ?? ?) + (set! ? &) + ;;; X Windows hack + (if (and (bound? 'display-flush-output) (bound? 'dpy) (display? dpy)) + (display-flush-output dpy)) + (if (> rep-level 0) + (display rep-level)) + (display "> ") + (set! input (read)) + (set! & input) + (if (not (eof-object? input)) + (begin + (set! value (eval input env)) + (set! !!! !!) + (set! !! !) + (set! ! value) + (write value) + (newline) + (loop))))) + +(define rep-frames) +(define rep-level) + +(set! interrupt-handler + (lambda () + (format #t "~%\7Interrupt!~%") + (let ((next-frame (car rep-frames))) + (next-frame #t)))) + +(define-macro (push-frame control-point) + `(begin + (set! rep-frames (cons ,control-point rep-frames)) + (set! rep-level (1+ rep-level)))) + +(define-macro (pop-frame) + '(begin + (set! rep-frames (cdr rep-frames)) + (set! rep-level (1- rep-level)))) + +(define (error-print error-msg) + (format #t "~s: " (car error-msg)) + (apply format `(#t ,@(cdr error-msg))) + (newline)) + +(set! error-handler + (lambda error-msg + (error-print error-msg) + (let loop ((intr-level (enable-interrupts))) + (if (positive? intr-level) + (loop (enable-interrupts)))) + (let loop () + (if (call-with-current-continuation + (lambda (control-point) + (push-frame control-point) + (rep-loop (the-environment)) + #f)) + (begin + (pop-frame) + (loop)))) + (newline) + (pop-frame) + (let ((next-frame (car rep-frames))) + (next-frame #t)))) + +(define top-level-environment (the-environment)) + +(define (top-level) + (let loop () + ;;; Allow GC to free old rep-frames when we get here on "reset": + (set! rep-frames (list top-level-control-point)) + (if (call-with-current-continuation + (lambda (control-point) + (set! rep-frames (list control-point)) + (set! top-level-control-point control-point) + (set! rep-level 0) + (rep-loop top-level-environment) + #f)) + (loop)))) + +(define (the-top-level) + (top-level) + (newline) + (exit)) + +(the-top-level) diff --git a/misc/sample.unroff b/misc/sample.unroff new file mode 100644 index 0000000..e5c32f5 --- /dev/null +++ b/misc/sample.unroff @@ -0,0 +1,14 @@ +;;;; -*-Scheme-*- +;;;; +;;;; ~/.unroff -- initializations for unroff + +(define signature + (concat "Markup created by <em>%progname%</em> %version%," nbsp nbsp + "%monthname+% %day%, %year%," nbsp nbsp "net@cs.tu-berlin.de")) + +(eval-if-mode (* html) + (set-option! 'mail-address "net@cs.tu-berlin.de")) + +(eval-if-mode (ms html) + (set-option! 'title "An `ms' document") + (set-option! 'signature signature)) diff --git a/scm/html/common.scm b/scm/html/common.scm new file mode 100644 index 0000000..e8ce75d --- /dev/null +++ b/scm/html/common.scm @@ -0,0 +1,597 @@ +;;;; -*-Scheme-*- +;;;; +;;;; $Revision: 1.20 $ +;;;; +;;;; Common definitions for HTML output format + + +;;; -------------------------------------------------------------------------- +;;; Configurable, site-specific definitions. + +(define-option 'troff-to-gif 'string + "groff -ms > %1%; /usr/www/lib/latex2html/pstogif %1% -out %2%") + +(define-option 'troff-to-text 'string + "groff -Tlatin1 -P-b -P-u |sed '/^[ \t]*$/d' > %1%") + +(define-option 'tbl 'string 'gtbl) +(define-option 'eqn 'string 'geqn) +(define-option 'pic 'string 'gpic) + + +;; A non-breaking space that is really non-breaking even in broken browsers: + +(define nbsp " <tt> </tt>") + + + +;;; -------------------------------------------------------------------------- +;;; Options. + + +(define-option 'title 'string #f) ; May be used for <title> +(define-option 'mail-address 'string #f) ; May be used for `mailto:' +(define-option 'document 'string #f) ; Prefix for output file(s) +(define-option 'tt-preformat 'boolean #f) ; do <tt>-changes inside .nf/.fi + +(define-option 'handle-eqn 'string "gif") ; gif/text/copy +(define-option 'handle-tbl 'string "text") ; +(define-option 'handle-pic 'string "gif") ; + + + +;;; -------------------------------------------------------------------------- +;;; Preformatted text. + +(define preform? #f) + +(define (preform on?) + (cond ((and on? (not preform?)) + (defsentence #f) + (with-font-preserved + (begin (set! preform? #t) "<pre>\n"))) + ((and (not on?) preform?) + (defsentence sentence-event) + (with-font-preserved + (begin (set! preform? #f) "</pre>\n"))) + (else ""))) + +(defrequest 'nf (lambda _ (preform #t))) +(defrequest 'fi (lambda _ (preform #f))) + +(define-macro (with-preform-preserved . body) + `(let (($p preform?)) + (concat (preform #f) ,@body (preform $p)))) + +(defchar #\tab + (lambda (c) + (if (not preform?) (surprise "tab outside .nf/.fi")) c)) + + + +;;; -------------------------------------------------------------------------- +;;; Silently ignoring these requests probably will not harm. There is +;;; nothing sensible we can do. + +(defrequest 'ne "") +(defrequest 'hw "") +(defrequest 'nh "") +(defrequest 'hy "") +(defrequest 'lg "") +(defrequest 'ps "") +(defrequest 'vs "") +(defrequest 'pl "") +(defrequest 'bp "") +(defrequest 'ns "") +(defrequest 'rs "") +(defrequest 'wh "") +(defrequest 'ch "") +(defrequest 'fl "") +(defrequest 'na "") +(defrequest 'ad "") + + + +;;; -------------------------------------------------------------------------- +;;; Basic escape sequences and special characters. + +(defescape #\c "") ; swallows its character argument +(defescape #\& "") +(defescape #\- #\-) +(defescape #\| "") +(defescape #\^ "") +(defescape #\space #\space) ; should be   (doesn't work in Mosaic) +(defescape #\0 #\space) +(defescape #\s "") +(defescape #\e #\\) +(defescape #\\ #\\) +(defescape #\' #\') +(defescape #\` #\`) +(defescape #\% "") + +(defescape "" + (lambda (c . _) + (warn "escape sequence `\\~a' expands to `~a'" c c) + (translate c))) + +(defspecial 'em "--") +(defspecial 'en #\-) +(defspecial 'mi #\-) +(defspecial 'pl #\+) ; plus +(defspecial 'lq "``") +(defspecial 'rq "''") +(defspecial '** #\*) +(defspecial 'bv #\|) ; bold vertical (what is this?) +(defspecial 'hy "­") ; `soft hyphen' +(defspecial 'co "©") ; copyright +(defspecial 'ap #\~) ; approximates +(defspecial '~= #\~) +(defspecial 'cd "·") ; centered dot +(defspecial 'de "°") ; degree +(defspecial '>= ">=") +(defspecial '<= "<=") +(defspecial 'eq #\=) +(defspecial '== "==") +(defspecial 'mu "×") ; multiplication +(defspecial 'tm "®") +(defspecial 'rg "®") +(defspecial '*m "µ") ; mu +(defspecial '*b "ß") ; beta (#223 is German sharp-s actually) +(defspecial 'aa #\') ; acute accent +(defspecial 'ga #\`) ; grave accent +(defspecial 'br #\|) ; vertical box rule +(defspecial 'or #\|) +(defspecial 'sl #\/) +(defspecial 'ru #\_) +(defspecial 'ul #\_) +(defspecial 'ci #\O) +(defspecial "14" "¼") +(defspecial "12" "½") +(defspecial "34" "¾") +(defspecial 'es "Ø") +(defspecial '+- "±") +(defspecial 'sc "§") +(defspecial 'fm #\') ; foot mark +(defspecial 'lh "<=") +(defspecial 'rh "=>") +(defspecial '-> "->") +(defspecial '<- "<-") +(defspecial 'no "¬") ; negation +(defspecial 'di "÷") ; division +(defspecial 'ss "ß") +(defspecial ':a "ä") +(defspecial 'a: "ä") +(defspecial ':o "ö") +(defspecial 'o: "ö") +(defspecial ':u "ü") +(defspecial 'u: "ü") +(defspecial ':A "Ä") +(defspecial 'A: "Ä") +(defspecial ':O "Ö") +(defspecial 'O: "Ö") +(defspecial ':U "Ü") +(defspecial 'U: "Ü") +(defspecial 'ct "¢") ; cent +(defspecial 'Po "£") ; pound +(defspecial 'Cs "¤") ; currency sign +(defspecial 'Ye "¥") ; yen +(defspecial 'ff "ff") +(defspecial 'fi "fi") +(defspecial 'fl "fl") +(defspecial 'Fi "ffi") +(defspecial 'Fl "ffl") +(defspecial 'S1 "¹") +(defspecial 'S2 "²") +(defspecial 'S3 "³") +(defspecial 'bb "¦") ; broken bar +(defspecial 'r! "¡") ; reverse exclamation mark +(defspecial 'r? "¿") ; reverse question mark + + +(defspecial 'bu (lambda _ (warn "rendering \\(bu as `+'") #\+)) +(defspecial 'sq (lambda _ (warn "rendering \\(sq as `o'") #\o)) +(defspecial 'dg (lambda _ (warn "rendering \\(dg as `**'") "**")) +(defspecial 'dd (lambda _ (warn "rendering \\(dd as `***'") "***")) + + + +;;; -------------------------------------------------------------------------- +;;; Local motion requests and related stuff (mostly ignored). + +(define (motion-ignored request . _) + (warn "local motion request \\~a ignored" request)) + +(defescape #\u motion-ignored) +(defescape #\d motion-ignored) +(defescape #\v motion-ignored) + +(define (motion-no-effect request arg) + (warn "local motion request \\~a has no effect" request) + (parse arg)) + +(defescape #\o motion-no-effect) +(defescape #\z motion-no-effect) + +(defescape #\k + (lambda (k reg) + ((requestdef 'nr) 'nr reg "0" ""))) + +(defescape #\h + (lambda (h arg) + (let* ((x (parse arg)) + (n (get-hunits (parse-expression x 0 #\m)))) + (if (negative? n) + (warn "\\h with negative argument ignored") + (make-string n #\space))))) + +(defescape #\w + (lambda (w s) + (let ((scale (get-scaling #\m)) + (len (string-length (parse s)))) + (number->string (quotient (* len (car scale)) (cdr scale)))))) + +;; Heuristic: generate <hr> if length could be line length, else +;; repeat specified character: + +(defescape #\l + (lambda (l s) + (let* ((p (parse-expression-rest s '(0 . "") #\m)) + (n (get-hunits (car p))) + (c (parse (cdr p)))) + (if (>= n line-length) + "<hr>" + (repeat-string n (if (eqv? c "") "_" c)))))) + + + +;;; -------------------------------------------------------------------------- +;;; Output translations for HTML special characters. + +(defchar #\< "<") +(defchar #\> ">") +(defchar #\& "&") + +;;; Like parse, but also take char of `"': + +(define (parse-unquote s) + (let ((old (defchar #\" """))) + (begin1 (parse s) (defchar #\" old)))) + + + +;;; -------------------------------------------------------------------------- +;;; Font handling. + +(define font-table (make-table 100)) + +(define (define-font name open close) + (table-store! font-table name (cons open close))) + +(define-font "R" "" "") +(define-font "I" '<i> '</i>) +(define-font "B" '<b> '</b>) +(define-font "C" '<tt> '</tt>) +(define-font "CW" '<tt> '</tt>) +(define-font "CO" '<i> '</i>) ; a kludge for Courier-Oblique + +(define font-positions (make-vector 10 #f)) + +(define (find-font f start) + (cond + ((= start (vector-length font-positions)) #f) + ((equal? (vector-ref font-positions start) f) start) + (else (find-font f (1+ start))))) + +(define (font->position f) + (let* ((m (find-font f 1)) (n (if m m (find-font #f 1)))) + (cond + (n (mount-font n f) n) + (else + (warn "no free font position for font ~a" f) #f)))) + +(define (get-font-name name) + (cond + ((table-lookup font-table name) name) + (else (warn "unknown font: ~a" name) "R"))) + +(define (mount-font i name) + (if (and (>= i 1) (< i (vector-length font-positions))) + (vector-set! font-positions i (get-font-name name)) + (warn "invalid font position: `~a'" i))) + +(mount-font 1 "R") +(mount-font 2 "I") +(mount-font 3 "B") +(mount-font 4 "R") + +(defrequest 'fp + (lambda (fp where name) + (if (not (string->number where)) + (warn "invalid font position `~a' in .fp" where) + (mount-font (string->number where) name) ""))) + +(define previous-font 1) +(define current-font 1) + +(define (reset-font) + (concat (change-font 1) (change-font 1))) ; current and previous + +(define (change-font-at i) + (cond + ((or (< i 1) (>= i (vector-length font-positions))) + (warn "invalid font position: `~a'" i)) + ((vector-ref font-positions i) + (let ((o (table-lookup font-table + (vector-ref font-positions current-font))) + (n (table-lookup font-table (vector-ref font-positions i)))) + (set! previous-font current-font) + (set! current-font i) + (if (and preform? (not (option 'tt-preformat))) + (concat (if (eq? (cdr o) '</tt>) "" (cdr o)) + (if (eq? (car n) '<tt>) "" (car n))) + (concat (cdr o) (car n))))) + (else (warn "no font mounted at position ~a" i)))) + +(define (change-font f) + (cond + ((number? f) + (change-font-at f)) + ((string->number f) + (change-font-at (string->number f))) + ((string=? f "P") + (change-font-at previous-font)) + (else + (let ((n (font->position (get-font-name f)))) + (if n (change-font-at n) ""))))) + +(defrequest 'ft + (lambda (ft font) + (change-font (if (eqv? font "") "P" font)))) + +(defescape #\f (requestdef 'ft)) + +(defnumreg '.f (lambda _ (number->string current-font))) + +(define-macro (with-font-preserved . body) + `(let (($f current-font)) + (concat (change-font "R") ,@body (change-font $f)))) + + + +;;; -------------------------------------------------------------------------- +;;; tbl, eqn, pic. + +(define (copy-preprocess for-eqn? proc-1 proc-2 stop inline) + (cond + (inline + (emit inline #\newline stop) + (filter-eqn-line inline)) + (else + (let loop ((x (read-line-expand)) + (use-output? (not for-eqn?))) + (cond ((eof-object? x) use-output?) + (else + (proc-1 (proc-2 x)) + (if (string=? x stop) + use-output? + (loop (read-line-expand) + (or (not for-eqn?) (filter-eqn-line x)))))))))) + +(define troff-to-gif + (let ((image-seqnum 1)) + (lambda (processor start stop what args inline) + (let ((docname (option 'document))) + (if (not docname) + (begin + (warn "~a skipped, because no `document' option given" what) + (if (not inline) + (skip-lines stop)) + "") + (let* ((num (number->string image-seqnum)) + (psname (concat docname #\- num ".ps")) + (gifname (concat docname #\- num ".gif")) + (ref (concat "<img src=\"" gifname + "\" alt=\"[" what "]\">\n")) + (use-output? #f)) + (++ image-seqnum) + (with-output-to-stream + (substitute (concat #\| (option processor) + #\| (option 'troff-to-gif)) psname gifname) + (emit start #\space (apply spread args) #\newline) + (set! use-output? (copy-preprocess (eq? processor 'eqn) + emit identity stop inline))) + (remove-file psname) + (if use-output? + (if inline ref (concat "<p>" ref "<p>\n")) + (remove-file gifname) ""))))))) + +(define (troff-to-text processor start stop what args inline) + (let* ((tmpname (substitute "%tmpname%")) + (use-output? #f)) + (with-output-to-stream + (substitute (concat #\| (option processor) #\| (option 'troff-to-text)) + tmpname) + (emit start #\space (apply spread args) #\newline) + (set! use-output? (copy-preprocess (eq? processor 'eqn) + emit identity stop inline))) + (let ((text (translate (stream->string tmpname)))) + (remove-file tmpname) + (if use-output? + (if inline + (with-font-preserved (concat (change-font 2) text)) + (concat (preform #t) text (preform #f))) + "")))) + +(define (troff-to-preform processor start stop what args inline) + (cond + (inline (with-font-preserved (concat (change-font 2) inline))) + (else + (emit (preform #t) start #\space (apply spread args) #\newline) + (copy-preprocess (eq? processor 'eqn) emit translate stop) + (preform #f)))) + +(define (troff-select-method option-name) + (let ((method (option option-name))) + (cond ((string=? method "gif") troff-to-gif) + ((string=? method "text") troff-to-text) + ((string=? method "copy") troff-to-preform) + (else + (warn "bad value `~a' for ~a, assuming `text'" method option-name) + troff-to-text)))) + +(defmacro 'TS + (lambda (TS . args) + ((troff-select-method 'handle-tbl) 'tbl ".TS" ".TE\n" "table" args #f))) + +(defmacro 'EQ + (lambda (EQ . args) + ((troff-select-method 'handle-eqn) 'eqn ".EQ" ".EN\n" "equation" args #f))) + +(defmacro 'PS + (lambda (PS . args) + ((troff-select-method 'handle-pic) 'pic ".PS" ".PE\n" "picture" args #f))) + +(defmacro 'TE "") +(defmacro 'EN "") +(defmacro 'PE "") + +(defequation + (lambda (eqn) + ((troff-select-method 'handle-eqn) 'eqn ".EQ" ".EN\n" "equation" '() eqn))) + + + +;;; -------------------------------------------------------------------------- +;;; Miscellaneous troff requests. + +(defrequest 'br + (lambda _ + (if (positive? lines-to-center) "" "<br>\n"))) + +(defrequest 'sp + (lambda (sp num) + (let ((n (if (eqv? num "") 1 (get-vunits (parse-expression num 0 #\v))))) + (cond + ((negative? n) + (warn ".sp with negative spacing ignored")) + (preform? + (repeat-string n "\n")) + ((zero? n) + "<br>\n") + (else + (with-font-preserved (repeat-string n "<p>\n"))))))) + +(defrequest 'ti + (lambda (ti num) + (let ((n (if (eqv? num "") 0 (get-hunits (parse-expression num 0 #\m))))) + (if (negative? n) + (warn ".ti with negative indent ignored") + (concat "<br>\n" (repeat-string n nbsp)))))) + + +;;; There is no reasonable way to create markup for .tl; just emit the +;;; argument: + +(defrequest 'tl + (lambda (tl s) + (let* ((p (parse s)) + (t (parse-triple p))) + (cond + (t + (spread (car t) (cadr t) (cddr t) #\newline)) + ((eqv? s "") + "") + (else + (warn "badly formed .tl argument: `~a'" p)))))) + + +;;; Until HTML can center, at least generate a <br> after each line: + +(defrequest 'ce + (lambda (ce num) + (let ((n (if (eqv? num "") 1 (string->number num)))) + (if n + (center (round n)) + (warn ".ce argument `~a' not understood" num))))) + +(define lines-to-center 0) + +(define (center n) + (set! lines-to-center n) + (defevent 'line 50 (if (positive? n) center-processor #f)) + "") + +(define (center-processor c) + (if (positive? (-- lines-to-center)) + (if (eqv? c #\newline) + (emit "<br>\n"))) + (if (not (positive? lines-to-center)) + (center 0))) + + + +;;; -------------------------------------------------------------------------- +;;; Other definitions. + +;;; Suppress comment if writing to a buffer, because in this case the +;;; output is likely to be re-read later (e.g. it may be a macro): + +(defescape #\" + (lambda (_ x) + (let ((c (string-prune-right x "\n" x)) + (old (defchar #\tab #f))) + (if (and (not (eqv? c "")) (not (stream-buffer? (output-stream)))) + (emit "<!-- " (translate c) " -->\n")) + (defchar #\tab old) + #\newline))) + + +;;; Extra white space at end of sentence: + +(define sentence-event + (lambda (c) + (concat c "<tt> </tt>\n"))) + +(defsentence sentence-event) + + +;;; Emit standardized output file prolog: + +(define (emit-HTML-prolog) + (let ((mailto (option 'mail-address))) + (emit "<html>\n<head>\n") + (emit "<!-- This file has been generated by " + (substitute "%progname% %version%, %date% %time%. -->\n") + "<!-- Do not edit! -->\n") + (if mailto (emit "<link rev=\"made\" href=\"mailto:" mailto "\">\n")))) + + +;;; Define a scaling for the usual scaling indicators. Note that the +;;; vertical spacing and character width will never change; and the +;;; device's vertical/horizontal resolution is 1. + +(define inch 240) ; units per inch + +(set-scaling! #\i inch 1) +(set-scaling! #\c (* 50 inch) 127) +(set-scaling! #\P inch 6) ; Pica +(set-scaling! #\m inch 10) +(set-scaling! #\n inch 10) +(set-scaling! #\p inch 72) +(set-scaling! #\v inch 7) + +;;; Convert from units back to ems and Vs: + +(define (get-hunits x) + (let ((s (get-scaling #\m))) + (if x (inexact->exact (/ (* x (cdr s)) (car s))) x))) + +(define (get-vunits x) + (let ((s (get-scaling #\v))) + (if x (inexact->exact (/ (* x (cdr s)) (car s))) x))) + +;;; Fake line length: + +(define line-length 65) + +(defnumreg '.l "1560") ; 65 ems diff --git a/scm/html/m.scm b/scm/html/m.scm new file mode 100644 index 0000000..8d9a44e --- /dev/null +++ b/scm/html/m.scm @@ -0,0 +1,26 @@ +;;;; -*-Scheme-*- +;;;; +;;;; $Revision: 1.4 $ +;;;; +;;;; Definitions for HTML output format to be loaded when no -mfoo +;;;; option has been given. + + +;;; -------------------------------------------------------------------------- +;;; Simple default start and exit handler. + +(defevent 'start 10 + (lambda _ + (let* ((docname (option 'document)) + (title (option 'title)) + (t (if title title (if docname docname "(untitled)")))) + (if docname + (set-output-stream! (open-output-stream (concat docname ".html")))) + (emit-HTML-prolog) + (emit "<title>" (translate t) "\n\n\n")))) + +(defevent 'exit 10 + (lambda _ + (emit (change-font "R") (preform #f)) + (emit "\n\n") + (close-stream (set-output-stream! #f)))) diff --git a/scm/html/man.scm b/scm/html/man.scm new file mode 100644 index 0000000..d5c2e71 --- /dev/null +++ b/scm/html/man.scm @@ -0,0 +1,316 @@ +;;;; -*-Scheme-*- +;;;; +;;;; $Revision: 1.18 $ +;;;; +;;;; `man' specific definitions for HTML output format + + +;;; -------------------------------------------------------------------------- +;;; Options. + +(define-option 'do-signature 'boolean #t) + + + +;;; -------------------------------------------------------------------------- +;;; Miscellaneous definitions. + +(defstring 'R "®") ; trademark +(defstring 'S "") ; change to default point size +(defstring 'lq "``") +(defstring 'rq "''") + +(define-font 'L ' ') ; whatever font L is supposed to be... + + + +;;; -------------------------------------------------------------------------- +;;; Bookkeeping for .TH, for requests that occur in pairs, etc. + +(define-pair header header? "

\n" "

\n") +(define-pair tag-para tag-para? "
\n" "
\n") +(define-pair list-para list-para? "
    \n" "
\n") +(define-pair hang-para hang-para? "
" "
\n") + +(define (reset-everything) + (concat + (reset-font) + (center 0) + (header #f) + (preform #f) + (hang-para #f) + (tag-para #f) + (list-para #f))) + +(define-nested-pair indent indent-level "
\n" "
\n") + + + +;;; -------------------------------------------------------------------------- +;;; File prolog and epilog functions. + +(defevent 'prolog 10 + (lambda (pathname filename) + (if (not (string=? filename "stdin")) + (set-option! 'document filename)) + (let ((docname (option 'document))) + (if docname + (set-output-stream! (open-output-stream (concat docname ".html")))) + (emit-HTML-prolog)))) + +(defevent 'epilog 10 + (lambda _ + (complain-if-no-title) + (emit (reset-everything) (indent 0)) + (if (option 'do-signature) + (emit + (substitute + "

\nMarkup created by %progname% %version%,") + nbsp nbsp + (substitute "%monthname+% %day%, %year%.\n"))) + (emit "\n\n") + (close-stream (set-output-stream! #f)))) + + + +;;; -------------------------------------------------------------------------- +;;; Title, section, subsection. + +(define title-seen? #f) + +(define (complain-if-no-title) + (if (not title-seen?) + (quit "manual page must begin with .TH request"))) + +(defmacro 'TH + (lambda (TH what section . _) + (let ((title (option 'title))) + (set! title-seen? #t) + (concat "" + (substitute (if title title "Manual page for %1%(%2%)") + (translate what) (translate section)) + "\n\n\n")))) + +(defmacro 'SH + (lambda (SH first . rest) + (complain-if-no-title) + (emit (reset-everything) (indent 0)) + (if (string=? first "NAME") + (header #t) + (concat "

" (parse (apply spread first rest)) "

\n")))) + +(defmacro 'SS + (lambda (SS . args) + (complain-if-no-title) + (emit (reset-everything) (indent 0)) + (cond + ((null? args) + (defevent 'line 11 + (lambda _ (emit "

\n") (defevent 'line 11 #f))) + (emit "

")) + (else + (concat "

" (parse (apply spread args)) "

\n"))))) + + + +;;; -------------------------------------------------------------------------- +;;; Font switching requests. +;;; +;;; Both with-font and with-fonts include a terminating newline in the +;;; parsing, because people are using .I xxx\c and .BR xxx\c etc., and +;;; end-of-sentence must be detected in situations like .BR send(2) . + +(define (with-font font words) + (let ((old current-font)) + (cond + ((null? words) + (defevent 'line 10 + (lambda _ (emit (change-font old)) (defevent 'line 10 #f))) + (emit (change-font font) #\newline)) + (else + (concat (change-font font) + (parse (apply spread words) #\newline) + (change-font old)))))) + +(defmacro 'I (lambda (I . args) (with-font "I" args))) +(defmacro 'B (lambda (B . args) (with-font "B" args))) + +(defmacro 'SB (requestdef 'B)) + +(defmacro 'SM + (lambda (SM . words) + (if (null? words) "" (parse (apply spread words) #\newline)))) + +(define (with-fonts f1 f2 words) + (define (recurse f1 f2 words) + (if (null? words) + "" + (concat (change-font f1) + (parse (concat (car words) + (if (null? (cdr words)) #\newline ""))) + (recurse f2 f1 (cdr words))))) + (let ((old current-font)) + (concat (recurse f1 f2 words) (change-font old)))) + +(defmacro 'BI (lambda (BI . args) (with-fonts "B" "I" args))) +(defmacro 'BR (lambda (BR . args) (with-fonts "B" "R" args))) +(defmacro 'IB (lambda (IB . args) (with-fonts "I" "B" args))) +(defmacro 'IR (lambda (IR . args) (with-fonts "I" "R" args))) +(defmacro 'RB (lambda (RB . args) (with-fonts "R" "B" args))) +(defmacro 'RI (lambda (RB . args) (with-fonts "R" "I" args))) + + + +;;; -------------------------------------------------------------------------- +;;; Indented paragraphs with labels. +;;; +;;; A heuristic is used to determine whether to emit a bulleted list +;;; or a tagged list: .TP with \(bu in the next input line and +;;; .IP with \(bu as argument both start a bulleted list. Of course, in +;;; case the style changes later, we have a problem and may want to end +;;; the current list and begin a new one with the new style. + +(define (next-para-TP) + (cond + (tag-para? + (defevent 'line 12 + (lambda _ (emit (reset-font) "
\n") (defevent 'line 12 #f))) + (emit "
")) + (else + "
  • "))) + +(define (next-para-IP arg) + (cond + (tag-para? + (if (null? arg) + "

    \n" + (concat "

    " (parse (car arg)) "
    \n"))) + ((or (null? arg) (string=? (car arg) "\\(bu")) + "
  • \n") + (else + (warn ".IP `arg' in a list that was begun as non-tagged") + (concat "
  • " (parse (car arg)) "
    \n")))) + +(defmacro 'TP + (lambda _ + (emit (reset-font) (hang-para #f)) + (if preform? + (begin + (surprise ".TP inside .nf/.fi") #\newline) + (let ((next (read-line))) + (if (eof-object? next) (set! next #\newline)) + (cond + ((string=? next "\\(bu\n") + (cond + (tag-para? + (emit (tag-para #f) (list-para #t))) ; change style + (else + (emit (list-para #t))))) + (else + (unread-line next) + (cond + (list-para? + (emit (list-para #f) (tag-para #t))) ; change style + (else + (emit (tag-para #t)))))) + (next-para-TP))))) + +(defmacro 'IP + (lambda (IP . arg) + (emit (reset-font) (hang-para #f)) + (if preform? + (begin + (surprise ".IP inside .nf/.fi") + (if (not (null? arg)) (concat (parse (car arg)) #\newline) #\newline)) + (if (or tag-para? list-para?) + (next-para-IP arg) + (cond + ((and (not (null? arg)) (string=? (car arg) "\\(bu")) + (emit (list-para #t)) + (set! arg '())) + (else + (emit (tag-para #t)))) + (next-para-IP arg))))) + + +;;; A hanging indent cannot be achieved in HTML. Therefore we have to +;;; kludge .HP by beginning a `tag-para' and putting everything up to +;;; the next line break between the
    and
    . + +(defmacro 'HP + (lambda _ + (emit (reset-font) (hang-para #f)) + (cond + (preform? + (surprise ".HP inside .nf/.fi") #\newline) + (else + (if list-para? (emit (list-para #f))) ; change style + (concat (tag-para #t) (hang-para #t)))))) + + + +;;; -------------------------------------------------------------------------- +;;; Relative indent. + +(define (relative-indent request . _) + (if preform? + (surprise ".RS/.RE inside .nf/.fi")) + (emit (reset-font) (hang-para #f) (tag-para #f) (list-para #f)) + (with-preform-preserved + (indent (if (string=? request "RS") '+ '-)))) + +(defmacro 'RS relative-indent) +(defmacro 'RE relative-indent) + + + +;;; -------------------------------------------------------------------------- +;;; Paragraphs. + +(define (paragraph . _) + (concat (reset-everything) "

    \n")) + +(defmacro 'LP paragraph) +(defmacro 'PP paragraph) +(defmacro 'P paragraph) + + + +;;; -------------------------------------------------------------------------- +;;; Miscellaneous break-causing requests (must end .HP paragraph). + +(defrequest 'sp + (let ((orig (requestdef 'sp))) + (lambda (sp num) + (concat (hang-para #f) (orig sp num))))) + +(defrequest 'bp (lambda _ (hang-para #f))) + +(defrequest 'ti + (let ((orig (requestdef 'ti))) + (lambda (ti num) + (concat (hang-para #f) (orig ti num))))) + +;;; Kludge: Suppress
    immediately after `hang-para' to avoid excessive +;;; white space + +(defrequest 'br + (lambda _ + (if hang-para? + (hang-para #f) + (concat (hang-para #f) "
    \n")))) + + + +;;; -------------------------------------------------------------------------- +;;; Bogus or SunOS-specific stuff. + +(defmacro 'TX + (lambda (TX name . id) + (concat "[a manual with the abbreviation " (parse name) "]" + (if (null? id) "" (car id)) #\newline))) + +(defmacro 'IX "") +(defmacro 'DT "") +(defmacro 'PD "") +(defmacro 'UC "") diff --git a/scm/html/ms.scm b/scm/html/ms.scm new file mode 100644 index 0000000..ce2b79e --- /dev/null +++ b/scm/html/ms.scm @@ -0,0 +1,628 @@ +;;;; -*-Scheme-*- +;;;; +;;;; $Revision: 1.14 $ +;;;; +;;;; `ms' specific definitions for HTML output format + + +;;; -------------------------------------------------------------------------- +;;; Options. + +(define-option 'signature 'string "") +(define-option 'split 'integer 0) +(define-option 'toc 'boolean #t) +(define-option 'toc-header 'string "Table of Contents") +(define-option 'pp-indent 'integer 3) +(define-option 'footnotes-header 'string "Footnotes") +(define-option 'footnote-reference 'string "[note %1%]") +(define-option 'footnote-anchor 'string "[%1%]") + + + +;;; -------------------------------------------------------------------------- +;;; Predefined strings and number registers. + +(defstring 'Q "``") +(defstring 'U "''") +(defstring '- "--") ; em-dash +(defstring 'MO (substitute "%monthname+%")) +(defstring 'DY (substitute "%monthname+% %day%, %year%")) + +(defnumreg 'PN #\0) + + + +;;; -------------------------------------------------------------------------- +;;; General bookkeeping. + + +(define split-sections? #f) ; #t if `split' option is positive + + +(define-pair abstract abstract? "" "

    \n") +(define-pair title title? "

    \n" "

    \n") +(define-pair secthdr secthdr? "

    \n" "

    \n") +(define-pair tag-para tag-para? "
    \n" "
    \n") +(define-pair list-para list-para? "
      \n" "
    \n") +(define-pair quoted quoted? "
    \n" "
    \n") + +(define (reset-everything) + (emit + (reset-font) + (center 0) + (quoted #f) + (secthdr #f) + (preform #f) + (tag-para #f) + (list-para #f) + (reset-title-features)) + (header-processor #f)) + +(define-nested-pair indent indent-level "
    \n" "
    \n") + + + +;;; -------------------------------------------------------------------------- +;;; Manage HTML output files. + +(define HTML-streams '()) + +(define (push-HTML-stream file-suffix title-suffix) + (let* ((docname (option 'document)) + (title (option 'title)) + (t (concat (if title title docname) title-suffix)) + (fn (if file-suffix (concat docname file-suffix ".html") #f)) + (s (if fn (open-output-stream fn) #f))) + (close-stream (set-output-stream! #f)) + (set-output-stream! s) + (list-push! HTML-streams fn) + (emit-HTML-prolog) + (emit "" (translate t) "\n\n"))) + +(define (pop-HTML-stream) + (if (not (eqv? (option 'signature) "")) + (emit "

    \n" (substitute (option 'signature))) #\newline) + (emit "\n\n") + (list-pop! HTML-streams) + (close-stream (set-output-stream! #f)) + (if (and (not (null? HTML-streams)) (car HTML-streams)) + (set-output-stream! (append-output-stream (car HTML-streams))))) + + + +;;; -------------------------------------------------------------------------- +;;; Callback procedure called by hyper.scm when creating hypertext anchor. + +(define (query-anchor request label) + (lambda (op) + (case op + (allowed? #t) + (emit-anchor? #t) + (filename + (if (not (stream-file? (output-stream))) + (car HTML-streams) + (stream-target (output-stream))))))) + + + +;;; -------------------------------------------------------------------------- +;;; Generate hypertext reference and anchor. + +(define (make-href type index contents) + (let* ((docname (option 'document)) + (file + (case type + ((section toc) (car HTML-streams)) + (footnote (if split-sections? (concat docname "-notes.html") ""))))) + (format #f "    ~a" file type index + (if contents (concat contents "\n") "")))) + +(define (make-anchor type index contents) + (format #f "~a" type index contents)) + + + +;;; -------------------------------------------------------------------------- +;;; Automatically generated TOC. + +(define auto-toc-entry + (let ((last-level 0)) + (lambda (anchor entry level labelnum) + (with-output-appended-to-stream "[autotoc]" + (emit (repeat-string (- level last-level) "
      ") + (repeat-string (- last-level level) "
    ")) + (set! last-level level) + (if (positive? level) + (emit "
  • " (make-href 'section labelnum anchor) entry)))))) + +(define (auto-toc-spill) + (auto-toc-entry "" "" 0 0) + (let ((toc (stream->string "[autotoc]"))) + (if (not (eqv? toc "")) + (emit "

    " (substitute (option 'toc-header)) "

    \n" toc)))) + + + +;;; -------------------------------------------------------------------------- +;;; Start and exit event functions. + +(defevent 'start 10 + (lambda _ + (set! split-sections? (positive? (option 'split))) + (let ((docname (option 'document))) + (if (not (or docname (option 'title))) + (quit "you must set either document= or title=")) + (if (and split-sections? (not docname)) + (quit "you must set document= for non-zero `split'")) + (push-HTML-stream (if docname "" #f) "")))) + +(defevent 'exit 10 + (lambda _ + (reset-everything) + (emit (indent 0)) + (footnote-processor 'spill) + (do () ((null? (cdr HTML-streams))) (pop-HTML-stream)) + (if (option 'toc) + (auto-toc-spill)) + (pop-HTML-stream))) + + + +;;; -------------------------------------------------------------------------- +;;; Title features, abstract. + +(define got-title? #f) + +(define (reset-title-features) + (concat (title #f) + (begin1 (if got-title? "
    \n" "") (set! got-title? #f)))) + +(defmacro 'TL + (lambda _ + (cond + (got-title? + (warn ".TL is only allowed once")) + (else + (reset-everything) + (set! got-title? #t) + (title #t))))) + +(defmacro 'AU + (lambda _ + (emit (title #f) "

    \n" (change-font 2)) + (center 999))) + +(defmacro 'AI + (lambda _ + (emit (title #f) "
    \n" (change-font 1)) + (center 999))) + +(defmacro 'AB + (lambda (AB . args) + (reset-everything) + (abstract #t) + (cond ((null? args) + "

    ABSTRACT

    \n

    \n") + ((string=? (car args) "no") + "

    \n") + (else + (concat "

    " (parse (car args)) "

    \n

    \n"))))) + +(defmacro 'AE + (lambda _ + (cond (abstract? (reset-everything) (abstract #f)) + (else (warn ".AE without preceding .AB"))))) + + + +;;; -------------------------------------------------------------------------- +;;; Numbered sections. + +(define sections (list 0)) + +(define (increment-section! s n) + (if (positive? n) + (increment-section! (cdr s) (1- n)) + (set-car! s (if (char? (car s)) + (integer->char (modulo (1+ (char->integer (car s))) 256)) + (1+ (car s)))) + (set-cdr! s '()))) + +(define (section-number s n) + (if (zero? n) + "" + (format #f "~a.~a" (car s) (section-number (cdr s) (1- n))))) + +(define (verify-section-number s) + (cond ((eqv? s "") #f) + ((string->number s) (string->number s)) + ((char-alphabetic? (string-ref s 0)) (string-ref s 0)) + (else #f))) + +(define (numbered-section args) + (cond + ((null? args) + (increment-section! sections 0) + (defstring 'SN (section-number sections 1)) + 1) + ((string=? (car args) "S") + (cond + ((null? (cdr args)) + (warn ".NH with `S' argument but no numbers") + 1) + (else + (let ((new (map verify-section-number (cdr args)))) + (if (memq #f new) + (warn "bad section number in .NH request") + (set! sections new)) + (defstring 'SN (section-number new (length new))) + (length new))))) + (else + (let ((level (string->number (car args)))) + (if (not level) + (begin + (warn "~a is not a valid section level" (car args)) + (set! level 1))) + (if (< (length sections) level) + (append! sections (make-list (- level (length sections)) 0))) + (increment-section! sections (1- level)) + (defstring 'SN (section-number sections level)) + level)))) + +(defmacro 'NH + (lambda (NH . args) + (reset-everything) + (emit (indent 0)) + (let ((level (numbered-section args))) + (if (and split-sections? (<= level (option 'split))) + (let* ((sect (stringdef 'SN)) + (suff (concat #\- (string-prune-right sect "." sect)))) + (push-HTML-stream suff (concat ", section " sect)))) + (header-processor #t level)))) + +(define header-processor + (let ((stream #f) (inside? #f) (seq 1) (level 0)) + (lambda (enter? . arg) + (cond + ((and enter? (not inside?)) + (set! level (car arg)) + (set! stream (set-output-stream! (open-output-stream "[header]")))) + ((and inside? (not enter?)) + (close-stream (set-output-stream! stream)) + (let ((hdr (stream->string "[header]")) + (sectno (stringdef 'SN))) + (cond + ((and split-sections? (option 'toc)) + (auto-toc-entry (concat sectno #\space) hdr level seq) + (emit "

    " (make-anchor 'section seq sectno))) + (else + (emit "

    " sectno))) + (emit nbsp hdr "

    \n") + (++ seq)))) + (set! inside? enter?) + ""))) + + + +;;; -------------------------------------------------------------------------- +;;; Font switching and related requests. + +(define (with-font font . args) + (let ((old current-font)) + (cond + ((null? args) + (concat (change-font font) #\newline)) + ((null? (cdr args)) + (concat (change-font font) (parse (car args) #\newline) + (change-font old))) + (else + (concat (change-font font) (parse (car args)) (change-font old) + (parse (cadr args) #\newline)))))) + +(defmacro 'I with-font) +(defmacro 'B with-font) +(defmacro 'R with-font) + +(defmacro 'UL (lambda (UL) (with-font "I"))) ; doesn't work + +(defmacro 'SM + (lambda (SM . words) + (if (null? words) "" (parse (apply spread words) #\newline)))) + +(defmacro 'LG (requestdef 'SM)) + + + +;;; -------------------------------------------------------------------------- +;;; Indented paragraph with optional label. + +(define (indented-paragraph IP . arg) + (define (non-tagged? s) + (or (null? s) (member (car s) '("\\(bu" "\\(sq" "\\-")))) + (emit (reset-font) (secthdr #f) (reset-title-features)) + (header-processor #f) + (cond + (preform? + (surprise ".IP inside .nf/.fi") + (if (not (null? arg)) (concat (parse (car arg)) #\newline) #\newline)) + (tag-para? + (if (null? arg) + "

    \n" + (concat "

    " (parse (car arg)) "
    \n"))) + (list-para? + (cond + ((non-tagged? arg) + "
  • \n") + (else + (warn ".IP `arg' in a list that was begun as non-tagged") + (concat "
  • " (parse (car arg)) "
    \n")))) + ((non-tagged? arg) + (concat (list-para #t) (indented-paragraph IP))) + (else + (concat (tag-para #t) (indented-paragraph IP (car arg)))))) + +(defmacro 'IP indented-paragraph) + + + +;;; -------------------------------------------------------------------------- +;;; Relative indent. + +(define (relative-indent request . _) + (if preform? + (surprise ".RS/.RE inside .nf/.fi")) + (emit (reset-font) (tag-para #f) (list-para #f)) + (with-preform-preserved + (indent (if (string=? request "RS") '+ '-)))) + +(defmacro 'RS relative-indent) +(defmacro 'RE relative-indent) + + + +;;; -------------------------------------------------------------------------- +;;; Displays. + +(define display-saved-font #f) +(define inside-display? #f) +(define indented-display? #f) + +(define (display-start type) + (if (or (string=? type "C") (string=? type "B")) + (begin + (warn "display type ~a not supported (using I)" type) + (set! type "I"))) + (cond + ((or (not (= (string-length type) 1)) + (not (memq (string-ref type 0) '(#\I #\L #\C #\B)))) + (warn "illegal display type `~a'" type)) + (inside-display? + (warn "nested display ignored")) + (preform? + (warn "display inside .nf/.fi ignored")) + (else + (set! display-saved-font current-font) + (emit (reset-font)) + (set! indented-display? (string=? type "I")) + (if indented-display? + (emit (indent '+))) + (set! inside-display? #t) + (preform #t)))) + +(defmacro 'DS + (lambda (DS . args) + (display-start (if (null? args) "I" (car args))))) + +(defmacro 'ID (lambda _ (display-start "I"))) +(defmacro 'LD (lambda _ (display-start "L"))) +(defmacro 'CD (lambda _ (display-start "C"))) +(defmacro 'BD (lambda _ (display-start "B"))) + +(defmacro 'DE + (lambda _ + (cond + ((not inside-display?) + (warn ".DE without matching display start")) + (else + (set! inside-display? #f) + (emit + (with-font-preserved + (preform #f) + (if indented-display? (indent '-) "")) + (change-font display-saved-font)) + "")))) + + + +;;; -------------------------------------------------------------------------- +;;; Footnotes. + +;; Generating \[***] for \** allows us to defer creating the anchor from +;; string expansion time to output time. Otherwise we couldn't use <...>. + +(defstring '* "\\[***]") + +(define **-count 0) + +(defspecial '*** + (lambda _ + (++ **-count) + (footnote-anchor (substitute (option 'footnote-reference) + (number->string **-count))))) + +(define next-footnote 0) + +(define (footnote-anchor sym) + (++ next-footnote) + (with-font-preserved + (concat (change-font 1) (make-href 'footnote next-footnote sym)))) + +;; New request to generate a footnote anchor; an alternative to \**. +;; Should be followed by .FS. Do not use `.FA \**'. + +(defmacro 'FA + (lambda (FA arg) (footnote-anchor (parse arg)))) + + +(define footnote-processor + (let ((stream #f) (inside? #f)) + (lambda (op . arg) + (case op + (begin + (cond + (inside? + (surprise "nested .FS")) + (else + (set! inside? #t) + (set! stream (set-output-stream! + (append-output-stream "[footnotes]"))) + (emit "

    \n") + (let ((anchor + (cond ((not (null? arg)) + (parse (car arg))) + ((positive? **-count) + (substitute (option 'footnote-anchor) + (number->string **-count))) + (else #f)))) + (if anchor + (emit "" (make-anchor 'footnote next-footnote anchor) + "" nbsp)))))) + (end + (cond + (inside? + (set! inside? #f) + (close-stream (set-output-stream! stream))) + (else (warn ".FE without matching .FS")))) + (spill + (if inside? (quit "unterminated footnote at end of document")) + (let ((contents (stream->string "[footnotes]")) + (hdr (substitute (option 'footnotes-header)))) + (cond + ((not (eqv? contents "")) + (if split-sections? + (push-HTML-stream "-notes" ", footnotes")) + (cond ((and split-sections? (option 'toc)) + (auto-toc-entry hdr "" 1 0) + (emit "

    " (make-anchor 'section 0 hdr))) + (else (emit "

    " hdr))) + (emit "

    \n" contents)) + ((positive? next-footnote) + (warn "footnote anchor used, but no .FS")))))) + ""))) + +(defmacro 'FS + (lambda (FS . arg) + (apply footnote-processor 'begin arg))) + +(defmacro 'FE + (lambda _ (footnote-processor 'end))) + + + +;;; -------------------------------------------------------------------------- +;;; TOC macros. + +(define toc-processor + (let ((stream #f) (inside? #f) (seq 1)) + (lambda (op . arg) + (case op + (begin + (cond + (inside? + (surprise "nested .XS")) + (else + (set! inside? #t) + (emit (make-anchor 'toc seq " ") #\newline) + (set! stream (set-output-stream! (append-output-stream "[toc]"))) + (if (>= (length arg) 2) + (emit + (repeat-string + (get-hunits (parse-expression (cadr arg) 0 #\n)) nbsp))) + (if (option 'document) + (emit (make-href 'toc seq #f))) + (++ seq)))) + (end + (cond + (inside? + (set! inside? #f) + (if (option 'document) (emit "\n")) + (emit "
    \n") + (close-stream (set-output-stream! stream))) + (else (warn ".XE or .XA without matching .XS")))) + (spill + (if inside? (quit "unterminated .XE")) + (if (or (null? arg) (not (string=? (car arg) "no"))) + (emit "

    Table of Contents

    \n")) + (emit (stream->string "[toc]")))) + ""))) + +(defmacro 'XS + (lambda (XS . arg) + (apply toc-processor 'begin arg))) + +(defmacro 'XE (lambda _ (toc-processor 'end))) +(defmacro 'XA (lambda _ (toc-processor 'end) (toc-processor 'begin))) + +(defmacro 'PX + (lambda (PX . arg) + (apply toc-processor 'spill arg))) + + +;;; -------------------------------------------------------------------------- +;;; Paragraphs of various kinds. + +(define-macro (define-paragraph request . body) + `(defmacro ,request (lambda _ (reset-everything) ,@body))) + +(define-paragraph 'LP "

    \n") +(define-paragraph 'PP (concat "

    \n" + (repeat-string (option 'pp-indent) nbsp))) +(define-paragraph 'QP (quoted #t)) +(define-paragraph 'SH (secthdr #t)) +(define-paragraph 'RT) + + + +;;; -------------------------------------------------------------------------- +;;; Requests that must be ignored, either because the function cannot +;;; be expressed in HTML or because they assume a page structure. + +(defmacro 'AM "") ; better accents +(defmacro 'BT "") ; bottom title +(defmacro 'CM "") ; cut mark between pages +(defmacro 'CT "") ; chapter title +(defmacro 'DA "") ; force date at page bottom +(defmacro 'EF "") ; even footer +(defmacro 'EH "") ; even header +(defmacro 'HD "") ; optional page header +(defmacro 'KE "") ; keep end +(defmacro 'KF "") ; floating keep +(defmacro 'KS "") ; keep +(defmacro 'ND "") ; no date in footer +(defmacro 'NL "") ; reset point size to normal +(defmacro 'OF "") ; odd footer +(defmacro 'OH "") ; odd header +(defmacro 'P1 "") ; print header on 1st page +(defmacro 'PT "") ; page title +(defmacro 'TM "") ; UCB thesis mode + +(defmacro 'BX ; boxed word + (lambda (BX word) + (parse word #\newline))) + +(define (multi-column-ignored request . _) + (warn "multi-column request .~a not supported" request)) + +(defmacro 'MC multi-column-ignored) +(defmacro '1C multi-column-ignored) +(defmacro '2C multi-column-ignored) + + + +;;; -------------------------------------------------------------------------- +;;; Anachronisms, kludges, etc. + +(defmacro 'UX "UNIX") + +(defmacro 'B1 "

    \n") +(defmacro 'B2 "
    \n") diff --git a/scm/misc/hyper.scm b/scm/misc/hyper.scm new file mode 100644 index 0000000..646ad12 --- /dev/null +++ b/scm/misc/hyper.scm @@ -0,0 +1,166 @@ +;;;; -*-Scheme-*- +;;;; +;;;; $Revision: 1.5 $ +;;;; +;;;; General-purpose hypertext requests +;;;; +;;;; This implementation is undocumented and is likely to change in +;;;; future relases. + + +(if (not (string=? (substitute "%format%") "html")) + (quit "hypertext functions require -fhtml")) + + + +;;; -------------------------------------------------------------------------- +;;; Data structures. + +(define ht-anchors '()) +(define ht-references '()) + + +(define anchor-name car) +(define anchor-location cdr) + +(define (anchor-create name location) + (cons name location)) + +(define ref-filename car) +(define ref-offset cadr) +(define ref-location caddr) +(define ref-name cadddr) + +(define (ref-unresolved? x) + (eqv? (ref-location x) "")) + +(define (set-ref-location! x l) + (set-car! (cddr x) l)) + +(define (ref-create filename offset name) + (list filename offset "" name)) + + + +;;; -------------------------------------------------------------------------- +;;; Figure out if hypertext request is allowed at a given place and the +;;; filename to use in hypertext anchor. + +(define (default-query-anchor request label) + (lambda (op) + (case op + (allowed? #t) + (emit-anchor? #t) + (filename (stream-target (output-stream)))))) + +(define (ht-querier request label) + (let ((q (if (bound? 'query-anchor) query-anchor default-query-anchor))) + (q request label))) + + + +;;; -------------------------------------------------------------------------- +;;; Create hypertext anchor. +;;; +;;; .Ha label anchor-text + +(defmacro 'Ha + (lambda (Ha name contents) + (let* ((q (ht-querier '.Ha name)) + (location (q 'filename))) + (cond + ((not (q 'allowed?)) + "") + ((assoc name ht-anchors) + (warn ".Ha with duplicate anchor name `~a'" name)) + (else + (resolve-ht-reference name location) + (list-push! ht-anchors (anchor-create name location)) + (if (q 'emit-anchor?) + (concat (format #f "~a" (parse-unquote name) + (parse contents))) + "")))))) + +(define (resolve-ht-reference name location) + (let loop ((x ht-references)) + (cond + ((not (null? x)) + (if (and (ref-unresolved? (car x)) + (string=? (ref-name (car x)) name)) + (set-ref-location! (car x) location)) + (loop (cdr x)))))) + + + +;;; -------------------------------------------------------------------------- +;;; Create hypertext reference. +;;; +;;; .Hr -url url anchor-text [suffix] +;;; .Hr -symbolic label anchor-text [suffix] +;;; .Hr troff-text + +(defmacro 'Hr + (lambda (Hr type . args) + (cond + ((string=? type "-url") + (if (< (length args) 2) + (warn "too few arguments for .Hr") + (concat + (format #f "~a~a" + (parse-unquote (car args)) + (parse (cadr args)) + (if (null? (cddr args)) + #\newline + (parse (caddr args) #\newline)))))) + ((string=? type "-symbolic") + (if (< (length args) 2) + (warn "too few arguments for .Hr") + (let* ((ref (car args)) + (q (ht-querier '.Hr ref)) + (filename (q 'filename)) + (a (assoc ref ht-anchors)) + (location (if a (cdr a) ""))) + (cond + ((not (q 'allowed?)) + "") + ((and (not a) (not (output-stream))) + (warn ".Hr forward reference requires `document' option")) + (else + (emit "" + (parse (cadr args)) "" + (if (null? (cddr args)) + #\newline + (parse (caddr args) #\newline)))))))) + (else "")))) + + + +;;; -------------------------------------------------------------------------- +;;; Complain about unresolved references and weed out references that +;;; point into the file where they appear; then do the file insertions. + +(define (check-ht-references) + (let loop ((x ht-references) (new '())) + (cond + ((null? x) + new) + ((ref-unresolved? (car x)) + (warn "unresolved hypertext reference `~a' in file ~a" + (ref-name (car x)) (ref-filename (car x))) + (loop (cdr x) new)) + ((string=? (ref-filename (car x)) (ref-location (car x))) + (loop (cdr x) new)) + (else + (loop (cdr x) (cons (car x) new)))))) + +(define (insert-ht-references) + (let ((refs (check-ht-references))) + (file-insertions refs))) + +(defevent 'exit 90 insert-ht-references) diff --git a/scm/troff.scm b/scm/troff.scm new file mode 100644 index 0000000..06f1922 --- /dev/null +++ b/scm/troff.scm @@ -0,0 +1,541 @@ +;;;; -*-Scheme-*- +;;;; +;;;; $Revision: 1.22 $ +;;;; +;;;; Basic initializations + + +;;; -------------------------------------------------------------------------- +;;; Define minimal reset, interrupt handler, and error handlers. + +(if (call-with-current-continuation + (lambda (c) + (set! top-level-control-point c) #f)) + (exit 1)) + +(define (interrupt-handler) (exit 1)) + +(define (error-handler . args) + (let ((port (error-port))) + (format port "~a: ~s: " (substitute "%progname%") (car args)) + (apply format port (cdr args)) + (newline port) + (exit 1))) + + + +;;; -------------------------------------------------------------------------- +;;; Procedures to print an error message and quit and to print warnings. + +(define (quit msg . args) + (let ((port (error-port))) + (display (substitute "%progname%:%filepos% ") port) + (apply format port msg args) + (newline port)) + (exit 1)) + +(define (warn msg . args) + (let ((port (error-port))) + (display (substitute "%progname%:%filepos% warning: ") port) + (apply format port msg args) + (newline port) + "")) ; return "" to assist use in event functions + +(define (surprise msg) + (warn (concat msg " may not work as expected"))) + + + +;;; -------------------------------------------------------------------------- +;;; Miscellaneous utilities. + +(define-macro (++ var) `(set! ,var (1+ ,var))) +(define-macro (-- var) `(set! ,var (1- ,var))) + +(define (identity x) x) + + +(define (copy-apply reader . procedures) + (define (apply-all val procs) + (if (null? procs) + val + ((car procs) (apply-all val (cdr procs))))) + (let loop ((x (reader))) + (cond ((eof-object? x) "") + (else + (apply-all x procedures) + (loop (reader)))))) + + +(define-macro (list-push! list elem) + `(set! ,list (cons ,elem ,list))) + +(define-macro (list-pop! list) + `(set! ,list (cdr ,list))) + +(define-macro (list-clear! list) + `(set! ,list '())) + + +(define (skip-lines stop) + (let ((x (read-line-expand))) + (cond ((eof-object? x) + (warn "end-of-stream while skipping input")) + ((not (string=? x stop)) + (skip-lines stop))))) + + +;;; Assist setting of options in initialization file: + +(define-macro (eval-if-mode mode . body) + (if (and (pair? mode) + (= (length mode) 2) + (symbol? (car mode)) + (symbol? (cadr mode))) + (let ((tmac (car mode)) (format (cadr mode))) + `(cond + ((and (or (eq? ',tmac '*) + (eq? ',tmac (string->symbol (substitute "m%macros%")))) + (or (eq? ',format '*) + (eq? ',format (string->symbol (substitute "%format%"))))) + ,@body))) + (error 'eval-if-mode "badly formed mode argument: `~a'" mode))) + + +;;; Macro to define a function and a predicate to manage requests that +;;; come in pairs, such as .fi/.nf. + +(define-macro (define-pair func inside enter leave) + `(begin + (define ,inside #f) + (define (,func on) + (begin1 + (if on + (if ,inside "" ,enter) + (if ,inside ,leave "")) + (set! ,inside on))))) + + +;;; Like define-pair, but for nested pairs. + +(define-macro (define-nested-pair func level enter leave) + `(begin + (define ,level 0) + (define (,func op) + (case op + (0 (begin1 (repeat-string ,level ,leave) (set! ,level 0))) + (+ (++ ,level) ,enter) + (- (if (zero? ,level) + "" + (-- ,level) ,leave)))))) + + + +;;; -------------------------------------------------------------------------- +;;; Options. + +(define option-types (make-table 10)) +(define option-table (make-table 100)) + +(define (define-option-type name check1 msg1 convert check2 msg2) + (table-store! option-types name (list check1 msg1 convert check2 msg2))) + +(define (define-option name type initial) + (if (not (table-lookup option-types type)) + (quit "bad type `~a' for define-option" type)) + (table-store! option-table name (cons initial type))) + +(define (option-setter as-event?) + (lambda (name value) + (let* ((opt (table-lookup option-table name)) + (t (if opt (table-lookup option-types (cdr opt)) #f)) + (err (lambda (msg) (quit "option `~a' requires ~a as value" + name msg)))) + (if opt + (let ((val value)) + (if as-event? + (begin + (if (not ((car t) val)) (err (cadr t))) + (set! val ((caddr t) (car opt) val)))) + (if (not ((cadddr t) val)) (err (car (cddddr t)))) + (set-car! opt val)) + (quit "undefined option: `~a'" name))))) + +(defevent 'option 0 (option-setter #t)) +(define set-option! (option-setter #f)) + +(define (option name) + (let ((opt (table-lookup option-table name))) + (if opt (car opt) (quit "undefined option: `~a'" name)))) + +(define-option-type 'integer + string? "" + (lambda (old new) (string->number new)) + integer? "an integer") + +(define-option-type 'boolean + (lambda (x) (member x '("0" "1"))) "0 or 1" + (lambda (old new) (string=? new "1")) + boolean? "a boolean") + +(define-option-type 'character + (lambda (x) (= (string-length x) 1)) "a character" + (lambda (old new) (string-ref new 0)) + char? "a character") + +(define-option-type 'string + string? "" + (lambda (old new) new) + string? "a string") + +(define-option-type 'dynstring + string? "" + string-compose + string? "a string") + + + +;;; -------------------------------------------------------------------------- +;;; Utilities for working with streams. + +(define (with-i/o name proc opener setter!) + (let* ((new (opener name)) (old (setter! new)) (result (proc))) + (setter! old) + (close-stream new) + result)) + +(define-macro (with-output-to-stream name . body) + `(with-i/o ,name (lambda () ,@body) open-output-stream set-output-stream!)) + +(define-macro (with-output-appended-to-stream name . body) + `(with-i/o ,name (lambda () ,@body) append-output-stream set-output-stream!)) + +(define-macro (with-input-from-stream name . body) + `(with-i/o ,name (lambda () ,@body) open-input-stream set-input-stream!)) + + + +;;; -------------------------------------------------------------------------- +;;; Basic troff requests that are not output format specific. + +(defrequest 'tm + (lambda (tm arg) + (display arg (error-port)) + (newline (error-port)))) + +(define-option 'include-files 'boolean #t) + +(defrequest 'so + (lambda (so fn) + (cond + ((eqv? fn "") + (warn "missing filename for .so")) + ((option 'include-files) + (with-input-from-stream fn + (copy-apply read-line-expand parse-line))) + (else "")))) + +(defrequest 'ec + (lambda (ec c) + (cond + ((eqv? c "") + (set-escape! #\\)) + ((= (string-length c) 1) + (set-escape! (string-ref c 0))) + (else + (warn "non-character argument for .ec") + (set-escape! #\\))))) + +(defrequest 'rm + (lambda (rm . names) + (for-each + (lambda (x) + (defrequest x #f) + (defstring x #f)) + names) "")) + + + +;;; -------------------------------------------------------------------------- +;;; Inline Scheme code execution; transparent output. + +(define \##-env (the-environment)) +(define (\##-eval expr) (eval expr \##-env)) + +(defrequest 'ig + (lambda (ig delim) + (define (copy-exec stop what) + (let loop ((s (read-line))) + (cond ((eof-object? s) + (warn "end-of-stream during ~a" what)) + ((not (string=? s stop)) + (emit s) + (loop (read-line)))))) + (cond + ((string=? delim "##") + (with-output-to-stream '[##] + (copy-exec ".##\n" "inline Scheme execution")) + (let ((p (open-input-string (stream->string '[##])))) + (copy-apply (lambda () (read p)) \##-eval))) + ((string=? delim ">>") + (copy-exec ".>>\n" "transparent output")) + (else + (skip-lines (concat #\. (if (eqv? delim "") #\. delim) #\newline)))) + "")) + +(defrequest '\## + (lambda (\## sexpr) + (let ((p (open-input-string sexpr))) + (copy-apply (lambda () (read p)) \##-eval)))) + +(defrequest '>> + (lambda (>> code) (emit code #\newline))) + + + +;;; -------------------------------------------------------------------------- +;;; User-defined macros. + +(define arg-stack '()) + +(defescape '$ + (lambda ($ n) + (let ((i (string->number n))) + (cond + ((not i) + (cond + ((string=? n "*") + (if (null? arg-stack) "" (apply spread (cdar arg-stack)))) + ((string=? n "@") + (let loop ((a (if (null? arg-stack) '() (cdar arg-stack)))) + (cond ((null? a) + "") + ((null? (cdr a)) + (concat #\" (car a) #\")) + (else + (concat #\" (car a) #\" #\space (loop (cdr a))))))) + (else + (warn "invalid $ argument `~a'" n)))) + ((or (null? arg-stack) (>= i (length (car arg-stack)))) + "") + (else (list-ref (car arg-stack) i)))))) + +(defnumreg '.$ + (lambda _ + (number->string (if (null? arg-stack) 0 (1- (length (car arg-stack))))))) + +(define (macro-buffer-name s) (concat "[." s "]")) + +(define (expand-macro . args) + (list-push! arg-stack args) + (with-input-from-stream (macro-buffer-name (car args)) + (copy-apply read-line-expand parse-line parse-copy-mode)) + (list-pop! arg-stack) "") + +(define (copy-macro-body) + (let* ((s (read-line-expand)) + (t (if (eof-object? s) #f (parse-copy-mode s)))) + (cond ((not t) + (warn "end-of-stream during macro definition")) + ((not (string=? t "..\n")) + (emit t) + (copy-macro-body))))) + +(defrequest 'de + (lambda (de name) + (cond ((eqv? name "") + (warn "missing name for .de")) + (else + (with-output-to-stream (macro-buffer-name name) + (copy-macro-body)) + (defmacro name expand-macro) "")))) + +(defrequest 'am + (lambda (am name) + (cond ((eqv? name "") + (warn "missing name for .am")) + (else + (with-output-appended-to-stream (macro-buffer-name name) + (copy-macro-body)) + (defmacro name expand-macro) "")))) + + + +;;; -------------------------------------------------------------------------- +;;; if, if-else, else. + +(defescape #\{ "") +(defescape #\} "") +(defrequest "\\}" "") ; do not complain about .\} + +(define-option 'if-true 'dynstring "to") +(define-option 'if-false 'dynstring "ne") + +(define if-stack '()) + +(define (if-request request condition rest) + (let* ((doit? #f) + (c (string-prune-left condition "!" condition)) + (len (string-length c)) + (neg? (not (eq? c condition)))) + (cond + ((and (= len 1) (char-alphabetic? (string-ref c 0))) + (cond + ((substring? c (option 'if-true)) + (set! doit? #t)) + ((substring? c (option 'if-false))) + (else (warn "unknown if-condition `~a'" c)))) + ((and (> len 0) (char-expression-delimiter? (string-ref c 0))) + (let ((x (parse-expression c #f #\u))) + (if x (set! doit? (not (zero? x)))))) + (else + (let ((pair (parse-pair c))) + (if pair + (set! doit? (string=? (car pair) (cdr pair))) + (warn "if-condition `~a' not understood" c))))) + (cond + ((eq? neg? doit?) + (unread-line (concat rest #\newline)) + (skip-group)) + (else + (unread-line (hack-if-argument rest)))) + (if (string=? request "ie") + (list-push! if-stack (not (eq? neg? doit?)))) + "")) + +;; Some people like to write .if requests such as +;; .if t \{\ +;; .foo +;; This causes the string "\{.foo" to be passed to .if, as the first line +;; is a continuation line. So let's strip the initial \{. What a hack. + +(define (hack-if-argument s) + (string-prune-left s "\\{" s)) + +(defrequest 'if if-request) +(defrequest 'ie if-request) + +(defrequest 'el + (lambda (_ rest) + (cond + ((null? if-stack) + (warn ".el without matching .ie request")) + ((car if-stack) + (unread-line (concat rest #\newline)) + (skip-group) + (list-pop! if-stack)) + (else + (unread-line (hack-if-argument rest)) + (list-pop! if-stack))) + "")) + + + +;;; -------------------------------------------------------------------------- +;;; Number registers. + +(define numreg-table (make-table 65536)) + +(defrequest 'nr + (lambda (nr name val incr) + (cond + ((eqv? name "") + (warn "missing name for .nr")) + ((eqv? val "") + (warn "missing value for .nr")) + (else + (let* ((old (table-lookup numreg-table name)) + (v (parse val)) + (n (parse-expression v #f #\u)) + (add? (string-prune-left v "+" #f)) + (i (if (eqv? incr "") + #f + (parse-expression (parse incr) #f #\u)))) + (cond + ((not n) "") + (old + (set-car! old (if (or add? (negative? n)) (+ (car old) n) n)) + (if i + (set-cdr! old i))) + (else + (table-store! numreg-table name (cons n (if i i 0)))))))) + "")) + +(defescape 'n + (lambda (_ name . sign) + (let ((val (table-lookup numreg-table name))) + (cond + (val + (if (not (null? sign)) + (case (car sign) + (#\+ (set-car! val (+ (car val) (cdr val)))) + (#\- (set-car! val (- (car val) (cdr val)))))) + (number->string (car val))) + (else (warn "undefined number register: `~a'" name) "0"))))) + +(defrequest 'rr + (lambda (rr . names) + (for-each + (lambda (x) + (defnumreg x #f) + (table-remove! numreg-table x)) + names) "")) + + +;;; Predefined number registers + +(defnumreg 'dw + (lambda _ + (number->string (1+ (string->number (substitute "%weekdaynum%")))))) + +(defnumreg 'dy (lambda _ (substitute "%day%"))) +(defnumreg 'mo (lambda _ (substitute "%month%"))) +(defnumreg 'yr (lambda _ (substring (substitute "%year%") 2 4))) +(defnumreg '.C (lambda _ (if (troff-compatible?) #\1 #\0))) +(defnumreg '% #\0) +(defnumreg '.z "") +(defnumreg '.U #\1) + + + +;;; -------------------------------------------------------------------------- +;;; Strings. Note that user-defined strings are re-scanned (strings +;;; defined via `defstring' aren't, because they may contain anything). + +(defrequest 'ds + (lambda (ds name val) + (if (eqv? name "") + (warn "missing name for .ds") + (let ((v (string-prune-left val "\"" val))) + (defstring name (lambda _ (parse-expand v))))) + "")) + +(defrequest 'as + (lambda (as name val) + (if (eqv? name "") + (warn "missing name for .as") + (let* ((f (stringdef name)) + (s (if f (if (string? f) f (f)) "")) + (new (concat s (string-prune-left val "\"" val)))) + (defstring name (lambda _ (parse-expand new))))) + "")) + +(defescape '* + (lambda (_ name) + (warn "undefined string: `~a'" name))) + + + +;;; -------------------------------------------------------------------------- +;;; Now we are done with the definitions. +;;; +;;; Load the output-format-specific Scheme code and the macro-package- +;;; specific Scheme code. + +(load (substitute "%directory%/scm/%format%/common.scm")) + +(load (substitute "%directory%/scm/%format%/m%macros%.scm")) + +(set! garbage-collect-notify? #f) + +(append! load-path (list (substitute "%directory%/scm/misc"))) diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..7887e02 --- /dev/null +++ b/src/Makefile @@ -0,0 +1,93 @@ +# $Revision: 1.12 $ + +### You need a C compiler that compiles ANSI C code. +CC = gcc +CFLAGS = -Wall -pedantic -O + +### If you need additional linker flags add them here. +LDFLAGS = + +### The directory where the Elk installation resides on your system. +ELKDIR = /usr/elk + +### Additional libraries. You may want to insert the output of the +### shell-script $(ELKDIR)/lib/ldflags here. +LIBS = -lm + +### The makedepend program (it's usually installed with the X11 binaries). +MAKEDEP = makedepend + +### The directory under which you will install the Scheme files. +DIR = /usr/local/lib/unroff + +### The default output format. +FORMAT = html + + + + +### End of configurable variables. +### ------------------------------------------------------------------------- + +SHELL = /bin/sh +INCLUDE = -I$(ELKDIR)/include +ELK = $(ELKDIR)/lib/module.o +DEFS = -DDEFAULT_DIR=\"$(DIR)\" -DDEFAULT_FORMAT=\"$(FORMAT)\" +CTAGS = ctags -t -w + +SOURCES = \ + args.c\ + buffer.c\ + error.c\ + event.c\ + expr.c\ + gcroot.c\ + insert.c\ + malloc.c\ + parse.c\ + prim.c\ + scmtable.c\ + stream.c\ + subst.c\ + table.c\ + unroff.c + +OBJECTS = \ + args.o\ + buffer.o\ + error.o\ + event.o\ + expr.o\ + gcroot.o\ + insert.o\ + malloc.o\ + parse.o\ + prim.o\ + scmtable.o\ + stream.o\ + subst.o\ + table.o\ + unroff.o\ + $(ELK) + +ALL = unroff + +all: $(ALL) + +.c.o: + $(CC) $(CFLAGS) $(INCLUDE) $(DEFS) -c $< + +clean: + rm -f *.o $(ALL) + +tags ctags: $(SOURCES) + $(CTAGS) $(SOURCES) + +unroff: $(OBJECTS) + $(CC) $(LDFLAGS) -o $@ $(OBJECTS) $(LIBS) + +depend: Makefile $(SOURCES) + $(MAKEDEP) $(INCLUDE) $(SOURCES) + + +# DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/src/args.c b/src/args.c new file mode 100644 index 0000000..f7c4bb6 --- /dev/null +++ b/src/args.c @@ -0,0 +1,72 @@ +/* $Revision: 1.5 $ + */ + +/* Functions that maintain a properly GC-linked list of Scheme + * arguments. The parser collects arguments to an event procedure + * using args_add(); the code that eventually calls the event + * procedure calls args_get() to obtain a list of arguments that + * can directly be passed to Funcall(). + * + * args_clear() -- clears the list + * args_add(obj) -- appends an object to the list + * args_get() -- returns the list + * args_num() -- returns the current length of the list + */ + +#include "unroff.h" + +static Object args, last, rest; +static int num; + +void args_clear(void) { + if (Nullp(last)) { + if (!Nullp(rest)) + args = rest; + } else + P_Setcdr(last, rest); + last = Null; + num = 0; +} + +void args_add(Object x) { + Object tmp; + GC_Node; + + if (Nullp(last)) { + last = args; + } else { + if (Nullp(Cdr(last))) { + GC_Link(x); + tmp = Cons(False, Null); + GC_Unlink; + Cdr(last) = tmp; + } + last = Cdr(last); + } + Car(last) = x; + rest = Cdr(last); + num++; +} + + +Object args_get(void) { + if (Nullp(last)) { + rest = args; + return Null; + } + rest = Cdr(last); + P_Setcdr(last, Null); + return args; +} + +int args_num(void) { + return num; +} + +void init_args(void) { + rest = Cons(False, Null); + args = last = Null; + Global_GC_Link(args); + Global_GC_Link(last); + Global_GC_Link(rest); +} diff --git a/src/args.h b/src/args.h new file mode 100644 index 0000000..9e09fc3 --- /dev/null +++ b/src/args.h @@ -0,0 +1,8 @@ +/* $Revision: 1.2 $ + */ + +void args_clear(void); +void args_add(Object); +Object args_get(void); +int args_num(void); +void init_args(void); diff --git a/src/buffer.c b/src/buffer.c new file mode 100644 index 0000000..04451ea --- /dev/null +++ b/src/buffer.c @@ -0,0 +1,68 @@ +/* $Revision: 1.7 $ + */ + +/* `Buffer' is a dynamically growing, general-purpose buffer data + * structure. + * + * buffer_new(size) -- returns new buffer with initial size `size' + * or some default size if argument is zero + * buffer_delete(b) -- marks a buffer as unused + * buffer_clear(b) -- empties a buffer + * buffer_puts(b,data,len) -- appends data to a buffer, growing it if + * necessary + * buffer_putc(b,c) -- appends a character to a buffer + */ + +#include "unroff.h" + +static int sizeinc_linear(Buffer *); + +static Buffer *first_free; + +Buffer *buffer_new(int size) { + Buffer *p; + + if (size == 0) + size = 512; + if (first_free) { /* reuse a buffer if there is one */ + p = first_free; + first_free = p->next; + if (p->max < size) { + free(p->data); + p->data = safe_malloc(p->max = size); + } + } else { + p = safe_malloc(sizeof *p); + p->data = safe_malloc(size); + p->increment = p->max = size; + p->sizeinc_func = sizeinc_linear; + } + buffer_clear(p); + return p; +} + +void buffer_delete(Buffer *p) { + assert(p->size >= 0); + p->size = -1; + p->next = first_free; + first_free = p; +} + +void buffer_grow(Buffer *p) { + p->max = p->sizeinc_func(p); + p->data = safe_realloc(p->data, p->max); +} + +void buffer_puts(Buffer *p, char *s, int size) { + assert(size >= 0); + while (p->size + size > p->max) + buffer_grow(p); + if (size == 0) + return; + memcpy(p->data+p->size, s, size); + p->size += size; +} + +static int sizeinc_linear(Buffer *p) { + return p->max + p->increment; +} diff --git a/src/buffer.h b/src/buffer.h new file mode 100644 index 0000000..54b97bc --- /dev/null +++ b/src/buffer.h @@ -0,0 +1,26 @@ +/* $Revision: 1.4 $ + */ + +typedef struct _buffer { + char *data; + int increment; + int size; + int max; + int (*sizeinc_func)(struct _buffer *); + struct _buffer *next; +} Buffer; + +Buffer *buffer_new(int); +void buffer_delete(Buffer *); +void buffer_grow(Buffer *); +void buffer_puts(Buffer *, char *, int); + +#define buffer_need_grow(p) ((p)->size == (p)->max) +#define buffer_clear(p) ((p)->size = 0) + +#define buffer_putc(p, c) {\ + if (buffer_need_grow(p))\ + buffer_grow(p);\ + (p)->data[(p)->size++] = (c);\ +} + diff --git a/src/config.h b/src/config.h new file mode 100644 index 0000000..8875f20 --- /dev/null +++ b/src/config.h @@ -0,0 +1,33 @@ +/* $Revision: 1.9 $ + */ + +/* Environment variable specifing library directory: + */ +#define DEFAULT_DIR_ENV "UNROFF_DIR" + + +/* Environment variable specifing default output format: + */ +#define DEFAULT_FORMAT_ENV "UNROFF_FORMAT" + + +/* User-supplied initialization file loaded from home directory: + */ +#define RC_FILE ".unroff" + + +/* File to load if option -t is given: + */ +#define TEST_TOPLEVEL "toplevel.scm" + + +#define MAJOR_VERSION 1 +#define MINOR_VERSION 0 + + +/* Hack: __GNUC_MINOR__ was introduced together with __attribute__ */ +#ifdef __GNUC_MINOR__ +# define NORETURN __attribute__ ((noreturn)) +#else +# define NORETURN +#endif diff --git a/src/elk-2.2-patch b/src/elk-2.2-patch new file mode 100644 index 0000000..8bb1fa8 --- /dev/null +++ b/src/elk-2.2-patch @@ -0,0 +1,53 @@ +*** 1.59 1994/01/24 16:03:30 +--- src/main.c 1995/02/01 17:06:20 +*************** +*** 90,95 **** +--- 90,98 ---- + struct stat st; + extern int errno; + char foo; ++ #ifdef NOMAIN ++ # define foo (av[0][0]) ++ #endif + + #ifdef CAN_DUMP + bzero (unused, 1); /* see comment above */ +*************** +*** 207,213 **** + * the load-path, so that -p can be used. + */ + Error_Tag = "scheme-init"; +! initfile = Safe_Malloc (strlen (SCM_DIR) + 1 + sizeof (INITFILE)); + sprintf (initfile, "%s/%s", SCM_DIR, INITFILE); + if (stat (initfile, &st) == -1 && errno == ENOENT) + file = Make_String (INITFILE, sizeof(INITFILE)-1); +--- 210,216 ---- + * the load-path, so that -p can be used. + */ + Error_Tag = "scheme-init"; +! initfile = Safe_Malloc (strlen (SCM_DIR) + 1 + sizeof (INITFILE) + 1); + sprintf (initfile, "%s/%s", SCM_DIR, INITFILE); + if (stat (initfile, &st) == -1 && errno == ENOENT) + file = Make_String (INITFILE, sizeof(INITFILE)-1); +*************** +*** 220,227 **** + + Error_Tag = "top-level"; + #ifdef NOMAIN +! if ((loadfile = toplevel) == 0) + return; + #endif + if (loadfile == 0) + loadfile = "toplevel.scm"; +--- 223,233 ---- + + Error_Tag = "top-level"; + #ifdef NOMAIN +! if ((loadfile = toplevel) == 0) { +! Interpreter_Initialized = 1; +! GC_Debug = debug; + return; ++ } + #endif + if (loadfile == 0) + loadfile = "toplevel.scm"; diff --git a/src/error.c b/src/error.c new file mode 100644 index 0000000..7e8318e --- /dev/null +++ b/src/error.c @@ -0,0 +1,91 @@ +/* $Revision: 1.12 $ + */ + +#include "unroff.h" + +static char *progname = "(whoami?)"; + +void set_progname(char *s) { + char *p; + + progname = (p = strrchr(s, '/')) ? p+1 : s; +} + +char *get_progname(void) { + return progname; +} + +void warn(char *fmt, ...) { + va_list args; + + fprintf(stderr, "%s: ", progname); + if (istream_is_open()) + fprintf(stderr, "%s:%lu: ", curr_istream_target(), curr_istream_lno()); + fprintf(stderr, "warning: "); + va_start(args, fmt); + vfprintf(stderr, fmt, args); + fprintf(stderr, ".\n"); +} + +void fatal_error(char *fmt, ...) { + va_list args; + + fprintf(stderr, "%s: ", progname); + va_start(args, fmt); + vfprintf(stderr, fmt, args); + fprintf(stderr, ".\n"); + exit(1); +} + +static char *strerr(void) { + extern int sys_nerr; + extern char *sys_errlist[]; + + return errno > 0 && errno < sys_nerr ? + sys_errlist[errno] : "unknown error"; +} + +void read_error(char *s) { + fatal_error("reading %s: %s", s, strerr()); +} + +void write_error(char *s) { + fatal_error("writing %s: %s", s, strerr()); +} + +void open_error(char *fn) { + fatal_error("%s: %s", fn, strerr()); +} + +char *printable_string(char *s, int len) { + static Buffer *bp; + char c[4]; + + if (!bp) + bp = buffer_new(0); + buffer_clear(bp); + for ( ; len > 0; len--, s++) { + if (isprint(UCHAR(*s)) || *s == ' ') { + buffer_putc(bp, *s); + } else { + buffer_putc(bp, '\\'); + switch (*s) { + case '\n': + buffer_putc(bp, 'n'); break; + case '\t': + buffer_putc(bp, 't'); break; + case '\b': + buffer_putc(bp, 'b'); break; + default: + sprintf(c, "%03o", *s); + buffer_puts(bp, c, 3); + } + } + } + buffer_putc(bp, '\0'); + return bp->data; +} + +char *printable_char(char c) { + return printable_string(&c, 1); +} diff --git a/src/error.h b/src/error.h new file mode 100644 index 0000000..372a637 --- /dev/null +++ b/src/error.h @@ -0,0 +1,20 @@ +/* $Revision: 1.7 $ + */ + +void set_progname(char *); +char *get_progname(void); + +void warn(char *, ...); + +void fatal_error(char *, ...) NORETURN; + +void read_error(char *) NORETURN; +void write_error(char *) NORETURN; +void open_error(char *) NORETURN; + +/* Redefined to add NORETURN + */ +extern Primitive_Error() NORETURN; + +char *printable_string(char *, int); +char *printable_char(char); diff --git a/src/event.c b/src/event.c new file mode 100644 index 0000000..c092f34 --- /dev/null +++ b/src/event.c @@ -0,0 +1,375 @@ +/* $Revision: 1.15 $ + */ + +/* Scheme primitives that define and query event procedures, and + * functions to lookup and execute events. + */ + +#include "unroff.h" + +#define NUM_VEC_EVENTS 6 + +static Table *requests, *numregs, *specials, *escapes, *chars, *others; +static Table *fallbacks; +static Object Key_Equation, Key_Sentence; +Object eventsvec; + +static SYMDESCR event_syms[] = { + { "line", EV_LINE }, + { "prolog", EV_PROLOG }, + { "epilog", EV_EPILOG }, + { "option", EV_OPTION }, + { "start", EV_START }, + { "exit", EV_EXIT }, + { 0, 0 } +}; + +static char *event_names[] = { + "line event", + "prolog event", + "epilog event", + "option event", + "start event", + "exit event", + "request", + "macro", + "string", + "number register", + "special character", + "inline equation", + "sentence event", + "escape sequence", + "character event", +}; + +static Object make_event_object(Object x) { + switch (TYPE(x)) { + case T_Null: + case T_Compound: + case T_String: + case T_Character: + case T_Symbol: + return x; + case T_Primitive: + Primitive_Error("event function must be a compound procedure"); + default: + if (EQ(x, False)) + return x; + Primitive_Error("invalid event value argument"); + } +} + +static Object store_event(Table *tp, char *key, int size, Object obj, + char flags) { + Elem *oldp; + Object ret = False; + + if ((oldp = table_lookup(tp, key, size)) != 0) + ret = get_object(oldp->obj); + if (!Nullp(obj)) + if (EQ(obj, False)) + table_remove(tp, key, size); + else + table_store(tp, key, size, obj, (unsigned long)flags); + return ret; +} + +static Object def_indexed(Table *tp, Object key, Object obj, char flags, + char *code) { + if (TYPE(key) == T_Symbol) + key = SYMBOL(key)->name; + else if (TYPE(key) != T_String) + Wrong_Type_Combination(key, "string or symbol"); + if (STRING(key)->size == 0) { + if (*code != 'r' && *code != 'p') + Primitive_Error("event key must be of non-zero length"); + return store_event(fallbacks, code, 1, make_event_object(obj), flags); + } + return store_event(tp, STRING(key)->data, STRING(key)->size, + make_event_object(obj), flags); +} + +static Object p_defrequest(Object key, Object obj) { + return def_indexed(requests, key, obj, 0, "r"); +} + +static Object p_defmacro(Object key, Object obj) { + return def_indexed(requests, key, obj, RQ_MACRO, "m"); +} + +static Object p_defstring(Object key, Object obj) { + return def_indexed(requests, key, obj, RQ_STRING, "s"); +} + +static Object p_defnumreg(Object key, Object obj) { + return def_indexed(numregs, key, obj, 0, "n"); +} + +static Object p_defspecial(Object key, Object obj) { + return def_indexed(specials, key, obj, 0, "p"); +} + +static Object p_defequation(Object obj) { + return def_indexed(others, Key_Equation, obj, 0, 0); +} + +static Object p_defsentence(Object obj) { + return def_indexed(others, Key_Sentence, obj, 0, 0); +} + +static Object p_requestdef(Object key) { + return def_indexed(requests, key, Null, 0, "r"); +} + +static Object p_macrodef(Object key) { + return def_indexed(requests, key, Null, 0, "m"); +} + +static Object p_stringdef(Object key) { + return def_indexed(requests, key, Null, 0, "s"); +} + +static Object p_numregdef(Object key) { + return def_indexed(numregs, key, Null, 0, "n"); +} + +static Object p_specialdef(Object key) { + return def_indexed(specials, key, Null, 0, "p"); +} + +static Object p_equationdef(void) { + return def_indexed(others, Key_Equation, Null, 0, 0); +} + +static Object p_sentencedef(void) { + return def_indexed(others, Key_Sentence, Null, 0, 0); +} + +static Object def_char_event(Table *tp, Object key, Object obj) { + char c; + + switch (TYPE(key)) { + case T_Character: + c = CHAR(key); break; + case T_Symbol: + key = SYMBOL(key)->name; + /* fall through */ + case T_String: + if (tp == escapes && STRING(key)->size == 0) + return store_event(fallbacks, "e", 1, make_event_object(obj), 0); + if (STRING(key)->size != 1) + goto err; + c = STRING(key)->data[0]; + break; + default: err: + Primitive_Error("cannot coerce argument to character"); + } + return store_event(tp, &c, 1, make_event_object(obj), 0); +} + +Object p_defescape(Object key, Object obj) { + return def_char_event(escapes, key, obj); +} + +Object p_defchar(Object key, Object obj) { + return def_char_event(chars, key, obj); +} + +Object p_escapedef(Object key) { + return def_char_event(escapes, key, Null); +} + +Object p_chardef(Object key) { + return def_char_event(chars, key, Null); +} + +Elem *event_lookup(Event e, char *key, int size) { + Elem *p; + + if (key && size == 0) { + switch(e) { + case EV_REQUEST: + return table_lookup(fallbacks, "r", 1); /* not yet */ + case EV_MACRO: + return table_lookup(fallbacks, "m", 1); /* not yet */ + case EV_SPECIAL: + return table_lookup(fallbacks, "p", 1); + case EV_ESCAPE: + return table_lookup(fallbacks, "e", 1); + default: + assert(0); + } + } else { + switch (e) { + case EV_REQUEST: + return ((p = table_lookup(requests, key, size)) && + !(p->flags & RQ_MACRO)) ? p : 0; + case EV_MACRO: + return ((p = table_lookup(requests, key, size)) && + (p->flags & RQ_MACRO)) ? p : 0; + case EV_STRING: + return table_lookup(requests, key, size); + case EV_NUMREG: + return table_lookup(numregs, key, size); + case EV_SPECIAL: + return table_lookup(specials, key, size); + case EV_ESCAPE: + return table_lookup(escapes, key, size); + case EV_CHAR: + assert(size == 1); + return table_lookup(chars, key, size); + case EV_EQUATION: + return table_lookup(others, "e", 1); + case EV_SENTENCE: + return table_lookup(others, "s", 1); + case EV_LINE: + case EV_PROLOG: + case EV_EPILOG: + case EV_OPTION: + case EV_START: + case EV_EXIT: + default: + assert(0); + } + } + return 0; /* shut up gcc -W */ +} + +static int check_num_args(Object fun, int num, char *evnam) { + char *s = 0; + struct S_Compound *comp = COMPOUND(fun); + + if (num < comp->min_args) + s = "few"; + else if (comp->max_args >= 0 && num > comp->max_args) + s = "many"; + if (s) warn("too %s arguments for %s function", s, evnam); + return !s; +} + +char *event_exec(Event e, char *key, int size, int *size_ret, int complain) { + Elem *p = event_lookup(e, key, size); + Object ret; + char *name = event_names[e]; + static char c; + + if (p) { + if ((e == EV_REQUEST || e == EV_MACRO) && (p->flags & RQ_STRING)) { + warn("cannot execute string as request or macro"); + return 0; + } + if (e == EV_STRING && !(p->flags & RQ_STRING)) { + warn("cannot execute request or macro as string"); + return 0; + } + ret = get_object(p->obj); + if (TYPE(ret) == T_Compound) { + if (!check_num_args(ret, args_num(), name)) + return 0; + ret = Funcall(ret, args_get(), 0); + } + assert(size_ret != 0); + switch (TYPE(ret)) { + case T_Character: + c = CHAR(ret); + *size_ret = 1; + return &c; + case T_Symbol: + ret = SYMBOL(ret)->name; /* fall through */ + case T_String: + *size_ret = STRING(ret)->size; + return STRING(ret)->data; + default: + warn("cannot coerce result of %s function to string", name); + return 0; + } + } + if (complain) + warn("no event value for %s `%s'", name, printable_string(key, size)); + return 0; +} + +char *event_exec_fallback(Event e, char *key, int size, int *size_ret) { + if (!event_lookup(e, key, size) && event_lookup(e, "", 0)) + return event_exec(e, "", 0, size_ret, 1); + else + return event_exec(e, key, size, size_ret, 1); +} + +static Object store_vec_event(int e, Object pri, Object obj) { + Object ret, v = VECTOR(eventsvec)->data[e]; + int p = Get_Integer(pri); + + if (p < 0 || p > 99) + Range_Error(pri); + ret = VECTOR(v)->data[p]; + if (!Nullp(obj)) + VECTOR(v)->data[p] = obj; + return ret; +} + +static Object p_defevent(Object event, Object pri, Object obj) { + char e = Symbols_To_Bits(event, 0, event_syms); + + if (Truep(obj) && TYPE(obj) != T_Compound) + Wrong_Type_Combination(obj, "compound procedure or #f"); + return store_vec_event(e, pri, obj); +} + +static Object p_eventdef(Object event, Object pri) { + char e = Symbols_To_Bits(event, 0, event_syms); + + return store_vec_event(e, pri, Null); +} + +void events_vec_exec(Event e) { + Object func, v; + int i; + + for (i = 0; i < 100; i++) { + v = VECTOR(eventsvec)->data[e]; + func = VECTOR(v)->data[i]; + if (Truep(func) && check_num_args(func, args_num(), event_names[e])) + (void)Funcall(func, args_get(), 0); + } +} + +void init_event(void) { + int i; + + requests = table_new(256*256); + numregs = table_new(256*256); + specials = table_new(256*256); + escapes = table_new(256); + chars = table_new(256); + others = table_new(10); + fallbacks = table_new(256); + Key_Equation = Make_String("e", 1); + Global_GC_Link(Key_Equation); + Key_Sentence = Make_String("s", 1); + Global_GC_Link(Key_Sentence); + eventsvec = Make_Vector(NUM_VEC_EVENTS, Null); + Global_GC_Link(eventsvec); + for (i = 0; i < NUM_VEC_EVENTS; i++) + VECTOR(eventsvec)->data[i] = Make_Vector(100, False); + Define_Primitive(p_defrequest, "defrequest", 2, 2, EVAL); + Define_Primitive(p_defmacro, "defmacro", 2, 2, EVAL); + Define_Primitive(p_defstring, "defstring", 2, 2, EVAL); + Define_Primitive(p_defnumreg, "defnumreg", 2, 2, EVAL); + Define_Primitive(p_defspecial, "defspecial", 2, 2, EVAL); + Define_Primitive(p_defequation, "defequation", 1, 1, EVAL); + Define_Primitive(p_defsentence, "defsentence", 1, 1, EVAL); + Define_Primitive(p_defescape, "defescape", 2, 2, EVAL); + Define_Primitive(p_defchar, "defchar", 2, 2, EVAL); + Define_Primitive(p_defevent, "defevent", 3, 3, EVAL); + Define_Primitive(p_requestdef, "requestdef", 1, 1, EVAL); + Define_Primitive(p_macrodef, "macrodef", 1, 1, EVAL); + Define_Primitive(p_stringdef, "stringdef", 1, 1, EVAL); + Define_Primitive(p_numregdef, "numregdef", 1, 1, EVAL); + Define_Primitive(p_specialdef, "specialdef", 1, 1, EVAL); + Define_Primitive(p_equationdef, "equationdef", 0, 0, EVAL); + Define_Primitive(p_sentencedef, "sentencedef", 0, 0, EVAL); + Define_Primitive(p_escapedef, "escapedef", 1, 1, EVAL); + Define_Primitive(p_chardef, "chardef", 1, 1, EVAL); + Define_Primitive(p_eventdef, "eventdef", 2, 2, EVAL); +} diff --git a/src/event.h b/src/event.h new file mode 100644 index 0000000..b41ace0 --- /dev/null +++ b/src/event.h @@ -0,0 +1,33 @@ +/* $Revision: 1.12 $ + */ + +/* Events: + */ +typedef enum _event { + EV_LINE, /* args: char|#f ret: */ + EV_PROLOG, /* args: pathname basename ret: */ + EV_EPILOG, /* args: pathname basename ret: */ + EV_OPTION, /* args: name value ret: */ + EV_START, /* args: ret: */ + EV_EXIT, /* args: ret: */ + EV_REQUEST, /* args: name args ret: stringable */ + EV_MACRO, /* args: name args ret: stringable */ + EV_STRING, /* args: name ret: stringable */ + EV_NUMREG, /* args: name [sign] ret: stringable */ + EV_SPECIAL, /* args: name ret: stringable */ + EV_EQUATION, /* args: string ret: stringable */ + EV_SENTENCE, /* args: char ret: stringable */ + EV_ESCAPE, /* args: char [arg [sign]] ret: stringable */ + EV_CHAR /* args: char ret: stringable */ +} Event; + +/* Flags stored in `requests' table + */ +#define RQ_STRING 1 +#define RQ_MACRO 2 + +void init_event(void); +Elem *event_lookup(Event, char *, int); +char *event_exec(Event, char *, int, int *, int); +char *event_exec_fallback(Event, char *, int, int *); +void events_vec_exec(Event); diff --git a/src/expr.c b/src/expr.c new file mode 100644 index 0000000..3743531 --- /dev/null +++ b/src/expr.c @@ -0,0 +1,235 @@ +/* $Revision: 1.5 $ + */ + +/* Scheme primitives that deal with troff numeric expressions. + */ + +#include "unroff.h" + +#define SCALE_INDICATORS "icPmnpuv" + +enum operator { + ADD, SUB, DIV, MUL, MOD, LT, GT, LE, GE, EQ, AND, OR, OOPS +}; + +static int scale_factor[128]; +static int scale_divisor[128]; + +static Object p_set_scaling(Object scale, Object x, Object y) { + int d, c; + + Check_Type(scale, T_Character); + c = CHAR(scale); + if (c == 0 || strchr(SCALE_INDICATORS, c) == 0) + Primitive_Error("invalid scale indicator ~s", scale); + scale_factor[c] = Get_Integer(x); + if ((d = Get_Integer(y)) == 0) + Range_Error(y); + scale_divisor[c] = d; + return Void; +} + +static Object p_get_scaling(Object scale) { + int c; + Object ret = Null; + GC_Node; + + Check_Type(scale, T_Character); + c = CHAR(scale); + if (c == 0 || strchr(SCALE_INDICATORS, c) == 0) + Primitive_Error("invalid scale indicator ~s", scale); + GC_Link(ret); + ret = Cons(Make_Integer(scale_factor[c]), Null); + Cdr(ret) = Make_Integer(scale_divisor[c]); + GC_Unlink; + return ret; +} + +static enum operator get_operator(char **p) { + enum operator op; + + switch (**p) { + case '+': + op = ADD; break; + case '-': + op = SUB; break; + case '/': + op = DIV; break; + case '*': + op = MUL; break; + case '%': + op = MOD; break; + case '<': + if ((*p)[1] == '=') { + (*p)++; + op = LE; + } else + op = LT; + break; + case '>': + if ((*p)[1] == '=') { + (*p)++; + op = GE; + } else + op = GT; + break; + case '&': + op = AND; break; + case ':': + op = OR; break; + case '=': + if ((*p)[1] == '=') + (*p)++; + op = EQ; + break; + default: + return OOPS; + } + (*p)++; + return op; +} + +static double parse_expr(char **, int, int); + +static double get_operand(char **p, int scale, int rest) { + double d; + char *ep; + + if (**p == '(') { + (*p)++; + d = parse_expr(p, scale, rest); + if (*p) { + if (**p != ')') *p = 0; + else (*p)++; + } + return d; + } + d = strtod(*p, &ep); + if (ep == *p) { + *p = 0; + return 0; + } + *p = ep; + if (**p && strchr(SCALE_INDICATORS, **p)) { + scale = **p; + (*p)++; + } + return d * scale_factor[scale] / scale_divisor[scale]; +} + +static double parse_expr(char **p, int scale, int rest) { + double acc, d; + enum operator op; + + acc = get_operand(p, scale, rest); + if (*p == 0) + return 0; + while (**p && **p != ')') { + if ((op = get_operator(p)) == OOPS) { + if (rest) + break; +err: *p = 0; + return 0; + } + d = get_operand(p, scale, rest); + if (*p == 0) + return 0; + switch (op) { + case ADD: + acc += d; break; + case SUB: + acc -= d; break; + case DIV: + if (d == 0.0) { + warn("division by zero"); goto err; + } + acc /= d; break; + case MUL: + acc *= d; break; + case MOD: + acc = fmod(acc, d); + if (isnan(acc)) { + warn("division by zero"); goto err; + } + break; + case LT: + acc = acc < d; break; + case GT: + acc = acc > d; break; + case LE: + acc = acc <= d; break; + case GE: + acc = acc >= d; break; + case EQ: + acc = acc == d; break; + case AND: + acc = acc > 0 && d > 0; break; + case OR: + acc = acc > 0 || d > 0; break; + case OOPS: + assert(0); + } + } + if (!finite(acc)) { + warn("expression evaluates to infinity"); goto err; + } + return acc; +} + +static Object parse_expression(Object str, Object fail, Object scale, + int rest) { + int c; + char *e, *s; + double d; + Object ret; + + Check_Type(scale, T_Character); + c = CHAR(scale); + if (c == 0 || strchr(SCALE_INDICATORS, c) == 0) + Primitive_Error("invalid scale indicator ~s", scale); + e = s = Get_String(str); + d = parse_expr(&s, c, rest); + if (s == 0 || (*s && !rest)) { + warn("invalid expression: `%s'", e); + return fail; + } + ret = P_Inexact_To_Exact(Make_Flonum(d)); + if (rest) { + Object x; + GC_Node; + + GC_Link(ret); + ret = Cons(ret, Null); + x = Make_String(s, strlen(s)); + Cdr(ret) = x; + GC_Unlink; + } + return ret; +} + +static Object p_parse_expression(Object str, Object fail, Object scale) { + return parse_expression(str, fail, scale, 0); +} + +static Object p_parse_expression_rest(Object str, Object fail, Object scale) { + return parse_expression(str, fail, scale, 1); +} + +static Object p_char_expression_delimiter(Object c) { + Check_Type(c, T_Character); + return strchr("0123456789()+-*/%<>=:&.", CHAR(c)) ? True : False; +} + +void init_expr(void) { + char *p; + + for (p = SCALE_INDICATORS; *p; p++) + scale_factor[(int)*p] = scale_divisor[(int)*p] = 1; + Define_Primitive(p_set_scaling, "set-scaling!", 3, 3, EVAL); + Define_Primitive(p_get_scaling, "get-scaling", 1, 1, EVAL); + Define_Primitive(p_parse_expression, "parse-expression", 3, 3, EVAL); + Define_Primitive(p_parse_expression_rest, + "parse-expression-rest", 3, 3, EVAL); + Define_Primitive(p_char_expression_delimiter, + "char-expression-delimiter?", 1, 1, EVAL); +} diff --git a/src/expr.h b/src/expr.h new file mode 100644 index 0000000..2df81d4 --- /dev/null +++ b/src/expr.h @@ -0,0 +1,4 @@ +/* $Revision: 1.1 $ + */ + +void init_expr(void); diff --git a/src/gcroot.c b/src/gcroot.c new file mode 100644 index 0000000..15cd1c5 --- /dev/null +++ b/src/gcroot.c @@ -0,0 +1,58 @@ +/* $Revision: 1.5 $ + */ + +#include "unroff.h" + +/* Functions to register Scheme objects in a vector that has been added + * to the GC root set to avoid having to deal with weak pointers. + * Code using these functions works with indexes into the vector. + * + * register_object(obj) -- registers an object and returns index + * deregister_object(inx) -- deregisters object specified by index + * get_object(inx) -- returns object specified by index + */ + +static int max_objects = 32; /* initial size */ +static int num_objects; +static Object objects; +static int inx; + +int register_object(Object x) { + Object v; + int n; + GC_Node; + + if (num_objects == max_objects) { + max_objects *= 2; + GC_Link(x); + v = Make_Vector(max_objects, Null); + GC_Unlink; + memcpy(VECTOR(v)->data, VECTOR(objects)->data, + num_objects * sizeof(Object)); + objects = v; + inx = num_objects; + } + for (n = 0; !Nullp(VECTOR(objects)->data[inx]); + inx++, inx %= max_objects) { + n++; + assert(n < max_objects); + } + VECTOR(objects)->data[inx] = x; + num_objects++; + return inx; +} + +void deregister_object(int i) { + VECTOR(objects)->data[i] = Null; + --num_objects; + assert(num_objects >= 0); +} + +Object get_object(int i) { + return VECTOR(objects)->data[i]; +} + +void init_gcroot(void) { + objects = Make_Vector(max_objects, Null); + Global_GC_Link(objects); +} diff --git a/src/gcroot.h b/src/gcroot.h new file mode 100644 index 0000000..3f8cb7e --- /dev/null +++ b/src/gcroot.h @@ -0,0 +1,7 @@ +/* $Revision: 1.1 $ + */ + +int register_object(Object); +void deregister_object(int); +Object get_object(int); +void init_gcroot(void); diff --git a/src/insert.c b/src/insert.c new file mode 100644 index 0000000..6acf32b --- /dev/null +++ b/src/insert.c @@ -0,0 +1,127 @@ +/* $Revision: 1.6 $ + */ + +/* The implementation of the Scheme primitive `file-insertions'. + */ + +#include +#include +#include +#include + +#include "unroff.h" + +static int cmp(const void *p1, const void *p2) { + struct S_String *s1, *s2; + Object o1, o2; + int tmp; + + o1 = *(Object *)p1, s1 = STRING(Car(o1)); + o2 = *(Object *)p2, s2 = STRING(Car(o2)); + if ((tmp = memcmp(s1->data, s2->data, + s1->size < s2->size ? s1->size : s2->size)) == 0) + if (s1->size == s2->size) + return Get_Integer(Car(Cdr(o1))) - Get_Integer(Car(Cdr(o2))); + else + return s1->size - s2->size; + return tmp; +} + +#define Finish_File {\ + if (fromfn) {\ + copy_rest(from, to, fromfn, tofn);\ + close(from);\ + close(to);\ + if (rename(tofn, fromfn) == -1) {\ + Saved_Errno = errno;\ + Primitive_Error("cannot rename ~s to ~s: ~E", tofn, fromfn);\ + }\ + free(tofn);\ + }\ +} + +static void copy(int from, int to, char *fromfn, char *tofn, + int len, int off) { + char buf[8192]; + int n; + + while (len > 0) { + if ((n = read(from, buf, len > 8192 ? 8192 : len)) == -1) + read_error(fromfn); + if (n == 0) + fatal_error("file `%s' too short for insertion at offset %d", + fromfn, off); + if (write(to, buf, n) != n) + write_error(tofn); + len -= n; + } +} + +static void copy_rest(int from, int to, char *fromfn, char *tofn) { + char buf[8192]; + int n; + + while ((n = read(from, buf, 8192)) > 0) + if (write(to, buf, n) != n) + write_error(tofn); + if (n == -1) + read_error(fromfn); +} + +static Object p_file_insertions(Object spec) { + Object v, x; + int i, t, from = 0, to = 0; /* make gcc -Wuninitialized happy */ + char *currfn, *fromfn, *tofn = 0; /* ditto */ + struct stat st; + int off = 0, nextoff; /* ditto for `off' */ + struct S_String *ins; + + v = P_List_To_Vector(spec); + for (i = VECTOR(v)->size; --i >= 0; ) { + x = VECTOR(v)->data[i]; + Check_List(x); + if (Fast_Length(x) < 3 || TYPE(Car(x)) != T_String || + ((t = TYPE(Car(Cdr(x)))) != T_Fixnum && t != T_Bignum) || + TYPE(Car(Cdr(Cdr(x)))) != T_String) + Primitive_Error("invalid file insertion specification"); + } + qsort(VECTOR(v)->data, VECTOR(v)->size, sizeof(Object), cmp); + for (fromfn = 0, i = 0; i < VECTOR(v)->size; i++) { + x = VECTOR(v)->data[i]; + currfn = Get_String(Car(x)); + if (!fromfn || strcmp(fromfn, currfn) != 0) { + Finish_File; + fromfn = currfn; + if ((from = open(fromfn, O_RDONLY)) == -1) + open_error(fromfn); + (void)fstat(from, &st); + if (st.st_nlink > 1) { + warn("links to `%s' exist; insertion skipped", fromfn); + close(from); + fromfn = 0; + continue; + } + tofn = safe_malloc(strlen(fromfn) + 1 + 4); + sprintf(tofn, "%s.new", fromfn); + if ((to = open(tofn, O_WRONLY|O_CREAT|O_TRUNC, st.st_mode)) == -1) + open_error(tofn); + off = 0; + } + x = Cdr(x); + nextoff = Get_Integer(Car(x)); + if (nextoff < 0) + Primitive_Error("invalid insertion offset ~a", Car(x)); + x = Cdr(x); + ins = STRING(Car(x)); + copy(from, to, fromfn, tofn, nextoff-off, nextoff); + if (write(to, ins->data, ins->size) != ins->size) + write_error(tofn); + off = nextoff; + } + Finish_File; + return Void; +} + +void init_insert(void) { + Define_Primitive(p_file_insertions, "file-insertions", 1, 1, EVAL); +} diff --git a/src/insert.h b/src/insert.h new file mode 100644 index 0000000..775b76f --- /dev/null +++ b/src/insert.h @@ -0,0 +1,4 @@ +/* $Revision: 1.1 $ + */ + +void init_insert(void); diff --git a/src/malloc.c b/src/malloc.c new file mode 100644 index 0000000..7bbc888 --- /dev/null +++ b/src/malloc.c @@ -0,0 +1,37 @@ +/* $Revision: 1.1 $ + */ + +#include "unroff.h" + +static void (*err_handler)(char *, size_t); +static void default_err_handler(char *, size_t); + +void *safe_malloc(size_t n) { + void *p; + + if ((p = malloc(n)) == 0) { + (err_handler ? err_handler : default_err_handler)("malloc", n); + exit(1); + } + return p; +} + +void *safe_realloc(void *old, size_t n) { + void *p; + + if ((p = realloc(old, n)) == 0) { + (err_handler ? err_handler : default_err_handler)("realloc", n); + exit(1); + } + return p; +} + +void set_alloc_failure(void (*func)(char *, size_t)) { + err_handler = func; +} + +static void default_err_handler(char *what, size_t n) { + fatal_error("cannot %s %lu bytes--virtual memory exhausted", + what, (unsigned long)n); +} + diff --git a/src/malloc.h b/src/malloc.h new file mode 100644 index 0000000..719ad37 --- /dev/null +++ b/src/malloc.h @@ -0,0 +1,7 @@ +/* $Revision: 1.1 $ + */ + +void *safe_malloc(size_t); +void *safe_realloc(void *, size_t); + +void set_alloc_failure(void (*)(char *, size_t)); diff --git a/src/parse.c b/src/parse.c new file mode 100644 index 0000000..0cbb186 --- /dev/null +++ b/src/parse.c @@ -0,0 +1,526 @@ +/* $Revision: 1.21 $ + */ + +/* The troff parser. Most of the troff-specific code is in this file + */ + +#include "unroff.h" + +extern int compatible; + +char escape = '\\'; +char eqn_delim1, eqn_delim2; +static char control = '.'; +static char control_nobreak = '\''; +static unsigned char argspec[256]; +static char *sentence_end = ".?!"; + + +/* Styles of escape char arguments: + */ +#define ARG_QUOTED 2 /* \h'xxx', \h|xxx|, ... */ +#define ARG_SYMBOL 4 /* \fx \f(xx \f[xxx] */ +#define ARG_SIZE 6 /* \sx \s(xx \s[xxx] \sdd */ +#define ARG_CHAR 8 /* \zx \z\x \z\(xx \z\[xxx] */ +#define ARG_LINE 16 /* \" */ +#define ARG_SIGN 1 /* optional sign: \s */ + + +/* parse_char() return values: + */ +#define TOK_CHAR 1 +#define TOK_ESC 2 + + +#define skip(c) {\ + for ( ; p < ep && *p != c; p++)\ + ;\ + if (p == ep) {\ + warn("missing closing `%s' delimiter", printable_char(c)); return 0;\ + }\ +} + +#define check_name(c) if (c) {\ + warn("missing escape name"); return 0;\ +} + +#define check_arg(c) if (c) {\ + warn("missing escape sequence argument"); return 0;\ +} + +#define check_empty(c) if (c) {\ + warn("empty `[xxx]' sequence"); return 0;\ +} + +#define is_request(p) \ + ((p)->size > 0 && ((p)->data[0] == control ||\ + (p)->data[0] == control_nobreak ||\ + (p)->data[0] == '.')) + + +/* Deals with \" \* \n. Returns 0 on error, 1 otherwise. + */ +int parse_expand(Buffer *ip, Buffer *op) { + char sign, *p, *ep, *q, *s, *ret; + int len, size_ret, nl, ev, fallback; + Object str; + + buffer_clear(op); + for (p = ip->data, ep = p + ip->size; p < ep; ) { + if (*p == escape && ++p < ep) { + switch (*p) { + case '"': + len = ep-p-1; + nl = p[len] == '\n'; + args_clear(); + args_add(Make_Char('"')); + args_add(Make_String(p+1, len)); + ret = event_exec(EV_ESCAPE, "\"", 1, &size_ret, 1); + if (ret) + buffer_puts(op, ret, size_ret); + else if (nl) + buffer_putc(op, '\n'); + p = ep; + break; + case 'n': + case '*': + s = p++; + check_name(p == ep); + if (*s == 'n' && (*p == '+' || *p == '-')) { + sign = *p++; + } else sign = 0; + check_name(p == ep); + switch (*p) { + case '(': + if ((q = ++p) > ep-2) { + warn("escape name truncated"); return 0; + } + len = 2; + p += 2; + break; + case '[': + if (!compatible) { + q = ++p; + skip(']'); + check_empty(p == q); + len = p++ - q; + break; + } + default: + check_name((q = p++) == ep); + len = 1; + break; + } + str = Make_String(q, len); + ev = *s == 'n' ? EV_NUMREG : EV_STRING; + fallback = event_lookup(EV_ESCAPE, s, 1) && + !event_lookup(ev, q, len); + args_clear(); + if (fallback) + args_add(Make_Char(*s)); + args_add(str); + if (sign) + args_add(Make_Char(sign)); + if (fallback) + ret = event_exec(EV_ESCAPE, s, 1, &size_ret, 1); + else + ret = event_exec(ev, q, len, &size_ret, 1); + if (ret) + buffer_puts(op, ret, size_ret); + else + buffer_puts(op, s-1, p-s+1); + break; + default: + buffer_putc(op, escape); + buffer_putc(op, *p); + p++; + break; + } + } else if (isspace(UCHAR(*p))) { /* kill space before comment */ + for (s = p+1; s < ep-1 && isspace(UCHAR(*s)); s++) + ; + if (s < ep-1 && *s == escape && s[1] == '"') + p = s; + else buffer_putc(op, *p++); + } else buffer_putc(op, *p++); + } + return 1; +} + +static int parse_char(char **pp, char *ep, Buffer *op, + int doescape, int doexec, int copymode) { + char sign, *p, *s, *ret; + char *q = 0; /* make gcc -Wuninitialized happy */ + int size_ret, tok = 0, len = 0, nl = 0; /* ditto */ + unsigned char spec; + + p = *pp; + if (*p == escape && doescape && p < ep-1) { + if (copymode) { + if (p[1] != '$') { + if (doexec && p[1] != '.' && p[1] != '\\') + buffer_putc(op, *p); + if (doexec) + buffer_putc(op, p[1]); + *pp = p+2; + return TOK_CHAR; + } + } + switch (*++p) { + case '(': + if (++p > ep-2) { + warn("special character truncated"); return 0; + } + if (doexec) { + args_clear(); + args_add(Make_String(p, 2)); + if ((ret = event_exec_fallback(EV_SPECIAL, p, 2, + &size_ret)) == 0) + buffer_puts(op, p-2, 4); + else + buffer_puts(op, ret, size_ret); + } + *pp = p+2; + return TOK_CHAR; + case '[': + if (!compatible) { + q = ++p; + skip(']'); + check_empty(p == q); + if (doexec) { + args_clear(); + args_add(Make_String(q, p-q)); + if ((ret = event_exec_fallback(EV_SPECIAL, q, p-q, + &size_ret)) == 0) + buffer_puts(op, q-2, p-q+3); + else + buffer_puts(op, ret, size_ret); + } + *pp = p+1; + return TOK_CHAR; + } + default: + spec = argspec[(unsigned char)*p]; + s = p++; + if (spec & ARG_SIGN && p < ep && (*p == '+' || *p == '-')) { + sign = *p++; + } else sign = 0; + switch (spec &= ~ARG_SIGN) { + case ARG_SYMBOL: + case ARG_SIZE: + check_arg(p == ep); + switch (*p) { + case '(': + if ((q = ++p) > ep-2) { + warn("escape sequence argument truncated"); + return 0; + } + len = 2; + p += 2; + break; + case '[': + if (!compatible) { + q = ++p; + skip(']'); + check_empty(p == q); + len = p++ - q; + break; + } + default: + check_arg((q = p++) == ep); + len = 1; + if (spec == ARG_SIZE && q < ep-1 && *q > '0' && *q < '4' + && isdigit(UCHAR(*p))) { + len++, p++; + } + break; + } + break; + case ARG_CHAR: + check_arg((q = p) == ep); + if (parse_char(&p, ep, op, doescape, 0, copymode) == 0) + return 0; + len = p - q; + break; + case ARG_LINE: + q = p; + p = ep; + len = ep - q; + nl = ep[-1] == '\n'; + break; + case ARG_QUOTED: + if ((q = p++) >= ep) { + warn("missing opening delimiter"); return 0; + } + if (p == ep) { +undelim: warn("missing closing `%s' delimiter", printable_char(*q)); + return 0; + } + + while ((tok = parse_char(&p, ep, op, doescape, 0, copymode)) + != 0) { + if (tok == TOK_CHAR && p[-1] == *q) + break; + if (p == ep) + goto undelim; + } + if (tok == 0) + return 0; + len = p - ++q - 1; + break; + } + if (doexec) { + args_clear(); + args_add(Make_Char(*s)); + if (spec) { + args_add(Make_String(q, len)); + if (sign) + args_add(Make_Char(sign)); + } + ret = event_exec_fallback(EV_ESCAPE, s, 1, &size_ret); + if (ret) + buffer_puts(op, ret, size_ret); + else if (spec & ARG_LINE) { + if (nl) buffer_putc(op, '\n'); + } else + buffer_puts(op, s-1, p-s+1); + } + *pp = p; + return TOK_ESC; + } + } else if (doexec && doescape && !copymode && + eqn_delim1 && *p == eqn_delim1) { + s = ++p; + for ( ; p < ep && *p != eqn_delim2; p++) + ; + if (p == ep) { + warn("non-terminated inline equation"); + return 0; + } + args_clear(); + args_add(Make_String(s, p-s)); + ret = event_exec(EV_EQUATION, 0, 0, &size_ret, 0); + if (ret) + buffer_puts(op, ret, size_ret); + else + buffer_puts(op, s-1, p-s+2); + *pp = p+1; + return TOK_ESC; + } else if (doexec && !copymode && event_lookup(EV_CHAR, p, 1)) { + args_clear(); + args_add(Make_Char(*p)); + ret = event_exec(EV_CHAR, p, 1, &size_ret, 0); + if (ret) + buffer_puts(op, ret, size_ret); + else + buffer_putc(op, *p); + *pp = p+1; + return TOK_CHAR; + } else { + if (doexec) + buffer_putc(op, *p); + *pp = p+1; + return TOK_CHAR; + } +} + +/* Deals with \( \[ \x and chardefs. Returns 0 on error, 1 otherwise. + */ +int parse_escape(Buffer *ip, Buffer *op, int doescape, int copymode) { + char *p, *ep; + + buffer_clear(op); + p = ip->data; + ep = p + ip->size; + while (p < ep && parse_char(&p, ep, op, doescape, 1, copymode) != 0) + ; + return p != 0; +} + +static int parse_request(Buffer *ip, Buffer *op) { + char *p, *q, *t, *ep, *ret, *start; + int reqlen, quote, len, size_ret; + int num, macro, minargs = 0, maxargs = 0; + Elem *event; + Object obj; + + assert(ip->size > 0); + p = ip->data+1; + ep = ip->data+ip->size; + for ( ; p < ep && (*p == ' ' || *p == '\t'); p++) + ; + + start = p; + for ( ; p < ep && !isspace(UCHAR(*p)); p++) + if (compatible && p == start+2) + break; + if ((reqlen = p - start) == 0) /* just a period */ + return 0; + + if ((event = event_lookup(EV_MACRO, start, reqlen)) != 0) { + macro = 1; + } else if ((event = event_lookup(EV_REQUEST, start, reqlen)) != 0) { + macro = 0; + obj = get_object(event->obj); + /* + * The following three lines prevent what I believe is an optimizer + * bug under OSF/1. `obj' is invalid unless it is passed to an + * (arbitrary) function before entering the if-statement. + */ +#ifdef __osf__ + (void)P_Not(obj); /* any function... */ +#endif + if (TYPE(obj) == T_Compound) { + if ((maxargs = COMPOUND(obj)->max_args - 1) < 0) + maxargs = INT_MAX; + minargs = COMPOUND(obj)->min_args; + } + } else { + warn("no event value for request or macro `%s'", + printable_string(start, reqlen)); + return 0; + } + + args_clear(); + args_add(Make_String(start, reqlen)); + for (num = 1; ; num++) { + for ( ; p < ep && isspace(UCHAR(*p)); p++) + ; + if (p >= ep) + break; + if (macro && *p == '"') { + quote = 1; + p++; + } else quote = 0; + q = t = p; + while (1) { + if (p == ep || *p == '\n') { + /* If quote==1, a closing delimiter is missing. This is + * not regarded as an error in troff. + */ + break; + } + if (!quote && isspace(UCHAR(*p)) && (macro || num < maxargs)) + break; + if (quote && *p == '"') { + if (p < ep-1 && p[1] == '"') /* turn "" into " */ + p++; + else + break; + } + if (*p == escape && p < ep-1) { + if (p[1] != '\\') + *t++ = *p; + p++; + } + *t++ = *p++; + } + p++; + len = t-q; + args_add(Make_String(q, len)); + } + if (!macro) + while (num++ < minargs) + args_add(Make_String("", 0)); + ret = event_exec(macro ? EV_MACRO : EV_REQUEST, start, reqlen, + &size_ret, 1); + if (ret) { + buffer_clear(op); + buffer_puts(op, ret, size_ret); + } + return ret != 0; +} + +static int is_sentence_end(Buffer *bp) { + int len = bp->size; + + return len > 1 && bp->data[len-1] == '\n' && + strchr(sentence_end, bp->data[len-2]); +} + +static void exec_sentence_end(Buffer *bp) { + int size_ret; + char *ret; + + args_clear(); + args_add(Make_Char(bp->data[bp->size-2])); + if ((ret = event_exec(EV_SENTENCE, 0, 0, &size_ret, 0)) != 0) { + bp->size -= 2; + buffer_puts(bp, ret, size_ret); + } +} + +static void exec_line(Buffer *bp) { + args_clear(); + if (bp->size > 0) + args_add(Make_Char(bp->data[bp->size-1])); + else + args_add(False); + events_vec_exec(EV_LINE); +} + +void parse_line(Buffer *ip, Buffer *op) { + int do_sentence_end; + + if (is_request(ip)) { + if (!parse_request(ip, op)) + return; + if (op->size == 0) /* it's not considered an input line */ + return; + do_sentence_end = 1; + } else { + do_sentence_end = is_sentence_end(ip); + if (!parse_escape(ip, op, 1, 0)) + return; + } + if (do_sentence_end && is_sentence_end(op)) + exec_sentence_end(op); + safe_write(op->data, op->size); + exec_line(op); +} + +void parse_input(void) { + int eof_seen; + Buffer *b1, *b2; + + b1 = buffer_new(0); + b2 = buffer_new(0); + do { + buffer_clear(b1); + if ((eof_seen = safe_readline(b1)) && b1->size == 0) + break; + if (parse_expand(b1, b2)) + parse_line(b2, b1); + } while (!eof_seen); + buffer_delete(b1); + buffer_delete(b2); +} + +void init_parse(void) { + argspec['b'] = ARG_QUOTED; + argspec['c'] = ARG_CHAR; + argspec['f'] = ARG_SYMBOL; + argspec['h'] = ARG_QUOTED; + argspec['k'] = ARG_SYMBOL; + argspec['l'] = ARG_QUOTED; + argspec['n'] = ARG_SYMBOL|ARG_SIGN; + argspec['o'] = ARG_QUOTED; + argspec['s'] = ARG_SIZE|ARG_SIGN; + argspec['v'] = ARG_QUOTED; + argspec['w'] = ARG_QUOTED; + argspec['x'] = ARG_QUOTED; + argspec['z'] = ARG_CHAR; + argspec['*'] = ARG_SYMBOL; + argspec['$'] = ARG_SYMBOL; + argspec['"'] = ARG_LINE; + if (!compatible) { + argspec['A'] = ARG_QUOTED; + argspec['C'] = ARG_QUOTED; + argspec['L'] = ARG_QUOTED; + argspec['N'] = ARG_QUOTED; + argspec['R'] = ARG_QUOTED; + argspec['V'] = ARG_SYMBOL; + argspec['Y'] = ARG_SYMBOL; + argspec['Z'] = ARG_QUOTED; + } +} diff --git a/src/parse.h b/src/parse.h new file mode 100644 index 0000000..3bafd47 --- /dev/null +++ b/src/parse.h @@ -0,0 +1,11 @@ +/* $Revision: 1.8 $ + */ + +extern char escape; +extern char eqn_delim1, eqn_delim2; + +int parse_expand(Buffer *, Buffer *); +int parse_escape(Buffer *, Buffer *, int, int); +void parse_line(Buffer *, Buffer *); +void parse_input(void); +void init_parse(void); diff --git a/src/prim.c b/src/prim.c new file mode 100644 index 0000000..917d49f --- /dev/null +++ b/src/prim.c @@ -0,0 +1,382 @@ +/* $Revision: 1.19 $ + */ + +/* The implementation of those Scheme primitives that do not deal with + * events, tables, streams, expressions, substitutions, and file + * insertions. + */ + +#include "unroff.h" + +static Object error_port; + +static Object p_error_port(void) { + return error_port; +} + +static Object p_read_line_expand(void) { + Buffer *ip, *op; + Object ret; + + ip = buffer_new(0); + op = buffer_new(0); + if (safe_readline(ip) && ip->size == 0) { + ret = Eof; + } else { + (void)parse_expand(ip, op); + ret = Make_String(op->data, op->size); + } + buffer_delete(ip); + buffer_delete(op); + return ret; +} + +static Object p_read_line(void) { + Buffer *ip; + Object ret; + + ip = buffer_new(0); + if (safe_readline(ip) && ip->size == 0) { + ret = Eof; + } else + ret = Make_String(ip->data, ip->size); + buffer_delete(ip); + return ret; +} + +static Object primitive_parse(int ac, Object *av, int what) { + Buffer *ip, *op; + Object ret; + + ip = buffer_new(0); + op = buffer_new(0); + while (ac-- > 0) { + Object x = *av++; + switch (TYPE(x)) { + case T_Character: + buffer_putc(ip, CHAR(x)); + break; + case T_Symbol: + x = SYMBOL(x)->name; /* fall through */ + case T_String: + buffer_puts(ip, STRING(x)->data, STRING(x)->size); + break; + default: + Primitive_Error("cannot coerce argument to string"); + } + } + switch (what) { + case 'c': parse_escape(ip, op, 1, 1); break; + case 'p': parse_escape(ip, op, 1, 0); break; + case 't': parse_escape(ip, op, 0, 0); break; + case 'l': parse_line(ip, op); break; + case 'e': parse_expand(ip, op); break; + } + ret = what == 'l' ? Void : Make_String(op->data, op->size); + buffer_delete(ip); + buffer_delete(op); + return ret; +} + +static Object p_parse(int ac, Object *av) { + return primitive_parse(ac, av, 'p'); +} + +static Object p_translate(int ac, Object *av) { + return primitive_parse(ac, av, 't'); +} + +static Object p_parse_line(int ac, Object *av) { + return primitive_parse(ac, av, 'l'); +} + +static Object p_parse_copy_mode(int ac, Object *av) { + return primitive_parse(ac, av, 'c'); +} + +static Object p_parse_expand(int ac, Object *av) { + return primitive_parse(ac, av, 'e'); +} + +static Object concat(int ac, Object *av, int spread) { + Buffer *op; + Object ret; + + op = buffer_new(0); + while (ac-- > 0) { + Object x = *av++; + switch (TYPE(x)) { + case T_Character: + buffer_putc(op, CHAR(x)); + break; + case T_Symbol: + x = SYMBOL(x)->name; /* fall through */ + case T_String: + buffer_puts(op, STRING(x)->data, STRING(x)->size); + break; + default: + Primitive_Error("cannot coerce argument to string"); + } + if (spread && ac > 0) + buffer_putc(op, ' ') + } + ret = Make_String(op->data, op->size); + buffer_delete(op); + return ret; +} + +static Object p_concat(int ac, Object *av) { + return concat(ac, av, 0); +} + +static Object p_spread(int ac, Object *av) { + return concat(ac, av, 1); +} + +static Object p_emit(int ac, Object *av) { + while (ac-- > 0) { + Object x = *av++; + switch (TYPE(x)) { + case T_Character: + safe_write_char(CHAR(x)); + break; + case T_Symbol: + x = SYMBOL(x)->name; /* fall through */ + case T_String: + safe_write(STRING(x)->data, STRING(x)->size); + break; + default: + Primitive_Error("cannot coerce argument to string"); + } + } + return Void; +} + +static Object p_shell_command(Object cmd) { + return Make_Integer(system(Get_Strsym(cmd))); +} + +static Object p_remove_file(Object fn) { + char *s = Get_Strsym(fn); + + if (remove(s)) warn("cannot remove file `%s'", s); + return Void; +} + +static Object p_parse_pair(Object x) { + char *p, *ep, *s1, *s2, delim; + Object str, ret; + GC_Node3; + + str = ret = False; + GC_Link3(x, str, ret); + Check_Type(x, T_String); + p = STRING(x)->data; + ep = p + STRING(x)->size; + if (p <= ep-3) { + delim = *p++; + for (s1 = p; p < ep && *p != delim; p++) + ; + if (p < ep) { + for (s2 = ++p; p < ep && *p != delim; p++) + ; + if (p == ep-1) { + str = Make_String(s1, s2-s1-1); + ret = Cons(str, Null); + str = Make_String(s2, p-s2); + Cdr(ret) = str; + } + } + } + GC_Unlink; + return ret; +} + +static Object p_parse_triple(Object x) { + char *p, *ep, *s1, *s2, *s3, delim; + Object str, ret; + GC_Node3; + + str = ret = False; + GC_Link3(x, str, ret); + Check_Type(x, T_String); + p = STRING(x)->data; + ep = p + STRING(x)->size; + if (p <= ep-4) { + delim = *p++; + for (s1 = p; p < ep && *p != delim; p++) + ; + if (p < ep) { + for (s2 = ++p; p < ep && *p != delim; p++) + ; + if (p < ep) { + for (s3 = ++p; p < ep && *p != delim; p++) + ; + if (p == ep-1) { + str = Make_String(s3, p-s3); + ret = Cons(Null, str); + str = Make_String(s2, s3-s2-1); + Car(ret) = str; + ret = Cons(Null, ret); + str = Make_String(s1, s2-s1-1); + Car(ret) = str; + } + } + } + } + GC_Unlink; + return ret; +} + +static Object p_skip_group(void) { + Buffer *ip; + int level = 0; + char *p, *ep; + + ip = buffer_new(0); + do { + if (safe_readline(ip) && ip->size == 0) { + warn("end-of-scream while skipping requests"); + break; + } + for (p = ip->data, ep = p + ip->size; p < ep-2; p++) + if (*p == escape) + if (*++p == '{') level++; + else if (*p == '}') level--; + buffer_clear(ip); + } while (level > 0); + buffer_delete(ip); + return Void; +} + +static Object p_set_escape(Object c) { + Check_Type(c, T_Character); + escape = CHAR(c); + return Void; +} + +static Object p_troff_compatible(void) { + extern int compatible; + return compatible ? True : False; +} + +static Object p_string_prune_left(Object str, Object pref, Object fail) { + int l1, l2; + + Check_Type(str, T_String); + Check_Type(pref, T_String); + l1 = STRING(str)->size, l2 = STRING(pref)->size; + if (l2 <= l1 && memcmp(STRING(str)->data, STRING(pref)->data, l2) == 0) + return Make_String(STRING(str)->data+l2, l1-l2); + return fail; +} + +static Object p_string_prune_right(Object str, Object suff, Object fail) { + int l1, l2, l; + + Check_Type(str, T_String); + Check_Type(suff, T_String); + l1 = STRING(str)->size, l2 = STRING(suff)->size, l = l1-l2; + if (l >= 0 && memcmp(STRING(str)->data+l, STRING(suff)->data, l2) == 0) + return Make_String(STRING(str)->data, l); + return fail; +} + +static Object p_string_compose(Object old, Object new) { + Buffer *bp; + struct S_String *s, *t; + int i; + Object ret; + + bp = buffer_new(0); + Check_Type(old, T_String); + Check_Type(new, T_String); + s = STRING(old), t = STRING(new); + if (t->size > 0) { + switch (t->data[0]) { + case '+': + buffer_puts(bp, s->data, s->size); + buffer_puts(bp, t->data+1, t->size-1); + break; + case '-': + for (i = 0; i < s->size; i++) + if (!memchr(t->data, s->data[i], t->size)) + buffer_putc(bp, s->data[i]); + break; + default: + buffer_puts(bp, t->data, t->size); + } + } + ret = Make_String(bp->data, bp->size); + buffer_delete(bp); + return ret; +} + +static Object p_repeat_string(Object num, Object str) { + Buffer *bp; + Object ret; + int n; + + Check_Type(str, T_String); + bp = buffer_new(0); + for (n = Get_Integer(num); n > 0; n--) + buffer_puts(bp, STRING(str)->data, STRING(str)->size); + ret = Make_String(bp->data, bp->size); + buffer_delete(bp); + return ret; +} + +static Object p_filter_eqn_line(Object str) { + char *p, *q, *ep; + + Check_Type(str, T_String); + p = STRING(str)->data, ep = p + STRING(str)->size; + for ( ; p < ep && isspace(UCHAR(*p)); p++) + ; + if (p == ep) + return False; + for (q = p; p < ep && !isspace(UCHAR(*p)); p++) + ; + if (p == ep) + return True; + if (p-q == 5 && strncmp(q, "delim", 5) == 0) { + p++; + if (ep-p == 3 && strncmp(p, "off", 3) == 0) + eqn_delim1 = 0; + else if (ep-p >= 2) + eqn_delim1 = *p, eqn_delim2 = p[1]; + return False; + } + return p-q == 6 && strncmp(q, "define", 6) == 0 ? False : True; +} + +void init_prim(void) { + error_port = Make_Port (0, stderr, Make_String ("stderr", 6)); + if (setvbuf(stderr, 0, _IOLBF, BUFSIZ) != 0) + fatal_error("cannot set stderr line buffered"); + Global_GC_Link(error_port); + Define_Primitive(p_error_port, "error-port", 0, 0, EVAL); + Define_Primitive(p_read_line, "read-line", 0, 0, EVAL); + Define_Primitive(p_read_line_expand, "read-line-expand", 0, 0, EVAL); + Define_Primitive(p_parse, "parse", 0, MANY, VARARGS); + Define_Primitive(p_parse_copy_mode, "parse-copy-mode", 0, MANY, VARARGS); + Define_Primitive(p_parse_line, "parse-line", 0, MANY, VARARGS); + Define_Primitive(p_parse_expand, "parse-expand", 0, MANY, VARARGS); + Define_Primitive(p_translate, "translate", 0, MANY, VARARGS); + Define_Primitive(p_concat, "concat", 0, MANY, VARARGS); + Define_Primitive(p_spread, "spread", 0, MANY, VARARGS); + Define_Primitive(p_emit, "emit", 0, MANY, VARARGS); + Define_Primitive(p_substitute, "substitute", 1, MANY, VARARGS); + Define_Primitive(p_shell_command, "shell-command", 1, 1, EVAL); + Define_Primitive(p_remove_file, "remove-file", 1, 1, EVAL); + Define_Primitive(p_parse_pair, "parse-pair", 1, 1, EVAL); + Define_Primitive(p_parse_triple, "parse-triple", 1, 1, EVAL); + Define_Primitive(p_skip_group, "skip-group", 0, 0, EVAL); + Define_Primitive(p_set_escape, "set-escape!", 1, 1, EVAL); + Define_Primitive(p_troff_compatible, "troff-compatible?", 0, 0, EVAL); + Define_Primitive(p_string_prune_left, "string-prune-left", 3, 3, EVAL); + Define_Primitive(p_string_prune_right,"string-prune-right", 3, 3, EVAL); + Define_Primitive(p_string_compose, "string-compose", 2, 2, EVAL); + Define_Primitive(p_repeat_string, "repeat-string", 2, 2, EVAL); + Define_Primitive(p_filter_eqn_line, "filter-eqn-line", 1, 1, EVAL); +} diff --git a/src/prim.h b/src/prim.h new file mode 100644 index 0000000..4168d89 --- /dev/null +++ b/src/prim.h @@ -0,0 +1,4 @@ +/* $Revision: 1.1 $ + */ + +void init_prim(void); diff --git a/src/scmtable.c b/src/scmtable.c new file mode 100644 index 0000000..4cef379 --- /dev/null +++ b/src/scmtable.c @@ -0,0 +1,105 @@ +/* $Revision: 1.3 $ + */ + +/* The implementation of the Scheme type `table' and the primitives + * that work on tables. This file is basically an additional layer + * on top of the code in table.c. + */ + +#include "unroff.h" + +#define TABLE(x) ((struct s_table *)POINTER(x)) + +struct s_table { + Object tag; + Table *t; +}; + +static int T_Table; + +static Object p_tablep(Object x) { + return TYPE(x) == T_Table ? True : False; +} + +static int table_equal(Object t1, Object t2) { + return EQ(t1, t2); +} + +static int table_print(Object x, Object port, int raw, int depth, + int length) { + Printf(port, "#[table %lu]", TABLE(x)->t); + return 0; +} + +static Object terminate_table(Object x) { + table_delete(TABLE(x)->t); + return Void; +} + +static Object p_make_table(Object size) { + Object t; + int s; + + if ((s = Get_Integer(size)) <= 0) + Range_Error(size); + t = Alloc_Object(sizeof(struct s_table), T_Table, 0); + TABLE(t)->tag = Null; + TABLE(t)->t = table_new(s); + Register_Object(t, (GENERIC)0, terminate_table, 0); + return t; +} + +static Object table_op(int op, Object t, Object key, Object val) { + Elem *p; + Object ret = Void; + char *data; + int size; + Table *tp; + + Check_Type(t, T_Table); + tp = TABLE(t)->t; + if (TYPE(key) == T_Symbol) + key = SYMBOL(key)->name; + else if (TYPE(key) != T_String) + Wrong_Type_Combination(key, "string or symbol"); + data = STRING(key)->data; + size = STRING(key)->size; + if (size == 0) + Primitive_Error("key must be of non-zero length"); + switch(op) { + case 's': + table_store(tp, data, size, val, 0); + break; + case 'r': + table_remove(tp, data, size); + break; + case 'l': + if ((p = table_lookup(tp, data, size)) == 0) + ret = False; + else + ret = get_object(p->obj); + } + return ret; +} + +static Object p_table_store(Object t, Object key, Object val) { + return table_op('s', t, key, val); +} + +static Object p_table_remove(Object t, Object key) { + return table_op('r', t, key, Null); +} + +static Object p_table_lookup(Object t, Object key) { + return table_op('l', t, key, Null); +} + +void init_scmtable(void) { + T_Table = Define_Type(0, "table", NOFUNC, sizeof(struct s_table), + table_equal, table_equal, table_print, NOFUNC); + Define_Primitive(p_tablep, "table?", 1, 1, EVAL); + Define_Primitive(p_make_table, "make-table", 1, 1, EVAL); + Define_Primitive(p_table_store, "table-store!", 3, 3, EVAL); + Define_Primitive(p_table_remove, "table-remove!", 2, 2, EVAL); + Define_Primitive(p_table_lookup, "table-lookup", 2, 2, EVAL); +} diff --git a/src/scmtable.h b/src/scmtable.h new file mode 100644 index 0000000..d293cd6 --- /dev/null +++ b/src/scmtable.h @@ -0,0 +1,4 @@ +/* $Revision: 1.1 $ + */ + +void init_scmtable(void); diff --git a/src/stream.c b/src/stream.c new file mode 100644 index 0000000..c751300 --- /dev/null +++ b/src/stream.c @@ -0,0 +1,440 @@ +/* $Revision: 1.14 $ + */ + +/* The implementation of the Scheme type `stream' and the primitives + * that work on streams. Additional functions exported by this module: + * + * istream_is_open() -- true if current input stream != #f + * ostream_is_open() -- true if current output stream != #f + * curr_istream_target() -- returns target of current input stream + * curr_istream_lno() -- returns current istream's input line number + * safe_readline(buffer) -- reads line from current istream into buffer; + * signals error if istream is not open + * safe_write_char(c) -- sends character to current ostream or to + * stdout if ostream is #f + * safe_write(data,len) -- same, but writes several characters + */ + + +#include "unroff.h" + +typedef struct _stream { + Object tag; + char open; + char type; + char direction; + char *target; + FILE *fp; + Buffer *bp; + int bs; + unsigned long lno; + unsigned long pos; + Buffer *unread; + int (*readline)(struct _stream *, Buffer *); + void (*write)(struct _stream *, char *, int); + void (*close)(struct _stream *); +} Stream; + +static Object buffers; +static Object istream, ostream; + +#define STREAM(x) ((Stream *)POINTER(x)) + +static int T_Stream; + +static Object p_streamp(Object x) { + return TYPE(x) == T_Stream ? True : False; +} + +static int stream_equal(Object s1, Object s2) { + return EQ(s1, s2); +} + +static int stream_print(Object x, Object port, int raw, int depth, + int length) { + Stream *p = STREAM(x); + + if (p->open || p->type == 'b') + Printf(port, "#[stream %s]", p->target); + else + Printf(port, "#[stream %lu]", POINTER(x)); + return 0; +} + +static Object terminate_stream(Object x) { + Stream *p = STREAM(x); + + if (p->open && !(p->type == 'b' && p->direction == 'o')) { + free(p->target); + buffer_delete(p->unread); + if (p->type != 'b') + p->close(p); + } + p->open = 0; + return Void; +} + +int istream_is_open(void) { + return Truep(istream); +} + +char *curr_istream_target(void) { + assert(Truep(istream)); + assert(STREAM(istream)->open); + return STREAM(istream)->target; +} + +unsigned long curr_istream_lno(void) { + return STREAM(istream)->lno; +} + +static int stream_is_active(Object str) { + return EQ(istream, str) || EQ(ostream, str); +} + +int safe_readline(Buffer *bp) { + Stream *str; + + if (!Truep(istream)) + Primitive_Error("no input stream defined"); + str = STREAM(istream); + if (str->unread->size > 0) { + buffer_puts(bp, str->unread->data, str->unread->size); + if (bp->data[bp->size-1] != '\n') + buffer_putc(bp, '\n'); + buffer_clear(str->unread); + return 0; + } + return str->readline(str, bp); +} + +void safe_write_char(char c) { + if (Truep(ostream)) { + STREAM(ostream)->pos++; + STREAM(ostream)->write(STREAM(ostream), &c, 1); + } else if (putc(c, stdout) == EOF) + write_error("stdout"); +} + +void safe_write(char *data, int len) { + if (len == 0) + return; + if (Truep(ostream)) { + STREAM(ostream)->pos += len; + STREAM(ostream)->write(STREAM(ostream), data, len); + } else if (fwrite(data, len, 1, stdout) == 0) + write_error("stdout"); +} + +#define is_continuation(p) \ + ((p)->size > oldsize && (p)->data[(p)->size-1] == escape &&\ + !((p)->size > oldsize+1 && (p)->data[(p)->size-2] == escape)) + +static int readline_buffer(Stream *self, Buffer *bp) { + int oldsize; + int c; + Buffer *sp = self->bp; + + assert(self->bs <= sp->size); + if (self->bs == sp->size) + return 1; + oldsize = bp->size; + while (self->bs < sp->size) { + if ((c = sp->data[self->bs++]) == '\n') { + self->lno++; + if (is_continuation(bp)) { + bp->size--; + } else { + buffer_putc(bp, c); + return 0; + } + } else buffer_putc(bp, c); + } + if (bp->size > oldsize) { + buffer_putc(bp, '\n'); + self->lno++; + } + return 1; +} + +static int readline_file(Stream *self, Buffer *bp) { + int oldsize; + int c; + + if (feof(self->fp)) + return 1; + oldsize = bp->size; + while ((c = getc(self->fp)) != EOF) { + if (c == '\n') { + self->lno++; + if (is_continuation(bp)) { + bp->size--; + } else { + buffer_putc(bp, c); + return 0; + } + } else buffer_putc(bp, c); + } + if (ferror(self->fp)) + read_error(self->target); + if (bp->size > oldsize) { + buffer_putc(bp, '\n'); + self->lno++; + } + return 1; +} + +static void write_buffer(Stream *self, char *data, int len) { + buffer_puts(self->bp, data, len); +} + +static void write_file(Stream *self, char *data, int len) { + if (fwrite(data, len, 1, self->fp) == 0) + write_error(self->target); +} + +static void close_file(Stream *self) { + (void)fclose(self->fp); +} + +static void close_pipe(Stream *self) { + (void)pclose(self->fp); +} + +static Object find_buffer(char *s) { + Object p; + + for (p = buffers; !Nullp(p); p = Cdr(p)) { + if (strcmp(STREAM(Car(p))->target, s) == 0) + return Car(p); + } + return Null; +} + +static int target_is_buffer(char *s) { + int len = strlen(s); + + return len > 1 && s[0] == '[' && s[len-1] == ']'; +} + +static Object open_stream(Object target, char direction, int append) { + char *t = Get_Strsym(target), *mode; + Stream *p; + Object ret = Null, b = Null; + GC_Node3; + + GC_Link3(target, ret, b); + if (target_is_buffer(t)) { + b = find_buffer(t); + if (!Nullp(b)) { + p = STREAM(b); + assert(p->type == 'b'); + assert(p->direction == 'o'); + if (p->open) + Primitive_Error("stream ~s is already open", b); + if (direction == 'o') { + p->open = 1; + p->lno = p->bs = 0; + if (!append) { + p->pos = 0; + buffer_clear(p->bp); + } + GC_Unlink; + return b; + } + } + } + ret = Alloc_Object(sizeof(Stream), T_Stream, 0); + p = STREAM(ret); + p->tag = Null; + p->open = 1; + p->direction = direction; + p->lno = p->pos = 0; + p->unread = buffer_new(0); + p->target = safe_malloc(strlen(t) + 1); + strcpy(p->target, t); + if (target_is_buffer(t)) { + p->readline = readline_buffer; + p->write = write_buffer; /* no close function */ + p->type = 'b'; + p->bp = buffer_new(0); + if (direction == 'o') { + buffers = Cons(ret, buffers); + } else { + p->bs = 0; + if (!Nullp(b)) + buffer_puts(p->bp, STREAM(b)->bp->data, STREAM(b)->bp->size); + } + } else { + mode = direction == 'i' ? "r" : append ? "a" : "w"; + p->readline = readline_file; + p->write = write_file; + if (t[0] == '|') { + char *s; + if ((p->fp = popen(t+1, mode)) == 0) + Primitive_Error("cannot open pipe to ~s", target); + if ((s = strchr(p->target, ' ')) != 0) + *s = 0; + p->close = close_pipe; + p->type = 'p'; + } else { + if (direction == 'i' && strcmp(t, "stdin") == 0) { + p->fp = stdin; + } else if ((p->fp = fopen(t, mode)) == 0) { + Saved_Errno = errno; + Primitive_Error("cannot open ~s: ~E", target); + } + p->close = close_file; + p->type = 'f'; + } + } + Register_Object(ret, (GENERIC)0, terminate_stream, 0); + GC_Unlink; + return ret; +} + +Object p_open_input_stream(Object target) { + return open_stream(target, 'i', 0); +} + +static Object p_open_output_stream(Object target) { + return open_stream(target, 'o', 0); +} + +static Object p_append_output_stream(Object target) { + return open_stream(target, 'o', 1); +} + +Object p_close_stream(Object x) { + if (!Truep(x)) + return Void; + Check_Type(x, T_Stream); + if (!STREAM(x)->open) + return Void; + if (stream_is_active(x)) + Primitive_Error("stream ~s is still in use", x); + return terminate_stream(x); +} + +static Object set_stream(Object x, Object *which) { + Object ret = *which; + Stream *p; + + if (Truep(*which) && STREAM(*which)->type != 'b' && + STREAM(*which)->direction == 'o') + (void)fflush(STREAM(*which)->fp); + if (Truep(x)) { + Check_Type(x, T_Stream); + p = STREAM(x); + if (!p->open) + Primitive_Error("stream ~s has been closed", x); + if (stream_is_active(x)) + Primitive_Error("stream ~s is already in use", x); + if (which == &istream && p->direction != 'i') + Primitive_Error("stream ~s is not an input stream", x); + if (which == &ostream && p->direction != 'o') + Primitive_Error("stream ~s is not an output stream", x); + *which = x; + } else { + *which = False; + } + return ret; +} + +Object p_set_input_stream(Object x) { + return set_stream(x, &istream); +} + +static Object p_set_output_stream(Object x) { + return set_stream(x, &ostream); +} + +static Object p_input_stream(void) { + return istream; +} + +static Object p_output_stream(void) { + return ostream; +} + +static Object p_unread_line(Object str) { + Check_Type(str, T_String); + if (!Truep(istream)) + Primitive_Error("no input stream defined"); + buffer_puts(STREAM(istream)->unread, STRING(str)->data, + STRING(str)->size); + return Void; +} + +#define stream_type_pred(what,t)\ + static Object p_stream_##what(Object x) {\ + if (Truep(x)) {\ + Check_Type(x, T_Stream);\ + return STREAM(x)->type == t ? True : False;\ + } else return False;\ +} +stream_type_pred(buffer, 'b') +stream_type_pred(file, 'f') +stream_type_pred(pipe, 'p') + +static Object p_stream_target(Object x) { + if (!Truep(x)) + return Make_String("", 0); + Check_Type(x, T_Stream); + return Make_String(STREAM(x)->target, strlen(STREAM(x)->target)); +} + +static Object p_stream_to_string(Object target) { + Object str, old, ret; + Stream *sp; + Buffer *bp; + + str = p_open_input_stream(target); + old = p_set_input_stream(str); + bp = buffer_new(0); + for (sp = STREAM(str); sp->readline(sp, bp) == 0; ) + ; + (void)p_set_input_stream(old); + (void)p_close_stream(str); + ret = Make_String(bp->data, bp->size); + buffer_delete(bp); + return ret; +} + +static Object p_stream_position(Object x) { + if (!Truep(x)) + return Make_Integer(0); + Check_Type(x, T_Stream); + return Make_Unsigned_Long(STREAM(x)->pos); +} + +void init_stream(void) { + istream = ostream = False; + buffers = Null; + Global_GC_Link(istream); + Global_GC_Link(ostream); + Global_GC_Link(buffers); + T_Stream = Define_Type(0, "stream", NOFUNC, sizeof(Stream), + stream_equal, stream_equal, stream_print, NOFUNC); + Define_Primitive(p_streamp, "stream?", 1, 1, EVAL); + Define_Primitive(p_open_input_stream, + "open-input-stream", 1, 1, EVAL); + Define_Primitive(p_open_output_stream, + "open-output-stream", 1, 1, EVAL); + Define_Primitive(p_append_output_stream, + "append-output-stream", 1, 1, EVAL); + Define_Primitive(p_close_stream, "close-stream", 1, 1, EVAL); + Define_Primitive(p_set_input_stream, + "set-input-stream!", 1, 1, EVAL); + Define_Primitive(p_set_output_stream, + "set-output-stream!", 1, 1, EVAL); + Define_Primitive(p_input_stream, "input-stream", 0, 0, EVAL); + Define_Primitive(p_output_stream, "output-stream", 0, 0, EVAL); + Define_Primitive(p_unread_line, "unread-line", 1, 1, EVAL); + Define_Primitive(p_stream_buffer, "stream-buffer?", 1, 1, EVAL); + Define_Primitive(p_stream_file, "stream-file?", 1, 1, EVAL); + Define_Primitive(p_stream_pipe, "stream-pipe?", 1, 1, EVAL); + Define_Primitive(p_stream_target, "stream-target", 1, 1, EVAL); + Define_Primitive(p_stream_to_string,"stream->string", 1, 1, EVAL); + Define_Primitive(p_stream_position, "stream-position", 1, 1, EVAL); +} diff --git a/src/stream.h b/src/stream.h new file mode 100644 index 0000000..dd05013 --- /dev/null +++ b/src/stream.h @@ -0,0 +1,17 @@ +/* $Revision: 1.5 $ + */ + +int istream_is_open(void); +int ostream_is_open(void); +char *curr_istream_target(void); +unsigned long curr_istream_lno(void); + +int safe_readline(Buffer *); +void safe_write_char(char); +void safe_write(char *, int); + +Object p_open_input_stream(Object); +Object p_close_stream(Object); +Object p_set_input_stream(Object); + +void init_stream(void); diff --git a/src/subst.c b/src/subst.c new file mode 100644 index 0000000..5563228 --- /dev/null +++ b/src/subst.c @@ -0,0 +1,98 @@ +/* $Revision: 1.9 $ + */ + +/* The implementation of the Scheme primitive `substitute' + */ + +#include "unroff.h" + +Object p_substitute(int ac, Object *av) { + Object str = *av; + static Buffer *fp; + char *p, *ep, *s, *t, *endp; + int len; + long a; + char buf[30]; + char *fmt; + time_t now; + extern char *macros, *format, *directory; + + Check_Type(str, T_String); + if (!fp) + fp = buffer_new(0); + buffer_clear(fp); + for (p = STRING(str)->data, ep = p + STRING(str)->size; p < ep; p++) { + if (*p == '%') { + for (s = ++p; p < ep && *p != '%'; p++) + ; + if (p == ep) + Primitive_Error("missing `%' delimiter"); + len = p-s; + t = safe_malloc(len+1); /* Make copy to add \0. C sucks... */ + memcpy(t, s, len); + t[len] = 0; + fmt = 0; + if (len == 0) + s = "%"; + else if (strcmp(t, "macros") == 0) + s = macros; + else if (strcmp(t, "format") == 0) + s = format; + else if (strcmp(t, "directory") == 0) + s = directory; + else if (strcmp(t, "progname") == 0) + s = get_progname(); + else if (strcmp(t, "filepos") == 0) { /* ` file:lno' */ + if (istream_is_open()) { + buffer_putc(fp, ' '); + buffer_puts(fp, curr_istream_target(), + strlen(curr_istream_target())); + sprintf(buf, ":%lu:", curr_istream_lno()); + s = buf; + } else s = ""; + } else if (strcmp(t, "tmpname") == 0) { + s = tmpnam(0); + } else if (strcmp(t, "version") == 0) { + sprintf(buf, "%d.%d", MAJOR_VERSION, MINOR_VERSION); + s = buf; + } else if (strcmp(t, "weekday") == 0) { + fmt = "%a"; + } else if (strcmp(t, "weekday+") == 0) { + fmt = "%A"; + } else if (strcmp(t, "weekdaynum")== 0) { + fmt = "%w"; + } else if (strcmp(t, "monthname") == 0) { + fmt = "%b"; + } else if (strcmp(t, "monthname+") == 0) { + fmt = "%B"; + } else if (strcmp(t, "day") == 0) { + fmt = "%d"; + } else if (strcmp(t, "month") == 0) { + fmt = "%m"; + } else if (strcmp(t, "year") == 0) { + fmt = "%Y"; + } else if (strcmp(t, "date") == 0) { + fmt = "%x"; + } else if (strcmp(t, "time") == 0) { + fmt = "%X"; + } else if ((a = strtol(t, &endp, 10)), endp == t+len) { + if (a < 1 || a > ac-1) + Primitive_Error("no argument for %-specifier"); + Check_Type(av[a], T_String); + buffer_puts(fp, STRING(av[a])->data, STRING(av[a])->size); + s = ""; + } else if ((s = getenv(t)) == 0) + s = ""; + if (fmt) { + now = time(0); + if (strftime(buf, sizeof buf, fmt, localtime(&now)) == 0) + s = ""; + else s = buf; + } + free(t); + buffer_puts(fp, s, strlen(s)); + } else + buffer_putc(fp, *p); + } + return Make_String(fp->data, fp->size); +} diff --git a/src/subst.h b/src/subst.h new file mode 100644 index 0000000..a20e653 --- /dev/null +++ b/src/subst.h @@ -0,0 +1,4 @@ +/* $Revision: 1.2 $ + */ + +Object p_substitute(int, Object*); diff --git a/src/table.c b/src/table.c new file mode 100644 index 0000000..ae1c0d7 --- /dev/null +++ b/src/table.c @@ -0,0 +1,101 @@ +/* $Revision: 1.8 $ + */ + +/* Simple hash tables. + * + * table_new(size) -- returns a new hash table + * table_delete(t) -- frees a table and its entries + * table_store(t,key,keylen,obj,flags) + * -- stores Scheme object and flags under key + * table_lookup(t,key,keylen) -- returns object stored under key, or 0 + * table_remove(t,key,keylen) -- removes entry stored under key + */ + + +#include "unroff.h" + +Table *table_new(int size) { + Table *p; + int i; + + assert(size > 0); + p = safe_malloc(sizeof *p); + p->data = safe_malloc(size * sizeof(Elem *)); + for (i = 0; i < size; i++) + p->data[i] = 0; + p->size = size; + return p; +} + +void table_delete(Table *tp) { + int i; + Elem *p, *q; + + for (i = 0; i < tp->size; i++) + for (p = tp->data[i]; p; p = q) { + deregister_object(p->obj); + free(p->data); + q = p->next; + free(p); + } + free(tp->data); + free(tp); +} + +/* This function ensures that no collisions can occur in tables of + * size 256^N if all keys are of length <= N (for small values of N). + */ +static unsigned long hash(char *key, int size) { + unsigned long i, j; + + assert(size > 0); + for (i = j = 0; j < size; j++) + i = i * 256 + (unsigned char)key[j]; + return i; +} + +void table_store(Table *tp, char *key, int size, Object obj, + unsigned long flags) { + int i = hash(key, size) % tp->size; + Elem *p; + + for (p = tp->data[i]; p; p = p->next) { + if (size == p->size && memcmp(key, p->data, size) == 0) break; + } + if (p) { + deregister_object(p->obj); + } else { + p = safe_malloc(sizeof *p); + p->data = safe_malloc(size); + memcpy(p->data, key, size); + p->size = size; + p->next = tp->data[i]; + tp->data[i] = p; + } + p->obj = register_object(obj); + p->flags = flags; +} + +void table_remove(Table *tp, char *key, int size) { + int i = hash(key, size) % tp->size; + Elem *p, **pp; + + for (pp = &tp->data[i]; (p = *pp); pp = &p->next ) + if (size == p->size && memcmp(key, p->data, size) == 0) break; + if (p) { + *pp = p->next; + deregister_object(p->obj); + free(p->data); + free(p); + } +} + +Elem *table_lookup(Table *tp, char *key, int size) { + int i = hash(key, size) % tp->size; + Elem *p; + + for (p = tp->data[i]; p; p = p->next) { + if (size == p->size && memcmp(key, p->data, size) == 0) return p; + } + return 0; +} diff --git a/src/table.h b/src/table.h new file mode 100644 index 0000000..1c2e5bf --- /dev/null +++ b/src/table.h @@ -0,0 +1,21 @@ +/* $Revision: 1.5 $ + */ + +typedef struct _elem { + char *data; + int size; + int obj; + unsigned long flags; + struct _elem *next; +} Elem; + +typedef struct _table { + Elem **data; + int size; +} Table; + +Table *table_new(int); +void table_delete(Table *); +void table_store(Table *, char *, int, Object, unsigned long); +void table_remove(Table *, char *, int); +Elem *table_lookup(Table *, char *, int); diff --git a/src/test.ms b/src/test.ms new file mode 100644 index 0000000..ce352e5 --- /dev/null +++ b/src/test.ms @@ -0,0 +1,44 @@ +.LP +Here comes an EQ/EN pair that just serves defining the delimiters +for inline equations (we will use the dollar sign for this purpose). +No eqn-output should not appear here, and no hypertext reference +should be generated if we are creating GIF files. +.EQ +delim $$ +.EN +.LP +Now lets typeset a real equation, again using EQ and EN. +The equation should either be displayed as preformatted text or as +an inline GIF image: +.EQ +size 18 { a+b over 2c = 1 } +.EN +Finally an inline equation such as $size 16 { sqrt a+b }$ which uses the +delimiters defined at the start of this document. +It should either be typeset in Italics or appear as a GIF image. +.LP +Now lets test tables. +Here is a simple table that uses the \f2box\fP attribute and +has two header rows, two columns, and three data rows: +.TS +box, tab(~); +c s +c | c +n n. +Price Development +_ +Year~Price +_ +1992~$1,500 +1993~2,000 +1994~12,220 +.TE +.LP +The table should either appear as preformatted text or as a GIF +image (the latter will probably turn out a bit too small). +Finally a PIC drawing: +.PS +box "foo" +arrow +box "bar" +.PE diff --git a/src/test.scm b/src/test.scm new file mode 100644 index 0000000..3ef36af --- /dev/null +++ b/src/test.scm @@ -0,0 +1,63 @@ +(define old-in (input-stream)) + +(define out (open-output-stream '/tmp/net)) +(set-output-stream! out) +(emit "Hello, ") +(set-output-stream! #f) + +(define out2 (open-output-stream '[out2])) +(set-output-stream! out2) +(close-stream out) + +(define in (open-input-stream '/tmp/net)) +(set-input-stream! in) +(emit (read-line-expand)) +(emit "world!") +(set-input-stream! #f) +(close-stream in) + +(set-output-stream! #f) +(close-stream out2) + +(define out2 (open-input-stream '[out2])) +(defchar #\newline "") +(set-input-stream! out2) +(emit (parse (read-line-expand))) +(emit (read-line-expand)) +(set-input-stream! old-in) +(close-stream out2) + +(shell-command "rm /tmp/net") + + +(define tt (make-table 1)) +(define t (make-table 100)) +(table-store! tt "table" t) +(define t (table-lookup tt 'table)) + +(table-store! t 'bye '()) +(table-remove! t 'bye) +(table-store! t 'greet "Hello,") +(table-store! t (table-lookup t 'greet) " world!\n") + +(if (and (table? t) (not (table-lookup t 'bye))) + (begin + (display (table-lookup t 'greet)) + (display (table-lookup t (table-lookup t 'greet))))) + + +(define-option-type 'hello-type + (lambda (x) (member (string-ref x 0) '(#\H #\w))) + "oops1!!" + (lambda (old new) (string->list new)) + (lambda (x) (member (car x) '(#\H #\w))) + "oops2!!") + +(define-option 'hello 'hello-type "oops3!!") + +((eventdef 'option 0) (string-compose "helxlxo" "-x") "Hello, ") +(display (list->string (option 'hello))) +(set-option! 'hello (string->list (string-compose "wo" "+rld"))) +(display (list->string (option 'hello))) +(display + (string-prune-left (concat (repeat-string 2 "!") #\newline) "!" "oops")) diff --git a/src/unroff.c b/src/unroff.c new file mode 100644 index 0000000..dce5c63 --- /dev/null +++ b/src/unroff.c @@ -0,0 +1,231 @@ +/* $Revision: 1.21 $ + */ + +#include "unroff.h" + +extern int getopt(int ac, char * const *av, const char *optstring); + +extern char *optarg; +extern int optind, opterr; + +char *macros = ""; +char *format; +char *directory; +int compatible; + +static int got_filename; +static int did_ev_start; +static int tflag; + +static void usage(void) { + fprintf(stderr, "Usage: %s [options] [file...]\n\n", get_progname()); + fprintf(stderr, " -mname name of troff macro package (e.g. -ms)\n"); + fprintf(stderr, " -fformat output format (e.h. -fhtml2)\n"); + fprintf(stderr, " -C enable nroff/troff compatibility\n"); + fprintf(stderr, " -hheapsize Scheme heap size in Kbytes\n"); + fprintf(stderr, " -t enter interactive top-level for testing\n"); + fprintf(stderr, " option=val any macro-package/format-specific option\n"); +} + +static char *filename_tail(char *fn) { + char *p = strrchr(fn, '/'); + + return p && p > fn && p[1] ? p+1 : fn; +} + +/* If the file name has the suffix .scm, load it into the interpreter. + * Else, open an input stream and assign it to the current input stream. + * Call start event procedure if necessary; trigger prolog event. + * Start the parser; when finished, trigger epilog event. + */ +static void do_input_file(char *fn) { + Object name, base, old, str; + char *p; + int len; + GC_Node4; + + len = strlen(fn); + if (len > 3 && strcmp(fn + len - 4, ".scm") == 0) { + name = Make_String(fn, strlen(fn)); + (void)P_Load(1, &name); + return; + } + if (fn[0] == '-' && fn[1] == 0) + fn = "stdin"; + name = base = old = str = Null; + GC_Link4(name, base, old, str); + name = Make_String(fn, strlen(fn)); + p = filename_tail(fn); + base = Make_String(p, strlen(p)); + str = p_open_input_stream(name); + old = p_set_input_stream(str); + if (!did_ev_start) { + args_clear(); + events_vec_exec(EV_START); + did_ev_start = 1; + } + args_clear(); + args_add(name); + args_add(base); + events_vec_exec(EV_PROLOG); + parse_input(); + args_clear(); + args_add(name); + args_add(base); + events_vec_exec(EV_EPILOG); + (void)p_set_input_stream(old); + (void)p_close_stream(str); + GC_Unlink; +} + +/* Determine whether argument is a file name or an option; trigger + * option event in the latter case. + */ +static void do_argument(char *arg) { + char *p; + + if ((p = strchr(arg, '=')) == 0) { + got_filename = 1; + if (!tflag) + do_input_file(arg); + } else { + if (p == arg) + fatal_error("empty option name"); + args_clear(); + args_add(Make_String(arg, p++ - arg)); + args_add(Make_String(p, strlen(arg) - (p - arg))); + events_vec_exec(EV_OPTION); + } +} + +/* Load scm/troff.scm. The rest is loaded from there. + */ +static void boot_code(void) { + char *fn = safe_malloc(strlen(directory) + 30); + Object arg; + + sprintf(fn, "%s/scm/troff.scm", directory); + arg = Make_String(fn, strlen(fn)); + (void)P_Load(1, &arg); + free(fn); +} + +/* Load $(HOME)/.RC_FILE, if it is there. + */ +static void load_rc_file(void) { + FILE *f; + char *home, *fn; + Object port; + GC_Node; + + if ((home = getenv("HOME")) == 0) + return; + fn = safe_malloc(strlen(home) + 30); + sprintf(fn, "%s/%s", home, RC_FILE); + if ((f = fopen(fn, "r")) != 0) { + port = Make_Port(P_INPUT, f, Make_String(fn, strlen(fn))); + GC_Link(port); + Load_Source_Port(port); + P_Close_Input_Port(port); /* does the fclose() */ + GC_Unlink; + } + free(fn); +} + +/* Load the interactive Scheme top-level. + */ +static void test_mode(void) { + Object arg; + char fn[] = TEST_TOPLEVEL; + + arg = Make_String(fn, strlen(fn)); + (void)P_Load(1, &arg); +} + +int main(int ac, char **av) { + char **eav; + int eac = 1, c; + + if (ac == 0) { + fprintf(stderr, "Oops--no argv[0]?\n"); return 1; + } + set_progname(av[0]); + if ((directory = getenv(DEFAULT_DIR_ENV)) == 0) + directory = DEFAULT_DIR; + if ((format = getenv(DEFAULT_FORMAT_ENV)) == 0) + format = DEFAULT_FORMAT; + eav = safe_malloc((ac+1+2) * sizeof(char *)); /* ac + -p xxx + 0-ptr */ + eav[0] = av[0]; + opterr = 0; + while ((c = getopt(ac, av, "h:gm:f:tC")) != EOF) { + switch (c) { + case 'g': + eav[eac++] = "-g"; break; + case 'h': + if (strcmp(optarg, "elp") == 0) { + usage(); + return 1; + } + eav[eac++] = "-h"; eav[eac++] = optarg; break; + case 'm': + macros = optarg; break; + case 'f': + format = optarg; break; + case 't': + tflag = 1; break; + case 'C': + compatible = 1; break; + case '?': + usage(); + return 1; + } + } + /* Set the Elk load-path to $(directory)/elk, so that a minimal, + * self-contained Elk runtime environment can be shipped with + * binary distributions. Sites with a full Elk can symlink + * $(directory)/elk to the real directory. + */ + eav[eac++] = "-p"; + eav[eac] = safe_malloc(strlen(directory) * 2 + 30); + sprintf(eav[eac++], ".:%s/elk/scm:%s/elk/obj", directory, directory); + eav[eac] = 0; + Elk_Init(eac, eav, 0, 0); + init_args(); + init_gcroot(); + init_insert(); + init_event(); + init_expr(); + init_parse(); + init_prim(); + init_scmtable(); + init_stream(); +#ifdef ELK_MAJOR + Set_Error_Tag("load"); +#else + Error_Tag = "load"; +#endif + boot_code(); + load_rc_file(); + if (tflag) { + while (optind < ac) + do_argument(av[optind++]); + if (got_filename) + warn("filename arguments are ignored when -t is given"); + test_mode(); + return 0; + } +#ifdef ELK_MAJOR + Set_Error_Tag("main-loop"); +#else + Error_Tag = "main-loop"; +#endif + while (optind < ac) + do_argument(av[optind++]); + if (!got_filename) + do_input_file("-"); + if (did_ev_start) { + args_clear(); + events_vec_exec(EV_EXIT); + } + return 0; +} diff --git a/src/unroff.h b/src/unroff.h new file mode 100644 index 0000000..40e6611 --- /dev/null +++ b/src/unroff.h @@ -0,0 +1,69 @@ +/* $Revision: 1.18 $ + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + + +/* Include files that may be required by gcc although they shouldn't: + */ +#include + + +/* Prototypes that may be required by cc/gcc although they shouldn't: + */ +extern time_t time(time_t *); +extern size_t strftime(char *, size_t, const char *, const struct tm *); +extern long strtol(const char *s, char **endp, int base); +extern double strtod(const char *s, char **endp); +extern int pclose(FILE *); +extern int system(const char *); +#ifndef tolower +extern int tolower(int); +#endif + +/* Prototypes for IEEE FP functions that may be missing: + */ +#ifndef finite +extern int finite(double); +#endif + + +#include "scheme.h" + +/* Prototypes that were missing from "scheme.h" in some Elk releases: + */ +extern void Elk_Init(int ac, char **av, int call_inits, char *filename); +extern void Load_Source_Port(Object); + + +/* Used for passing a `char' to a function that takes an `int' argument, + * such as isspace(). Maybe I should have used `unsigned char' rather + * than `char' in the first place... + */ +#define UCHAR(c) ((unsigned char)(c)) + + +#include "config.h" +#include "args.h" +#include "buffer.h" +#include "table.h" +#include "error.h" +#include "event.h" +#include "expr.h" +#include "gcroot.h" +#include "insert.h" +#include "malloc.h" +#include "parse.h" +#include "prim.h" +#include "scmtable.h" +#include "stream.h" +#include "subst.h"