Issue #80: added `AbstractOperatingSystem class >> #getLanguage` and `#getLanguageTerritory` jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Sun, 19 Nov 2017 14:58:45 -0300
branchjv
changeset 23091 817fd8c6e4c5
parent 23090 58f7ca7bb385
child 23092 5d343af8922a
Issue #80: added `AbstractOperatingSystem class >> #getLanguage` and `#getLanguageTerritory` ...that return operating system defined locale. See https://swing.fit.cvut.cz/projects/stx-jv/ticket/80
AbstractOperatingSystem.st
UnixOperatingSystem.st
Win32OperatingSystem.st
--- a/AbstractOperatingSystem.st	Sat Oct 28 21:47:57 2017 +0100
+++ b/AbstractOperatingSystem.st	Sun Nov 19 14:58:45 2017 -0300
@@ -16,7 +16,8 @@
 Object subclass:#AbstractOperatingSystem
 	instanceVariableNames:''
 	classVariableNames:'ConcreteClass ErrorSignal LastErrorNumber LocaleInfo OSSignals
-		PipeFailed Resources'
+		PipeFailed Resources Language LanguageTerritory LanguageModifier
+		LanguageCodeset'
 	poolDictionaries:''
 	category:'System-Support'
 !
@@ -247,6 +248,14 @@
 
 initializeConcreteClass
     OperatingSystem := ConcreteClass := self getConcreteClass.
+!
+
+initializeLocale
+    "Initializes locale variables (Language, LanguageTerritory an so on)"
+
+    self subclassResponsibility
+
+    "Created: / 19-11-2017 / 14:53:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !AbstractOperatingSystem class methodsFor:'OS signal constants'!
@@ -4356,9 +4365,21 @@
 !
 
 getLanguage
-    "get the LANGUAGE setting (example: de_DE.iso8859-15@euro)"
-
-    ^ self getEnvironment:'LANG'.
+    Language isNil ifTrue:[ 
+        self initializeLocale.
+    ].
+    ^ Language
+
+    "Created: / 19-11-2017 / 14:21:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+getLanguageTerritory
+    LanguageTerritory isNil ifTrue:[ 
+        self initializeLocale.
+    ].   
+    ^ LanguageTerritory
+
+    "Created: / 19-11-2017 / 14:22:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 getLocaleInfo
--- a/UnixOperatingSystem.st	Sat Oct 28 21:47:57 2017 +0100
+++ b/UnixOperatingSystem.st	Sun Nov 19 14:58:45 2017 -0300
@@ -1137,6 +1137,8 @@
     SlowFork := false.
     CurrentDirectory := nil.
     self initializeCodeset.
+
+    "Modified: / 19-11-2017 / 14:52:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 initializeCodeset
@@ -1172,6 +1174,59 @@
     "
 !
 
+initializeLocale
+    | locale |
+
+    "/ Defaults
+    Language := #en.
+    LanguageTerritory := #us.   
+
+    "/ Extract locale information from LC_ALL / LANG env variables.
+    "/ Format of locale is: language[_territory][.codeset][@modifier]
+    "/    language        ISO-639  Language code
+    "/    territory       ISO-3166 Contry code
+    locale := self getEnvironment: 'LC_ALL'.
+    locale isNil ifTrue:[ locale := self getEnvironment: 'LANG' ].
+    locale isNil ifTrue:[ locale := 'en' ].          
+    locale notNil ifTrue:[ 
+        | i lang territory |
+
+        i := locale indexOf:$@.
+        (i ~~ 0) ifTrue:[
+            LanguageModifier := (locale copyFrom:(i + 1)) asLowercase asSymbol.
+            locale := locale copyTo:(i - 1).
+        ] ifFalse:[
+            LanguageModifier := nil.
+        ].
+        i := locale indexOf:$..
+        (i ~~ 0) ifTrue:[
+            LanguageCodeset := (locale copyFrom:(i + 1)) asLowercase asSymbol.
+            locale := locale copyTo:(i - 1).
+        ] ifFalse:[
+            LanguageCodeset := #'iso8859-1'.
+        ].
+        i := locale indexOf:$_.
+        (i == 0) ifTrue:[
+            lang := locale.
+            territory := locale
+        ] ifFalse:[
+            lang := locale copyTo:(i - 1).
+            territory := locale copyFrom:(i + 1)
+        ].
+        lang := lang asLowercase.
+        territory := territory asLowercase.
+        (lang = 'c') ifTrue:[
+            Language := #en.
+            LanguageTerritory := #us.
+        ] ifFalse:[
+            Language := lang asSymbol.
+            LanguageTerritory := territory asSymbol
+        ] 
+    ].
+
+    "Created: / 19-11-2017 / 14:26:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 update:something with:aParameter from:changedObject
     "catch image restart and flush some cached data"
 
