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