Matt McCutchen's Web Site / superbchemistry / superbchemistry.git / blame
| 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 | ||
| db7363ac MM |
88 | ' Step 1: Insert @m@ between an item and a number or charge that may be part of |
| 89 | ' a chemical formula (subject to later checks). | |
| 2eec932f MM |
90 | If HaveSelection(ThisComponent) Then |
| 91 | ' doc.replaceAll is not capable of searching a selection, while the | |
| 92 | ' dispatch-based replace API uses the current format options in the | |
| 93 | ' "Find & Replace" dialog and does not let us change them, which means that | |
| 94 | ' (1) existing settings can break things and (2) we cannot make superscripts | |
| 95 | ' and subscripts. We do the best we can by using one dispatch-based replace | |
| 96 | ' to tag all the sequences we want to operate on (which loses the selection in | |
| 97 | ' OpenOffice anyway) and then proceed with replaceAll calls on the whole | |
| 98 | ' document, which will only operate on the already tagged sequences. | |
| 99 | If Not formatSelectionWarningShown Then | |
| 100 | MsgBox "Due to limitations in the OpenOffice/LibreOffice API, the " & _ | |
| 101 | """Format selection"" command may not process some chemical formulas " & _ | |
| 102 | "in the selection or may apply incorrect formatting if any format " & _ | |
| 103 | "options are active in the ""Find & Replace"" dialog box. If this " & _ | |
| 104 | "happens, just undo the command (if any changes were made), clear the " & _ | |
| 105 | "format options in the ""Find & Replace"" dialog box (focus the " & _ | |
| 106 | """Find"" field, click ""No Format"", and repeat for the ""Replace"" " & _ | |
| 107 | "field), and run ""Format selection"" again." & Chr$(13) & Chr$(13) & _ | |
| 108 | "This message is always shown on the first ""Format selection"" " & _ | |
| 109 | "command in each OpenOffice/LibreOffice session because " & _ | |
| 110 | "SuperbChemistry has no way to detect whether format options are " & _ | |
| 111 | "active in ""Find & Replace"".", _ | |
| 112 | 0, "SuperbChemistry ""Format selection"" notice" | |
| 113 | formatSelectionWarningShown = True | |
| 114 | End If | |
| 115 | ReplaceInSelection(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&") | |
| 116 | Else | |
| 117 | SuperbReplace(ThisComponent, "(?<=[A-Z][a-z]?|[\])}])[-+−0-9]+", "@m@&", 0) | |
| 118 | End If | |
| 119 | ||
| db7363ac MM |
120 | ' Step 2: Insert @c@ after a charge symbol, if it's followed by one of the |
| 121 | ' allowed characters for the second kind of "recognized sequence" described in | |
| 122 | ' the readme. | |
| 2eec932f MM |
123 | SuperbReplace(ThisComponent, "(?<=@m@)([0-9]*[-+−])(?=[ \t\])}.,:;?!'""]|$)", "&@c@", 0) |
| 124 | ||
| db7363ac | 125 | ' Step 3: Real minus signs in charges. |
| 2eec932f MM |
126 | SuperbReplace(ThisComponent, "-@c@", "−@c@", 0) |
| 127 | ||
| db7363ac MM |
128 | ' Step 4: Some groups grab a single following digit as a quantity rather than a |
| 129 | ' charge amount. Insert @sq@ marker to prevent the charge from grabbing the | |
| 130 | ' digit. | |
| 2eec932f MM |
131 | SuperbReplace(ThisComponent, "(?<=(H|O|F|Cl|Br|I|[\])}])@m@)[0-9]", "&@sq@", 0) |
| 132 | ||
| db7363ac MM |
133 | ' Step 5: Each charge grabs at most one digit and moves the @c@ in front to |
| 134 | ' prevent the quantity from grabbing the digit. | |
| 2eec932f MM |
135 | SuperbReplace(ThisComponent, "([0-9]?[−+])@c@", "@c@$1", 1) |
| 136 | ||
| db7363ac MM |
137 | ' Step 6: Remove any @sq@ markers so items can grab all the digits that follow |
| 138 | ' for the quantity. | |
| 2eec932f MM |
139 | SuperbReplace(ThisComponent, "(.)@sq@", "$1", 0) |
| 140 | ||
| 141 | ' At this point, we have only @m@ and @c@ markers left. | |
| 142 | ||
| db7363ac MM |
143 | ' Step 7: Format quantities: as many digits as we can still grab. The digits |
| 144 | ' must be followed by one of the allowed characters for the first kind of | |
| 145 | ' "recognized sequence" described by a readme or by @, which we assume is part | |
| 146 | ' of a @c@ tag we added in step 2. The allowed characters A-Z\[({ represent | |
| 147 | ' the beginning of another item; the other allowed characters are the same as | |
| 148 | ' in step 2. | |
| 149 | SuperbReplace(ThisComponent, "(?<=@m@)[0-9]+(?=[@A-Z\[({ \t\])}.,:;?!'""]|$)", "&", -1) | |
| 2eec932f | 150 | |
| db7363ac | 151 | ' Step 8: Clean up @c@ markers. We know there is a charge sign after each. |
| 2eec932f MM |
152 | SuperbReplace(ThisComponent, "@c@(.)", "$1", 0) |
| 153 | ||
| db7363ac | 154 | ' Step 9: Clean up @m@ markers. We know there is some character before each. |
| 2eec932f MM |
155 | SuperbReplace(ThisComponent, "(.)@m@", "$1", 0) |
| 156 | ||
| 157 | End Sub | |
| 158 | ||
| 159 | Dim madeChanges As Boolean | |
| 160 | ||
| 161 | Sub UndoListener_undoActionAdded() | |
| 162 | End Sub | |
| 163 | Sub UndoListener_actionUndone() | |
| 164 | End Sub | |
| 165 | Sub UndoListener_actionRedone() | |
| 166 | End Sub | |
| 167 | Sub UndoListener_allActionsCleared() | |
| 168 | End Sub | |
| 169 | Sub UndoListener_redoActionsCleared() | |
| 170 | End Sub | |
| 171 | Sub UndoListener_resetAll() | |
| 172 | End Sub | |
| 173 | Sub UndoListener_enteredContext() | |
| 174 | End Sub | |
| 175 | Sub UndoListener_enteredHiddenContext() | |
| 176 | End Sub | |
| 177 | Sub UndoListener_leftContext() | |
| 178 | madeChanges = True | |
| 179 | End Sub | |
| 180 | Sub UndoListener_leftHiddenContext() | |
| 181 | End Sub | |
| 182 | Sub UndoListener_cancelledContext() | |
| 183 | End Sub | |
| 184 | ||
| 185 | Sub FormatSelectionOrDocument() | |
| 186 | ||
| 187 | Dim undoActionName As String | |
| 188 | If HaveSelection(ThisComponent) Then | |
| 189 | undoActionName = "SuperbChemistry: Format selection" | |
| 190 | Else | |
| 191 | undoActionName = "SuperbChemistry: Format document" | |
| 192 | End If | |
| 193 | ThisComponent.UndoManager.enterUndoContext(undoActionName) | |
| 194 | ||
| 195 | On Error Goto ErrorHandler | |
| 196 | FormatSelectionOrDocumentDebug | |
| 197 | On Error Goto 0 | |
| 198 | ||
| 199 | ThisComponent.UndoManager.leaveUndoContext() | |
| 200 | Exit Sub | |
| 201 | ||
| 202 | ErrorHandler: | |
| 203 | ||
| 204 | ' If our undo context is nonempty, we want to undo the generated action. | |
| 205 | ' If not, we do not want to undo as that would undo the user's previous | |
| 206 | ' action. If we just check whether the title of the last undoable action | |
| 207 | ' is "SuperbChemistry: Format (selection|document)", that might be wrong if | |
| 208 | ' the user ran FormatDocument twice in a row: probably unlikely, but the | |
| 209 | ' completely correct check is not that hard. | |
| 210 | Dim listener As Object | |
| 211 | listener = CreateUnoListener("UndoListener_", "com.sun.star.document.XUndoManagerListener") | |
| 212 | madeChanges = False | |
| 213 | ThisComponent.UndoManager.addUndoManagerListener(listener) | |
| 214 | ThisComponent.UndoManager.leaveUndoContext() | |
| 215 | ThisComponent.UndoManager.removeUndoManagerListener(listener) | |
| 216 | If madeChanges Then | |
| 217 | ThisComponent.UndoManager.undo() | |
| 218 | ThisComponent.UndoManager.clearRedo() | |
| 219 | End If | |
| 220 | ||
| 221 | MsgBox "SuperbChemistry encountered an unexpected error:" & Chr$(13) & Chr$(13) & _ | |
| 222 | "Code " & Err & ": " & Error$ & Chr$(13) & Chr$(13) & _ | |
| 223 | "Any changes made so far have been undone." & Chr$(13) & Chr$(13) & _ | |
| 224 | "SuperbChemistry needed to catch the error in order to leave your undo " & _ | |
| 225 | "history in a consistent state. If the problem is reproducible and you " & _ | |
| 05bf78df | 226 | "want to see the precise error location, run the FormatSelectionOrDocumentDebug " & _ |
| 2eec932f MM |
227 | "macro, but be advised that it may generate multiple entries in the undo " & _ |
| 228 | "history and will not undo them on error.", _ | |
| 229 | 0, "SuperbChemistry internal error" | |
| 230 | On Error Goto 0 | |
| 231 | End Sub | |
| 071359bb MM |
232 | |
| 233 | </script:module> |