'MacroName:CutterCreate
'MacroDescription:Creates a two- or three-digit Cutter for the
' selected text
'
' This macro was written by Walter F. Nickeson,
' University of Rochester, Rochester, NY
' wnickeson@library.rochester.edu
'
' Last updated: 6 October 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: Select a text string from which to derive a
' Cutter (based on LC practice) and run the macro. The macro
' will display a (quick and dirty) two to four character LC
' Cutter, based on the first few characters of the selection,
' ignoring punctuation and diacritics. The Cutter is also copied
' to the Windows Clipboard for pasting in at the appropriate
' place. A decimal may be prefixed, if desired. Be sure to
' adjust the macro's Cutter to fit your own shelflist!
'***************************************************************

Option Explicit

Declare Function Digits$( Numb% )

Sub Main

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

Dim ButtonOne$
Dim ButtonTwo$
Dim Char$                    : Char$ = ""
Dim Character%               : Character% = 1
Dim Cutter$                  : Cutter$ = ""
Dim CutterDecimal$
Dim CutterString$            : CutterString$ = ""
Dim FirstCutter$
Dim Text$                    : Text$ = ""

Dim Check%
Dim Counter%                 : Counter% = 1
Dim FourthCutter%
Dim SecondCutter%
Dim ThirdCutter%

If CS.GetSelectedText( Text$ ) = FALSE Then
    MsgBox "Please select text for the macro to work with.", 48, "No text is selected!"
    Exit Sub
End If

If Len( Text$ ) > 18 Then
    MsgBox "Please select fewer than 18 characters. This macro needs only four to construct the Cutter.", 48, "Selection too large!"
    Exit Sub
End If

' Convert the selection to uppercase for manipulation. Then
' build the string to Cutter on by getting the first one to four
' letters of the selection

Text$ = Trim$( UCase$( Text$ ) )

Do
  Char$ = Mid$( Text$, Character%, 1 )
  Check% = Asc( Char$ )
  Select Case Check%

' If the first digit is a number, it's a special case

    Case 48 To 57
      If Counter% = 1 Then
          CutterString$ = "A" & Char$
          Counter% = Counter% + 2
        Else
          CutterString$ = CutterString$ & Char$
          Counter% = Counter% + 1
      End If
    Case 65 to 90
      CutterString$ = CutterString$ & Char$
      Counter% = Counter% + 1
    Case 161, 177                          'Letter "L"
      CutterString$ = CutterString$ & "L"
      Counter% = Counter% + 1
    Case 162, 172, 178, 188                'Letter "O"
      CutterString$ = CutterString$ & "O"
      Counter% = Counter% + 1
    Case 163, 164, 179, 180                'Letter "D"
      CutterString$ = CutterString$ & "D"
      Counter% = Counter% + 1
    Case 165, 181                          'Digraph "AE"
      CutterString$ = CutterString$ & "AE"
      Counter% = Counter% + 2
    Case 166, 182                          'Digraph "OE"
      CutterString$ = CutterString$ & "OE"
      Counter% = Counter% + 2
    Case 173, 189                          'Letter "U"
      CutterString$ = CutterString$ & "U"
      Counter% = Counter% + 1
    Case 184                               'Letter "I"
      CutterString$ = CutterString$ & "I"
      Counter% = Counter% + 1

' Space or period (full stop): assume that the end of the word
' has been reached

    Case 32, 46
      GoTo Continue:

' If the cursor is on punctuation or a non-alphabetic character,
' and the macro is just starting, end the macro with a warning
' that a Cutter cannot be created; otherwise keep going

    Case Else
      If Counter% = 1 Then
          Beep
          MsgBox "The first character must be a letter or number. Please select different text.", 48, "Cutter creation failed!"
          Exit Sub
      End If

  End Select
  Character% = Character% + 1

Loop Until Counter% >= 5 Or Character% > Len( Text$ )

Continue:

If Len( CutterString$ ) > 1 Then
    FirstCutter$ = Left$( CutterString$, 1 )
    SecondCutter% = Asc( Mid$( CutterString$, 2, 1 ) )

