1 <?xml version="1.0" encoding="UTF-8"?>
2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Main" script:language="StarBasic">Option Explicit
5 Function HaveSelection(doc As Object)
7 sel = doc.CurrentController.Selection
8 If sel.Count > 1 Then
13 s0 = sel.getByIndex(0)
14 If s0.Text.compareRegionStarts(s0.Start, s0.End) = 0 Then
21 ' Regular expression replace in the document, creating superscripts if
22 ' superb > 0 or subscripts if superb < 0.
23 Sub SuperbReplace(doc As Object, searchRegex As String, replacePattern As String, superb As Integer)
26 rd = doc.createReplaceDescriptor()
28 rd.SearchCaseSensitive = true
29 rd.SearchRegularExpression = true
30 rd.setSearchString(searchRegex)
31 rd.setReplaceString(replacePattern)
33 If superb <> 0 Then
34 Dim replaceAttrs(1) As New com.sun.star.beans.PropertyValue
35 replaceAttrs(0).Name = "CharEscapement"
37 replaceAttrs(0).Value = 33
39 ' The default escapement for subscripts is -33, which looked bad to me in
40 ' chemical formulas. This looks better. Modify to your taste.
41 replaceAttrs(0).Value = -9
43 replaceAttrs(1).Name = "CharEscapementHeight"
44 replaceAttrs(1).Value = 58
45 rd.setReplaceAttributes(replaceAttrs)
52 Sub ReplaceInSelection(doc As Object, searchRegex As String, replacePattern As String)
54 Dim frame As Object, dispatcher As Object
55 frame = doc.CurrentController.Frame
56 dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
58 Dim args(6) As New com.sun.star.beans.PropertyValue
59 args(0).Name = "SearchItem.AlgorithmType"
61 args(1).Name = "SearchItem.SearchFlags"
62 args(1).Value = &H1800 ' Search in selection
63 args(2).Name = "SearchItem.SearchString"
64 args(2).Value = searchRegex
65 args(3).Name = "SearchItem.ReplaceString"
66 args(3).Value = replacePattern
67 args(4).Name = "SearchItem.Command"
69 args(5).Name = "SearchItem.AlgorithmType2"
71 args(6).Name = "Quiet"
74 dispatcher.executeDispatch(frame, ".uno:ExecuteSearch", "", 0, args())
78 Global formatSelectionWarningShown As Boolean
79 ' I haven't found a way to initialize the variable, but it looks like its
80 ' default value is treated as false in an if statement.
81 'formatSelectionWarningShown = False
83 Sub FormatSelectionOrDocumentDebug()
84 ' Replacing with an empty replacement string triggers a bug in LibreOffice
85 ' (https://bugs.documentfoundation.org/show_bug.cgi?id=136577), so we must
86 ' avoid it. Fortunately, avoiding it is pretty straightforward.
88 ' Insert @m@ between an item and a number or charge.
89 If HaveSelection(ThisComponent) Then
90 ' doc.replaceAll is not capable of searching a selection, while the
91 ' dispatch-based replace API uses the current format options in the
92 ' "Find & Replace" dialog and does not let us change them, which means that
93 ' (1) existing settings can break things and (2) we cannot make superscripts
94 ' and subscripts. We do the best we can by using one dispatch-based replace
95 ' to tag all the sequences we want to operate on (which loses the selection in
96 ' OpenOffice anyway) and then proceed with replaceAll calls on the whole
97 ' document, which will only operate on the already tagged sequences.
98 If Not formatSelectionWarningShown Then
99 MsgBox "Due to limitations in the OpenOffice/LibreOffice API, the " & _
100 """Format selection"" command may not process some chemical formulas " & _
101 "in the selection or may apply incorrect formatting if any format " & _
102 "options are active in the ""Find & Replace"" dialog box. If this " & _
103 "happens, just undo the command (if any changes were made), clear the " & _
104 "format options in the ""Find & Replace"" dialog box (focus the " & _
105 """Find"" field, click ""No Format"", and repeat for the ""Replace"" " & _
106 "field), and run ""Format selection"" again." & Chr$(13) & Chr$(13) & _
107 "This message is always shown on the first ""Format selection"" " & _
108 "command in each OpenOffice/LibreOffice session because " & _
109 "SuperbChemistry has no way to detect whether format options are " & _
110 "active in ""Find & Replace"".", _
111 0, "SuperbChemistry ""Format selection"" notice"
112 formatSelectionWarningShown = True
114 ReplaceInSelection(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&")
116 SuperbReplace(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&", 0)
119 ' Insert @c@ after a charge.
120 SuperbReplace(ThisComponent, "(?<=@m@)([0-9]*[-+−])(?=[ \t\])}.,:;?!'""]|$)", "&@c@", 0)
122 ' Real minus signs in charges.
123 SuperbReplace(ThisComponent, "-@c@", "−@c@", 0)
125 ' Some groups grab a single following digit as a quantity rather than a charge amount.
126 ' Insert @sq@ marker to prevent the charge from grabbing the digit.
127 SuperbReplace(ThisComponent, "(?<=(H|O|F|Cl|Br|I|[\])}])@m@)[0-9]", "&@sq@", 0)
129 ' Each charge grabs at most one digit and moves the @c@ in front to prevent the
130 ' quantity from grabbing the digit.
131 SuperbReplace(ThisComponent, "([0-9]?[−+])@c@", "@c@$1", 1)
133 ' Remove any @sq@ markers so items can grab all the digits that follow for the quantity.
134 SuperbReplace(ThisComponent, "(.)@sq@", "$1", 0)
136 ' At this point, we have only @m@ and @c@ markers left.
138 ' Format quantities: as many digits as we can still grab.
139 ' We have to allow @ as a following character for our own @c@ tag.
140 SuperbReplace(ThisComponent, "(?<=@m@)[0-9]+(?=[@A-Z \t\])}.,:;?!'""]|$)", "&", -1)
142 ' Clean up @c@ markers. We know there is a charge sign after each.
143 SuperbReplace(ThisComponent, "@c@(.)", "$1", 0)
145 ' Clean up @m@ markers. We know there is some character before each.
146 SuperbReplace(ThisComponent, "(.)@m@", "$1", 0)
150 Dim madeChanges As Boolean
152 Sub UndoListener_undoActionAdded()
154 Sub UndoListener_actionUndone()
156 Sub UndoListener_actionRedone()
158 Sub UndoListener_allActionsCleared()
160 Sub UndoListener_redoActionsCleared()
162 Sub UndoListener_resetAll()
164 Sub UndoListener_enteredContext()
166 Sub UndoListener_enteredHiddenContext()
168 Sub UndoListener_leftContext()
171 Sub UndoListener_leftHiddenContext()
173 Sub UndoListener_cancelledContext()
176 Sub FormatSelectionOrDocument()
178 Dim undoActionName As String
179 If HaveSelection(ThisComponent) Then
180 undoActionName = "SuperbChemistry: Format selection"
182 undoActionName = "SuperbChemistry: Format document"
184 ThisComponent.UndoManager.enterUndoContext(undoActionName)
186 On Error Goto ErrorHandler
187 FormatSelectionOrDocumentDebug
190 ThisComponent.UndoManager.leaveUndoContext()
195 ' If our undo context is nonempty, we want to undo the generated action.
196 ' If not, we do not want to undo as that would undo the user's previous
197 ' action. If we just check whether the title of the last undoable action
198 ' is "SuperbChemistry: Format (selection|document)", that might be wrong if
199 ' the user ran FormatDocument twice in a row: probably unlikely, but the
200 ' completely correct check is not that hard.
201 Dim listener As Object
202 listener = CreateUnoListener("UndoListener_", "com.sun.star.document.XUndoManagerListener")
204 ThisComponent.UndoManager.addUndoManagerListener(listener)
205 ThisComponent.UndoManager.leaveUndoContext()
206 ThisComponent.UndoManager.removeUndoManagerListener(listener)
208 ThisComponent.UndoManager.undo()
209 ThisComponent.UndoManager.clearRedo()
212 MsgBox "SuperbChemistry encountered an unexpected error:" & Chr$(13) & Chr$(13) & _
213 "Code " & Err & ": " & Error$ & Chr$(13) & Chr$(13) & _
214 "Any changes made so far have been undone." & Chr$(13) & Chr$(13) & _
215 "SuperbChemistry needed to catch the error in order to leave your undo " & _
216 "history in a consistent state. If the problem is reproducible and you " & _
217 "want to see the precise error location, run the FormatDocumentOrSelectionDebug " & _
218 "macro, but be advised that it may generate multiple entries in the undo " & _
219 "history and will not undo them on error.", _
220 0, "SuperbChemistry internal error"