home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / orx8.zip / nls_util.cmd < prev    next >
OS/2 REXX Batch file  |  1997-07-21  |  11KB  |  313 lines
  1. /*
  2. program:   nls_util.cmd
  3. type:      Object REXX, REXXSAA 6.0
  4. purpose:   implements functions and classes for easier dealing with NLS-support
  5. version:   1.0.1
  6. date:      1997-04-15
  7. changed:   1997-06-26, rgf, changed a bug in NLS' SETENTRY and INIT methods
  8.            1997-07-16, rgf, changed instance method "DUMP" of NLS to output
  9.                        to the .error object.
  10.  
  11. author:    Rony G. Flatscher
  12.            Rony.Flatscher@wu-wien.ac.at
  13.            (Wirtschaftsuniversitaet Wien, University of Economics and Business
  14.            Administration, Vienna/Austria/Europe)
  15. needs:     Test_Util-module
  16.  
  17. usage:     see program :)
  18.  
  19. comments:  prepared for the "8th International Rexx Symposium 1997", April 1997, Heidelberg/Germany
  20.  
  21. All rights reserved and copyrighted 1997 by the author,
  22. no guarantee that it works without errors, etc. etc.
  23.  
  24. You are granted the right to use this module under the condition that you don't charge money for this module (as you didn't write
  25. it in the first place) or modules directly derived from this module, that you document the original author (to give appropriate
  26. credit) with the original name of the module and that you make the unaltered, original source-code of this module available on
  27. demand.  If that holds, you may even bundle this module (either in source or compiled form) with commercial software.
  28.  
  29. If you find an error, please send me the description (preferably a *very* short example);
  30. I'll try to fix it and re-release it to the net.
  31. */
  32.  
  33.  
  34. /* create the default NLS-object, using default country and actual codepage */
  35. CALL set_nls_default_object     /* to be stored with the class object   */
  36.  
  37.  
  38.  
  39. :: REQUIRES is_util.cmd         /* for IsA() routine    */
  40.  
  41.  
  42. :: ROUTINE GET_NLS_DEFAULT_OBJECT       PUBLIC  /* return the default NLS-object */
  43.    RETURN .nls ~ default_NLS
  44.  
  45. :: ROUTINE SET_NLS_DEFAULT_OBJECT       PUBLIC  /* set the default NLS-object   */
  46.    USE ARG country, codepage
  47.  
  48.    IF IsA( ARG( 1 ), .nls ) THEN        /* first argument not a country, but a NLS-object?*/
  49.    DO
  50.       .nls ~ default_NLS = ARG( 1 )     /* if so, use it as the default object          */
  51.    END
  52.    ELSE
  53.    DO
  54.       IF \VAR( "country" ) | country = .nil | "COUNTRY" = country
  55.       THEN country = 0                  /* use default country  */
  56.       ELSE country = STRIP( country )
  57.  
  58.       IF \VAR( "codepage" ) | codepage = .nil | "CODEPAGE" = codepage
  59.       THEN codepage = 0                 /* use default codepage */
  60.       ELSE codepage = STRIP( codepage )
  61.  
  62.       .nls ~ default_NLS = .nls ~ new( country , codePage )
  63.    END
  64.  
  65.    RETURN .nls ~ default_NLS
  66.  
  67.  
  68. :: ROUTINE NLS_UPPER                    PUBLIC          /* do a NLS uppercase */
  69.    USE ARG string
  70.    RETURN .nls ~ default_NLS ~ nls_upper( string )
  71.  
  72.  
  73. :: ROUTINE NLS_LOWER                    PUBLIC          /* do a NLS lowercase */
  74.    USE ARG string
  75.    RETURN .nls ~ default_NLS ~ nls_lower( string )
  76.  
  77.  
  78. :: ROUTINE NLS_COMPARE                  PUBLIC          /* do a NLS compare */
  79.    USE ARG string1, string2
  80.    RETURN .nls ~ default_NLS ~ nls_compare( string1, string2 )
  81.  
  82.  
  83. :: ROUTINE NLS_COLLATE                  PUBLIC          /* translate string into NLS collate */
  84.    USE ARG string
  85.    RETURN .nls ~ default_NLS ~ nls_collate( string )
  86.  
  87.  
  88.  
  89.  
  90.  
  91. /* ========================================================================= */
  92. :: CLASS NLS            PUBLIC
  93.  
  94. /* -------------------------------- class methods ------------------------- */
  95. :: METHOD INIT CLASS
  96.    EXPOSE nlsDirectory default_NLS
  97.  
  98.    nlsDirectory = .directory ~ new      /* directory to contain NLS-objects     */
  99.    default_NLS  = .nil                  /* set default NLS-object to .nil       */
  100.  
  101. :: METHOD default_NLS CLASS ATTRIBUTE   /* may contain an NLS-object            */
  102.  
  103. :: METHOD supplier CLASS                /* return a supplier of NLS-objects created so far      */
  104.    EXPOSE nlsDirectory
  105.  
  106.    RETURN nlsDirectory ~ supplier
  107.  
  108. :: METHOD entry CLASS                   /* look and return NLS object, if available */
  109.    EXPOSE nlsDirectory
  110.    USE ARG country, codepage
  111.  
  112.    IF \VAR( "country" ) | country = .nil | "COUNTRY" = country
  113.    THEN country = 0
  114.    ELSE country = STRIP( country )
  115.  
  116.    IF \VAR( "codepage" ) | codepage = .nil | "CODEPAGE" = codepage
  117.    THEN codepage = 0
  118.    ELSE codepage = STRIP( codepage )
  119.  
  120.    tmpKey = country codepage
  121.    RETURN nlsDirectory ~ entry( tmpKey )
  122.  
  123.  
  124. :: METHOD hasentry CLASS                /* query for the existence of a specific NLS-object     */
  125.    EXPOSE nlsDirectory
  126.    USE ARG country, codepage
  127.  
  128.    IF \VAR( "country" ) | country = .nil | "COUNTRY" = country
  129.    THEN country = 0
  130.    ELSE country = STRIP( country )
  131.  
  132.    IF \VAR( "codepage" ) | codepage = .nil | "CODEPAGE" = codepage
  133.    THEN codepage = 0
  134.    ELSE codepage = STRIP( codepage )
  135.  
  136.    tmpKey = country codepage
  137.    RETURN nlsDirectory ~ entry( tmpKey )
  138.  
  139.  
  140. :: METHOD setentry CLASS                /* set a new NLS-object, if it does not exist yet       */
  141.    EXPOSE nlsDirectory
  142.    USE ARG country, codepage, object
  143.  
  144.    IF \VAR( "country" ) | country = .nil | "COUNTRY" = country
  145.    THEN country = 0
  146.    ELSE country = STRIP( country )
  147.  
  148.    IF \VAR( "codepage" ) | codepage = .nil | "CODEPAGE" = codepage
  149.    THEN codepage = 0
  150.    ELSE codepage = STRIP( codepage )
  151.  
  152.    tmpKey = country codepage
  153.  
  154.    tmpObject = nlsDirectory ~ entry( tmpKey )
  155.    IF tmpObject = .nil THEN             /* no entry yet         */
  156.    DO
  157.       IF VAR( "object" ) THEN           /* object given ?       */
  158.       DO
  159.          nlsDirectory ~ setentry( tmpKey, object )
  160.          RETURN object
  161.       END
  162.       RETURN .nil
  163.    END
  164.    ELSE                                 /* entry available      */
  165.    DO
  166.       IF \ VAR( "object" ) THEN         /* no object given, hence delete old object     */
  167.          nlsDirectory ~ setentry( tmpKey )      /* remove entry                 */
  168.       ELSE
  169.          nlsDirectory ~ setentry( tmpKey, object )
  170.  
  171.       RETURN tmpObject
  172.    END
  173.  
  174. /* -------------------------------- instance methods ---------------------- */
  175. :: METHOD INIT
  176.    EXPOSE country codepage lowercase uppercase collating_table coll_lower coll_upper
  177.    USE ARG country, codepage
  178.  
  179.  
  180.    IF \VAR( "country" )  | country = .nil  | "COUNTRY" = country   THEN
  181.       country = 0
  182.  
  183.    IF \VAR( "codepage" ) | codepage = .nil | "CODEPAGE" = codepage  THEN
  184.       codepage = 0
  185.  
  186.  
  187.    SIGNAL ON SYNTAX     /* build translate to uppercase tables, if wrong combination
  188.                            of country and codepage a syntax error is raised     */
  189.    collating_table = SysGetCollate( country, codepage )
  190.  
  191.    tmpObj = self ~ class ~ setentry( codepage, country, self )
  192.  
  193.    IF tmpObj <> self THEN       /* already set-up, return       */
  194.    DO
  195.       RETURN tmpObj
  196.    END
  197.  
  198.  
  199.    /* determine differing characters for plain lower/uppercase translation */
  200.    lowercase = ""
  201.    uppercase = ""
  202.  
  203.    all_chars = XRANGE( "0"x, "ff"x)     /* create all 256 Bytes */
  204.  
  205.    tmp_up = SysMapCase( all_chars, country, codepage )         /* build translate to uppercase tables */
  206.    DO i = 1 TO LENGTH( all_chars )
  207.       low   = SUBSTR( all_chars, i, 1 )
  208.       upper = SUBSTR( tmp_up,    i, 1 )
  209.  
  210.       IF low <> upper THEN
  211.       DO
  212.          lowercase = lowercase || low
  213.          uppercase = uppercase || upper
  214.       END
  215.    END
  216.  
  217.  
  218.    /* determine differing characters for collating sequence */
  219.    coll_lower = ""
  220.    coll_upper = ""
  221.  
  222.  
  223.    DO i = 1 TO LENGTH( all_chars )
  224.       low   = SUBSTR( all_chars,       i, 1 )
  225.       upper = SUBSTR( collating_table, i, 1 )
  226.  
  227.       IF low <> upper THEN
  228.       DO
  229.          coll_lower = coll_lower || low
  230.          coll_upper = coll_upper || upper
  231.       END
  232.    END
  233.    RETURN self
  234.  
  235.         /* illegal combination of country and codepage in SysGetCollate() */
  236. SYNTAX : RAISE PROPAGATE        /* raise SYNTAX error in caller */
  237.  
  238.  
  239. :: METHOD codepage                      ATTRIBUTE
  240. :: METHOD coll_lower                    ATTRIBUTE
  241. :: METHOD coll_upper                    ATTRIBUTE
  242. :: METHOD collating_table               ATTRIBUTE
  243. :: METHOD country                       ATTRIBUTE
  244. :: METHOD lowercase                     ATTRIBUTE
  245. :: METHOD uppercase                     ATTRIBUTE
  246.  
  247. :: METHOD makestring                    /* a string representation of a NLS-object      */
  248.    EXPOSE country codepage
  249.  
  250.    RETURN "a" self ~ class ~ id  "[country=" || country || ",codepage=" || codepage || "]"
  251.  
  252. :: METHOD nls_upper                     /* no a NLS uppercase */
  253.    EXPOSE uppercase lowercase
  254.    USE ARG string
  255.  
  256.    RETURN TRANSLATE( string, uppercase, lowercase )
  257.  
  258. :: METHOD nls_lower                     /* do a NLS lowercase */
  259.    EXPOSE uppercase lowercase
  260.    USE ARG string
  261.  
  262.    RETURN TRANSLATE( string, lowercase, uppercase )
  263.  
  264.  
  265. :: METHOD nls_compare                   /* do a case sensitive NLS-compare */
  266.    EXPOSE country codepage
  267.    USE ARG string1, string2
  268.  
  269.         /*  uses Collating Sequence (relatively slow, because of external function call)
  270.  
  271.             string1 < string2 ... -1
  272.             string1 = string2 ...  0
  273.             string1 > string2 ...  1
  274.         */
  275.    RETURN SysNationalLanguageCompare( string1, string2, country, codepage )
  276.  
  277. :: METHOD nls_collate                   /* translate string with collating table */
  278.    EXPOSE coll_upper coll_lower
  279.    USE ARG string
  280.  
  281.    RETURN TRANSLATE( string, coll_upper, coll_lower )
  282.  
  283.  
  284. :: METHOD dump                          /* show effects on lower/uppercase and collating sequence       */
  285.  
  286.     .error ~ LINEOUT(  "NLS-object:" )
  287.     .error ~ LINEOUT()
  288.     .error ~ LINEOUT(  "   country:" pp( self ~ country ) "codepage:" pp( self ~ codepage ) )
  289.     .error ~ LINEOUT() 
  290.     .error ~ LINEOUT(  "lowercase:" pp( self ~ lowercase ) )
  291.     .error ~ LINEOUT(  "uppercase:" pp( self ~ uppercase ) )
  292.     .error ~ LINEOUT()
  293.  
  294.     .error ~ LINEOUT(  "effect of collating table:" )
  295.     .error ~ LINEOUT()
  296.    start  = 1
  297.    length = 60
  298.    coll_length = LENGTH( self ~ coll_lower )
  299.    DO WHILE start < coll_length
  300.       start = RIGHT( start, 3)
  301.       end   = RIGHT( MIN( coll_length, start + length - 1 ), 3 )
  302.        .error ~ LINEOUT(  " low ("start"-"end"):" pp( STRIP( SUBSTR( self ~ coll_lower, start, length ) ) ) )
  303.        .error ~ LINEOUT(  "  up ("start"-"end"):" pp( STRIP( SUBSTR( self ~ coll_upper, start, length ) ) ) )
  304.        .error ~ LINEOUT()
  305.       start = start + length
  306.    END
  307.    RETURN
  308.  
  309. PP : PROCEDURE                          /* cheap :) pretty-print        */
  310.    RETURN "[" || ARG( 1 ) || "]"
  311.  
  312.  
  313.