litvinovg/cleanandvalidate
1
0
Fork 0
Code Issues 4 Pull requests Projects Releases 50 Packages Wiki Activity Actions

Fix diacritic characters

Browse source
This commit is contained in:
Georgy Litvinov 2021-10-28 20:54:54 +02:00
parent 907c483775
commit 8bef4474ae
7 changed files with 106 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

70
Redaction/Clean.xba
View file

@ -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 mark93
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub mark95
End Sub
@ -50,6 +50,7 @@ Private Sub makerUpMenu
advancedCleaningDialog.getControl(&quot;convertFontsToCharStyles&quot;).Label = getTranslation(&quot;advancedMenuconvertFontsToCharStyles&quot;)
advancedCleaningDialog.getControl(&quot;fixBrokenCharBackTransparent&quot;).Label = getTranslation(&quot;fixBrokenCharBackTransparentMenuItem&quot;)
advancedCleaningDialog.getControl(&quot;removeNotTransparentBackgrounds&quot;).Label = getTranslation(&quot;removeNotTransparentBackgrounds&quot;)
advancedCleaningDialog.getControl(&quot;fixDiacriticKerning&quot;).Label = getTranslation(&quot;fixDiacriticKerning&quot;)
advancedCleaningDialog.getControl(&quot;Cancel&quot;).Label = getTranslation(&quot;buttonCancel&quot;)
advancedCleaningDialog.getControl(&quot;OK&quot;).Label = getTranslation(&quot;buttonOK&quot;)
advancedCleaningDialog.getControl(&quot;buttonLoad&quot;).Label = getTranslation(&quot;buttonLoad&quot;)
@ -164,7 +165,9 @@ Private Sub cleanAccordingTo(dialog As Object)
If dialog.getControl(&quot;removeNotTransparentBackgrounds&quot;).state = 1 Then
fixColoredBackgroundInDoc()
EndIf
If dialog.getControl(&quot;fixDiacriticKerning&quot;).state = 1 Then
fixDiacriticKerning()
EndIf
statusIndicator.end()
saveAndreload()
@ -203,6 +206,8 @@ Private Sub quietCleaning
saveAndreload()
statusIndicator = ThisComponent.getCurrentController.statusIndicator
unicodeSymbolsConversion
statusIndicator.Start(getTranslation(&quot;statusFixingDiacriticCharactersKerning&quot;),100)
fixDiacriticKerning
statusIndicator.Start(getTranslation(&quot;statusCleaningManualFormatting&quot;),100)
cleanFormatting
statusIndicator.Start(getTranslation(&quot;statusReplaceWhiteBackground&quot;),100)
@ -330,7 +335,7 @@ Private Sub unicodeSymbolsConversion
&apos;Cyrillic unicode block range \u0400-\u04FF
&apos;Basic Latin \u0020-\u007E
&apos;Combining diacritical marks 0301 0304 0303 0323 032e 0331 035f
combiningDiacritic_Astra = &quot;\u0301\u0303\u0304\u0323\u032e\u0331\u0341\u035f&quot;
combiningDiacritic_Astra = &quot;\u0301\u0303\u0304\u0308\u0323\u032e\u0331\u0341\u035f&quot;
Dim extendedLatinA_Astra As String
extendedLatinA_Astra = &quot;\u1e15\u1e17\u1e53\u0129\u0169&quot;
&apos;
@ -2118,4 +2123,63 @@ Function fixColoredBackgroundInDoc() As Boolean
EndIf
End Function
Sub fixDiacriticKerning
Dim oSearch As Object
Dim oFound As Object
Dim oPara As Object
turnOffTracking()
oSearch = ThisComponent.createSearchDescriptor()
oSearch.SearchString = &quot;[\u0300-\u036F]&quot;
oSearch.SearchRegularExpression=True
oSearch.searchAll=True
oFound = ThisComponent.findFirst(oSearch)
Do While Not IsNull(oFound)
oPara = oFound.TextParagraph
fixDiacriticKerningInPara(oPara)
oFound = ThisComponent.findNext(oFound.End, oSearch)
Loop
End Sub
Sub fixDiacriticKerningInPara(oPara As Object)
Dim paraEnum As Object
Dim portion As Object
Dim prevPortion As Object
paraEnum = oPara.createEnumeration
If paraEnum.hasMoreElements Then
prevPortion = paraEnum.nextElement
While paraEnum.hasMoreElements
portion = paraEnum.nextElement
While isFirstCharDiacritic(portion)
moveFirstCharacter(portion, prevPortion)
Wend
prevPortion = portion
Wend
EndIf
End Sub
Function isFirstCharDiacritic(portion As Object) As Boolean
isFirstCharDiacritic = false
Dim portionText As String
Dim diaLowBound As Long
Dim diaHighBound As Long
Dim charNum As Long
diaLowBound = 768
diaHighBound = 879
portionText = portion.String
If Len(portionText) = 0 Then
Exit Function
EndIf
charNum = Asc(portionText)
If charNum &gt;= diaLowBound And charNum &lt;= diaHighBound Then
isFirstCharDiacritic = true
EndIf
End Function
Sub moveFirstCharacter(portion As Object, prevPortion As Object)
prevPortion.String = prevPortion.String &amp; Left(portion.String,1)
portion.String = Right(portion.String,Len(portion.String) - 1)
End Sub
</script:module>