Option Explicit Function HaveSelection(doc As Object) Dim sel as Object sel = doc.CurrentController.Selection If sel.Count > 1 Then HaveSelection = True Exit Function End If Dim s0 s0 = sel.getByIndex(0) If s0.Text.compareRegionStarts(s0.Start, s0.End) = 0 Then HaveSelection = False Else HaveSelection = True End If End Function ' Regular expression replace in the document, creating superscripts if ' superb > 0 or subscripts if superb < 0. Sub SuperbReplace(doc As Object, searchRegex As String, replacePattern As String, superb As Integer) Dim rd As Object rd = doc.createReplaceDescriptor() rd.SearchCaseSensitive = true rd.SearchRegularExpression = true rd.setSearchString(searchRegex) rd.setReplaceString(replacePattern) If superb <> 0 Then Dim replaceAttrs(1) As New com.sun.star.beans.PropertyValue replaceAttrs(0).Name = "CharEscapement" If superb > 0 Then replaceAttrs(0).Value = 33 Else ' The default escapement for subscripts is -33, which looked bad to me in ' chemical formulas. This looks better. Modify to your taste. replaceAttrs(0).Value = -9 End If replaceAttrs(1).Name = "CharEscapementHeight" replaceAttrs(1).Value = 58 rd.setReplaceAttributes(replaceAttrs) End If doc.replaceAll(rd) End Sub Sub ReplaceInSelection(doc As Object, searchRegex As String, replacePattern As String) Dim frame As Object, dispatcher As Object frame = doc.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") Dim args(6) As New com.sun.star.beans.PropertyValue args(0).Name = "SearchItem.AlgorithmType" args(0).Value = 1 args(1).Name = "SearchItem.SearchFlags" args(1).Value = &H1800 ' Search in selection args(2).Name = "SearchItem.SearchString" args(2).Value = searchRegex args(3).Name = "SearchItem.ReplaceString" args(3).Value = replacePattern args(4).Name = "SearchItem.Command" args(4).Value = 3 args(5).Name = "SearchItem.AlgorithmType2" args(5).Value = 2 args(6).Name = "Quiet" args(6).Value = true dispatcher.executeDispatch(frame, ".uno:ExecuteSearch", "", 0, args()) End Sub Global formatSelectionWarningShown As Boolean ' I haven't found a way to initialize the variable, but it looks like its ' default value is treated as false in an if statement. 'formatSelectionWarningShown = False Sub FormatSelectionOrDocumentDebug() ' Replacing with an empty replacement string triggers a bug in LibreOffice ' (https://bugs.documentfoundation.org/show_bug.cgi?id=136577), so we must ' avoid it. Fortunately, avoiding it is pretty straightforward. ' Step 1: Insert @m@ between an item and a number or charge that may be part of ' a chemical formula (subject to later checks). If HaveSelection(ThisComponent) Then ' doc.replaceAll is not capable of searching a selection, while the ' dispatch-based replace API uses the current format options in the ' "Find & Replace" dialog and does not let us change them, which means that ' (1) existing settings can break things and (2) we cannot make superscripts ' and subscripts. We do the best we can by using one dispatch-based replace ' to tag all the sequences we want to operate on (which loses the selection in ' OpenOffice anyway) and then proceed with replaceAll calls on the whole ' document, which will only operate on the already tagged sequences. If Not formatSelectionWarningShown Then MsgBox "Due to limitations in the OpenOffice/LibreOffice API, the " & _ """Format selection"" command may not process some chemical formulas " & _ "in the selection or may apply incorrect formatting if any format " & _ "options are active in the ""Find & Replace"" dialog box. If this " & _ "happens, just undo the command (if any changes were made), clear the " & _ "format options in the ""Find & Replace"" dialog box (focus the " & _ """Find"" field, click ""No Format"", and repeat for the ""Replace"" " & _ "field), and run ""Format selection"" again." & Chr$(13) & Chr$(13) & _ "This message is always shown on the first ""Format selection"" " & _ "command in each OpenOffice/LibreOffice session because " & _ "SuperbChemistry has no way to detect whether format options are " & _ "active in ""Find & Replace"".", _ 0, "SuperbChemistry ""Format selection"" notice" formatSelectionWarningShown = True End If ReplaceInSelection(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&") Else SuperbReplace(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&", 0) End If ' Step 2: Insert @c@ after a charge symbol, if it's followed by one of the ' allowed characters for the second kind of "recognized sequence" described in ' the readme. SuperbReplace(ThisComponent, "(?<=@m@)([0-9]*[-+−])(?=[ \t\])}.,:;?!'""]|$)", "&@c@", 0) ' Step 3: Real minus signs in charges. SuperbReplace(ThisComponent, "-@c@", "−@c@", 0) ' Step 4: Some groups grab a single following digit as a quantity rather than a ' charge amount. Insert @sq@ marker to prevent the charge from grabbing the ' digit. SuperbReplace(ThisComponent, "(?<=(H|O|F|Cl|Br|I|[\])}])@m@)[0-9]", "&@sq@", 0) ' Step 5: Each charge grabs at most one digit and moves the @c@ in front to ' prevent the quantity from grabbing the digit. SuperbReplace(ThisComponent, "([0-9]?[−+])@c@", "@c@$1", 1) ' Step 6: Remove any @sq@ markers so items can grab all the digits that follow ' for the quantity. SuperbReplace(ThisComponent, "(.)@sq@", "$1", 0) ' At this point, we have only @m@ and @c@ markers left. ' Step 7: Format quantities: as many digits as we can still grab. The digits ' must be followed by one of the allowed characters for the first kind of ' "recognized sequence" described by a readme or by @, which we assume is part ' of a @c@ tag we added in step 2. The allowed characters A-Z\[({ represent ' the beginning of another item; the other allowed characters are the same as ' in step 2. SuperbReplace(ThisComponent, "(?<=@m@)[0-9]+(?=[@A-Z\[({ \t\])}.,:;?!'""]|$)", "&", -1) ' Step 8: Clean up @c@ markers. We know there is a charge sign after each. SuperbReplace(ThisComponent, "@c@(.)", "$1", 0) ' Step 9: Clean up @m@ markers. We know there is some character before each. SuperbReplace(ThisComponent, "(.)@m@", "$1", 0) End Sub Dim madeChanges As Boolean Sub UndoListener_undoActionAdded() End Sub Sub UndoListener_actionUndone() End Sub Sub UndoListener_actionRedone() End Sub Sub UndoListener_allActionsCleared() End Sub Sub UndoListener_redoActionsCleared() End Sub Sub UndoListener_resetAll() End Sub Sub UndoListener_enteredContext() End Sub Sub UndoListener_enteredHiddenContext() End Sub Sub UndoListener_leftContext() madeChanges = True End Sub Sub UndoListener_leftHiddenContext() End Sub Sub UndoListener_cancelledContext() End Sub Sub FormatSelectionOrDocument() Dim undoActionName As String If HaveSelection(ThisComponent) Then undoActionName = "SuperbChemistry: Format selection" Else undoActionName = "SuperbChemistry: Format document" End If ThisComponent.UndoManager.enterUndoContext(undoActionName) On Error Goto ErrorHandler FormatSelectionOrDocumentDebug On Error Goto 0 ThisComponent.UndoManager.leaveUndoContext() Exit Sub ErrorHandler: ' If our undo context is nonempty, we want to undo the generated action. ' If not, we do not want to undo as that would undo the user's previous ' action. If we just check whether the title of the last undoable action ' is "SuperbChemistry: Format (selection|document)", that might be wrong if ' the user ran FormatDocument twice in a row: probably unlikely, but the ' completely correct check is not that hard. Dim listener As Object listener = CreateUnoListener("UndoListener_", "com.sun.star.document.XUndoManagerListener") madeChanges = False ThisComponent.UndoManager.addUndoManagerListener(listener) ThisComponent.UndoManager.leaveUndoContext() ThisComponent.UndoManager.removeUndoManagerListener(listener) If madeChanges Then ThisComponent.UndoManager.undo() ThisComponent.UndoManager.clearRedo() End If MsgBox "SuperbChemistry encountered an unexpected error:" & Chr$(13) & Chr$(13) & _ "Code " & Err & ": " & Error$ & Chr$(13) & Chr$(13) & _ "Any changes made so far have been undone." & Chr$(13) & Chr$(13) & _ "SuperbChemistry needed to catch the error in order to leave your undo " & _ "history in a consistent state. If the problem is reproducible and you " & _ "want to see the precise error location, run the FormatSelectionOrDocumentDebug " & _ "macro, but be advised that it may generate multiple entries in the undo " & _ "history and will not undo them on error.", _ 0, "SuperbChemistry internal error" On Error Goto 0 End Sub