' For a word of only one letter, arbitrarily assign the Cutter
' "12" to the letter

  Else
    Cutter$ = CutterString$ & "12"
    GoTo Finish:
End If

If Counter% > 3 Then
    ThirdCutter% = Asc( Mid$( CutterString$, 3, 1 ) )
    FourthCutter% = Asc( Right$( CutterString$, 1 ) )
End If

' The first number (the second character) of the Cutter is
' determined by the first character, depending on whether that
' first character is a vowel, a consonant, or the letters Q and
' S

Select Case FirstCutter$
  Case "A", "E", "I", "O", "U"
    Select Case SecondCutter%
      Case 48 To 57
        Cutter$ = FirstCutter$ & "1" & Digits$( SecondCutter% )
      Case 65 to 67
        Cutter$ = FirstCutter$ & "2"
      Case 68 to 75
        Cutter$ = FirstCutter$ & "3"
      Case 76 to 77
        Cutter$ = FirstCutter$ & "4"
      Case 78 to 79
        Cutter$ = FirstCutter$ & "5"
      Case 80 to 81
        Cutter$ = FirstCutter$ & "6"
      Case 82
        Cutter$ = FirstCutter$ & "7"
      Case 83 to 84
        Cutter$ = FirstCutter$ & "8"
      Case 85 to 90
        Cutter$ = FirstCutter$ & "9"
    End Select
  Case "S"
    Select Case SecondCutter%
      Case 48 To 57
        Cutter$ = FirstCutter$ & "1" & Digits$( SecondCutter% )
      Case 65 to 66
        Cutter$ = FirstCutter$ & "2"
      Case 67
        If ThirdCutter% = 72 Then
            Cutter$ = FirstCutter$ & "3"
            Select Case FourthCutter%
              Case 48 To 57
                Cutter$ = Cutter$ & "1" & Digits$( FourthCutter% )
              Case 65 To 68
                Cutter$ = Cutter$ & "22"
              Case 69 To 72
                Cutter$ = Cutter$ & "24"
              Case 73 To 75
                Cutter$ = Cutter$ & "26"
              Case 76
                Cutter$ = Cutter$ & "28"
              Case 77
                Cutter$ = Cutter$ & "29"
              Case 78
                Cutter$ = Cutter$ & "32"
              Case 79 To 81
                Cutter$ = Cutter$ & "33"
              Case 82 to 84
                Cutter$ = Cutter$ & "35"
              Case 85 to 86
                Cutter$ = Cutter$ & "37"
              Case 87 to 90
                Cutter$ = Cutter$ & "38"
            End Select
        Else
            Cutter$ = FirstCutter$ & "3"
        End If
      Case 68 to 69
        Cutter$ = FirstCutter$ & "4"
      Case 70 to 76
        Cutter$ = FirstCutter$ & "5"
      Case 77 to 82
        Cutter$ = FirstCutter$ & "6"
      Case 83 to 84
        Cutter$ = FirstCutter$ & "7"
      Case 85
        Cutter$ = FirstCutter$ & "8"
      Case 86 to 90
        Cutter$ = FirstCutter$ & "9"
    End Select
  Case "Q"
    If SecondCutter% = 85 Then
        Select Case ThirdCutter%
          Case 48 To 57
            Cutter$ = FirstCutter$ & "1" & Digits$( ThirdCutter% )
          Case 65 to 68
            Cutter$ = FirstCutter$ & "3"
          Case 69 to 72
            Cutter$ = FirstCutter$ & "4"
          Case 73 to 78
            Cutter$ = FirstCutter$ & "5"
          Case 79 to 81
            Cutter$ = FirstCutter$ & "6"
          Case 82 to 83
            Cutter$ = FirstCutter$ & "7"
          Case 84 to 88
            Cutter$ = FirstCutter$ & "8"
          Case 89 to 90
            Cutter$ = FirstCutter$ & "9"
        End Select
      ElseIf SecondCutter% > 85 Then
        Cutter$ = FirstCutter$ & "9"
        Select Case SecondCutter%
          Case 48 To 57
            Cutter$ = Cutter$ & "1" & _
              Digits$( SecondCutter% )
          Case 65 to 68
            Cutter$ = Cutter$ & "3"
          Case 69 to 72
            Cutter$ = Cutter$ & "4"
          Case 73 to 75
            Cutter$ = Cutter$ & "5"
          Case 76 to 78
            Cutter$ = Cutter$ & "6"
          Case 79 to 81
            Cutter$ = Cutter$ & "7"
          Case 82 to 83
            Cutter$ = Cutter$ & "8"
          Case 84, 86 to 90
            Cutter$ = Cutter$ & "9"
        End Select
      Else
        Cutter$ = FirstCutter$ & "2"
        Select Case SecondCutter%
          Case 48 To 57
            Cutter$ = Cutter$ & "1" & _
              Digits$( SecondCutter% )
          Case 65 to 68
            Cutter$ = Cutter$ & "3"
          Case 69 to 72
            Cutter$ = Cutter$ & "4"
          Case 73 to 75
            Cutter$ = Cutter$ & "5"
          Case 76 to 78
            Cutter$ = Cutter$ & "6"
          Case 79 to 81
            Cutter$ = Cutter$ & "7"
          Case 82 to 83
            Cutter$ = Cutter$ & "8"
          Case 84, 86 to 90
            Cutter$ = Cutter$ & "9"
        End Select
    End If
  Case Else
    Select Case SecondCutter%
      Case 48 To 57
        Cutter$ = FirstCutter$ & "1" & _
          Digits$( SecondCutter% )
      Case 65 to 68
        Cutter$ = FirstCutter$ & "3"
      Case 69 to 72
        Cutter$ = FirstCutter$ & "4"
      Case 73 to 78
        Cutter$ = FirstCutter$ & "5"
      Case 79 to 81
        Cutter$ = FirstCutter$ & "6"
      Case 82 to 84
        Cutter$ = FirstCutter$ & "7"
      Case 85 to 88
        Cutter$ = FirstCutter$ & "8"
      Case 89 to 90
        Cutter$ = FirstCutter$ & "9"
    End Select
