[net.sources] VAX/VMS TPU formletter facility

gregg@okstate.UUCP (Gregg Wonderly) (01/08/87)

Below is a VAX/VMS TPU form letter facility.  It is wrapped in a DCL archive,
so you should save it to a file, and then use "@filename" to extract it.
The README file describes, somewhat, how it works.  I have included a sample
letter, and a sample command file to provide some extra information.  If
you use the command

	EDIT/TPU/COMMAND=LETTER.TPU

to envoke the facility, and then answer

	COMMANDS.DAT

to the first prompt, and

	LETTER1.DAT

to the second prompt, you should see the results.  You can then use RUNOFF
to format the letter with the command

	RUNOFF/OUT=TT: FOO.BAR

Send bugs and gripes to me....

Gregg Wonderly
Department of Computing and Information Sciences
Oklahoma State University

UUCP: {cbosgd, ea, ihnp4, isucs1, mcvax, uokvax}!okstate!gregg
ARPA:  gregg@A.CS.OKSTATE.EDU
-------------------------------------------------------------------------------
$ show default
$ write sys$output "Creating COMMANDS.DAT"
$ create COMMANDS.DAT
$ DECK/DOLLARS="*$*$*EOD*$*$*"
FILE
SUBS 1 Mr.
SUBS 2 Joe
SUBS 3 Blow
SUBS 4 123 N This place
SUBS 5 Anywhere Nearhere, 92983
SUBS 6 the Chop-Your-Head-Off collection agency
SUBS 7 back
WRITE FOO.BAR
*$*$*EOD*$*$*
$ write sys$output "Creating FORMLETTER.COM"
$ create FORMLETTER.COM
$ DECK/DOLLARS="*$*$*EOD*$*$*"
$ !
$ !		This command file envokes TPU to execute the FORMLETTER facility
$ !	written by Gregg Wonderly.
$ !
$ !	Written by Gregg Wonderly  January 7, 1987
$ !
$ EDIT/TPU/COMMAND=PUB$ROOT:[LETTPU]LETTER.TPU
*$*$*EOD*$*$*
$ write sys$output "Creating LETTER.TPU"
$ create LETTER.TPU
$ DECK/DOLLARS="*$*$*EOD*$*$*"
!
!   Initialization procedure for setting things up.
!
PROCEDURE let$initialize
    let$commands := "FILE  SUBS  WRITE ";
    let$cmd_len := 6;
    let$cmd_no := 3;
    let$lineno := 0;
    let$initstr := "({";
    let$endstr := "})";
ENDPROCEDURE

