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

Text File | 1993-05-25 | 23KB | 567 lines

/* This genie creates new style tags automatically by examining all the text in a document. If any text is in a style which does not match an existing tag, a new tag is created and the text is set to that tag. Tags are named with a simplified description of the typeface; you can alter any of these names to anything you wish (using the "Style Tags Modify" menu item). If you modify the tag, its typeface name might no longer suit it.
Don Cox ⌐ Sept 92  Not Public Domain. All rights reserved. */

/* Method: load in typographic data from article texts. If an existing style is used, see if it is modified (further data after the style name). Ignore any data for text after the first letter. If no existing style is used, assemble the data and compare with all existing styles to see if there is a match. If not, suggest a name for a new style, create it and apply it to the block. */


trace n
if ~show(l, "gdarexxsupport.library") then
    if ~(exists("libs:gdarexxsupport.library") & addlib("gdarexxsupport.library", 0, -30)) then
        exit_msg("Please install the gdarexxsupport.library in your libs: directory before running this Genie")


address command
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)

prevdoc  = ppm_GetDocName()

if ppm_DocChanged() then
do
    if ppm_SavedDate() = "Not Saved" then prevdoc = ""

    if ppm_Inform(2, "You must save the document first. Save and continue?", "Cancel", "Ok") then
                call ppm_SaveDocument(prevdoc)
    else
            exit_msg(0,)

    prevdoc = ppm_GetDocName()
end

colormode = ppm_GetColorMode()
call ppm_SetColorMode(0)
cpage   = ppm_CurrentPage()


tolerant = ppm_Inform(2,"Ignore bold, italic and underline?","No","Yes")
call ppm_ShowStatus("Working..")

existing = 0   /* flag for style matching existing style  */
randval = (randu() * time(s)) % 1 /* mark boxes with random number to avoid doing them twice */
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)
        text = ppm_GetArticleText(box, 1)
        call ppm_ShowStatus("  Analysing article that begins in box "box)
        if text  = '' then iterate

        paraname = ""
        paracode = ""
        stylename = ""
        stylecode = ""
        fontname = ""
        typestyle = ""
        fontsize = ""
        bold = ""
        italic = ""
        underline = ""
        outline = ""
        kerning = ""
        hyphenation = ""
        linespace = ""
        linespacecode = ""
        lineshift = ""
        tracking = ""
        colour = ""
        justification = ""

position = 1
trace n
        do x = 1 to 10000  /* big number - go right through article  */
            change = 0
            notcode = 0
            position = parsecodes(position) /* parse a block of codes in text */
            if position = 0 then break
            if stylecode = "dS" then iterate
            if notcode = 1 then iterate   /* non-style codes  */

/* put together style definition from text */
            trackstring = "\t<"tracking">"
            if tracking = "" then trackstring = ""
            linespacestring = "\"linespacecode"<"||linespace||">"
            if linespacecode = "" | linespacecode = "" then linespacestring = ""
            fontnamestring = "\ff<"fontname">"
            if fontname = "" then fontnamestring = ""
            fontsizestring = "\fs<"fontsize">"
            if fontsize = "" then fontsizestring = ""
            colourstring = "\c<"colour">"
            if colour = "" then colourstring = ""
            styledefinition = "\"paracode||paraname ||typestyle ||bold ||italic ||outline ||underline || fontnamestring|| fontsizestring|| justification|| kerning|| hyphenation|| linespacestring|| trackstring||colourstring

            if tolerant = 1 then styledefinition = "\"paracode||paraname || fontnamestring|| fontsizestring|| justification|| kerning|| hyphenation|| linespacestring|| trackstring||colourstring

