'MacroName:DeformatClipboard
'MacroDescription:Removes some formatting from text
' placed on the Clipboard for pasting into Connexion.
'
' This macro was written by Walter F. Nickeson,
' University of Rochester, Rochester, NY
' wnickeson@library.rochester.edu
'
' Last updated: 11 August 2006.
' Check for the latest versions of this and my other macros at
' http://docushare.lib.rochester.edu/docushare/dsweb/View/Collection-2556
' Please e-mail me with bug reports or to suggest improvements.
'
' Works in Connexion client 2.10.
'
'***************************************************************
' How it works: Use this macro to paste text copied to the
' Windows clipboard into a Connexion record. It attempts to de-
' format text by removing carriage returns and line feeds (which
' it will optionally convert to dashes, as used in contents
' notes), and tabs, collapsing white space, and changing proper
' or typographer's quotation marks (also known as "curly
' quotes") and dashes to simple, straight quotation marks and
' hyphens.
'***************************************************************

Option Explicit

Sub Main

Dim CS As Object
Set CS = CreateObject("Connex.Client")

Dim Character$
Dim CharRead$
Dim CRSpace$                 : CRSpace$ = Chr$( 13 ) & " "
Dim Flatten$
Dim SpaceCR$                 : SpaceCR$ = " " & Chr$( 13 )
Dim TempString$
Dim TwoCRs$                  : TwoCRs$ = Chr$( 13 ) & Chr$( 13 )
Dim TwoSingleQuotes$         : TwoSingleQuotes$ = Chr$( 39 ) & Chr$( 39 )

Dim Char%
Dim i, p As Integer

Dim ConvertCRsToDashes       : ConvertCRsToDashes = FALSE
Dim TestForCRs               : TestForCRs = FALSE

Flatten$ = Clipboard.GetText( )
If Flatten$ = "" Then
    MsgBox "There is no text on the clipboard!", 48, "Macro cannot proceed"
    Exit Sub
End If

' Go through the text on the clipboard, substituting plain text
' characters for characters not allowed

TempString$ = ""
For i = 1 To Len( Flatten$ )
  CharRead$ = Mid$( Flatten$, i, 1 )
  Char% = Asc( CharRead$ )
  Select Case Char%
    Case 9, 11, 12
      Character$ = " "
    Case 10, 13
      If TestForCRs = FALSE Then
          Begin Dialog CRToDash 206, 100, "Convert returns"
            Text  22, 10, 170, 10, "Convert carriage returns/line feeds to spaces or dashes?"
            ButtonGroup .Convert
              PushButton  28, 30, 62, 18, "&Spaces"
              PushButton  116, 30, 62, 18, "&Dashes"
              PushButton  72, 64, 62, 18, "&Cancel"
          End Dialog
          Dim ChooseConversion As CRToDash
          Dialog ChooseConversion
          Select Case ChooseConversion.Convert
            Case 1
              ConvertCRsToDashes = TRUE
            Case 2
              Exit Sub
          End Select
          TestForCRs = TRUE
      End If
      If ConvertCRsToDashes = TRUE Then
          Character$ = Chr$( 13 )
        Else
          Character$ = " "
      End If
    Case 32 To 95, 97 To 126, 192 To 255
      Character$ = CharRead$
    Case 133
      Character$ = "..."
    Case 96
      Character$ = Chr$( 39 )
    Case 145 To 146
      Character$ = Chr$( 39 )
    Case 147 To 148
      Character$ = Chr$( 34 )
    Case 150
      Character$ = "-"
    Case 151
      Character$ = "--"
    Case Else
      Character$ = ""
  End Select

TempString$ = TempString$ & Character$

Next i

' Do a first round of eliminating double spaces

Do
  p = InStr( TempString$, "  " )
  If p <> 0 Then
      TempString$ = Mid$( TempString$, 1, p - 1 ) & " " & Mid$( TempString$, p + 2)
  End If
Loop Until p = 0

' Combine consecutive single quotes into one double quote

Do
  p = InStr( TempString$, TwoSingleQuotes$ )
  If p <> 0 Then
      TempString$ = Mid$( TempString$, 1, p - 1 ) & Chr$( 34 ) & Mid$( TempString$, p + 2)
  End If
Loop Until p = 0

' Convert carriage returns to dashes

If ConvertCRsToDashes = TRUE Then

' First get rid of all extra spaces preceding and following
' carriage returns
  Do
    p = InStr( TempString$, SpaceCR$ )
    If p <> 0 Then
        TempString$ = Mid$( TempString$, 1, p - 1 ) & Chr$( 13 ) & Mid$( TempString$, p + 2)
    End If
  Loop Until p = 0
  Do
    p = InStr( TempString$, CRSpace$ )
    If p <> 0 Then
        TempString$ = Mid$( TempString$, 1, p - 1 ) & Chr$( 13 ) & Mid$( TempString$, p + 2)
    End If
  Loop Until p = 0

' Next, collapse consecutive occurrences of a carriage return to
' a single occurrence
  Do
    p = InStr( TempString$, TwoCRs$ )
    If p <> 0 Then
        TempString$ = Mid$( TempString$, 1, p - 1 ) & Chr$( 13 ) & Mid$( TempString$, p + 2)
     End If
  Loop Until p = 0

' Finally, convert the carriage return to space-dash-space
' (i.e., space-hyphen-hyphen-space)
  Do
    p = InStr( TempString$, Chr$( 13 ) )
    If p <> 0 Then
        If p = Len( TempString$ ) Then
            TempString$ = Left$( TempString$, p - 1 )
          Else
            TempString$ = Mid$( TempString$, 1, p - 1 ) & " -- " & Mid$( TempString$, p + 1)
        End If
    End If
  Loop Until p = 0
End If

' As the last step, clean up any remaining or introduced double
' spaces

Do
  p = InStr( TempString$, "  " )
  If p <> 0 Then
      TempString$ = Mid$( TempString$, 1, p - 1 ) & " " & Mid$( TempString$, p + 2)
  End If
Loop Until p = 0

Clipboard.Clear
Clipboard.SetText TempString$
CS.Paste

End Sub