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

Code cleaning

Browse source
This commit is contained in:
Georgy Litvinov 2020-03-21 11:55:13 +01:00
parent bf58089cf1
commit 21d1d274bd
4 changed files with 73 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

125
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 mark33
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub mark34
End Sub
@ -28,7 +28,7 @@ Private Sub makerUpMenu
Exit sub
End Sub
Private Sub cleanAccordingTo(dialog)
Private Sub cleanAccordingTo(dialog As Object)
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
dialog.setVisible(false)
@ -141,6 +141,8 @@ Private Sub quietCleaning
End Sub
Private Sub removeFirstElementPageBreak
Dim enum1 As Object
Dim enum1Element As Object
enum1 = ThisComponent.Text.createEnumeration
If enum1.hasMoreElements Then
enum1Element = enum1.nextElement
@ -163,12 +165,14 @@ Private Sub replaceStyleFonts
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
Private Sub replaceFontsInStyles(oldFontStart As String,newFontName As String)
Dim propertySetInfo As Object
Dim oPositionOfMatch As Long
oDoc = ThisComponent
Dim oFamilies As Object
Dim sElements As Object
Dim oFamily As Object
Dim oStyle As Object
Dim fontName As String
oFamilies = Thiscomponent.StyleFamilies
sElements() = oFamilies.getElementNames()
For i = 0 to oFamilies.count -1
@ -183,10 +187,10 @@ Private Sub replaceFontsInStyles(oldFontStart,newFontName)
oStyle.CharFontName = newFontName
If propertySetInfo.hasPropertyByName(&quot;CharFontNameComplex&quot;) Then
oStyle.CharFontNameComplex = newFontName
ENdIf
EndIf
If propertySetInfo.hasPropertyByName(&quot;CharFontNameAsian&quot;) Then
oStyle.CharFontNameAsian = newFontName
ENdIf
EndIf
EndIf
EndIf
@ -248,18 +252,19 @@ Private Sub unicodeSymbolsConversion
End Sub
Private Sub unicodeConversionEverywhere(searchPattern,rAtts)
&apos;in text
Private Sub unicodeConversionEverywhere(searchPattern As String,rAtts)
setAttributesBySearchPattern(searchPattern,RAtts)
End Sub
&apos;Replaces manual formatting text with font into character style with assigned font
Private Sub convertFontsToCharStyles
Dim oDoc
oDoc = Thiscomponent
Dim oDoc As Object
Dim SDesc As Object
Dim founds As Object
Dim curFont As String
Dim srch(0) as new com.sun.star.beans.PropertyValue
oDoc = Thiscomponent
SDesc = Thiscomponent.createSearchDescriptor()
SDesc.SearchAll = true
SDesc.ValueSearch = false
@ -294,9 +299,11 @@ End Sub
Private Sub removeUserPageStyles
Dim oStyles As Object
Dim oStyle As Object
oStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
Dim count As Long
Dim i As Long
oStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
count = oStyles.count - 1
For i = 0 to count
oStyle = oStyles.getByIndex(i)
If oStyle.isUserDefined Then
@ -366,29 +373,29 @@ Private Sub fixFrequentMistakes
End Sub
Private Sub loadArticleStyles
Dim dispatcher as object
Dim fileePath As String
Dim fileTest As Object
Dim fileName As String
Dim aArgs(0) As New com.sun.star.beans.PropertyValue
fileName = &quot;Статья.ott&quot;
filePath = getTemplatePath() &amp; &quot;/&quot; &amp; fileName
fileTest = CreateUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
If NOT fileTest.exists(filePath) Then
MsgBox &quot;Файл стилей &quot; &amp; fileName &amp; &quot; не добавлен в Мои шаблоны. Не могу загрузить стили в текущий файл.&quot;
Exit Sub
EndIf
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
Dim dispatcher As Object
Dim filePath As String
Dim fileTest As Object
Dim fileName As String
Dim aArgs(0) As New com.sun.star.beans.PropertyValue
fileName = &quot;Статья.ott&quot;
filePath = getTemplatePath() &amp; &quot;/&quot; &amp; fileName
fileTest = CreateUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
If NOT fileTest.exists(filePath) Then
MsgBox &quot;Файл стилей &quot; &amp; fileName &amp; &quot; не добавлен в Мои шаблоны. Не могу загрузить стили в текущий файл.&quot;
Exit Sub
EndIf
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
aArgs(0).Name = &quot;OverwriteStyles&quot;
aArgs(0).Value = True
ThisComponent.StyleFamilies.loadStylesFromURL( filePath, aArgs() )
End Sub
Private Sub CreateCharacterStyle(sStyleName$, oProps())
Dim i%
Dim oFamilies
Dim oStyle
Dim oStyles
Private Sub CreateCharacterStyle(sStyleName As String, oProps())
Dim i As Integer
Dim oFamilies As Object
Dim oStyle As Object
Dim oStyles As Object
oFamilies = ThisComponent.StyleFamilies
oStyles = oFamilies.getByName(&quot;CharacterStyles&quot;)
If oStyles.HasByName(sStyleName) Then
@ -412,21 +419,20 @@ Private Function CreateProperty( Optional cName As String, Optional uValue ) As
CreateProperty() = oPropertyValue
End Function
Private Sub AskAndReplace(SearchString, oReplaceString)
Private Sub AskAndReplace(SearchString As String, oReplaceString As String)
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue
ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true)
End Sub
Private Function DocHasCharStyle(oDoc, sName$) As Boolean
Dim oStyles
Dim oStyles As Object
oStyles = oDoc.StyleFamilies.getByName(&quot;CharacterStyles&quot;)
DocHasCharStyle() = oStyles.hasByName(sName)
End Function
Private Function getTemplatePath() as String
Dim ath as String
Dim path as String
Dim settings As Object
Dim configProvider As Object
Dim params(0) As new com.sun.star.beans.PropertyValue
@ -448,20 +454,17 @@ End Function
Private Sub removeHyperlinks()
Dim aNote As Object
Dim i As Long
removeHLInText(ThisComponent.Text)
For x = 0 to ThisComponent.FootNotes.Count -1
For i = 0 to ThisComponent.FootNotes.Count -1
aNote = ThisComponent.FootNotes.getByIndex(x)
removeHLInText(aNote.Text)
Next
For x = 0 to ThisComponent.EndNotes.Count -1
For i = 0 to ThisComponent.EndNotes.Count -1
aNote = ThisComponent.EndNotes.getByIndex(x)
removeHLInText(aNote.Text)
Next
End Sub
Private Sub removeHLInText(textElement)
@ -506,13 +509,16 @@ Private Sub disposeAllBookmarks()
elementName = ThisComponent.Links.ElementNames(6)
bookmarks = ThisComponent.Links.getByName(elementName)
While bookmarks.hasElements()
bookmark = bookmarks.getByName(bookmarks.ElementNames(0))
bookmark.dispose()
bookmark = bookmarks.getByName(bookmarks.ElementNames(0))
bookmark.dispose()
Wend
End Sub
Private Sub removeManualPageBreaks
Dim oTextCursor As Object
Dim enum1 As Object
Dim enum1Element As Object
oTextCursor = ThisComponent.Text.CreateTextCursor()
enum1 = ThisComponent.Text.createEnumeration
While enum1.hasMoreElements
@ -538,12 +544,15 @@ Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optiona
doNotTrack
dim stringValue1 As String
dim stringValue2 As String
Dim oSearch
Dim oSearch As Object
Dim oTextCursor As Object
Dim oViewCursor As Object
Dim replace As Boolean
Dim attrName As string
Dim attrValue As String
Dim oFound As Object
Dim i As Long
Dim j As Long
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
oSearch = ThisComponent.createSearchDescriptor()
oSearch.SearchString = searchPattern
@ -585,9 +594,8 @@ Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optiona
End Sub
Private Sub saveAndreload()
dim document as object
dim dispatcher as object
Dim document As Object
Dim dispatcher As Object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
dispatcher.executeDispatch(document, &quot;.uno:Save&quot;, &quot;&quot;, 0, Array())
@ -596,9 +604,8 @@ Private Sub saveAndreload()
End Sub
Private Sub saveDocument()
dim document as object
dim dispatcher as object
Dim document As Object
Dim dispatcher As Object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
dispatcher.executeDispatch(document, &quot;.uno:Save&quot;, &quot;&quot;, 0, Array())
@ -616,20 +623,16 @@ Private Sub cleanFormatting
&apos;Не должно быть пустых абзацев
AskAndReplace(&quot;^$&quot;,&quot;&quot;)
convertFormattingToText
convertFormattingToText()
convertFontsToCharStyles
convertFontsToCharStyles()
replaceBaseWithStandard
replaceBaseWithStandard()
removeDirectFormatting
removeDirectFormatting()
convertFormattingFromText
convertFormattingFromText()
End Sub
Private Sub fixTableWidth()
@ -637,6 +640,7 @@ Private Sub fixTableWidth()
Dim tables As Object
tables = ThisComponent.TextTables
Dim count As Long
Dim i As Long
count = ThisComponent.TextTables.getCount()
For i = 0 To count - 1
table = tables.getByIndex(i)
@ -654,6 +658,7 @@ Private Sub fixDrawingAnchors()
Dim drawings As Object
drawings = ThisComponent.DrawPage
Dim count As Long
Dim i As Long
count = drawings.getCount()
For i = 0 To count - 1
drawing = drawings.getByIndex(i)