Frozen Fish 2: PC/frozenfish_august_1995.bin/bbs/d09xx/d0925.lha/DonsGenies/DonsGenies.lha/Don'sGenies/MailMerge2.pprx

Text File | 1993-02-28 | 8KB | 315 lines

/*
@BMailMerge  @P@ICopyright Gold Disk Inc., Jan, 1993. Close-up added by Don Cox, Feb.93.

This genie will load a tab or comma delimited merge file and print multiple copies of the current document. It will substitute the merge string in appropriate places. In this version, if the names of the fields end in a numeral (e.g. ADDR1, ADDR2, etc), blank lines will be closed up.

In order to delimit a field as a merge field, you must surround the merge
text with double guillemots. Example:½½Name╗╗
   Open guillemot: alt-9
   Closing guillemot: alt-0
*/

parse arg filename
if ~show(l, "rexxsupport.library") then
    if ~addlib("rexxsupport.library",0,-30) then
        call exit_msg("Please install the rexxsupport.library in your libs: directory before running this Genie")

signal on error
signal on syntax
signal on break_c
signal on break_d
signal on break_e
signal on halt
signal on ioerr
address command
call SafeEndEdit.rexx()
call ppm_SetBatchMode(1)
call ppm_AutoUpdate(0)
cr = '0a'x

npages  = ppm_NumPages()
if npages = 0 then exit_msg("You must have a merge document prepared to run this Genie.")

if filename = '' then
    filename = ppm_GetFileName("Select Merge File","", "")

if filename = '' then exit_msg()

if ~open(file, filename, "r") then
    call exit_msg("Unable to open "file)


line = readln(file)

delimiter = ''
matrix. = ""  /* null string for unfilled positions */

if pos('",', line) ~= 0 then do
    delimiter   = '",'  /* Look for ",  */
    qt          = '"'   /* Look for inchmark */
    rparseline  = "parse var line matrix.0.fields '"delimiter"' line"
    parseline   = "parse var line datum '"delimiter"' line"
    rstripline  = "matrix.0.fields = upper(strip(matrix.0.fields, b, '"qt"'))"
    stripline   = "datum = strip(datum, b,'"qt"')"
    end

else if pos('09'x, line) ~= 0 then do  /* Look for tabs */
    rparseline  = "parse var line matrix.0.fields '09'x line"
    parseline   = "parse var line datum '09'x line"
    rstripline  = "matrix.0.fields = upper(strip(matrix.0.fields))"
    stripline   = "datum = strip(datum)"
    end

else if length(line) < 255 then do  /* single items, no delimiters  */
    rparseline  = "matrix.0.fields = upper(strip(line));line = ''"
    parseline   = "datum = strip(line);line = ''"
    stripline   = "/**/"
    rstripline  = "/**/"
    end

else
    exit_msg("File must be either comma delimited or tab delimited")


fields = 0
records  = 0
do while line ~ = ''  /* Process first line, listing the fields */

    fields = fields + 1  /* Count fields */
    interpret rparseline
    interpret rstripline
end

/* Now process the data lines, building up the matrix */

do while ~eof(file)

    line = readln(file)

    if line = '' then iterate

    records = records + 1

    call ppm_ShowStatus("Importing record "records)

    field = 1
    counter = 1
    do until counter = fields+1

        interpret parseline  /* These are the data lines */
        interpret stripline
        testdigit = right(matrix.0.counter,1)
        if ~datatype(testdigit,"n") then field = counter
        counter = counter+1
        matrix.records.field = datum
        if datum ~="" then field = field+1
        if line = '' then leave
    end
end

call close(file)

call ppm_ShowStatus("Preparing document for mail merge..")
boxes   = 1

call analyzeboxes()

reccount = 1
boxnum  = 1
btext   = 1
ctext   = 2
field   = 1

if doctext.0 < 1 then exit_msg("No merge codes found")

