Matt McCutchen's Web Site - superbchemistry/superbchemistry.git/blob

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 ' 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).

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

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.

123 SuperbReplace(ThisComponent, "(?<=@m@)([0-9]*[-+−])(?=[ \t\])}.,:;?!'""]|$)", "&@c@", 0)

124

125 ' Step 3: Real minus signs in charges.

126 SuperbReplace(ThisComponent, "-@c@", "−@c@", 0)

127

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.

131 SuperbReplace(ThisComponent, "(?<=(H|O|F|Cl|Br|I|[\])}])@m@)[0-9]", "&@sq@", 0)

132

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.

135 SuperbReplace(ThisComponent, "([0-9]?[−+])@c@", "@c@$1", 1)

136

137 ' Step 6: Remove any @sq@ markers so items can grab all the digits that follow

138 ' for the quantity.

139 SuperbReplace(ThisComponent, "(.)@sq@", "$1", 0)

140

141 ' At this point, we have only @m@ and @c@ markers left.

142

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)

150

151 ' Step 8: Clean up @c@ markers. We know there is a charge sign after each.

152 SuperbReplace(ThisComponent, "@c@(.)", "$1", 0)

153

154 ' Step 9: Clean up @m@ markers. We know there is some character before each.

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 " & _

226 "want to see the precise error location, run the FormatSelectionOrDocumentDebug " & _

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

232

233 </script:module>