From 8b4458693283f27f354e3569ce298bc6e0293829 Mon Sep 17 00:00:00 2001 From: Georgy Litvinov Date: Fri, 31 Jan 2020 14:35:45 +0100 Subject: [PATCH] Version 0.4.0 --- IPHRedaction/Clean.xba | 115 ++++++++++++++++++++++++++++++++++++----- description.xml | 2 +- releasenotes.txt | 1 + 3 files changed, 105 insertions(+), 13 deletions(-) diff --git a/IPHRedaction/Clean.xba b/IPHRedaction/Clean.xba index 0950c33..155ccb0 100644 --- a/IPHRedaction/Clean.xba +++ b/IPHRedaction/Clean.xba @@ -1,6 +1,6 @@ -Sub mark4 +Sub mark6 End Sub @@ -15,8 +15,8 @@ Sub cleanButton saveDocument doNotTrack statusIndicator.Start("Чистка документа начата, подождите",30) + replaceStyleFonts unicodeSymbolsConversion - cleanFormatting removeHyperlinks disposeAllBookmarks @@ -43,7 +43,51 @@ Private Sub removeFirstElementPageBreak EndIf End Sub +Private Sub replaceStyleFonts +' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) + replaceFontsInStyles("IPH Lib Serif","IPH Astra Serif") + replaceFontsInStyles("Liberation Serif","IPH Astra Serif") + replaceFontsInStyles("PTSerif","IPH Astra Serif") + replaceFontsInStyles("PT Serif","IPH Astra Serif") + replaceFontsInStyles("ArabicD","IPH Astra Serif") + replaceFontsInStyles("Palatino Linotype Greek","Tinos") +End Sub + +Private Sub replaceFontsInStyles(oldFontStart,newFontName) + ' 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("CharFontName") Then + fontName = oStyle.getPropertyValue("CharFontName") + oPositionOfMatch = InStr(fontName, oldFontStart) + If oPositionOfMatch = 1 Then + oStyle.CharFontName = newFontName + If propertySetInfo.hasPropertyByName("CharFontNameComplex") Then + oStyle.CharFontNameComplex = newFontName + ENdIf + If propertySetInfo.hasPropertyByName("CharFontNameAsian") Then + oStyle.CharFontNameAsian = newFontName + ENdIf + + EndIf + EndIf + Next + Next +End Sub + Private Sub unicodeSymbolsConversion + + convertWLLatin2IPHAstra + Dim newFontName As String newFontName = "IPH Astra Serif" Dim RAtts(2) as new com.sun.star.beans.PropertyValue @@ -61,7 +105,8 @@ Private Sub unicodeSymbolsConversion 'Basic Latin \u0020-\u007E 'Combining diacritical marks 0301 0304 0323 032e 0331 035f 'General Punctuation \u2000-\u206f - unicodeConversionEverywhere("[\u2100-\u214F,\u0080-\u00FF,\u0400-\u04FF,\u0020-\u007E,\u2000-\u206f,\u0301,\u0304,\u0323,\u032e,\u0331,\u035f]+",RAtts) +' unicodeConversionEverywhere("[\u0020-\u007F]+",RAtts) + unicodeConversionEverywhere("[\u2100-\u214F,\u0020-\u007F,\u0080-\u00FF,\u0400-\u04FF,\u2000-\u206f,\u0301,\u0304,\u0323,\u032e,\u0331,\u035f]+",RAtts) 'Arabic Scheherazade newFontName = "Scheherazade" RAtts(0).Value = newFontName @@ -74,10 +119,11 @@ Private Sub unicodeSymbolsConversion RAtts(0).Value = newFontName RAtts(1).Value = newFontName RAtts(2).Value = newFontName - 'Greek and Coptic - unicodeConversionEverywhere("[\u0370-\u03FF]+",RAtts) - 'Greek extended - unicodeConversionEverywhere("[\u1F00-\u1FFF]+",RAtts) + 'Greek and Coptic 0370—03FF + 'Greek extended 1F00—1FFF + unicodeConversionEverywhere("[\u0370-\u03FF,\u1F00-\u1FFF]+",RAtts) + + 'DejaVu Sans Mathematical operators newFontName = "DejaVu Sans" RAtts(0).Value = newFontName @@ -116,7 +162,13 @@ Private Sub convertFontsToCharStyles EndIf If curFont <> "IPH Astra Serif" AND curFont <> "" Then If Not DocHasCharStyle(oDoc,curFont) Then - oProps() = Array(CreateProperty("CharFontName", curFont)) + Dim oProps(2) As New com.sun.star.beans.PropertyValue + oProps(0).Name = "CharFontName" + oProps(1).Name = "CharFontNameComplex" + oProps(2).Name = "CharFontNameAsian" + oProps(0).Value = curFont + oProps(1).Value = curFont + oProps(2).Value = curFont CreateCharacterStyle(curFont, oProps()) End If founds.CharStyleNames = Array(curFont) @@ -371,16 +423,18 @@ 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("com.sun.star.frame.DispatchHelper") oSearch = ThisComponent.createSearchDescriptor() oSearch.SearchString = searchPattern +' Mri oSearch oSearch.SearchRegularExpression=True oSearch.SearchAll = True If Not IsMissing (SrchAttributes) Then If Not IsEmpty(SrchAttributes(0).Value) Then - oSearch.searchStyles = true + oSearch.searchStyles = true oSearch.SetSearchAttributes(SrchAttributes()) End If EndIf @@ -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 = "IPH Astra Serif" + Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue + Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue + SrchAttributes(0).Name = "CharFontName" + SrchAttributes(0).Value = "WL LatinAllIn1Goth" + ReplAttributes(0).Name = "CharFontName" + ReplAttributes(0).Value = newFontName + + SearchString = "\uF0D4" + oReplaceString = "̱" + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false) + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true) + + SearchString = "\uF0D6" + oReplaceString = "̣" + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false) + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true) + + SearchString = "\uF0F4" + oReplaceString = "̄" + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false) + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true) + + ReplAttributes(0).Value = newFontName + SearchString = "\uF0F1" + oReplaceString = "́" + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, false) + ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true) + + replaceFontsInStyles( "WL LatinAllIn1Goth", newFontName) +End Sub \ No newline at end of file diff --git a/description.xml b/description.xml index 3da3879..d6a8c1e 100644 --- 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"> - + Cleaning and validation documents for publishing in html and epub with pagination diff --git a/releasenotes.txt b/releasenotes.txt index 3a328dc..8f1bd1e 100644 --- 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)