End Select

' In this next part, if the word is three characters long,
' continue by selecting the next letter for expansion

FourthLetter:

If Counter% > 3 Then
    Select Case ThirdCutter%
      Case 48 To 57
        Cutter$ = Cutter$ & Digits$( ThirdCutter% )
      Case 65 to 68
        Cutter$ = Cutter$ & "3"
      Case 69 to 72
        Cutter$ = Cutter$ & "4"
      Case 73 to 76
        Cutter$ = Cutter$ & "5"
      Case 77 to 79
        Cutter$ = Cutter$ & "6"
      Case 80 to 83
        Cutter$ = Cutter$ & "7"
      Case 84 to 86
        Cutter$ = Cutter$ & "8"
      Case 87 to 90
        Cutter$ = Cutter$ & "9"
    End Select
End If

Finish:

Cutter$ = Left$( Cutter$, 4 )
CutterDecimal$ = "." & Left$( Cutter$, 4 )
ButtonOne$ = "&Plain Cutter = " & Cutter$
ButtonTwo$ = "&Decimal added = " & CutterDecimal$
Clipboard.Clear

Begin Dialog SpecifyDecimal 192, 124, "Cutter created and copied to the Clipboard"
  ButtonGroup .AddDecimal
    PushButton  48, 16, 96, 20, ButtonOne$
    PushButton  48, 52, 96, 20, ButtonTwo$
    PushButton  48, 88, 96, 20, "&Cancel (clear Clipboard)"
End Dialog
Dim SelectCutter as SpecifyDecimal
Dialog SelectCutter
Select Case SelectCutter.AddDecimal
  Case 0
    Clipboard.SetText Cutter$
  Case 1
    Clipboard.SetText CutterDecimal$
End Select

End Sub

' This function assigns Cutter numbers to strings of digits

Function Digits$( Numb% )

Select Case Numb%
  Case 48
    Digits$ = "2"
  Case 49
    Digits$ = "3"
  Case 50 To 51
    Digits$ = "4"
  Case 52
    Digits$ = "5"
  Case 53
    Digits$ = "6"
  Case 54 To 55
    Digits$ = "7"
  Case 56
    Digits$ = "8"
  Case 57
    Digits$ = "9"
End Select

End Function