'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: 4 May 2009.
' 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 deformat 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

Declare Function AddCancel( Id$, Action%, SValue& )

Sub Main

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

Dim Character$
Dim CharRead$
Dim CRSpace$                 : CRSpace$         = Chr$( 13 ) & " "
Dim RawString$
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

' First, make sure there is text on the clipboard to paste

RawString$ = Clipboard.GetText( )
If RawString$ = "" 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( RawString$ )
  CharRead$ = Mid$( RawString$, 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", .AddCancel
            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"
            CancelButton 1, 1, 1, 1
          End Dialog
          Dim ChooseConversion As CRToDash
          On Error Resume Next
          Dialog ChooseConversion
          If Err = 102 Then Exit Sub

          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 quotation makrs into one double quotation mark

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

If ConvertCRsToDashes = TRUE Then

' If carriage returns are to be converted to dashes, begin by getting rid of all extra
' spaces preceding and following them

  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

'****************************************************************************************
Function AddCancel( Id$, Action%, SValue& )

' This function makes the pixel-square "CancelButton" in the dialog box invisible, so it
' can be closed with the [ESC] key or the X-close box in the corner while still retaining
' the hotkey enabled custom cancel button

If Action% = 1 Then DlgVisible "Cancel", 0

End Function