Force Capitalized String

questions
7

from a message by Mike Hanson 17 May 2003, 03:43:23

on this thread:
https://groups.google.com/g/comp.lang.clarion/c/pHcdA5kUm4Y/m/j7WwwKN-4iAJ

Here's the best of the bunch, evolved from DOS days, and now availabe
in the BoxSoft SuperStuff templates.  Not only does it handle names
like McMaster and O'Henry, it will also handle McDonald's without
capitalizing the trailing "s".  It's aware of international characters
too.
-=> Mike Hanson <=-


  MEMBER
!==============================================================================
  MAP
Proper               PROCEDURE(STRING N),STRING
IsNumericChar        PROCEDURE(STRING pChar),BYTE
IsAlphaChar          PROCEDURE(STRING pChar),BYTE
IsLowerChar          PROCEDURE(STRING pChar),BYTE
IsUpperChar          PROCEDURE(STRING pChar),BYTE
ToLower              PROCEDURE(STRING pChar),STRING
ToUpper              PROCEDURE(STRING pChar),STRING
  END!MAP
!==============================================================================
Mod:IntU             STRING('ЗДЕЙЖЦЬС'),STATIC
Mod:IntL             STRING('здейжцьс'),STATIC
Mod:IntLC            STRING('ьйвдаезклипомжфцтыщябнуъс'),STATIC
Mod:IntUC            STRING('ЬЙAДAЕЗEEEIIIЖOЦOUUYAIOUС'),STATIC
!==============================================================================
Proper PROCEDURE(STRING N)
Loc:RetVal       STRING(255)
Loc:Char         STRING(1),DIM(255),OVER(Loc:RetVal)
Loc:X            BYTE
Loc:Start        BYTE
Loc:Len          BYTE
Loc:Mc           BYTE(-1)
  CODE
  Loc:RetVal = N
  IF IsLowerChar(Loc:Char[1])
    Loc:Char[1] = ToUpper(Loc:Char[1])
  END!IF
  IF Loc:Char[1] = 'M' AND UPPER(Loc:Char[2]) = 'C'
    Loc:Char[2] = 'c'
    Loc:Start   = 3
    Loc:Mc      = 1
  ELSE
    Loc:Start = 2
  END!IF
  Loc:Len = LEN(CLIP(N))
  LOOP Loc:X = Loc:Start TO Loc:Len
    IF IsAlphaChar(Loc:Char[Loc:X])
      IF IsAlphaChar(Loc:Char[Loc:X-1])
        IF Loc:Mc <> Loc:X-2
          IF IsUpperChar(Loc:Char[Loc:X])
            Loc:Char[Loc:X] = ToLower(Loc:Char[Loc:X])
          END!IF
          IF Loc:Char[Loc:X]='c' AND Loc:Char[Loc:X-1]='M'
            Loc:Mc = Loc:X - 1
          END!IF
        ELSE
          IF IsLowerChar(Loc:Char[Loc:X])
            Loc:Char[Loc:X] = ToUpper(Loc:Char[Loc:X])
          END!IF
        END!IF
      ELSIF UPPER(Loc:Char[Loc:X])='S' AND Loc:Char[Loc:X-1]=''''
        IF Loc:X >= 3
          IF Loc:Char[Loc:X-2] = 'O'
            Loc:Char[Loc:X] = 'S'
          ELSE
            Loc:Char[Loc:X] = 's'
          END!IF
        ELSE
          Loc:Char[Loc:X] = 's'
        END!IF
      ELSIF IsNumericChar(Loc:Char[Loc:X-1])
        IF IsUpperChar(Loc:Char[Loc:X])
          Loc:Char[Loc:X] = ToLower(Loc:Char[Loc:X])
        END!IF
      ELSIF IsLowerChar(Loc:Char[Loc:X])
        Loc:Char[Loc:X] = ToUpper(Loc:Char[Loc:X])
      END!IF
    END!IF
  END!LOOP
  RETURN Loc:RetVal
!==============================================================================
IsNumericChar PROCEDURE(STRING pChar)
  CODE
  RETURN CHOOSE(pChar[1] >= '0' AND pChar[1] <= '9')
!==============================================================================
IsAlphaChar PROCEDURE(STRING pChar)
  CODE
  IF (pChar[1] >= 'A' AND pChar[1] <= 'Z')  |
  OR (pChar[1] >= 'a' AND pChar[1] <= 'z')  |
  OR INSTRING(pChar[1], Mod:IntU)           |
  OR INSTRING(pChar[1], Mod:IntLC)
    RETURN 1
  ELSE
    RETURN 0
  END!IF
!==============================================================================
IsLowerChar PROCEDURE(STRING pChar)
  CODE
  IF pChar[1] >= 'a' and pChar[1] <= 'z'  |
  OR INSTRING(pChar[1], Mod:IntLC)
    RETURN 1
  ELSE
    RETURN 0
  END!IF
!==============================================================================
IsUpperChar PROCEDURE(STRING pChar)
  CODE
  IF pChar[1] >= 'A' and pChar[1] <= 'Z'  |
  OR INSTRING(pChar[1], Mod:IntU, 1)
    RETURN 1
  ELSE
    RETURN 0
  END!IF
!==============================================================================
ToLower PROCEDURE(STRING pChar)
P BYTE,AUTO
  CODE
  IF pChar[1] < '~'
    RETURN  CHR(VAL(pChar)+32)
  ELSE
    P = INSTRING(pChar[1], Mod:IntU)
    RETURN CHOOSE(~P, pChar[1], Mod:IntL[P])
  END!IF
!==============================================================================
ToUpper PROCEDURE(STRING pChar)
P BYTE,AUTO
  CODE
  IF pChar[1] < '~'
    RETURN CHR(VAL(pChar[1])-32)
  ELSE
    P = INSTRING(pChar[1], Mod:IntLC)
    RETURN CHOOSE(~P, pChar[1], Mod:IntUC[P])
  END!IF
!==============================================================================
www.boxsoft.net

also Mike did an article on a later version in Clarion Magazine:

Formatting Names Using Proper Case
by Mike Hanson
Published 2008-12-22

attached here with thanks to Dave Harms.

cmag-2008-12.pdf (793.0 KB)
v10n12proper.zip (23.9 KB)

1 Like