| | 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 |
| | 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 |
| | 223 | |
| | 224 | </script:module> |
Matt McCutchen's Web Site / superbchemistry / superbchemistry.git / blame_incremental