DTP Toolbox/DTPToolbox.iso/propage4.0/arexx/mailmerge.pprx

Text File | 1993-02-15 | 7.1 KB | 305 lines

/*
@BMailMerge  @P@ICopyright Gold Disk Inc., Jan, 1993

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 order to delimit a field as a merge field, you must surround the merge
text with double guilme's. Example:««Name»»
   Open guilme: alt-9
   Closing guilme: 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 = ''

if pos('",', line) ~= 0 then
do
    delimiter   = '",'
    qt          = '"'
    rparseline  = "parse var line matrix.0.fields '"delimiter"' line"
    parseline   = "parse var line matrix.records.field '"delimiter"' line"
    rstripline  = "matrix.0.fields = upper(strip(matrix.0.fields, b, '"qt"'))"
    stripline   = "matrix.records.field = strip(matrix.records.field,b,'"qt"')"
end
else if pos('09'x, line) ~= 0 then
do
    rparseline  = "parse var line matrix.0.fields '09'x line"
    parseline   = "parse var line matrix.records.field '09'x line"
    rstripline  = "matrix.0.fields = upper(strip(matrix.0.fields))"
    stripline   = "matrix.records.fields = strip(matrix.records.field)"
end
else if length(line) < 255 then
do
    rparseline  = "matrix.0.fields = upper(strip(line));line = ''"
    parseline   = "matrix.records.field = 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 ~ = ''

    fields = fields + 1
    interpret rparseline
    interpret rstripline
end


do while ~eof(file)

    line = readln(file)

    if line = '' then iterate

    records = records + 1

    call ppm_ShowStatus("Importing record "records)

    do field = 1 to fields

        interpret parseline
        interpret stripline
        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
                string = ''
                address command
                interpret "string "field
                address

                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