bluegecko General User

Joined: 12 Jun 2007 Posts: 49 Location: Portugal
|
Posted: Tue Jun 09, 2009 4:16 pm Post subject: A smart macro for smart quotes... UPDATED |
|
|
Hi all
UPDATED 14 January 2010
Here's a macro I wrote for converting between plain quotes and curly/smart/typographical ones. It's a step ahead of similar macros, I hope, as it should correctly deal with most/all situations regardless of surrounding punctuation and spaces.
My original code was barely ten lines, until I noticed it killed character formatting (using character classes in Regular Expressions does that), hence the umpteen passes I'm using now.
I hope this helps someone. Feel free to suggest improvements if it doesn't work for you (oh, and if you're new to macros and want to play with it, comment out the pairs of lines under "hide screen update" and "screen update", or any errors may well freeze OOo.
| Code: |
Sub Main
' By bluegecko, 13 January 2010. Public domain.
' This is a revised version of the smart quotes routine posted in June 2009 on this
' same page (http://www.oooforum.org/forum/viewtopic.phtml?p=328916)
' The macro switches apostrophes and quotation marks (single and double) from
' their straight (or "dumb") variants to what are variously called "smart", "curly"
' or "typographer's" quotes, and vice-versa.
' Although OpenOffice has an apparently similar Autocorrect function, it's buggy
' in all but the simplest of cases. Autocorrect, if you want to apply it to an entire
' dcument, is unfortunately also restricted to text formatted in the default paragraph
' style, so useless if your document is already styled up.
' This macro provides a solution. It should work correctly in most instances, and should
' also preserve any character formatting or styling. I've tested it in various contexts,
' including contemporary quotation formatting (no space on one side of the quotation mark);
' in older style formatting with spaces on either side of the quotation mark; and, also an
' old style (Victorian and earlier), with double quotes without closures that were used to
' mark long quotes split into several paragraphs, where the closing double quote only appears
' at the end of the last paragraph. The macro should also correctly deal with apostrophes, and,
' hopefully, any combination or multiple of single quotes and apostrophes.
' The logic makes some assumptions:
' 1. single quotation marks within words are apostrophes
' 2. if there's an odd number of quotation marks (excluding apostrophes) in a paragraph, the
' first one is considered to have no closure (as was the norm in the 19th century: quotations
' spanning several paragraphs had an opening quotation mark at the start of each paragraph,
' but a closing mark only at the end of the last paragraph)
' 3. stand-alone acute and grave accents are assumed to be single quotation marks, and will
' be converted as such.
' The routine uses a subroutine to perform the search and replacements. It uses far more
' steps than would have been necessary were OpenOffice's implementation of Regular Expressions
' not so bloody awful (and were OpenOffice not in the habit of trashing character formatting
' when performing Regular Expression search/replaces on parts of a string).
' LIMITATIONS - GLOTTAL STOPS
' The macro does not deal with single quotes used to indicate a glottal stops in some transliterations,
' for instance Arabic (eg. ’Abdullah). In such transliterations, aleph glottal stops are often
' written with a single right quotation mark, whilst the reverse form, the ‘ayn, is often written with
' a left quotation mark.
' I can't think of a method to reliably detect these without messing up the single quote detection, as
' even if I used a word list, the opening quote might really be a quote, not a glottal stop.
' If you do use glottal stops in your documents, I'd suggest you use the correct Unicode characters.
' In properly encoded multilingual fonts such as Gentium, Linux Libertine and DejaVu (all of them
' free), the aleph (left-pointing) is at code point 02BE, whilst ‘ayn (right-pointing) is at 02BF.
' In OpenOffice's "Insert | Special character" dialog, they're under Spacing Modifier Letters.
a$ = "Use typographer’s quotes?" + Chr(10) + Chr(10) + _
"— Yes changes all quotation marks and apostrophes to curly ones;" + Chr(10) + _
"— No changes them all to straight ones;" + Chr(10) + _
"— Cancel leaves them as they are."
response = MsgBox(a$,512 + 32 + 3,"Typography - quotes")
If (response = 2) Then goto noChange ' 2 = cancel, so do nothing
REM save cursor position
oViewCursor = ThisComponent.getCurrentController().getViewCursor()
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
REM disable screen update
ThisComponent.lockControllers
ThisComponent.CurrentController.Frame.ContainerWindow.Enable = False
REM correct quotes made with acute or grave accents
FindReplaceQuotes ("´","'","all") ' change acute to single quote
FindReplaceQuotes ("`","'","all") ' change grave to single quote
If (response = 6) Then ' APPLY SMART QUOTATION MARKS
REM DOUBLE QUOTES
DQ = Chr(34) ' Chr(34) is the straight double quote
FindReplaceQuotes (""+DQ+"[^"+DQ+"]+"+DQ+"","","all") ' find "....."
FindReplaceQuotes (""+DQ+"[^"+DQ+"]+","","selection") ' find "..... within selections
FindReplaceQuotes (""+DQ+"","“","selection") ' change to “
FindReplaceQuotes ("“[^"+DQ+"“]+"+DQ+"","","all") ' find “...."
FindReplaceQuotes (""+DQ+"","”","selection") ' change " to ”
FindReplaceQuotes (""+DQ+"","“","all") ' change remaining quotes to “
REM SINGLE QUOTES
FindReplaceQuotes ("'","’","all") ' change all single quotes to right
FindReplaceQuotes ("’\<","‘","all") ' change rightquotes before words to leftquotes
FindReplaceQuotes ("([:alnum:])‘([:alnum:])","","all") ' find leftquotes within words
FindReplaceQuotes ("‘","’","selection") ' change to rightquotes (apostrophes)
' deal with single quotes that have spaces around them
FindReplaceQuotes (" ’","¨","all") ' temporarily change space+rightquote to dieresis (¨)
FindReplaceQuotes ("¨[^¨]+¨","","all") ' select all pairs
FindReplaceQuotes ("¨[^¨]+","","selection") ' trim selections to exclude closing space+rightquote
FindReplaceQuotes ("¨"," ‘","selection") ' replace with leftquote
FindReplaceQuotes ("¨"," ’","all") ' change markers back to rightquotes
' deal with single quotes at start of line, paragraph, or following tabs or starting punctuation
FindReplaceQuotes ("(\t|[“\[\(\{])’","","all") ' select rightquotes following opening punctuation or tabs
FindReplaceQuotes ("’","‘","selection") ' change to leftquotes
FindReplaceQuotes ("^’","‘","all") ' change rightquotes at new line to leftquotes
FindReplaceQuotes ("“ ’","","all") ' change rightquotes after quotequote+space (2 steps)
FindReplaceQuotes ("’","‘","selection")
Else ' APPLY STRAIGHT QUOTATION MARKS
FindReplaceQuotes ("‘","'","all")
FindReplaceQuotes ("’","'","all")
FindReplaceQuotes ("“",Chr(34),"all")
FindReplaceQuotes ("”",Chr(34),"all")
EndIf
REM restore cursor position
oViewCursor = ThisComponent.getCurrentController().getViewCursor()
oViewCursor.gotoRange(oTextCursor,false)
REM reenable screen update
ThisComponent.CurrentController.Frame.ContainerWindow.Enable = True
ThisComponent.unlockControllers
noChange:
End Sub
Sub FindReplaceQuotes (sFind,sReplace,sScope)
REM sFind: regular expression
REM sReplace: if empty, function selects all occurrences of sFind
REM sScope: set to "all" for entire document, or "selection" to restrict the scope.
REM function searches backwards (necessary to correctly catch quotes)
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(18) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.Backward"
args1(4).Value = true
args1(5).Name = "SearchItem.Pattern"
args1(5).Value = false
args1(6).Name = "SearchItem.Content"
args1(6).Value = false
args1(7).Name = "SearchItem.AsianOptions"
args1(7).Value = false
args1(8).Name = "SearchItem.AlgorithmType"
args1(8).Value = 1
args1(9).Name = "SearchItem.SearchFlags"
If sScope = "all" Then
args1(9).Value = 65536 ' parse entire doc
Else
args1(9).Value = 71680 ' parse selection only
End If
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = sFind
args1(11).Name = "SearchItem.ReplaceString"
args1(11).Value = sReplace
args1(12).Name = "SearchItem.Locale"
args1(12).Value = 255
args1(13).Name = "SearchItem.ChangedChars"
args1(13).Value = 2
args1(14).Name = "SearchItem.DeletedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.InsertedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.TransliterateFlags"
args1(16).Value = 1280
args1(17).Name = "SearchItem.Command"
If sReplace = "" Then
args1(17).Value = 1 ' find all
Else
args1(17).Value = 3 ' replace all
End If
args1(18).Name = "Quiet"
args1(18).Value = true
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
End Sub
|
Enjoy! |
|