extension/SuperbChemistry/Main.xba

   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 &gt; 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 &apos; Regular expression replace in the document, creating superscripts if
  22 &apos; superb &gt; 0 or subscripts if superb &lt; 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 &lt;&gt; 0 Then
  34                 Dim replaceAttrs(1) As New com.sun.star.beans.PropertyValue
  35                 replaceAttrs(0).Name = &quot;CharEscapement&quot;
  36                 If superb &gt; 0 Then
  37                         replaceAttrs(0).Value = 33
  38                 Else
  39                         &apos; The default escapement for subscripts is -33, which looked bad to me in
  40                         &apos; chemical formulas.  This looks better.  Modify to your taste.
  41                         replaceAttrs(0).Value = -9
  42                 End If
  43                 replaceAttrs(1).Name = &quot;CharEscapementHeight&quot;
  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(&quot;com.sun.star.frame.DispatchHelper&quot;)
  57
  58         Dim args(6) As New com.sun.star.beans.PropertyValue
  59         args(0).Name = &quot;SearchItem.AlgorithmType&quot;
  60         args(0).Value = 1
  61         args(1).Name = &quot;SearchItem.SearchFlags&quot;
  62         args(1).Value = &amp;H1800  &apos; Search in selection
  63         args(2).Name = &quot;SearchItem.SearchString&quot;
  64         args(2).Value = searchRegex
  65         args(3).Name = &quot;SearchItem.ReplaceString&quot;
  66         args(3).Value = replacePattern
  67         args(4).Name = &quot;SearchItem.Command&quot;
  68         args(4).Value = 3
  69         args(5).Name = &quot;SearchItem.AlgorithmType2&quot;
  70         args(5).Value = 2
  71         args(6).Name = &quot;Quiet&quot;
  72         args(6).Value = true
  73
  74         dispatcher.executeDispatch(frame, &quot;.uno:ExecuteSearch&quot;, &quot;&quot;, 0, args())
  75
  76 End Sub
  77
  78 Global formatSelectionWarningShown As Boolean
  79 &apos; I haven&apos;t found a way to initialize the variable, but it looks like its
  80 &apos; default value is treated as false in an if statement.
  81 &apos;formatSelectionWarningShown = False
  82
  83 Sub FormatSelectionOrDocumentDebug()
  84         &apos; Replacing with an empty replacement string triggers a bug in LibreOffice
  85         &apos; (https://bugs.documentfoundation.org/show_bug.cgi?id=136577), so we must
  86         &apos; avoid it.  Fortunately, avoiding it is pretty straightforward.
  87
  88         &apos; Insert @m@ between an item and a number or charge.
  89         If HaveSelection(ThisComponent) Then
  90                 &apos; doc.replaceAll is not capable of searching a selection, while the
  91                 &apos; dispatch-based replace API uses the current format options in the
  92                 &apos; &quot;Find &amp; Replace&quot; dialog and does not let us change them, which means that
  93                 &apos; (1) existing settings can break things and (2) we cannot make superscripts
  94                 &apos; and subscripts.  We do the best we can by using one dispatch-based replace
  95                 &apos; to tag all the sequences we want to operate on (which loses the selection in
  96                 &apos; OpenOffice anyway) and then proceed with replaceAll calls on the whole
  97                 &apos; document, which will only operate on the already tagged sequences.
  98                 If Not formatSelectionWarningShown Then
  99                         MsgBox &quot;Due to limitations in the OpenOffice/LibreOffice API, the &quot; &amp; _
 100                                 &quot;&quot;&quot;Format selection&quot;&quot; command may not process some chemical formulas &quot; &amp; _
 101                                 &quot;in the selection or may apply incorrect formatting if any format &quot; &amp; _
 102                                 &quot;options are active in the &quot;&quot;Find &amp; Replace&quot;&quot; dialog box.  If this &quot; &amp; _
 103                                 &quot;happens, just undo the command (if any changes were made), clear the &quot; &amp; _
 104                                 &quot;format options in the &quot;&quot;Find &amp; Replace&quot;&quot; dialog box (focus the &quot; &amp; _
 105                                 &quot;&quot;&quot;Find&quot;&quot; field, click &quot;&quot;No Format&quot;&quot;, and repeat for the &quot;&quot;Replace&quot;&quot; &quot; &amp; _
 106                                 &quot;field), and run &quot;&quot;Format selection&quot;&quot; again.&quot; &amp; Chr$(13) &amp; Chr$(13) &amp; _
 107                                 &quot;This message is always shown on the first &quot;&quot;Format selection&quot;&quot; &quot; &amp; _
 108                                 &quot;command in each OpenOffice/LibreOffice session because &quot; &amp; _
 109                                 &quot;SuperbChemistry has no way to detect whether format options are &quot; &amp; _
 110                                 &quot;active in &quot;&quot;Find &amp; Replace&quot;&quot;.&quot;, _
 111                                 0, &quot;SuperbChemistry &quot;&quot;Format selection&quot;&quot; notice&quot;
 112                         formatSelectionWarningShown = True
 113                 End If
 114                 ReplaceInSelection(ThisComponent, &quot;(?&lt;=[A-Z][a-z]?|[\])}])[-+−0-9]+&quot;, &quot;@m@&amp;&quot;)
 115         Else
 116                 SuperbReplace(ThisComponent, &quot;(?&lt;=[A-Z][a-z]?|[\])}])[-+−0-9]+&quot;, &quot;@m@&amp;&quot;, 0)
 117         End If
 118
 119         &apos; Insert @c@ after a charge.
 120         SuperbReplace(ThisComponent, &quot;(?&lt;=@m@)([0-9]*[-+−])(?=[ \t\])}.,:;?!&apos;&quot;&quot;]|$)&quot;, &quot;&amp;@c@&quot;, 0)
 121
 122         &apos; Real minus signs in charges.
 123         SuperbReplace(ThisComponent, &quot;-@c@&quot;, &quot;−@c@&quot;, 0)
 124
 125         &apos; Some groups grab a single following digit as a quantity rather than a charge amount.
 126         &apos; Insert @sq@ marker to prevent the charge from grabbing the digit.
 127         SuperbReplace(ThisComponent, &quot;(?&lt;=(H|O|F|Cl|Br|I|[\])}])@m@)[0-9]&quot;, &quot;&amp;@sq@&quot;, 0)
 128
 129         &apos; Each charge grabs at most one digit and moves the @c@ in front to prevent the
 130         &apos; quantity from grabbing the digit.
 131         SuperbReplace(ThisComponent, &quot;([0-9]?[−+])@c@&quot;, &quot;@c@$1&quot;, 1)
 132
 133         &apos; Remove any @sq@ markers so items can grab all the digits that follow for the quantity.
 134         SuperbReplace(ThisComponent, &quot;(.)@sq@&quot;, &quot;$1&quot;, 0)
 135
 136         &apos; At this point, we have only @m@ and @c@ markers left.
 137
 138         &apos; Format quantities: as many digits as we can still grab.
 139         &apos; We have to allow @ as a following character for our own @c@ tag.
 140         SuperbReplace(ThisComponent, &quot;(?&lt;=@m@)[0-9]+(?=[@A-Z \t\])}.,:;?!&apos;&quot;&quot;]|$)&quot;, &quot;&amp;&quot;, -1)
 141
 142         &apos; Clean up @c@ markers.  We know there is a charge sign after each.
 143         SuperbReplace(ThisComponent, &quot;@c@(.)&quot;, &quot;$1&quot;, 0)
 144
 145         &apos; Clean up @m@ markers.  We know there is some character before each.
 146         SuperbReplace(ThisComponent, &quot;(.)@m@&quot;, &quot;$1&quot;, 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 = &quot;SuperbChemistry: Format selection&quot;
 181         Else
 182                 undoActionName = &quot;SuperbChemistry: Format document&quot;
 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         &apos; If our undo context is nonempty, we want to undo the generated action.
 196         &apos; If not, we do not want to undo as that would undo the user&apos;s previous
 197         &apos; action.  If we just check whether the title of the last undoable action
 198         &apos; is &quot;SuperbChemistry: Format (selection|document)&quot;, that might be wrong if
 199         &apos; the user ran FormatDocument twice in a row: probably unlikely, but the
 200         &apos; completely correct check is not that hard.
 201         Dim listener As Object
 202         listener = CreateUnoListener(&quot;UndoListener_&quot;, &quot;com.sun.star.document.XUndoManagerListener&quot;)
 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 &quot;SuperbChemistry encountered an unexpected error:&quot; &amp; Chr$(13) &amp; Chr$(13) &amp; _
 213                 &quot;Code &quot; &amp; Err &amp; &quot;: &quot; &amp; Error$ &amp; Chr$(13) &amp; Chr$(13) &amp; _
 214                 &quot;Any changes made so far have been undone.&quot; &amp; Chr$(13) &amp; Chr$(13) &amp; _
 215                 &quot;SuperbChemistry needed to catch the error in order to leave your undo &quot; &amp; _
 216                 &quot;history in a consistent state.  If the problem is reproducible and you &quot; &amp; _
 217                 &quot;want to see the precise error location, run the FormatDocumentOrSelectionDebug &quot; &amp; _
 218                 &quot;macro, but be advised that it may generate multiple entries in the undo &quot; &amp; _
 219                 &quot;history and will not undo them on error.&quot;, _
 220                 0, &quot;SuperbChemistry internal error&quot;
 221         On Error Goto 0
 222 End Sub
 223
 224 </script:module>