Commit | Line | Data |
---|---|---|
071359bb MM |
1 | <?xml version="1.0" encoding="UTF-8"?> |
2 | <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> | |
2eec932f MM |
3 | <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Main" script:language="StarBasic">Option Explicit |
4 | ||
5 | Function HaveSelection(doc As Object) | |
6 | Dim sel as Object | |
7 | sel = doc.CurrentController.Selection | |
8 | If sel.Count > 1 Then | |
9 | HaveSelection = True | |
10 | Exit Function | |
11 | End If | |
12 | Dim s0 | |
13 | s0 = sel.getByIndex(0) | |
14 | If s0.Text.compareRegionStarts(s0.Start, s0.End) = 0 Then | |
15 | HaveSelection = False | |
16 | Else | |
17 | HaveSelection = True | |
18 | End If | |
19 | End Function | |
20 | ||
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) | |
24 | ||
25 | Dim rd As Object | |
26 | rd = doc.createReplaceDescriptor() | |
27 | ||
28 | rd.SearchCaseSensitive = true | |
29 | rd.SearchRegularExpression = true | |
30 | rd.setSearchString(searchRegex) | |
31 | rd.setReplaceString(replacePattern) | |
32 | ||
33 | If superb <> 0 Then | |
34 | Dim replaceAttrs(1) As New com.sun.star.beans.PropertyValue | |
35 | replaceAttrs(0).Name = "CharEscapement" | |
36 | If superb > 0 Then | |
37 | replaceAttrs(0).Value = 33 | |
38 | Else | |
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 | |
42 | End If | |
43 | replaceAttrs(1).Name = "CharEscapementHeight" | |
44 | replaceAttrs(1).Value = 58 | |
45 | rd.setReplaceAttributes(replaceAttrs) | |
46 | End If | |
47 | ||
48 | doc.replaceAll(rd) | |
49 | ||
50 | End Sub | |
51 | ||
52 | Sub ReplaceInSelection(doc As Object, searchRegex As String, replacePattern As String) | |
53 | ||
54 | Dim frame As Object, dispatcher As Object | |
55 | frame = doc.CurrentController.Frame | |
56 | dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") | |
57 | ||
58 | Dim args(6) As New com.sun.star.beans.PropertyValue | |
59 | args(0).Name = "SearchItem.AlgorithmType" | |
60 | args(0).Value = 1 | |
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" | |
68 | args(4).Value = 3 | |
69 | args(5).Name = "SearchItem.AlgorithmType2" | |
70 | args(5).Value = 2 | |
71 | args(6).Name = "Quiet" | |
72 | args(6).Value = true | |
73 | ||
74 | dispatcher.executeDispatch(frame, ".uno:ExecuteSearch", "", 0, args()) | |
75 | ||
76 | End Sub | |
77 | ||
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 | |
82 | ||
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. | |
87 | ||
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 | |
113 | End If | |
114 | ReplaceInSelection(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&") | |
115 | Else | |
116 | SuperbReplace(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&", 0) | |
117 | End If | |
118 | ||
119 | ' Insert @c@ after a charge. | |
120 | SuperbReplace(ThisComponent, "(?<=@m@)([0-9]*[-+−])(?=[ \t\])}.,:;?!'""]|$)", "&@c@", 0) | |
121 | ||
122 | ' Real minus signs in charges. | |
123 | SuperbReplace(ThisComponent, "-@c@", "−@c@", 0) | |
124 | ||
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) | |
128 | ||
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) | |
132 | ||
133 | ' Remove any @sq@ markers so items can grab all the digits that follow for the quantity. | |
134 | SuperbReplace(ThisComponent, "(.)@sq@", "$1", 0) | |
135 | ||
136 | ' At this point, we have only @m@ and @c@ markers left. | |
137 | ||
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) | |
141 | ||
142 | ' Clean up @c@ markers. We know there is a charge sign after each. | |
143 | SuperbReplace(ThisComponent, "@c@(.)", "$1", 0) | |
144 | ||
145 | ' Clean up @m@ markers. We know there is some character before each. | |
146 | SuperbReplace(ThisComponent, "(.)@m@", "$1", 0) | |
147 | ||
148 | End Sub | |
149 | ||
150 | Dim madeChanges As Boolean | |
151 | ||
152 | Sub UndoListener_undoActionAdded() | |
153 | End Sub | |
154 | Sub UndoListener_actionUndone() | |
155 | End Sub | |
156 | Sub UndoListener_actionRedone() | |
157 | End Sub | |
158 | Sub UndoListener_allActionsCleared() | |
159 | End Sub | |
160 | Sub UndoListener_redoActionsCleared() | |
161 | End Sub | |
162 | Sub UndoListener_resetAll() | |
163 | End Sub | |
164 | Sub UndoListener_enteredContext() | |
165 | End Sub | |
166 | Sub UndoListener_enteredHiddenContext() | |
167 | End Sub | |
168 | Sub UndoListener_leftContext() | |
169 | madeChanges = True | |
170 | End Sub | |
171 | Sub UndoListener_leftHiddenContext() | |
172 | End Sub | |
173 | Sub UndoListener_cancelledContext() | |
174 | End Sub | |
175 | ||
176 | Sub FormatSelectionOrDocument() | |
177 | ||
178 | Dim undoActionName As String | |
179 | If HaveSelection(ThisComponent) Then | |
180 | undoActionName = "SuperbChemistry: Format selection" | |
181 | Else | |
182 | undoActionName = "SuperbChemistry: Format document" | |
183 | End If | |
184 | ThisComponent.UndoManager.enterUndoContext(undoActionName) | |
185 | ||
186 | On Error Goto ErrorHandler | |
187 | FormatSelectionOrDocumentDebug | |
188 | On Error Goto 0 | |
189 | ||
190 | ThisComponent.UndoManager.leaveUndoContext() | |
191 | Exit Sub | |
192 | ||
193 | ErrorHandler: | |
194 | ||
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") | |
203 | madeChanges = False | |
204 | ThisComponent.UndoManager.addUndoManagerListener(listener) | |
205 | ThisComponent.UndoManager.leaveUndoContext() | |
206 | ThisComponent.UndoManager.removeUndoManagerListener(listener) | |
207 | If madeChanges Then | |
208 | ThisComponent.UndoManager.undo() | |
209 | ThisComponent.UndoManager.clearRedo() | |
210 | End If | |
211 | ||
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" | |
221 | On Error Goto 0 | |
222 | End Sub | |
071359bb MM |
223 | |
224 | </script:module> |