--- a/Win32OperatingSystem.st	Sat Oct 28 21:47:57 2017 +0100
+++ b/Win32OperatingSystem.st	Sun Nov 19 14:58:45 2017 -0300
@@ -979,6 +979,47 @@
     "Modified: 13.9.1997 / 10:47:32 / cg"
 !
 
+initializeLocale
+   | lang territory |
+
+    "/ Defaults
+    Language := #en.
+    LanguageTerritory := #us.   
+
+%{    
+    char str_buf[9];
+    int  str_len = 0;
+    
+    /*
+     * While the documentation says we should use GetLocaleInfoEx(), 
+     * we by purpose use (discourage) GetLocaleInfo() in order to run
+     * also on Windows XP. Not sure it makes much sense these days,
+     * but there was a request recently some XP fixes.
+     */
+    str_len = GetLocaleInfoA(LOCALE_NAME_USER_DEFAULT, LOCALE_SISO639LANGNAME, str_buf, sizeof(str_buf));
+    if (str_len) {    	
+    	lang = __MKSTRING_L(str_buf, str_len);
+    }
+    str_len = GetLocaleInfoA(LOCALE_NAME_USER_DEFAULT, LOCALE_SISO3166CTRYNAME, str_buf, sizeof(str_buf));
+    if (str_len) {    	
+    	territory = __MKSTRING_L(str_buf, str_len);
+    }
+%}.
+    "/ Since this may be called early during initialization, do not make
+    "/ `#primitiveFailed` when `GetLocaleInfoEx()` fails. Otherwise smalltalk
+    "/ may fail to compe up. 
+    "/ Instead, log an error and proceed with `en-us` locale. 
+    lang isNil ifTrue:[
+    	Logger error: 'GetLocaleInfoEx(..., LOCALE_SISO639LANGNAME, ...) failed'.
+    ].
+    territory isNil ifTrue:[
+    	Logger error: 'GetLocaleInfoEx(..., LOCALE_SISO3166CTRYNAME, ...) failed'.
+    ].
+    Language := lang asSymbol.
+    LanguageTerritory := territory asLowercase asSymbol.   
+
+!
+
 update:something with:aParameter from:changedObject
     "catch image restart and flush some cached data"
 
@@ -8485,31 +8526,6 @@
     "
 !
 
-getLanguage
-    "get the LANGUAGE setting (example: de_DE.iso8859-15@euro).
-     An environment value has higher preceedence than the system language setting."
-
-    |lang|
-
-    lang := self getEnvironment:'LANG'.
-    (lang isNil or:[lang = 'default']) ifTrue:[
-	"/ ok, search the registry ...
-	"/ under XP, it is found there ...
-	lang := RegistryEntry
-		    stringValueFor:'sLanguage'
-		    atKey:'HKEY_CURRENT_USER\Control Panel\International'.
-	lang notNil ifTrue:[
-	    lang := self mapLanguage:lang.
-	].
-    ].
-    ^ lang
-
-    "
-     OperatingSystem getLanguage
-    "
-    "Modified: 26.4.1996 / 10:04:54 / stefan"
-!
-
 getLocaleInfo
     "return a dictionary filled with values from the locale information;
      Not all fields may be present, depending on the OS's setup and capabilities.