/* see if new definition matches any of the old ones */
            stylelist = ppm_GetStyleTagList()
            stylelistTest = stylelist||"0a"x
            parse var stylelist NumberOfTags "0a"x stylelist

            if NumberOfTags~=0 then do
                do t=1 to NumberOfTags
                    parse var stylelist thisname "0a"x stylelist
                    thisdata = ppm_GetStyleTagData(thisname)
                    thisdata = substr(thisdata, pos("{",thisdata)+1)
                    thisdata = left(thisdata, lastpos("}",thisdata)-1)
                    if tolerant = 1 then do  /* take out unwanted codes */
                        p=pos(thisdata,"\B")
                        if p~=0 then thisdata = delstr(thisdata,p,2)
                        p=pos(thisdata,"\b")
                        if p~=0 then thisdata = delstr(thisdata,p,2)
                        p=pos(thisdata,"\U")
                        if p~=0 then thisdata = delstr(thisdata,p,2)
                        p=pos(thisdata,"\u")
                        if p~=0 then thisdata = delstr(thisdata,p,2)
                        p=pos(thisdata,"\I")
                        if p~=0 then thisdata = delstr(thisdata,p,2)
                        p=pos(thisdata,"\i")
                        if p~=0 then thisdata = delstr(thisdata,p,2)
                        end
                    if thisdata = styledefinition then do
                        ThisTagName = "\dS<"||thisname||">"
                        if stylecode~= "dS" then text = insert(ThisTagName,text, position-2)
                        change = 0
                        leave t
                        end
                    end   /* t=1 to NumberOfTags  */
            end

            if change = 0 then iterate x   /* No need to make a new tag */


            numbering = 1
            newbold = ""
            if right(bold,1) = "B" then newbold = "B"
            newitalic = ""
            if right(italic,1) = "I" then newitalic = "I"
            suggestname = left(fontname, 9)||newbold||newitalic||"."||(fontsize%1)||"pt."||colour
            testsuggest = "0a"x||suggestname||"0a"x

            do i = 1 to 999  /* if name already used, give it a new number */
                if pos(testsuggest,stylelistTest)=0 then break
                numbering = numbering+1
                suggestname = left(fontname, 9)||newbold||newitalic||"."||(fontsize%1)||"pt."||colour"."||right(numbering, 3,"0")
                testsuggest = "0a"x||suggestname||"0a"x
                end

            ThisTagName = "\dS<"||suggestname||">"
            text = insert(ThisTagName,text, position-2)
            position = position+3
            styledefinition = "<"suggestname"{"styledefinition"}>"
            call ppm_DefineStyleTag(styledefinition)
            end   /* of article text - position = 0  */

/* replace text with new version containing new style codes */
        gone = ppm_DeleteContents(box)
        overflow = ppm_TextIntoBox(box, text)
        do while box ~= 0  /* mark all the other boxes in this chain  */
            call ppm_SetBoxUserData(box, randval)
            box = ppm_ArtNextBox(box)
            end
        box = oldbox  /* back to the box we are working on */
        end

    box = ppm_DocNextBox(box)

end


title = ppm_GetDocName()
colon = lastpos('/', title)
if colon = 0 then colon = pos(':', title)
title = substr(title,colon+1)

datafile = "ram:"||title||".tags"
stylelist = ppm_GetStyleTagList()
parse var stylelist NumberOfTags "0a"x stylelist
text ="List of style tags"||"0a0a"x

if NumberOfTags~=0 then do
    do t=1 to NumberOfTags
        parse var stylelist thisname "0a"x stylelist
        thisdata = ppm_GetStyleTagData(thisname)
        text = text||thisdata"0a"x
        end   /* t=1 to NumberOfTags  */
    end

paralist = ppm_GetParaTagList()
parse var paralist NumberOfTags "0a"x paralist
text =text||"0a"x||"List of paragraph tags"||"0a0a"x

if NumberOfTags~=0 then do
    do t=1 to NumberOfTags
        parse var paralist thisname "0a"x paralist
        thisdata = ppm_GetParaTagData(thisname)
        text = text||thisdata"0a"x
        end   /* t=1 to NumberOfTags  */
    end

call ppm_SaveText(datafile,text)
newpage = ppm_GoToPage(cpage)
call exit_msg()
end

/*  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  */

/* Parse a block of style codes in text; stop at first text character  */

