Version 0.4.0

2020-01-31 14:35:45 +01:00 · 2020-01-31 14:35:45 +01:00 · 8b44586932
commit 8b44586932
parent ffbca8cc0a
3 changed files with 105 additions and 13 deletions
--- a/IPHRedaction/Clean.xba
+++ b/IPHRedaction/Clean.xba
@ -1,6 +1,6 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
-<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub mark4
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub mark6

 End Sub

@ -15,8 +15,8 @@ Sub cleanButton
 	saveDocument
 	doNotTrack
 	statusIndicator.Start(&quot;Чистка документа начата, подождите&quot;,30)
+	replaceStyleFonts
    unicodeSymbolsConversion	
-	
 	cleanFormatting
 	removeHyperlinks
 	disposeAllBookmarks
@ -43,7 +43,51 @@ Private Sub removeFirstElementPageBreak
 	EndIf 
 End Sub

+Private Sub replaceStyleFonts
+&apos;	Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
+	replaceFontsInStyles(&quot;IPH Lib Serif&quot;,&quot;IPH Astra Serif&quot;)
+	replaceFontsInStyles(&quot;Liberation Serif&quot;,&quot;IPH Astra Serif&quot;)
+	replaceFontsInStyles(&quot;PTSerif&quot;,&quot;IPH Astra Serif&quot;)
+	replaceFontsInStyles(&quot;PT Serif&quot;,&quot;IPH Astra Serif&quot;)
+	replaceFontsInStyles(&quot;ArabicD&quot;,&quot;IPH Astra Serif&quot;)
+	replaceFontsInStyles(&quot;Palatino Linotype Greek&quot;,&quot;Tinos&quot;)	
+End Sub
+
+Private Sub replaceFontsInStyles(oldFontStart,newFontName)
+	&apos; Substitutes font names starts with oldFont value with newFont value
+	Dim oDoc as Object
+	Dim propertySetInfo As Object
+	Dim oPositionOfMatch As Long
+	oDoc = ThisComponent
+	oFamilies = Thiscomponent.StyleFamilies
+	sElements() = oFamilies.getElementNames()
+	For i = 0 to oFamilies.count -1 
+	  oFamily = oFamilies.getByName(sElements(i))
+	  For j = 0 to oFamily.getCount -1
+	    oStyle = oFamily.getByIndex(j)
+		propertySetInfo = oStyle.getPropertySetInfo()
+	    If propertySetInfo.hasPropertyByName(&quot;CharFontName&quot;) Then
+	      fontName = oStyle.getPropertyValue(&quot;CharFontName&quot;)
+	      oPositionOfMatch = InStr(fontName, oldFontStart)
+	      If oPositionOfMatch = 1 Then
+	        oStyle.CharFontName = newFontName
+			If propertySetInfo.hasPropertyByName(&quot;CharFontNameComplex&quot;) Then
+				oStyle.CharFontNameComplex = newFontName
+			ENdIf
+			If propertySetInfo.hasPropertyByName(&quot;CharFontNameAsian&quot;) Then
+				oStyle.CharFontNameAsian = newFontName
+			ENdIf
+     	    
+	      EndIf
+	    EndIf
+	  Next
+	Next
+End Sub
+
 Private Sub unicodeSymbolsConversion
+
+	convertWLLatin2IPHAstra
+	
 	Dim newFontName As String
 	newFontName = &quot;IPH Astra Serif&quot;
 	Dim RAtts(2) as new com.sun.star.beans.PropertyValue
@ -61,7 +105,8 @@ Private Sub unicodeSymbolsConversion
 	&apos;Basic Latin \u0020-\u007E
 	&apos;Combining diacritical marks 0301 0304 0323 032e 0331 035f
 	&apos;General Punctuation \u2000-\u206f
-	unicodeConversionEverywhere(&quot;[\u2100-\u214F,\u0080-\u00FF,\u0400-\u04FF,\u0020-\u007E,\u2000-\u206f,\u0301,\u0304,\u0323,\u032e,\u0331,\u035f]+&quot;,RAtts)
+&apos;	unicodeConversionEverywhere(&quot;[\u0020-\u007F]+&quot;,RAtts)
+	unicodeConversionEverywhere(&quot;[\u2100-\u214F,\u0020-\u007F,\u0080-\u00FF,\u0400-\u04FF,\u2000-\u206f,\u0301,\u0304,\u0323,\u032e,\u0331,\u035f]+&quot;,RAtts)
 	&apos;Arabic Scheherazade
 	newFontName = &quot;Scheherazade&quot;
 	RAtts(0).Value = newFontName
@ -74,10 +119,11 @@ Private Sub unicodeSymbolsConversion
 	RAtts(0).Value = newFontName
 	RAtts(1).Value = newFontName
 	RAtts(2).Value = newFontName