do while reccount <= records

    do boxes = 1 to doctext.0

        box = doctext.boxes
        tlen    = 0

        boxtext = doctext.boxes.btext

        do mergpos = 1 to doctext.boxes.btext.0

            field   = doctext.boxes.btext.mergpos.1
            if field = 'NEXT' then do
                reccount = reccount + 1
                ftext   = ''
                end

            else if left(field, 1) = '=' then do /* Interpret any ARexx expression */
                string = ''
                address command
                interpret "string "field
                address  /* back to PPage port */

                ftext = string
                end

            else
                ftext   = matrix.reccount.field

            fpos    = doctext.boxes.btext.mergpos
            boxtext = insert(ftext, boxtext, fpos - 1 + tlen)
            tlen    = tlen + length(ftext)

        end

        call ppm_ShowStatus("Merging record "reccount" of "records)
                call ppm_DeleteContents(box)
                call ppm_TextIntoBox(box, boxtext)

    end

    reccount = reccount + 1

    lastpage = ppm_DocLastPage()

    do page = 1 to npages

        call ppm_CopyPage(page, lastpage + 1, 1)
        lastpage = lastpage + 1

    end


end

do i = 1 to doctext.0

    box = doctext.i
    text    = doctext.i.2

        call ppm_DeleteContents(box)
        call ppm_TextIntoBox(box, text)
        call ppm_SetBoxUserData(box, "")

end

exit_msg("Done")


exit_msg: procedure
do
    parse arg message

    if message ~= '' then call ppm_Inform(1,message,)
    call ppm_SetBatchMode(0)
    call ppm_ClearStatus()
    call ppm_AutoUpdate(1)
    exit
end


analyzeboxes: procedure expose doctext. matrix. fields
do
        randval = (randu() * time(s)) % 1
    boxnum  = 1
    rpos    = 1
    btext   = 1
    ctext   = 2
    field   = 1

    box = ppm_DocFirstBox()

    do while box ~= 0

        if upper(word(ppm_GetBoxInfo(box), 1)) ~= TEXT | ppm_GetBoxUserData(box) = randval then
        do
            box = ppm_DocNextBox(box)
            iterate
        end

                oldbox = box
                box = ppm_ArtFirstBox(box)
                boxtext = ppm_GetArticleText(box, 1)

        copy    = boxtext
        fpos    = pos('½½', boxtext)

        if fpos ~= 0 then
        do
            doctext.boxnum  = box
            rpos    = 1

            do while fpos ~= 0
                                found = 0
                epos    = pos('╗╗', boxtext, fpos)
                if epos = 0 then leave
                fieldlen    = epos - fpos + 2
                temptext   = strip(substr(boxtext, fpos + 2, fieldlen - 4))
                fieldtext   = upper(temptext)
                if fieldtext = 'NEXT'  then
                                do
                                        found    = 1
                    fieldnum = 'NEXT'
                                end
                else if left(fieldtext, 1) = '=' then
                                do
                                        found    = 1
                    fieldnum = temptext
                                end
                else
                do fieldnum = 1 to fields

                    if matrix.0.fieldnum = fieldtext then
                                        do
                                                found = 1
                                                leave fieldnum
                                        end
                end

                                if found then
                                do
                        boxtext = delstr(boxtext, fpos, fieldlen)
                        doctext.boxnum.btext.rpos = fpos
                        doctext.boxnum.btext.rpos.1 = fieldnum
                        rpos = rpos + 1
                                end

                                fpos = pos('½½', boxtext, fpos + 1)
            end

            doctext.boxnum.btext = boxtext
            doctext.boxnum.ctext = copy

            doctext.boxnum.btext.0 = rpos - 1
            doctext.0   = boxnum
            boxnum  = boxnum + 1

        end

                do while box ~= 0

                        call SetBoxUserData(box, randval)
                        box = ppm_ArtNextBox(box)

                end

        box = ppm_DocNextBox(oldbox)

    end

    return

end



error:
syntax:
break_c:
break_d:
break_e:
break_f:
halt:
ioerr:
novalue:
do
    call ppm_Inform(1,"An Arexx error has occured interpeting Arexx string: "errortext(rc)" Line "SIGL,)
    return
end