parsecodes:
parse arg position
position = pos("\",text,position)
if position = 0 then return position
if substr(text,position+1,1) = "." then position = 0 /* end of text */
if position = 0 then return position
nonstylecode = ""
stylecode = "ds"  /* assume new block of codes means new style */

        do forever
            if substr(text,position,1)~="\" then break
            if substr(text,position+1,1) = "." then position = 0
            if position = 0 then break
            code = substr(text,position+1,2)
trace n
            select
                when verify(left(code,1),"NMPTs-!?#","m")~=0 then do
                    position = position+2 /* non-style codes */
                    change = 0
                    notcode = 1
                    code = substr(text,position-1,5)
                    select
                        when left(code,4) = "#<Pp" then do
                            nonstylecode = "previousboxpage"||substr(code,5,1)
                            position = position+5
                            end
                        when left(code,4) = "#<Pc" then do
                            nonstylecode = "currentpage"||substr(code,5,1)
                            position = position+5
                            end
                        when left(code,4) = "#<Pn" then do
                            nonstylecode = "nextboxpage"||substr(code,5,1)
                            position = position+5
                            end
                        when left(code,4) = "#<Dc" then do
                            nonstylecode = "creationdate"||substr(code,5,1)
                            position = position+5
                            end
                        when left(code,4) = "#<Dp" then do
                            nonstylecode = "printingdate"||substr(code,5,1)
                            position = position+5
                            end
                        when left(code,1) = "?" then do
                            nonstylecode = "comment"
                            position = pos(">",text,position)
                            end
                        when left(code,1) = "!" then do
                            nonstylecode = "boxbreak"
                            end
                        when left(code,1) = "P" then do
                            nonstylecode = "newparagraph"
                            end
                        when left(code,1) = "M" then do
                            nonstylecode = "mspace"
                            end
                        when left(code,1) = "N" then do
                            nonstylecode = "nspace"
                            end
                        when left(code,1) = "T" then do
                            nonstylecode = "thinspace"
                            end
                        when left(code,1) = "s" then do
                            nonstylecode = "tab"
                            end
                        when left(code,1) = "-" then do
                            nonstylecode = "softhyphen"
                            end
                        otherwise do
                            nonstylecode = ""
                            end
                    end
                when code = "dp" then do
                    paraname = ""
                    paracode = code
                    position = position+3
                    end
                when code = "dP" then do
                    position1 = pos(">",text,position)
                    position = position+4
                    oldname = paraname
                    paraname = "<"||substr(text, position, position1-position)||">"
                    if paraname~=oldname  then change = 1
                    oldname = paracode
                    paracode = "dP"
                    if paracode~=oldname  then change = 1
                    position = position1+1
                    end
                when code = "ds" then do
                    stylename = ""
                    stylecode = code
                    position = position+3
                    end
                when code = "dS" then do
                    position1 = pos(">",text,position)
                    position = position+4
                    stylename = substr(text,position,position1-position)
                    tagdata = ppm_GetStyleTagData(stylename)
                    call parsetag(tagdata) /* new style so reset all variables  */
                    change = 0
                    stylecode = "dS"
                    position = position1+1
                    end
                when verify(left(code,1),"bB","m")~=0 then do
                    oldname = bold
                    bold = "\"||left(code,1)
                    position = position+2
                    if bold~=oldname  then change = 1
                    end
                when verify(left(code,1),"iI","m")~=0 then do
                    oldname = italic
                    italic = "\"||left(code,1)
                    position = position+2
                    if italic~=oldname  then change = 1
                    end
                when verify(left(code,1),"uU","m")~=0 then do
                    oldname = underline
                    underline = "\"||left(code,1)
                    position = position+2
                    if underline~=oldname  then change = 1
                    end
                when verify(left(code,1),"oO","m")~=0 then do
                    oldname = outline
                    outline = "\"||left(code,1)
                    position = position+2
                    if outline~=oldname  then change = 1
                    end
                when left(code,1) = "n" then do
                    typestyle = ""
                    if bold~="" then change = 1
                    bold = "\b"
                    if italic~="" then change = 1
                    italic = "\i"
                    if underline~="" then change = 1
                    underline = "\u"
                    if outline~="" then change = 1
                    outline = "\o"
                    position = position+2
                    end
                when code = "ff" then do
                    position1 = pos(">",text,position)
                    position = position+4
                    oldname = fontname
                    fontname = substr(text,position,position1-position)
                    if fontname~=oldname  then change = 1
                    position = position1+1
                    end
                when code = "fs" then do
                    position1 = pos(">",text,position)
                    position = position+4
                    oldname = fontsize
                    fontsize = substr(text,position,position1-position)
                    if fontsize~=oldname  then change = 1
                    position = position1+1
                    end
                when verify(left(code,1),"kK","m")~=0 then do
                    oldname = kerning
                    kerning = "\"||left(code,1)
                    position = position+2
                    if kerning~=oldname  then change = 1
                    end
                when verify(left(code,1),"hH","m")~=0 then do
                    oldname = hyphenation
                    hyphenation = "\"||left(code,1)
                    if hyphenation~=oldname  then change = 1
                    position = position+2
                    end
                when code = "lr"|code = "lf"|code = "ll" then do
                    position1 = pos(">",text,position)
                    position = position+4
                    oldname = linespace
                    linespace = substr(text,position,position1-position)
                    if linespace~=oldname  then change = 1
                    oldname = linespacecode
                    linespacecode = code
                    if linespacecode~=oldname  then change = 1
                    position = position1+1
                    end
                when code = "ls" then do
                    position1 = pos(">",text,position)
                    position = position+4
                    oldname = lineshift
                    lineshift = substr(text,position,position1-position)
                    if lineshift~=oldname  then change = 1
                    position = position1+1
                    end
                when left(code,1) = "t" then do
                    position1 = pos(">",text,position)
                    position = position+3
                    oldname = tracking
                    tracking = substr(text,position,position1-position)
                    if tracking~=oldname  then change = 1
                    position = position1+1
                    end
                when left(code,1) = "c" then do
                    position1 = pos(">",text,position)
                    position = position+3
                    oldname = colour
                    colour = substr(text,position,position1-position)
                    if colour~=oldname  then change = 1
                    position = position1+1
                    end
                when code = "jl"|code = "jr"|code = "jc"|code = "jf" then do
                    oldname = justification
                    justification = "\"||code
                    if justification~=oldname  then change = 1
                    position = position+3
                    end
                when code = "DC" then do
                    position = pos("}>",text,position)+2
                    nonstylecode = "definecolor"
                    change = 0
                    notcode = 1
                    end
                otherwise position = position+2
                end      /* of select */
        end   /* of do forever */
position = position+1
return position


/*  +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  */

/* Parse a style tag definition  */
parsetag:

parse arg tagdata
tlength = length(tagdata)
tposition = pos("\",tagdata)
if pos = 0 then return

/* Clear all codes - the only compulsory info is the tag's name */
        paraname = ""
        paracode = ""
        fontname = ""
        typestyle = ""
        fontsize = ""
        bold = ""
        italic = ""
        underline = ""
        outline = ""
        kerning = ""
        hyphenation = ""
        linespace = ""
        linespacecode = ""
        lineshift = ""
        tracking = ""
        colour = ""
        justification = ""

do forever
    if substr(tagdata,tposition,1)~="\" then break
    code = substr(tagdata,tposition+1,2)
    select
        when code = "dp" then do
            paraname = ""
            paracode = code
            tposition = tposition+3
            end
        when code = "dP" then do
            tposition1 = pos(">",tagdata,tposition)
            tposition = tposition+4
            paraname = "<"||substr(tagdata,tposition,tposition1-tposition)||">"
            paracode = code
            tposition = tposition1+1
            end
        when verify(left(code,1),"bB","m")~=0 then do
            bold = "\"||left(code,1)
            tposition = tposition+2
            end
        when verify(left(code,1),"iI","m")~=0 then do
            italic = "\"||left(code,1)
            tposition = tposition+2
            end
        when verify(left(code,1),"uU","m")~=0 then do
            underline = "\"||left(code,1)
            tposition = tposition+2
            end
        when verify(left(code,1),"oO","m")~=0 then do
            outline = "\"||left(code,1)
            tposition = tposition+2
            end
        when left(code,1) = "n" then do
            typestyle = "\n"
            bold = ""
            italic = ""
            underline = ""
            outline = ""
            tposition = tposition+2
            end
        when code = "ff" then do
            tposition1 = pos(">",tagdata,tposition)
            tposition = tposition+4
            fontname = substr(tagdata,tposition,tposition1-tposition)
            tposition = tposition1+1
            end
        when code = "fs" then do
            tposition1 = pos(">",tagdata,tposition)
            tposition = tposition+4
            fontsize = substr(tagdata,tposition,tposition1-tposition)
            tposition = tposition1+1
            end
        when verify(left(code,1),"kK","m")~=0 then do
            kerning = "\"||left(code,1)
            tposition = tposition+2
            end
        when verify(left(code,1),"hH","m")~=0 then do
            hyphenation = "\"||left(code,1)
            tposition = tposition+2
            end
        when code = "lr"|code = "lf"|code = "ll" then do
            tposition1 = pos(">",tagdata,tposition)
            tposition = tposition+4
            linespace = substr(tagdata,tposition,tposition1-tposition)
            linespacecode = code
            tposition = tposition1+1
            end
        when code = "ls" then do
            tposition1 = pos(">",tagdata,tposition)
            tposition = tposition+4
            lineshift = substr(tagdata,tposition,tposition1-tposition)
            tposition = tposition1+1
            end
        when left(code,1) = "t" then do
            tposition1 = pos(">",tagdata,tposition)
            tposition = tposition+3
            tracking = substr(tagdata,tposition,tposition1-tposition)
            tposition = tposition1+1
            end
        when left(code,1) = "c" then do
            tposition1 = pos(">",tagdata,tposition)
            tposition = tposition+3
            colour = substr(tagdata,tposition,tposition1-tposition)
            tposition = tposition1+1
            end
        when code = "jl"|code = "jr"|code = "jc"|code = "jf" then do
            justification = "\"||code
            tposition = tposition+3
            end
        otherwise tposition = tposition+2
        end
end
return

/*  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  */

exit_msg:
do
    parse arg message
    if message ~="" then call ppm_inform(1,message,"Resume")
    call ppm_ClearStatus()
    call ppm_SetColorMode(colormode)
    call ppm_AutoUpdate(1)
    exit
end