2021-02-19 22:53:23 +00:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
2021-05-04 11:50:02 +01:00
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ApZotFunctions" script:language="StarBasic">REM ***** BASIC *****
'************************************************************************
'* Copyright 2021 by Bastien Dumont (bastien.dumont@posteo.net)
'*
'* This file is part of the ApresZotero library.
'*
'* ApresZotero is free software: you can redistribute it and/or modify
'* it under the terms of the GNU General Public License as published by
'* the Free Software Foundation, either version 3 of the License, or
'* (at your option) any later version.
'*
'* ApresZotero is distributed in the hope that it will be useful,
'* but WITHOUT ANY WARRANTY; without even the implied warranty of
'* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'* GNU General Public License for more details.
'*
'* You should have received a copy of the GNU General Public License
'* along with ApresZotero. If not, see <https://www.gnu.org/licenses/>.
'*
'************************************************************************
2021-02-19 22:53:23 +00:00
Option Compatible
Option Explicit
Function Check (mJournal As String) As Integer
Dim iReturnCode As Long
iReturnCode = MsgBox("Avez-vous terminé de modifier le document et actualisé les citations Zotéro
If iReturnCode = 7 Then
MsgBox("Veuillez terminer votre travail sur le document et actualiser les citations avant de lancer la macro.", 0, mJournal)
End If
Check = iReturnCode
End Function
Sub Abbreviate (oDocument As Object, mTitreLong() As Variant, mAbrev() As Variant, mEditeur As String, bExpandFirstCitation As Boolean)
REM Cette subroutine devrait devenir obsolète si les pistes envisagées dans le fil et la page ci-dessous se concrétisent
REM https://forums.zotero.org/discussion/comment/325925#Comment_325925
REM https://www.zotero.org/support/kb/journal_abbreviations
Dim oSearch As Object
Dim sCited As String
Dim oCursor As Object
Dim n As Integer
Dim oOccurrence As Object
Dim bAlreadyAbbreviated As Boolean
Dim iReturnCode As Integer
Dim vCharPosture As Variant
On Error Goto ErrorHandler 'Si l'utilisateur a tenté de lancer cette sous-routine, oDocument n'est pas défini.
oSearch = oDocument.createSearchDescriptor()
oSearch.SearchWords = TRUE
oSearch.SearchRegularExpression = FALSE
oSearch.SearchCaseSensitive = FALSE
On Error GoTo 0
oCursor = oDocument.getCurrentController.getViewCursor()
For n = lbound(mTitreLong) To ubound(mTitreLong)
oSearch.SearchString = mTitreLong(n)
oOccurrence = oDocument.findFirst(oSearch)
bAlreadyAbbreviated = FALSE
Do While Not IsNull(oOccurrence)
oCursor.gotoRange(oOccurrence, False)
iReturnCode = MsgBox("Remplacer le texte sélectionné par l'abréviation correspondante ?", 3, mEditeur)
If iReturnCode = 2 Then 'Cancel
MsgBox("Vous avez arrêté l'exécution de la macro, mais les éventuels titres de revues déjà remplacés n'ont pas été restaurés.", 0, mEditeur)
Exit Sub
ElseIf iReturnCode = 6 Then 'Yes
vCharPosture = oCursor.CharPosture
If bExpandFirstCitation AND bAlreadyAbbreviated = FALSE Then
oCursor.collapseToEnd()
oCursor.setString(" (" & mAbrev(n) & ")")
oCursor.CharPosture = vCharPosture
bAlreadyAbbreviated = TRUE
Else
oCursor.setString(mAbrev(n))
oCursor.CharPosture = vCharPosture
End If
ElseIf iReturnCode = 7 Then 'No
End If
oOccurrence = oDocument.findNext(oOccurrence.End, oSearch)
Loop
Next n
Exit Sub
ErrorHandler:
If Err = 449 Then
MsgBox("La macro Abbreviate n'est pas destinée à être lancée directement par l'utilisateur. "&_
"Veuillez lancer la macro correspondant au nom de la revue souhaité.", 0, "Erreur")
Else
MsgBox(Error$, 0, "Erreur")
End If
On Error Goto 0
End Sub
Sub SetStringPartToExponent(oScope As Object, sWholeStringRegex As String, sSubstringInExponentRegex As String)
Dim oViewProperties As Object
Dim nCurrentZoomFactor As Integer
Dim oWholeStringSearch As Object
Dim oWholeStringResult As Object
Dim oFound As Object
Dim iResult As Integer
Dim oFoundCursor As Object
Dim iReturnCode As Integer
oViewProperties = ThisComponent.getViewData().getByIndex(0)
nCurrentZoomFactor = getCurrentZoomFactor()
ThisComponent.CurrentController.ViewSettings.ZoomType = 3
ThisComponent.CurrentController.ViewSettings.ZoomValue = nBigZoomFactor
oWholeStringSearch = ThisComponent.createSearchDescriptor
oWholeStringSearch.SearchString = sWholeStringRegex
oWholeStringSearch.SearchRegularExpression = TRUE
oWholeStringResult = oScope.findAll(oWholeStringSearch)
oFoundCursor = ThisComponent.getCurrentController.getViewCursor()
For iResult = 0 To oWholeStringResult.count - 1
oFound = oWholeStringResult.getByIndex(iResult)
oFoundCursor.gotoRange(oFound, False)
PlaceCursorOnSubstring(oFoundCursor, sSubstringInExponentRegex)
iReturnCode = MsgBox("Mettre le texte surligné en exposant
If iReturnCode = 2 Then 'Cancel
MsgBox("Vous avez arrêté l'exécution de la macro, mais les actions déjà réalisées n'ont pas été annulées.", 0)
ThisComponent.CurrentController.ViewSettings.ZoomValue = nCurrentZoomFactor
Exit Sub
ElseIf iReturnCode = 6 Then 'Yes
oFoundCursor.CharEscapement = nExponentCharSizePercentage
oFoundCursor.CharEscapementHeight = nExponentCharHeightPercentage
ElseIf iReturnCode = 7 Then 'No
End If
Next iResult
ThisComponent.CurrentController.ViewSettings.ZoomValue = nCurrentZoomFactor
End Sub
Function getCurrentZoomFactor() As Integer
Dim oDocument As Object
Dim oViewProperties As Object
Dim iProperty As Integer
oViewProperties = ThisComponent.getViewData().getByIndex(0)
For iProperty = 0 to UBound(oViewProperties)
If oViewProperties(iProperty).Name = "ZoomFactor" Then
getCurrentZoomFactor = oViewProperties(iProperty).Value
End If
Next iProperty
End Function
Sub PlaceCursorOnSubstring(oCursor As Object, sSubstringRegex As String)
Dim oSubstringSearch As Object
Dim oResult As Object
oSubstringSearch = ThisComponent.createSearchDescriptor()
oSubstringSearch.SearchString = sSubstringRegex
oSubstringSearch.SearchRegularExpression = TRUE
oResult = ThisComponent.findNext(oCursor.getStart(), oSubstringSearch)
oCursor.gotoRange(oResult, FALSE)
End Sub
Function extractMatchingString(sSearchedString As String, aSearchResult As Object, iMatch As Integer, nCharsToIgnore As Integer) As String
Dim iMatchStartPos As Integer
Dim nMatchLen As Integer
iMatchStartPos = aSearchResult.startOffset(iMatch) + 1
nMatchLen = aSearchResult.endOffset(iMatch) - aSearchResult.startOffset(iMatch)
extractMatchingString = Mid(sSearchedString, iMatchStartPos+nCharsToIgnore, nMatchLen-nCharsToIgnore)
End Function
Sub AddItemToMap(vMap() As Variant, sID As String, sTitle As String)
Dim iItem As Integer
For iItem = LBound(vMap(), 1) To UBound(vMap(), 1)
If vMap(iItem, 0) = sID Then
vMap(iItem, 2) = vMap(iItem, 2)+1
Exit Sub
End If
Next iItem
vMap(UBound(vMap(), 1), 0) = sID
vMap(UBound(vMap(), 1), 1) = sTitle
vMap(UBound(vMap(), 1), 2) = 1
ReDim Preserve vMap(UBound(vMap(), 1)+1, 3) As Variant
End Sub
Function sortMapByNbOccurrences(ByVal vMap() As Variant)
Dim vSortedMap(UBound(vMap(), 1), 3) As Variant
Dim iSortedMap As Integer
Dim nMaxOccurrences As Integer
Dim iNbOccurrences As Integer
Dim iMap As Integer
nMaxOccurrences = getMaxOccurrences(vMap)
iSortedMap = 0
For iNbOccurrences = nMaxOccurrences To 1 Step -1
For iMap = LBound(vMap(), 1) To UBound(vMap(), 1)
If vMap(iMap, 2) = iNbOccurrences Then
vSortedMap(iSortedMap, 0) = vMap(iMap, 0)
vSortedMap(iSortedMap, 1) = vMap(iMap, 1)
vSortedMap(iSortedMap, 2) = iNbOccurrences
iSortedMap = iSortedMap+1
End If
Next iMap
Next iNbOccurrences
sortMapByNbOccurrences = vSortedMap
End Function
Function getMaxOccurrences(vMap As Variant)
Dim nCurrentOccurrences As Integer
Dim iMap As Integer
For iMap = LBound(vMap(), 1) To UBound(vMap(), 1)
If vMap(iMap, 2) > nCurrentOccurrences Then
nCurrentOccurrences = vMap(iMap, 2)
End If
Next iMap
getMaxOccurrences = nCurrentOccurrences
End Function
Sub PrintMap(vMap() As Variant)
Dim oDocumentText As Object
Dim iMap As Integer
Dim sStringToInsert As String
oDocumentText = ThisComponent.Text
oDocumentText.insertString(oDocumentText.End, CHR$(10) & CHR$(10) & CHR$(10), False)
For iMap = LBound(vMap(), 1) To UBound(vMap(), 1)-1
sStringToInsert = vMap(iMap, 2) & " {""" & vMap(iMap, 1) & CHR$(10) & CHR$(10)
oDocumentText.insertString(oDocumentText.End, sStringToInsert, False)
Next iMap
End Sub
Sub HandleItemsInBibliography'(sBibliographyHeaderStyle As String)
Dim iReturnCode As Integer
Dim oBibliographyCursor As Object
Dim sAbbrevsAndExtendedList() As String
Const sBibliographyHeaderStyle As String = "Titre Liste des abréviations"
iReturnCode = MsgBox("Avez-vous créé une liste d'abréviations
" Si oui, la première mention de chaque item dans la bibliographie sera abrégée.",_
4, "Traitement des items de la bibliographie")
If iReturnCode = 7 Then
Exit Sub
End If
oBibliographyCursor= getBibliographyCursor(sBibliographyHeaderStyle)
sAbbrevsAndExtendedList() = createAbbrevsAndExtendedReferencesList(oBibliographyCursor)
SuppressFirstCitationReferenceForItemsInAbbrevList(sAbbrevsAndExtendedList)
MsgBox("Le traitement est terminé. Il vous reste à abréger manuellement la première référence de chaque item cité dans la bibliographie.")
End Sub
Function createAbbrevsAndExtendedReferencesList(oBibliographyCursor As Object)
Dim oFirstNoteText As Object
Dim sAbbrevsAndExtendedList() As String
Dim oTextCursorToStore As Object
Dim oNextParagraph As Object
Dim sAbbrev As String
Dim sExtendedReference As String
oBibliographyCursor.gotoNextParagraph(False)
oBibliographyCursor.gotoPreviousParagraph(False)
Do
oBibliographyCursor.collapseToStart()
Do While InStr(oBibliographyCursor.getString(), sSeparatorForListOfAbbreviations) = 0
oBibliographyCursor.goRight(1, True)
Loop
oBibliographyCursor.goLeft(1, True)
sAbbrev = oBibliographyCursor.getString()
AddToList(sAbbrev, sAbbrevsAndExtendedList)
ReplaceSeparator(oBibliographyCursor)
oBibliographyCursor.gotoEndOfParagraph(True)
sExtendedReference = oBibliographyCursor.getString()
AddToList(sExtendedReference, sAbbrevsAndExtendedList)
oBibliographyCursor.gotoNextParagraph(False)
oBibliographyCursor.gotoEndOfParagraph(True)
Loop While oBibliographyCursor.ParaStyleName = sBibliographyStyleName _
AND InStr(oBibliographyCursor.getString(), sSeparatorForListOfAbbreviations) > 0
createAbbrevsAndExtendedReferencesList = sAbbrevsAndExtendedList
End Function
Sub ReplaceSeparator(oCursor As Object)
oCursor.collapseToEnd()
oCursor.goRight(1, True)
oCursor.setString(sReplacementSeparatorForListOfAbbreviations)
oCursor.CharPosture = "com.sun.star.awt.FontSlant.NONE"
oCursor.collapseToEnd()
End Sub
Sub AddToList(sString As String, sList() As String)
ReDim Preserve sList(UBound(sList)+1)
sList(UBound(sList)) = sString
End Sub
Sub SuppressFirstCitationReferenceForItemsInAbbrevList(sAbbrevsAndExtendedList As String)
Dim oDocument As Object
Dim oCitRefSearch As Object
Dim nReferences As Integer
Dim iAbbrev As Integer
Dim sAbbrevString As String
Dim oCitRefResult As Object
Dim oCitRefFoundCursor As Object
Dim oCitRefFound As Object
Dim iResult As Integer
oDocument = ThisComponent
oCitRefSearch = oDocument.createSearchDescriptor()
For iAbbrev = LBound(sAbbrevsAndExtendedList) To UBound(sAbbrevsAndExtendedList)-1 Step 2
sAbbrevString = sAbbrevsAndExtendedList(iAbbrev)
oCitRefSearch.SearchString = sAbbrevString & sFirstCitationPrefix & "[0-9]+"
oCitRefSearch.SearchRegularExpression = TRUE
oCitRefResult = oDocument.findAll(oCitRefSearch)
oCitRefFoundCursor = ThisComponent.getCurrentController.getViewCursor()
For iResult = 0 To oCitRefResult.count - 1
oCitRefFound = oCitRefResult.getByIndex(iResult)
oCitRefFoundCursor.gotoRange(oCitRefFound, False)
oCitRefFoundCursor.goRight(Len(sAbbrevString), True)
oCitRefFoundCursor.setString("")
Next iResult
Next iAbbrev
End Sub
Sub AbbreviateFirstOccurrences(oAbbrevAndReferencesList As Object)
Dim oDocument As Object
Dim oFootnotes As Object
Dim iExpandedReference As Integer
Dim oExpandedRefSearch As Object
Dim oFirstOccurrence As Object
Dim oCopyPasteCursor As Object
Dim oFrame As Object
Dim oDispatcher As Object
oDocument = ThisComponent
oCopyPasteCursor = oDocument.currentController.getViewCursor()
oFrame = oDocument.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oExpandedRefSearch = oDocument.createSearchDescriptor()
For iExpandedReference = 1 To UBound(oAbbrevAndReferencesList) Step 2
oExpandedRefSearch.SearchString = oAbbrevAndReferencesList(iExpandedReference).getString()
oExpandedRefSearch.SearchRegularExpression = FALSE
oFirstOccurrence = oDocument.findFirst(oExpandedRefSearch)
oFirstOccurrence.setString("")
oCopyPasteCursor.gotoRange(oAbbrevAndReferencesList(iExpandedReference)-1, False)
oDispatcher.executeDispatch(oFrame, ".uno:Copy", "", 0, Array())
oCopyPasteCursor.gotoRange(oFirstOccurrence, False)
oCopyPasteCursor.CharCaseMap = 0
oCopyPasteCursor.CharPosture = "com.sun.star.awt.FontSlant.NONE"
oCopyPasteCursor.ParaStyleName = "Style par défaut"
oDispatcher.executeDispatch(oFrame, ".uno:Paste", "", 0, Array())
Next iExpandedReference
End Sub
Sub AbbrevAnnee_Philologique(bExpandFirstCitation as Boolean)
Const mJournal As String = "Année Philologique"
Dim mTitreLong() As String
mTitreLong = Array("Antike und Abendland", "Antigüedad y cristianismo", "Atene e Roma", "Archäologischer Anzeiger / Deutsches Archäologisches Institut", "Acta ad archaeologiam et artium historiam pertinentia. Series altera in 8o;", "Annuaire / Amis de la Bibliothèque humaniste de Sélestat", "Anales de arqueología cordobesa", "Annuario / Accademia Etrusca di Cortona", "Anzeiger für die Altertumswissenschaft", "Atti della Accademia Ligure di Scienze e Lettere", "Atti della Accademia di Scienze Morali e Politiche della Società Nazionale di Scienze, Lettere ed Arti di Napoli", "Acta antiqua Academiae Scientiarum Hungaricae", "Atti della Accademia Pontaniana", "Atti della Accademia di Scienze, Lettere e Arti di Palermo. 2, Lettere", "Atti e memorie dell'Accademia Patavina di Scienze, Lettere ed Arti. 3, Memorie della Classe di Scienze Morali, Lettere ed Arti", "Atti della Accademia Peloritana dei Pericolanti, Classe di Lettere, Filosofia e Belle Arti", "Acta archaeologica", "Acta archaeologica Academiae Scientiarum Hungaricae", "Arheološki vestnik", "Annales archéologiques arabes syriennes", "Atti della Accademia Roveretana degli Agiati, Classe di Scienze umane, Classe di Lettere ed Arti", "Jahrbuch Archäologie Schweiz", "Annuaire d'Archéologie Suisse", "The Annual of the American Schools of Oriental Research", "Atti della Accademia delle Scienze di Torino. 2, Classe di Scienze Morali, Storiche e Filologiche", "Atti e memorie dell'Accademia Toscana La Colombaria", "Anzeiger der philosophisch-historischen Klasse / Österreichische Akademie der Wissenschaften Wien", "Analecta Bollandiana", "Archiv für Begriffsgeschichte", "Annales de Bretagne et des Pays de l'Ouest", "The Annual of the British School at Athens", "The Art Bulletin", "Abhandlungen der Braunschweigischen Wissenschaftlichen Gesellschaft", "L'Antiquité classique", "Acta classica Universitatis Scientiarum Debreceniensis", "Annuaire du Collège de France", "Acta classica", "Acme", "Acta Hyperborea", "Ἀρχαιολογικὸν Δελτίον. Μελέτες", "Adamantius", "Annali del Dipartimento di Filosofia, Università di Firenze", "Archivo español de arqueología", "Aegyptus", "Αρχείον οικονομικής ιστορίας", "Archives of economic history", "Ἀρχαιολογικὴ ἐφημερίς", "Archaeologiai értesítő", "Aestimatio", "Aevum", "Aevum antiquum", "Anuari de filologia. Secció D, Studia Graeca et Latina", "Anales de filología clásica", "Annali della Facoltà di Giurisprudenza di Genova", "Anuario filósofico", "Annali della Facoltà di Lettere e Filosofia, Università degli Studi di Bari", "Annali della Facoltà di Lettere e Filosofia dell'Università di Cagliari", "Annales de la Faculté des lettres et sciences humaines, Université Cheikh Anta Diop de Dakar", "Annali della Facoltà di Lettere e Filosofia, Università di Macerata", "Annali della Facoltà di Lettere e Filosofia dell'Università di Napoli", "Annali della Facoltà di Lettere e Filosofia di Perugia. 1, Studi classici", "Annali della Facoltà di Lettere e Filosofia di Perugia. 4, Studi filosofici", "Annali della Facoltà di Lettere e Filosofia di Perugia. 3, Studi linguistici e letterari", "Annali della Facoltà di Lettere e Filosofia di Perugia. 2, Studi storico-antropologici", "Annali della Facoltà di Lettere e Filosofia, Università di Siena", "Annali della Faco
Dim mAbrev() As String
mAbrev = Array("A&A", "A&Cr", "A&R", "AA", "AAAH", "AABS", "AAC", "AAEC", "AAHG", "AALig", "AAN", "AAntHung", "AAP", "AAPal", "AAPat", "AAPel", "AArch", "AArchHung", "AArchSlov", "AArchSyr", "AARov", "AAS", "AAS", "AASO", "AAT", "AATC", "AAWW", "AB", "ABG", "ABPO", "ABSA", "ABull", "ABWG", "AC", "ACD", "ACF", "AClass", "Acme", "ActaHyp", "AD", "Adamantius", "ADFF", "AEA", "Aegyptus", "AEH", "AEH", "AEph", "AErt", "Aestimatio", "Aevum", "Aevum(ant)", "AFB", "AFC", "AFGG", "AFilos", "AFLB", "AFLC", "AFLD", "AFLM", "AFLN", "AFLPer(class)", "AFLPer(filos)", "AFLPer(ling)", "AFLPer(stor)", "AFLS", "AFMC", "Africa", "AFSFC", "AGI", "AGLComo", "AGPh", "AH", "AHAM", "AHAUSJ", "AHB", "AHB", "AHC", "AHDE", "AHES", "AHIg", "AHistHung", "AHMA", "AHR", "AIHS", "AIIN", "AIIS", "AION(archeol)", "AION(filol)", "AION(ling)", "AIPh", "AIPhO", "AIV", "AJ", "AJA", "AJAH", "AJN", "AJPh", "AK", "AKB", "AKBern", "AKBern", "AKG", "Akroterion", "Alba Regia", "Alfinge", "ALGP", "ALMA", "Altertum", "AMal", "AMAM(A)", "AMAM(M)", "AMAP", "AMArc", "AMAV", "Ambix", "AMSI", "AMW", "AN", "Anabases", "Anas", "Anatolica", "AncNarr", "AncPhil", "AncSoc", "AncW", "Anemos", "Annales (HSS)", "AnnNorm", "AnnSE", "Anregung", "Anschnitt", "AntAfr", "Antichthon", "Antiquity", "AntJ", "Antonianum", "AntPhilos", "AntTard", "AOF", "AOFL", "AOrientHung", "APapyrol", "APB", "Apeiron", "APF", "APhD", "Apocrypha", "Apollinaris", "Aquila legionis", "Aquitania", "AR", "Aram", "Arcadia", "Archaeologia", "Archaeologiae", "Archaeonautica", "Archaiognosia", "ArchClass", "Archeologia", "Architectura", "ArchN", "ArchOrient", "ArchPhilos", "ArchS", "ArchS", "Arctos", "Arethusa", "ARF", "ARG", "Argos", "Ariadne", "ARID", "Arion", "ARP", "AS", "ASAA", "ASAE", "ASCL", "Asclepio", "ASE", "ASGM", "ASGP", "ASHF", "ASMG", "ASNP", "ASP", "ASR", "ASSard", "AStadt", "Athena", "Athenaeum", "Atiqot", "AU", "AUB(class)", "AUB(jur)", "AUB(phil)", "AUFG", "Aufidus", "AUFL", "AUFS", "AugStud", "Augustiniana", "Augustinianum", "Augustinus", "AUMLA", "AUS", &quo
Dim oDocument As Object
Dim iReturnCode As Integer
If Check(mJournal) = 7 Then
Exit Sub
End If
iReturnCode = MsgBox("Cette macro vous permet d'abréger les titres des revues citées en suivant les normes de l'Année Philologique." &_
vbNewLine & vbNewLine & "Attention, il est recommandé d'appliquer les normes de votre éditeur (éventuellement grâce à une macro dédiée) avant celles de l'Année Philologique." &_
vbNewLine & vbNewLine & "Voulez-vous continuer ?",_
1, mJournal)
If iReturnCode = 2 Then
Exit Sub
Endif
oDocument = ThisComponent
Abbreviate (oDocument, mTitreLong(), mAbrev(), mJournal, bExpandFirstCitation)
End Sub
Function getOccurrencesCount(oScope As Object) As Variant
Const sZoteroItemIDRegex As String = """itemData"":\{""id"":[0-9]+"
Const nZoteroItemIDCharsToIgnore As Integer = 17
Const sZoteroItemInfoRegex As String = "[^}]+\}"
Const nZoteroItemInfoCharsToIgnore As Integer = 2
Dim oZoteroNotes As Object
Dim sZoteroNoteContent As String
Dim iZoteroNote As Integer
Dim sItemIDRegex As String
Dim vIDBiblioNboccMap(0, 2) As Variant
Dim iMap As Integer
Dim oItemIDSearch As Object
Dim aIDSearchOptions As New com.sun.star.util.SearchOptions
Dim oItemInfoSearch As Object
Dim aInfoSearchOptions As New com.sun.star.util.SearchOptions
Dim aIDSearchResult As Object
Dim aTitleSearchResult As Object
Dim iItemIDMatch As Integer
Dim sItemID As String
Dim sItemInfo As String
Dim vSortedItemMap As Variant
oItemIDSearch = CreateUnoService("com.sun.star.util.TextSearch")
With aIDSearchOptions
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
.searchString = sZoteroItemIDRegex
End With
oItemIDSearch.setOptions(aIDSearchOptions)
oItemInfoSearch = CreateUnoService("com.sun.star.util.TextSearch")
With aInfoSearchOptions
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
.searchString = sZoteroItemInfoRegex
End With
oItemInfoSearch.setOptions(aInfoSearchOptions)
oZoteroNotes = oScope.getReferenceMarks()
For iZoteroNote = 0 To oZoteroNotes.getCount()-1
sZoteroNoteContent = oZoteroNotes.getByIndex(iZoteroNote).Name
aIDSearchResult = oItemIDSearch.searchForward(sZoteroNoteContent, 0, Len(sZoteroNoteContent)-1)
Do While aIDSearchResult.subRegExpressions > 0
iItemIDMatch = aIDSearchResult.subRegExpressions - 1
sItemID = extractMatchingString(sZoteroNoteContent, aIDSearchResult, iItemIDMatch, nZoteroItemIDCharsToIgnore)
aTitleSearchResult = oItemInfoSearch.searchForward(sZoteroNoteContent, aIDSearchResult.endOffset(iItemIDMatch), Len(sZoteroNoteContent)-1)
sItemInfo = extractMatchingString(sZoteroNoteContent, aTitleSearchResult, 0, nZoteroItemInfoCharsToIgnore)
AddItemToMap(vIDBiblioNboccMap, sItemID, sItemInfo)
aIDSearchResult = oItemIDSearch.searchForward(sZoteroNoteContent, aIDSearchResult.endOffset(iItemIDMatch)+1, Len(sZoteroNoteContent)-1)
Loop
Next iZoteroNote
getOccurrencesCount = sortMapByNbOccurrences(vIDBiblioNboccMap)
End Function
Function getBibliographySection() As Object
Dim oTextSections As Object
Dim oTextSectionNames As Object
Dim iTextSection As Integer
Const sZoteroBibliographyID As String = "ZOTERO_BIBL"
On Error Goto
oTextSections = ThisComponent.getTextSections()
oTextSectionNames = oTextSections.getElementNames()
For iTextSection = 0 to UBound(oTextSectionNames)
If InStr(1, oTextSectionNames(iTextSection), sZoteroBibliographyID, 1) = 1 Then
getBibliographySection = oTextSections.getByIndex(iTextSection)
End If
Next iTextSection
End Function
Function getBibliographyCursor(sBibliographyHeaderStyle As String) As Object
Dim oSearch As Object
Dim oCursor As Object
oSearch = ThisComponent.createSearchDescriptor()
oSearch.SearchString = sBibliographyHeaderStyle
oSearch.SearchWords = TRUE
oSearch.SearchRegularExpression = FALSE
oSearch.SearchStyles = TRUE
On Error GoTo 0
oCursor = ThisComponent.Text.createTextCursorByRange(ThisComponent.findFirst(oSearch))
oCursor.collapseToEnd()
oCursor.gotoNextParagraph(False)
getBibliographyCursor = oCursor
End Function
Sub SetFontSlantToString(sString As String, vFontSlant As Variant)
Dim oDocument As Object
Dim oSearch As Object, oReplace As Object, oResult As Object
Dim oFound As Object, oFoundCursor As Object
Dim n As Integer
oDocument = ThisComponent
oSearch = oDocument.createSearchDescriptor
oReplace = oDocument.createReplaceDescriptor
oSearch.SearchString = sString
oSearch.SearchRegularExpression = FALSE
oSearch.SearchWords = TRUE
oSearch.SearchCaseSensitive = TRUE
oResult = oDocument.findAll(oSearch)
If oResult.count > 0 Then
For n = 0 To oResult.count - 1
oFound = oResult.getByIndex(n)
oFoundCursor = oFound.Text.createTextCursorByRange(oFound)
oFoundCursor.CharPosture = vFontSlant
Next n
End If
End Sub
Sub SetFolioToPluralForm(sFolioSingular As String, sFolioPlural As String)
Dim sFolioFindRegex As String
sFolioFindRegex = " " & sFolioSingular & "([0-9]+[rv]?)-"
Dim sFolioReplaceRegex As String
sFolioReplaceRegex = " " & sFolioPlural & "$1-"
Dim oDocument As Object
Dim oSearch As Object, oReplace As Object, oResult As Object
oDocument = ThisComponent
oReplace = oDocument.createReplaceDescriptor
oReplace.SearchString = sFolioFindRegex
oReplace.SearchRegularExpression = TRUE
oReplace.SearchAll = TRUE
oReplace.ReplaceString = sFolioReplaceRegex
oDocument.replaceAll(oReplace)
End Sub
Sub RestoreNonBreakableSpaces ' Must be called before macros that involve formatting of the targeted strings.
Dim sStringsWithBreakableSpaceFirstSpace() As String
sStringsWithBreakableSpaceFirstSpace = Array(" ;", " :", " !", " ?")
Dim sStringsWithBreakableSpaceSecondSpace() As String
sStringsWithBreakableSpaceSecondSpace = Array(" n. ", " no ", " nos ", " p. ", " f. ", " ff. ", " l. ")
Dim oDocument As Object
Dim oReplace As Object, oResult As Object
Dim iString As Integer
Dim sStringToReplace As String
oDocument = ThisComponent
oReplace = oDocument.createReplaceDescriptor
For iString = 0 To UBound(sStringsWithBreakableSpaceFirstSpace)
sStringToReplace = sStringsWithBreakableSpaceFirstSpace(iString)
oReplace.SearchString = sStringToReplace
oReplace.SearchRegularExpression = FALSE
oReplace.SearchAll = TRUE
oReplace.ReplaceString = Replace(sStringToReplace, " ", "
oDocument.replaceAll(oReplace)
Next iString
For iString = 0 To UBound(sStringsWithBreakableSpaceSecondSpace)
sStringToReplace = sStringsWithBreakableSpaceSecondSpace(iString)
oReplace.SearchString = sStringToReplace
oReplace.SearchRegularExpression = FALSE
oReplace.SearchAll = TRUE
oReplace.ReplaceString = " " & Replace(sStringToReplace, " ", "
oDocument.replaceAll(oReplace)
Next iString
End Sub
Sub ReplaceString(sToReplace As String, sReplacement As String, bIsRegex As Boolean)
Dim oReplace As Object
oReplace = ThisComponent.createSearchDescriptor()
oReplace.SearchString = sToReplace
oReplace.SearchRegularExpression = bIsRegex
oReplace.ReplaceString = sReplacement
ThisComponent.replaceAll(oReplace)
End Sub
2021-05-04 11:50:02 +01:00
</script:module>