-	&apos;Greek and Coptic
-	unicodeConversionEverywhere(&quot;[\u0370-\u03FF]+&quot;,RAtts)
-	&apos;Greek extended
-	unicodeConversionEverywhere(&quot;[\u1F00-\u1FFF]+&quot;,RAtts)
+	&apos;Greek and Coptic 0370—03FF
+	&apos;Greek extended 1F00—1FFF
+	unicodeConversionEverywhere(&quot;[\u0370-\u03FF,\u1F00-\u1FFF]+&quot;,RAtts)
+
+
 	&apos;DejaVu Sans Mathematical operators
 	newFontName = &quot;DejaVu Sans&quot;
 	RAtts(0).Value = newFontName
@ -116,7 +162,13 @@ Private Sub convertFontsToCharStyles
        EndIf
 	    If curFont &lt;&gt; &quot;IPH Astra Serif&quot; AND curFont &lt;&gt; &quot;&quot; Then
 	        If Not DocHasCharStyle(oDoc,curFont) Then
-		        oProps() = Array(CreateProperty(&quot;CharFontName&quot;, curFont))
+                Dim oProps(2) As New com.sun.star.beans.PropertyValue
+				oProps(0).Name = &quot;CharFontName&quot;
+				oProps(1).Name = &quot;CharFontNameComplex&quot;
+				oProps(2).Name = &quot;CharFontNameAsian&quot;
+				oProps(0).Value = curFont
+				oProps(1).Value = curFont
+				oProps(2).Value = curFont
 				CreateCharacterStyle(curFont, oProps())
 			End If
 		    founds.CharStyleNames = Array(curFont)
@ -371,11 +423,13 @@ Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optiona
 	Dim oSearch
 	Dim oTextCursor As Object 
 	Dim oViewCursor As Object
-	Dim lineIndent
 	Dim replace As Boolean
+	Dim attrName As string
+	Dim attrValue As String
 	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
 	oSearch = ThisComponent.createSearchDescriptor()
 	oSearch.SearchString = searchPattern
+&apos;	Mri oSearch
 	oSearch.SearchRegularExpression=True
    oSearch.SearchAll = True
    If Not IsMissing (SrchAttributes) Then 
@ -402,8 +456,10 @@ Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optiona
 		EndIf
 		If replace then
 			For i = LBound(ReplAttributes) To Ubound(ReplAttributes)
-		  		If oFound.getPropertySetInfo.hasPropertyByName(ReplAttributes(i).Name) Then
-					oFound.SetPropertyValue(ReplAttributes(i).Name,ReplAttributes(i).Value)
+				attrName = ReplAttributes(i).Name
+				attrValue = ReplAttributes(i).Value
+		  		If oFound.getPropertySetInfo.hasPropertyByName(attrName) Then
+					oFound.SetPropertyValue(attrName,attrValue)
 				EndIf
 			Next i
 		EndIf	  
@ -907,4 +963,39 @@ Private Function getStyleNames(oFamily,bLocalized as Boolean, _
 	Endif
 	xArray(iUB) = vNextElement
 End Sub
+
+
+Private Sub convertWLLatin2IPHAstra
+	Dim newFontName As String
+	newFontName = &quot;IPH Astra Serif&quot;
+	Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
+	Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue
+	SrchAttributes(0).Name = &quot;CharFontName&quot;
+	SrchAttributes(0).Value = &quot;WL LatinAllIn1Goth&quot;
+	ReplAttributes(0).Name = &quot;CharFontName&quot;
+	ReplAttributes(0).Value = newFontName
+	
+	SearchString = &quot;\uF0D4&quot;
+	oReplaceString = &quot;̱&quot;
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true)
+	
+	SearchString = &quot;\uF0D6&quot;
+	oReplaceString = &quot;̣&quot;
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true)
+	
+	SearchString = &quot;\uF0F4&quot;
+	oReplaceString = &quot;̄&quot;
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true)
+	
+	ReplAttributes(0).Value = newFontName
+	SearchString = &quot;\uF0F1&quot;
+	oReplaceString = &quot;́&quot;
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
+	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true)
+	
+	replaceFontsInStyles( &quot;WL LatinAllIn1Goth&quot;, newFontName)
+End Sub
 </script:module>
--- a/description.xml
+++ b/description.xml
@ -3,7 +3,7 @@
             xmlns:dep="http://openoffice.org/extensions/description/2006"
             xmlns:xlink="http://www.w3.org/1999/xlink">
  <identifier value="pro.litvinovg.Redaction" />
-  <version value="0.3.7" />
+  <version value="0.4.0" />
  <platform value="all" />
  <display-name>
    <name lang="en">Cleaning and validation documents for publishing in html and epub with pagination</name>
--- a/releasenotes.txt
+++ b/releasenotes.txt
@ -1,3 +1,4 @@
+0.4.0 Added fonts in styles conversion, also added conversion for WL Latin symbols
 0.3.7 Added greek extended conversion to Tinos, extended latin and letter-like symbols to base font
 0.3.6 Added check for null EmbeededObject (13.01.2019)
 0.0.1 (18.10.2019)