home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The CDPD Public Domain Collection for CDTV 4
/
CDPD_IV.bin
/
fish
/
911-930
/
ff925
/
donsgenies
/
frenchgenies.lha
/
Rexx
/
AjoutAutoDeStyles.pprx
next >
Wrap
Text File
|
1993-08-03
|
28KB
|
680 lines
/*
@BAjoutAutoDeStyles @P @I Ecrit et © par Don Cox en septembre 1992
@IRévisé en avril 1993. N'est pas du Domaine Publique. Tous Droits
@IRéservés.
Traduit par Fabien Larini le 01/08/93.
Ce Génie crée automatiquement de nouveaux formats de style en examinant
tout le texte dans un document. Si du texte est dans un style qui
n'existe pas parmis la liste des formats de style, un nouveau format est
crée et le texte reçoit ce format. Les formats sont nommés avec une
description simplifiée de la police de caractère, vous pouvez modifier ces
noms de formats.
*/
/* StyleTagsAutoCreate3*/
/* 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 Revised April 93. 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.
Note that style tags can be inspected by saving them (Style Tag menu) and
then loading the resulting file into a text editor. */
trace n
if ~show(l, "gdarexxsupport.library") then
if ~(exists("libs:gdarexxsupport.library") & addlib("gdarexxsupport.library", 0, -30)) then
exit_msg("Installez gdarexxsupport.library dans votre répertoire Libs: avant d'utiliser ce 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, "Vous devez d'abord sauver ce documet. Sauve et continue?", "Cancel", "Ok") then
call ppm_SaveDocument(prevdoc)
else
call exit_msg("Non Sauvé, abandon")
prevdoc = ppm_GetDocName()
end
cpage = ppm_CurrentPage()
tolerant = ppm_Inform(2,"Ignore les caractères gras, italiques et soulignés ?","Non","Oui")
call ppm_ShowStatus("Travail en cours ...")
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 = "TEXTE") & (ppm_GetBoxUserData(box) ~= randval) then do
oldbox = box
box = ppm_ArtFirstBox(box)
text = ppm_GetArticleText(box, 1)
call ppm_ShowStatus("Analyse du texte commençant boîte "box)
if text = '' then iterate
call clearcodes /* initialize style tag codes */
position = 1
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 /* given by "\." code - end of text */
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 = "" | linespace = "" then linespacestring = ""
fontnamestring = "\ff<"fontname">"
if fontname = "" then fontnamestring = ""
fontsizestring = "\fs<"fontsize">"
if fontsize = "" then fontsizestring = ""
colourstring = "\c<"colour">"
if colour = "" then colourstring = ""
paravaluestring = "\pv<"paravalue">"
if paravalue = "" then paravaluestring = ""
paraspacingstring = "\ps<"paraspacing">"
if paraspacing = "" then paraspacingstring = ""
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
if tolerant = 1 then styledefinition = "\"paracode||paraname ||shadow|| 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 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)
tagchange = 0
leave t
end
end /* t=1 to NumberOfTags */
end
if tagchange = 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("Terminé")
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
notcode = 0 /* ds is the last in the string at the start of an article, which includes para codes, which are not style tag codes. This switches "code" back on. */
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
end
when code = "Fp" then do
oldname = fillpattern
fillpattern = "\"||code
if fillpattern ~= oldname then change = 1
position = position+3
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,)
call ppm_ClearStatus()
call ppm_AutoUpdate(1)
exit
end
