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

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

/* This genie creates a new style tag automatically by examining a block of selected text in a document. If the text is in a style which does not match an existing tag, a new tag is created and the text is optionally 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. */

/* Method: load in typographic data from selected text. 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. */
/* Written by Don Cox 1993. Not Public Domain. All rights reserved. */

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

text = ppm_GetBlockText( 1)

if text  = '' then exit_msg("No text selected")
apply = ppm_Inform(2,"Apply style to whole of selected text?","No","Yes")
call ppm_ShowStatus("  Analysing text...")

call clearcodes


position = 1

change = 0
position = parsecodes(position) /* parse a block of codes in text */
if position = 0 then exit_msg("No style information found")

suggestname=stylename
if change = 1 then do

/* 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 = ""
    fillpatternstring = "\FP<"fillpattern">"
    if fillpattern = "" then fillpatternstring = ""
    if fillpattern = "\Fp" then fillpatternstring = "\Fp"

    styledefinition = "\"paracode||paraname ||typestyle ||bold ||italic ||outline ||underline ||shadow ||superscript ||subscript || fontnamestring|| fontsizestring|| justification|| kerning|| hyphenation|| linespacestring|| trackstring||colourstring ||fillpatternstring



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

    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 thisdata = styledefinition then do
                ThisTagName = "\dS<"||thisname||">"
                tagchange = 0
                suggestname = thisname
                leave t
                end
            end   /* t=1 to NumberOfTags  */
    end

if tagchange ~=0 then do

    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

do i=1 to 10
    newname = ppm_GetForm(" Name of new style tag",30," Suggested Name :"suggestname)
    if newname = "" then exit_msg("User aborted genie")
    newtest = "0a"x||newname||"0a"x  /* test for complete lines only */
    if pos(newtest,stylelistTest)=0 then do
        styledefinition = "<"newname"{"styledefinition"}>"
        call ppm_DefineStyleTag(styledefinition)
        call ppm_SetStyleTag(newname)
        call exit_msg
        end

    choice = ppm_inform(3,"Replace existing tag of same name?","Replace","Try another name","Cancel")
    if choice = 2 then exit_msg("Aborted by User")
    if choice = 0 then do
        styledefinition = "<"newname"{"styledefinition"}>"
        call ppm_DefineStyleTag(styledefinition)
        call ppm_SetStyleTag(newname)
        call exit_msg
        end
    styledefinition = "<"newname"{"styledefinition"}>"
    call ppm_DefineStyleTag(styledefinition)
end  /* i=1 to 10  */
end  /* tagchange~=0  */


if apply = 1 then call ppm_SetStyleTag(suggestname)

if tagchange = 0 & apply = 1 then do
    call exit_msg('Applying existing tag "'suggestname'" to text block.')
    end
if tagchange = 0 then do
    call exit_msg('This is existing tag "'suggestname'".')
    end
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 = -1
            if position = -1 then break
            code = substr(text,position+1,2)
            select
                when verify(left(code,1),"pNMPTs-!?#","m")~=0 then call parsenonstylecodes

                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 code = "FP" then do
                    position1 = pos(">",text,position)
                    position = position+4
                    oldname = fillpattern
                    fillpattern = substr(text,position,position1-position)
                    if fillpattern ~=oldname  then change = 1
                    position = position1+1
                    notcode = 0
                    end
                when code = "Fp" then do
                    oldname = fillpattern
                    fillpattern = "\"||code
                    if fillpattern ~= oldname then change = 1
                    position = position+3
                    notcode = 0
                    end
                when code = "SH"|code = "Sh" then do
                    oldname = shadow
                    shadow = "\"||code
                    if shadow ~= oldname then change = 1
                    position = position+3
                    end
                when code = "SP"|code = "Sp" then do
                    oldname = superscript
                    superscript = "\"||code
                    if superscript ~= oldname then change = 1
                    position = position+3
                    end
                when code = "SB"|code = "Sb" then do
                    oldname = subscript
                    subscript = "\"||code
                    if subscript ~= oldname then change = 1
                    position = position+3
                    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 */
call clearcodes

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 code = "FP" then do
            tposition1 = pos(">",text,tposition)
            tposition = tposition+4
            oldname = fillpattern
            fillpattern = substr(text,tposition,tposition1-tposition)
            if fillpattern ~=oldname  then change = 1
            tposition = tposition1+1
            end
        when code = "Fp" then do
            oldname = fillpattern
            fillpattern = "\"||code
            if fillpattern ~= oldname then change = 1
            tposition = tposition+3
            end
        when code = "SH"|code = "Sh" then do
            oldname = shadow
            shadow = "\"||code
            if shadow ~= oldname then change = 1
            tposition = tposition+3
            end
        when code = "SP"|code = "Sp" then do
            oldname = superscript
            superscript = "\"||code
            if superscript ~= oldname then change = 1
            tposition = tposition+3
            end
        when code = "SB"|code = "Sb" then do
            oldname = subscript
            subscript = "\"||code
            if subscript ~= oldname then change = 1
            tposition = tposition+3
            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

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

parsenonstylecodes:
                    position = position+2 /* non-style codes */

                    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,2) = "pv" then do
                            position1 = pos(">",text,position)
                            position = position+2
                            nonstylecode = "paravalue"||substr(text, position, position1 -position)
                            position = position1+1
                            end
                        when left(code,2) = "ps" then do
                            position1 = pos(">",text,position)
                            position = position+2
                            nonstylecode ="paraspacing"|| substr(text,position, position1 -position)
                            position = position1+1
                            end
                        when left(code,2) = "pi"|left(code,2) = "po" |left(code, 2) = "pn" then do
                            nonstylecode = "indent"||left(code,2)
                            position = position+1
                            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 nonstylecode = ""
                        end
return

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

clearcodes:
        paraname = ""
        paracode = ""
        stylename = ""
        stylecode = ""
        fontname = ""
        typestyle = ""
        fontsize = ""
        bold = ""
        italic = ""
        shadow = ""
        superscript = ""
        subscript = ""
        fillpattern = ""
        underline = ""
        outline = ""
        kerning = ""
        hyphenation = ""
        linespace = ""
        linespacecode = ""
        lineshift = ""
        tracking = ""
        colour = ""
        justification = ""
return

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

exit_msg:
do
    parse arg message
    if message ~="" then call ppm_inform(1,message,"Resume")
    call ppm_ClearStatus()

    exit
end