home *** CD-ROM | disk | FTP | other *** search
/* @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 