!
!   Main procedure
!
PROCEDURE let$parse_file (command_file, template)

    LOCAL
        pos,
        fileno,
        curln,
        count,
        infile,
        value,
        strng,
        fndreg,
        erareg,
        outbuf,
        inbuf;

    infile := FILE_SEARCH ("");
    infile := FILE_SEARCH (command_file);
    IF (infile = "") THEN
        MESSAGE (
            "LETTER-F-NOINPUT, can't find input command file """+command_file+"""");
        RETURN (0);
    ENDIF;

    inbuf := CREATE_BUFFER ("Command_buffer", infile);
    IF (inbuf = 0) THEN
        MESSAGE (
            "LETTER-F-CANTREAD, can't read input command file """+infile+""".");
        RETURN (0);
    ENDIF;
    SET (NO_WRITE, inbuf);

    outbuf := CREATE_BUFFER ("Template_buffer");
    IF (outbuf = 0) THEN
        MESSAGE ("LETTER-F-CANTOUT, can't create a buffer for the template.");
        DELETE (inbuf);
        RETURN (0);
    ENDIF;
    SET (NO_WRITE, outbuf);

    pos := MARK (NONE);

    POSITION (BEGINNING_OF (inbuf));
    fileno := 0;
    let$lineno := 1;

    LOOP
        ! Save the input line.

        curln := CURRENT_LINE;

        ! Get the command number from the command specified.

        CASE let$getcmd (curln) FROM 0 TO 4
            [0] :  !  FILE command
                ERASE (outbuf);
                POSITION (outbuf);
                infile := FILE_SEARCH ("");
                infile := FILE_SEARCH (template);

                IF (infile = "") THEN
                    MESSAGE (
    "LETTER-F-NOTEMPLATE, can't find input template """+template+"""");
                    RETURN (0);
                ENDIF;

                IF (READ_FILE (infile) = "") THEN
                    MESSAGE (
    "LETTER-F-NOTEMPLATE, can't read input template """+infile+"""");
                    RETURN (0);
                ENDIF;

                IF (curln <> "") THEN
                    fileno := INT (curln);
                ELSE
                    fileno := fileno + 1;
                ENDIF;

                IF fileno < 0 THEN
                    let$message ("LETTER-E-BADFILE, invalid file number in FILE command");
                    POSITION (pos);
                    DELETE (outbuf);
                    DELETE (inbuf);
                    RETURN (0);
                ENDIF;

            [1] :  !  SUBStitute command
                IF (let$get_subs (curln, value, strng) = 0) THEN
                    POSITION (pos);
                    DELETE (outbuf);
                    DELETE (inbuf);
                    RETURN (0);
                ENDIF;
                POSITION (outbuf);
                count := let$replace (let$initstr + value + let$endstr, strng);
                IF (count = 0) THEN
                    let$message ("LETTER-W-NOTFOUND, didn't find "+let$initstr+
                             value + let$endstr+" in the input file");
                ENDIF;

            [2] :  !  WRITE
                outfile := let$get_word (curln);
                IF outfile = "" THEN
                    WRITE_FILE (outbuf, let$outfile (infile, fileno));
                ELSE
                    WRITE_FILE (outbuf, outfile);
                ENDIF;

            [OUTRANGE] :  !  For the -1, command not found, case.
                let$message (
                    "LETTER-W-NOTCMD, unrecognized command in command file");
        ENDCASE;

        ! Move back to the input file

        POSITION (inbuf);

        ! Next line.

        MOVE_VERTICAL (1);

        ! Stop if at end of buffer.

        EXITIF (MARK (NONE) = END_OF (inbuf));

        ! Increment input file line number counter

        let$lineno := let$lineno + 1;
    ENDLOOP;

    ! Reposition back to the original position.

    POSITION (pos);

    ! Clean up, and return normal completion.

    DELETE (outbuf);
    DELETE (inbuf);
    RETURN (1);
ENDPROCEDURE

!
!   This procedure looks at the line passed, and extracts the command verb
!   from the line, and returns its number.  "curln" is modified so that it
!   no longer contains the verb, only the arguments.
!
PROCEDURE let$getcmd (curln)
    LOCAL
        found,
        idx,
        cmd;

    ! Get the command as the first word of the line.

    cmd := let$get_word (curln);

    ! Make sure the letters will match on the compare.

    CHANGE_CASE (cmd, UPPER);
    idx := 1;

    LOOP
        found := 0;
        EXITIF idx > LENGTH (let$commands);
        found := 1;
        EXITIF (SUBSTR (let$commands, idx, LENGTH (cmd)) = cmd);
        idx := idx + let$cmd_len;
    ENDLOOP;

    ! Check to make sure we found it, and fail if we did not find the command

    IF (found = 0) THEN
        RETURN (-1);
    ENDIF;

    ! Return the relative command number as given by occurence in let$commands.

    RETURN (idx/let$cmd_len);
ENDPROCEDURE;

!
!   Display the message passed, along with the current line number of the input
!   command file.
!
PROCEDURE let$message (mess)
    MESSAGE (mess+" at line "+
                STR(let$lineno)+" of command file");
ENDPROCEDURE;

!
!   Create an output filename given a file number, and the original input file.
!
PROCEDURE let$outfile (fname, value);
    RETURN (
            FILE_PARSE (fname, "", "", NAME)
                +"_OUT_"+STR(VALUE)+
            FILE_PARSE (fname, "", "", TYPE)
           );
ENDPROCEDURE;

!
!   Get the 2 parameters of the SUBS command.  Fail if the first does not
!   seem to be numeric.
!
PROCEDURE let$get_subs (curln, value, strng)

    IF (INDEX ("0123456789", SUBSTR (curln, 1, 1)) <> 0) THEN
        value := let$get_word (curln);
        strng := curln;
    ELSE
        let$message ("LETTER-E-BADSUBS, improper substitution number");
        RETURN (0);
    ENDIF;
    RETURN (1);
ENDPROCEDURE;

!
! Get the next blank separated word from "curln", and return it.  "curln"
! is altered, to remove the word from it.
!
PROCEDURE let$get_word (curln)
    LOCAL
        idx,
        word;

    word := "";
    idx := 1;

    LOOP
        EXITIF (idx > LENGTH (curln));
        EXITIF (SUBSTR (curln, idx, 1) = " ");
        word := word + SUBSTR (curln, idx, 1);
        idx := idx + 1;
    ENDLOOP;

    LOOP
        EXITIF (idx > LENGTH (curln));
        EXITIF (SUBSTR (curln, idx, 1) <> " ");
        idx := idx + 1;
    ENDLOOP;

    curln := SUBSTR (curln, idx, LENGTH (curln) - idx + 1);

    RETURN (word);
ENDPROCEDURE;

!
!   Do the actual work of the SUBS command.  Replace every occurance of
!   "initstr" with "newstr", starting at the top of the buffer.
!
PROCEDURE let$replace (initstr, newstr)
    LOCAL
        loc,
        start,
        count,
        rng;

    ON_ERROR
    ENDON_ERROR;

    count := 0;
    POSITION (BEGINNING_OF (CURRENT_BUFFER));

    LOOP
        loc := SEARCH (initstr, FORWARD, EXACT);
        EXITIF loc = 0;

        POSITION (BEGINNING_OF (loc));

        start := MARK (NONE);
        POSITION (END_OF (loc));
        rng := CREATE_RANGE (start, MARK (NONE), NONE);
        EXITIF (rng = 0);

        POSITION (start);
        ERASE_CHARACTER (LENGTH (rng));
        COPY_TEXT (newstr);
        count := count + 1;
    ENDLOOP;

    RETURN (count);
ENDPROCEDURE;

!
!   Create a callable EVE command for envoking this facility.
!
PROCEDURE eve_form_letter
    LOCAL
        errno,
        template,
        commands;

    commands := READ_LINE ("Command filename: ");
    template := READ_LINE ("Template filename: ");
    IF (commands <> "") THEN
        let$initialize;
        let$parse_file (commands, template);
    ELSE
        MESSAGE ("Command aborted!!");
    ENDIF;
ENDPROCEDURE;

!
!   Do the initialization for the GWEDIT INSTALL command
!
PROCEDURE gwinstall$initialize
    let$initialize;
ENDPROCEDURE;

eve_form_letter;

SET (INFORMATIONAL, OFF);
SET (SUCCESS, OFF);
POSITION (BEGINNING_OF (MESSAGE_BUFFER));
SPLIT_LINE;
COPY_TEXT ("*************************  Message Buffer  *************************");
SPLIT_LINE;
SPLIT_LINE;
WRITE_FILE (MESSAGE_BUFFER, "SYS$ERROR:");
QUIT;
*$*$*EOD*$*$*
$ write sys$output "Creating LETTER1.DAT"
$ create LETTER1.DAT
$ DECK/DOLLARS="*$*$*EOD*$*$*"
.s 5
.c;December 23, 1986
.s 5
({1}) ({2}) ({3})
.br
({4})
.br
({5})
.s
Dear ({1}) ({3}):
.P
As much as I regret to inform you, your account is much overdue.  Our company
has continued to work with you on allowing extra time for your account to be
paid in full.
.P
Sorry ({2}), your time is up.  We will be passing the information about your
account over to our attorney and a carbon copy to ({6}).
.P
Please remit payment within one week of the date on this letter if you wish
to get us off of your ({7}).
.s 2
Sincerely yours,
.s 3
Johnny Afteryours
*$*$*EOD*$*$*
$ write sys$output "Creating README."
$ create README.
$ DECK/DOLLARS="*$*$*EOD*$*$*"
The file LETTER.TPU is a TPU source file that can be used as either a command
file as in

    EDIT/TPU/COMMAND=LETTER.TPU

or as an extension to your favorite TPU section file.

To use it with EVE,

       Use the GET command to place the file LETTER.TPU into a buffer.  Then
       use the "EXTEND *" command to extend EVE to include the procedure that
       the file defines. 

To use it with the EDT emulator:

       You will have to place the file into a buffer by itself.  Use the TPU
       command "letbuf:=CREATE_BUFFER('letbuf','letter.tpu')", to create the
       buffer.  Then, use the TPU command "COMPILE(letbuf)" to compile the
       procedures and make them known to TPU.  You can then use the (now
       defined) TPU command "eve_form_letter" to envoke the procedure that does
       all of the work. 

The first filename that you wil be prompted for is a file containing commands
to be performed to create the form letters.  There are only 3 recognized
commands, FILE, SUBS, and WRITE.

The FILE command is used to number files when there are a large number, and
naming them all would be tedious.  It accepts as an argument a number that
indicates the relative number of this file.  If the number is not present, then
the previous number is incremented by 1 (the initial value of the file number
is 0).  Anytime that the FILE command is executed, a new copy of the input
template file is read. 

The SUBS command is for performing the substitutions necessary to change the
special strings within the file into specific strings.  SUBS accepts 2
arguments.  The first is a number that will be used to locate the special
strings in the file. The remaining portion of the line is the specific string
to substitute.  The number will have the string "({" prepended to it, and the
string "})" appended to it to create a special string (eg. ({1}), ({2}),
({232}), etc).

The WRITE command is used to write out the result file when all SUBS operations
have been performed.  Write accepts, but does not require, one argument.  The
argument is the name of the file to write.  If the name is not present, then a
name is created using the file number currently in effect (as the result of a
preceding FILE command).  The output filename has the NAME portion of the input
template file followed by the string "_OUT_nnnn", where nnnn is the file
number, and is completed with the same TYPE as the input template file.  Eg.
if the input template filename is "LETTER1.DAT", then the first filename
generated is "LETTER1_OUT_1.DAT".  
*$*$*EOD*$*$*
$ exit