diff --git a/Redaction/Clean.xba b/Redaction/Clean.xba index 826d34e..cff21ec 100644 --- a/Redaction/Clean.xba +++ b/Redaction/Clean.xba @@ -1,6 +1,6 @@ -Sub mark93 +Sub mark96 End Sub @@ -50,6 +50,7 @@ Private Sub makerUpMenu advancedCleaningDialog.getControl("convertFontsToCharStyles").Label = getTranslation("advancedMenuconvertFontsToCharStyles") advancedCleaningDialog.getControl("fixBrokenCharBackTransparent").Label = getTranslation("fixBrokenCharBackTransparentMenuItem") advancedCleaningDialog.getControl("removeNotTransparentBackgrounds").Label = getTranslation("removeNotTransparentBackgrounds") + advancedCleaningDialog.getControl("fixDiacriticKerning").Label = getTranslation("fixDiacriticKerning") advancedCleaningDialog.getControl("Cancel").Label = getTranslation("buttonCancel") advancedCleaningDialog.getControl("OK").Label = getTranslation("buttonOK") advancedCleaningDialog.getControl("buttonLoad").Label = getTranslation("buttonLoad") @@ -164,7 +165,9 @@ Private Sub cleanAccordingTo(dialog As Object) If dialog.getControl("removeNotTransparentBackgrounds").state = 1 Then fixColoredBackgroundInDoc() EndIf - + If dialog.getControl("fixDiacriticKerning").state = 1 Then + fixDiacriticKerning() + EndIf statusIndicator.end() saveAndreload() @@ -203,6 +206,8 @@ Private Sub quietCleaning saveAndreload() statusIndicator = ThisComponent.getCurrentController.statusIndicator unicodeSymbolsConversion + statusIndicator.Start(getTranslation("statusFixingDiacriticCharactersKerning"),100) + fixDiacriticKerning statusIndicator.Start(getTranslation("statusCleaningManualFormatting"),100) cleanFormatting statusIndicator.Start(getTranslation("statusReplaceWhiteBackground"),100) @@ -330,7 +335,7 @@ Private Sub unicodeSymbolsConversion 'Cyrillic unicode block range \u0400-\u04FF 'Basic Latin \u0020-\u007E 'Combining diacritical marks 0301 0304 0303 0323 032e 0331 035f - combiningDiacritic_Astra = "\u0301\u0303\u0304\u0323\u032e\u0331\u0341\u035f" + combiningDiacritic_Astra = "\u0301\u0303\u0304\u0308\u0323\u032e\u0331\u0341\u035f" Dim extendedLatinA_Astra As String extendedLatinA_Astra = "\u1e15\u1e17\u1e53\u0129\u0169" ' @@ -2118,4 +2123,67 @@ Function fixColoredBackgroundInDoc() As Boolean EndIf End Function + + +Sub fixDiacriticKerning + Dim oSearch As Object + Dim oFound As Object + Dim oPara As Object + oSearch = ThisComponent.createSearchDescriptor() + oSearch.SearchString = "[\u0300-\u036F]" + 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 >= diaLowBound And charNum <= diaHighBound Then + isFirstCharDiacritic = true + EndIf +End Function + +Sub moveFirstCharacter(portion As Object, prevPortion As Object) + Dim prevEnd As Object + Dim nextStart As Object + prevEnd = prevPortion.getEnd() + prevEnd.String = Left(portion.String,1) + nextStart = portion.Text.createTextCursorByRange(portion.Start) + nextStart.goRight(1,true) + nextStart.setString("") +End Sub + \ No newline at end of file diff --git a/Redaction/CleaningDialog.xdl b/Redaction/CleaningDialog.xdl index 317b762..af7ce20 100644 --- a/Redaction/CleaningDialog.xdl +++ b/Redaction/CleaningDialog.xdl @@ -1,10 +1,10 @@ - + - + - + @@ -20,7 +20,7 @@ - + @@ -30,6 +30,7 @@ - + + \ No newline at end of file diff --git a/Redaction/Configuration.xba b/Redaction/Configuration.xba index 62c8f70..9e4a190 100644 --- a/Redaction/Configuration.xba +++ b/Redaction/Configuration.xba @@ -1,7 +1,7 @@ Public Const redactionExtensionName = "cleanAndValidate" -Public Const redactionExtensionVersion = "0.10.5" +Public Const redactionExtensionVersion = "0.10.11" Public Const template_name_monography = "Монография" Public Const template_name_pj = "Философский журнал" Public Const template_name_pq = "Вопросы философии" diff --git a/Redaction/Translations.xba b/Redaction/Translations.xba index 538d13e..51dd9dd 100644 --- a/Redaction/Translations.xba +++ b/Redaction/Translations.xba @@ -344,6 +344,12 @@ Function getRussian(identifier As String) As String Case "templateChosen" getRussian = "Выбран шаблон" Exit Function + Case "statusFixingDiacriticCharactersKerning" + getRussian = "Исправляем комбинирование с диакритическими символами" + Exit Function + Case "fixDiacriticKerning" + getRussian = "Исправить комбинирование с диакритическими символами" + Exit Function Case Else getRussian = "Перевод не найден" End Select @@ -670,6 +676,12 @@ Function getEnglish(identifier As String) As String Case "templateChosen" getEnglish = "Selected template" Exit Function + Case "statusFixingDiacriticCharactersKerning" + getEnglish = "Fixing the combination with diacritics " + Exit Function + Case "fixDiacriticKerning" + getEnglish = "Fix combining with diacritic characters" + Exit Function Case Else getEnglish = "No translation" End Select @@ -995,6 +1007,12 @@ Function getCroatian(identifier As String) As String Case "templateChosen" getCroatian = "Izabrani šablon" Exit Function + Case "statusFixingDiacriticCharactersKerning" + getCroatian = "Popravljanje kombinacije s dijakritičkim znakovima" + Exit Function + Case "fixDiacriticKerning" + getCroatian = "Ispravite kombiniranje s naglašenim likovima" + Exit Function Case Else getCroatian = "No translation" End Select @@ -1320,6 +1338,12 @@ Function getSerbian(identifier As String) As String Case "templateChosen" getSerbian = "Изабрани шаблон" Exit Function + Case "statusFixingDiacriticCharactersKerning" + getSerbian = "Ispravljanje kombinacije sa dijakritičkim znacima " + Exit Function + Case "fixDiacriticKerning" + getSerbian = "Ispravite kombiniranje s naglašenim likovima" + Exit Function Case Else getSerbian = "No translation" End Select @@ -1645,6 +1669,12 @@ Function getBosnian(identifier As String) As String Case "templateChosen" getBosnian = "Izabrani šablon" Exit Function + Case "statusFixingDiacriticCharactersKerning" + getBosnian = "Popravljanje kombinacije s dijakritičkim znakovima" + Exit Function + Case "fixDiacriticKerning" + getBosnian = "Ispravite kombiniranje s naglašenim likovima" + Exit Function Case Else getBosnian = "No translation" End Select diff --git a/Redaction/Validation.xba b/Redaction/Validation.xba index 2f3d98c..74b0974 100644 --- a/Redaction/Validation.xba +++ b/Redaction/Validation.xba @@ -1,7 +1,6 @@ -Sub markval30 - +Sub markval31 End Sub @@ -770,11 +769,9 @@ Sub fontReportButton Exit sub EndIf Dim FileName As String - FileName = getCharsInFont(targetFontName) + getCharsInFont(targetFontName) statusIndicator.end() - If FileName <> "" Then - openReport(FileName) - EndIf + End Sub Sub onSelectFont(oEvent) @@ -914,7 +911,7 @@ Sub addToArray(xArray(),vNextElement) xArray(iUB) = vNextElement End Sub -Function getCharsInFont(fontName As String) As String +Sub getCharsInFont(fontName As String) Dim resultArray() As String Dim pageNums() As Long Dim firstPages() As Long @@ -1000,43 +997,30 @@ Function getCharsInFont(fontName As String) As String EndIf Next j Next i - resultString = "" - For i = LBound(resultArray) To UBound(resultArray) - resultString = resultString & "<a href='https://unicode-table.com/ru/" & resultArray(i) & "'" & ">https://unicode-table.com/ru/" & resultArray(i) & "</a> " & getTranslation("charFirstPage") & " " & pageNums(i) & "<br>" & Chr(10) - Next i - If resultString <> "" Then - 'MsgBox "Символы в шрифте "& fontName &Chr(10)&resultString - Dim FileName As String 'Holds the file name - Dim n As Integer 'Holds the file number - Dim f As Integer 'Index variable - Dim s As String 'Temporary string for input - Dim fileaccess As Object - Dim outtextstream As Object - Dim out As Object - - Dim sTemp$ - GlobalScope.BasicLibraries.loadLibrary("Tools") - path=DirectoryNameoutofPath(ThisComponent.getURL(),"/") - FileName = path & "/symbolsInFont" & fontName & ".html" - 'n = FreeFile() 'Next free file number - 'Open FileName For Output Access Read Write As #n 'Open for read/write - fileaccess = createUnoService ("com.sun.star.ucb.SimpleFileAccess") - outtextstream = createUnoService ("com.sun.star.io.TextOutputStream") - outtextstream.setEncoding( "UTF-8" ) - out = fileaccess.openFileWrite( FileName ) - outtextstream.setOutputStream( out ) - outtextstream.writeString( "<html><head><title>" & getTranslation("symbolsInFontHeading") & " "& fontName & "</title></head><body><h2>" & getTranslation("symbolsInFontHeading") & " "& fontName &":</h2>"&resultString &"</body></html>" ) - outtextstream.closeOutput() - getCharsInFont = FileName - Exit Function + Dim newDocCursor As Object + Dim newDoc As Object + newDoc = starDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Array()) + newDocCursor = newDoc.getCurrentController().getViewCursor() + newDocCursor.String = getTranslation("symbolsInFontHeading") & " " & fontName + newDocCursor.ParaStyleName = "Heading 1" + newDocCursor.collapseToEnd() + newDocCursor.Text.insertControlCharacter(newDocCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + For i = LBound(resultArray) To UBound(resultArray) + newDocCursor.ParaStyleName = "Text body" + newDocCursor.String = "https://unicode-table.com/ru/" & resultArray(i) + newDocCursor.HyperLinkURL = "https://unicode-table.com/ru/" & resultArray(i) + newDocCursor.collapseToEnd() + newDocCursor.String = " " & getTranslation("charFirstPage") & " " & pageNums(i) + newDocCursor.collapseToEnd() + newDocCursor.Text.insertControlCharacter(newDocCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + Next i + Exit Sub Else MsgBox getTranslation("symbolsInFontNotFound1") & " " & fontName & " " & getTranslation("symbolsInFontNotFound2") - getCharsInFont = "" - Exit Function EndIf -End Function +End Sub Function findBadCharacters() As Boolean diff --git a/cleanandvalidate.update.xml b/cleanandvalidate.update.xml index 3585505..19726d1 100644 --- a/cleanandvalidate.update.xml +++ b/cleanandvalidate.update.xml @@ -2,9 +2,9 @@ - + - + diff --git a/description.xml b/description.xml index 63c2ecb..be730b9 100644 --- a/description.xml +++ b/description.xml @@ -21,7 +21,7 @@ - + diff --git a/gradle.properties b/gradle.properties index 58ee9a0..8e6f42e 100644 --- a/gradle.properties +++ b/gradle.properties @@ -1 +1 @@ -version=0.10.6 +version=0.10.11 diff --git a/templates/articles/статья_фж.ott b/templates/articles/статья_фж.ott index 8c1eb5c..02e22b0 100644 Binary files a/templates/articles/статья_фж.ott and b/templates/articles/статья_фж.ott differ diff --git a/translations.ods b/translations.ods index ac58eef..d685210 100644 Binary files a/translations.ods and b/translations.ods differ