Apache OpenOffice Community Forum

Code: Select all

sub Quotes

'   By bluegecko, 13 January 2010. Public domain.

'jh Regular expressions changed in OOo 3.4 - search at start / end of word changed

'   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 ****** 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.
'
'  Alternative method - do two passes with the following
'  The first pass handles all the close quotes; the second gets the remaining (open) quotes.
'  Search for: ([^ ])"       '   " = straight quotes
'  Replace with: $1”         '   ” = curly close quotes 
'  Options/Regular expression: ON
'  Click "Replace All"
'
'  Search for: "             '   " = straight quotes
'  Replace with: “           '   “ = curly open quotes
'  Click "Replace All"
'
'jh Remove the question and set the response = 6 so as to change straight to curly

'jh   a$ = "Use typographer’s quotes?" + Chr(10) + Chr(10) + _
'jh      "— Yes changes all quotation marks and apostrophes to curly ones;" + Chr(10) + _
'jh      "— No changes them all to straight ones;" + Chr(10) + _
'jh      "— Cancel leaves them as they are."
'jh   response = MsgBox(a$,512 + 32 + 3,"Typography - quotes")

'jh   If (response = 2) Then goto noChange                  ' 2 = cancel, so would do nothing

'jh set response to be 6 to change straight quotes to curly quotes

   response = 6        ' set by jh
   
   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
      
'jh  I think that in the above two lines, the first line searches all.  
'jh  The second line searches only the selection 
 
      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
'jh  I think the following are correct.  Here in case they are needed - but not used below
      SQ   = Chr(39)    ' single quote - straight
      LQc  = Chr(8216)  ' single quote left - curly  
      RQc  = Chr(8217)  ' single quote right - curly
      LDQc = Chr(8220)  ' double quote left - curly
      RDQc = Chr(8221)  ' double quote right - curly
      
'jh   macro works differently if changes are enabled
        
      FindReplaceQuotes ("'","’","all")          ' change all single quotes to right

'jhq FindReplaceQuotes ("’\>","‘","all")   ' change rightquotes before words to leftquotes
'jhq the previous line should only replace "r-quotes before words". It replaces "r-quotes before and after words"
'jhq because??  \< no longer works for non-alpha chars (in macros?) after OOo 3.4.1. So ...

      FindReplaceQuotes ("’","‘","all")          ' change all rightquotes to leftquotes

'jhq Now change back only the "l-quotes after words"
'jhq ...look for (chars)(l-quote)(punctuation or sp). note \) rqd for )

      FindReplaceRegExp ("([a-z0-9])(‘)(\.|\?| |!|,|;|:|\))","$1’$3","all") 'l-quote at end of word changed to r-quote

'jhq ... and we have done it

'jhq Note that FindReplaceQuotes ("z\>","‘","all") works OK for z\> where z is a character.

      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")

'jh  simplest to leave this - it will never be executed as response was set to 6 above

   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:

'jh  Remove search backwards and regular expressions by running a dummy RESET search with them unticked
   FindReplaceReset ("abc","abc","all")                             ' change a abc to abc 

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                            ' backward is required for quotes
   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                                ' search using Regular Expressions
   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

Sub FindReplaceReset (sFind,sReplace,sScope)
'jh This sub FindReplaceReset is used merely to untick the Regular Expression and Backwards search boxes.
   REM sFind:     is not a 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 forwards to untick the box

   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 = false                      ' set to false to search forwards so as to untick the box
   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 = 0                          ' set to 0 to untick regular expressions
   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