home *** CD-ROM | disk | FTP | other *** search
- /*
- @BSubStituteFont @P@ICopyright Gold Disk Inc., Jan, 1993
-
- This Genie will substitute one font for another throughout an entire document.
- */
- arg font, replacement
- address command
- call SafeEndEdit.rexx()
- call ppm_AutoUpdate(0)
- cpage = ppm_CurrentPage()
-
- if font = '' then
- do
- font = ppm_SelectFromList("Enter font to change", 32, 8, 0, FontList.rexx(ppm_GetFont()))
-
- if font = '' then exit_msg()
-
- replacement = ppm_SelectFromList("Enter font to change", 32, 8, 0, FontList.rexx(ppm_GetFont()))
-
- end
-
- if replacement = '' then exit_msg()
-
- font = "ff<"font">"
- flen = length(font)
- upperfont = upper(font)
- replacement = "ff<"replacement">"
- rlen = length(replacement)
-
- call ppm_ShowStatus("Working..")
- randval = (randu() * time(s)) % 1
- box = ppm_DocFirstBox()
-
- do while box ~= 0
-
- info = upper(word(ppm_GetBoxInfo(box), 1))
-
- if (info = "TEXT") & (ppm_GetBoxUserData(box) ~= randval) then
- do
- oldbox = box
- box = ppm_ArtFirstBox(box)
- boxtext = ppm_GetArticleText(box, 1)
-
- fpos = 1
- change = 0
-
- do forever
-
- uppertext = upper(boxtext)
-
- fpos = pos(upperfont, uppertext, fpos)
- if fpos = 0 then leave
-
- change = 1
-
- boxtext = delstr(boxtext, fpos, flen)
- boxtext = insert(replacement, boxtext, fpos - 1, rlen)
- fpos = fpos + rlen
-
- end
-
- if change then
- do
- call ppm_DeleteContents(box)
- call ppm_TextIntoBox(box, boxtext)
- end
-
- do while box ~= 0
-
- call ppm_SetBoxUserData(box, randval)
- box = ppm_ArtNextBox(box)
-
- end
- box = oldbox
- end
-
- box = ppm_DocNextBox(box)
-
- end
-
- exit_msg("Done")
-
- exit_msg: procedure expose cpage
- do
- parse arg message
-
- if message ~= '' then call ppm_Inform(1,message,)
- if cpage ~= 0 then call ppm_GotoPage(cpage)
- call ppm_ClearStatus()
- call ppm_AutoUpdate(1)
- exit
- end
-
-