Starting Finnish for new API

5 files changed, 65 insertions, 11 deletions

diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs
index c7b27c3ca..c15ad13ed 100644
--- a/src/GF/Shell/Commands.hs
+++ b/src/GF/Shell/Commands.hs
@@ -168,8 +168,8 @@ execCommand env c s = case c of
     return (env', state1)
 -}
 
-----  CCEnvOn  name -> return (languageOn  (language name) env,s)
-----  CCEnvOff name -> return (languageOff (language name) env,s)
+  CCEnvOn  name -> return (env,s) ---- return (languageOn  (language name) env,s)
+  CCEnvOff name -> return (env,s) ---- return (languageOff (language name) env,s)
 
 -- this command is improved by the use of IO
   CRefineRandom -> do
diff --git a/src/GF/Text/ExtendedArabic.hs b/src/GF/Text/ExtendedArabic.hs
index d766abc67..0c8b88d4f 100644
--- a/src/GF/Text/ExtendedArabic.hs
+++ b/src/GF/Text/ExtendedArabic.hs
@@ -1,5 +1,26 @@
 module ExtendedArabic where
 
+mkArabic0600 :: String -> String
+mkArabic0600 = digraphWordToUnicode . aarnesToDigraphWord
+
+aarnesToDigraphWord :: String -> [(Char, Char)]
+aarnesToDigraphWord str = case str of
+  [] -> []
+  '<' : cs -> ('\\', '<') : spoolMarkup2 cs
+
+  'v' : cs -> ('T', 'H') : aarnesToDigraphWord cs
+  'a' : cs -> (' ', 'A') : aarnesToDigraphWord cs
+  'o' : cs -> (' ', '3') : aarnesToDigraphWord cs
+  'O' : cs -> ('\'', 'i') : aarnesToDigraphWord cs
+
+  'u' : cs -> ('\'', 'A') : aarnesToDigraphWord cs
+  'C' : cs -> (' ', 'X') : aarnesToDigraphWord cs
+
+  'U' : cs -> ('~', 'A') : aarnesToDigraphWord cs
+  'A' : cs -> ('"', 't') : aarnesToDigraphWord cs
+  'c' : cs -> ('s', 'h') : aarnesToDigraphWord cs
+  c : cs -> (' ', c) : aarnesToDigraphWord cs
+
 mkExtendedArabic :: String -> String
 mkExtendedArabic = digraphWordToUnicode . adHocToDigraphWord
 
@@ -56,3 +77,9 @@ spoolMarkup s = case s of
    [] -> [] -- Shouldn't happen
    '>' : cs -> ('\\', '>') : adHocToDigraphWord cs
    c1 : cs -> ('\\', c1) : spoolMarkup cs
+
+spoolMarkup2 :: String -> [(Char, Char)]
+spoolMarkup2 s = case s of
+   [] -> [] -- Shouldn't happen
+   '>' : cs -> ('\\', '>') : aarnesToDigraphWord cs
+   c1 : cs -> ('\\', c1) : spoolMarkup2 cs
\ No newline at end of file
diff --git a/src/GF/Text/ExtraDiacritics.hs b/src/GF/Text/ExtraDiacritics.hs
new file mode 100644
index 000000000..75eb5d48e
--- /dev/null
+++ b/src/GF/Text/ExtraDiacritics.hs
@@ -0,0 +1,23 @@
+module ExtraDiacritics where
+
+mkExtraDiacritics :: String -> String
+mkExtraDiacritics = mkExtraDiacriticsWord
+
+mkExtraDiacriticsWord :: String -> String
+mkExtraDiacriticsWord str = case str of
+  [] -> []
+  '<' : cs -> '<' : spoolMarkup cs
+  -- 
+  '/' : cs -> toEnum 0x0301 : mkExtraDiacriticsWord cs
+  '~' : cs -> toEnum 0x0306 : mkExtraDiacriticsWord cs
+  ':' : cs -> toEnum 0x0304 : mkExtraDiacriticsWord cs -- some of these could be put in LatinA
+  '.' : cs -> toEnum 0x0323 : mkExtraDiacriticsWord cs
+  'i' : '-' : cs -> toEnum 0x0268 : mkExtraDiacriticsWord cs -- in IPA extensions
+  -- Default 
+  c : cs -> c : mkExtraDiacriticsWord cs
+
+spoolMarkup :: String -> String
+spoolMarkup s = case s of
+   [] -> [] -- Shouldn't happen
+   '>' : cs -> '>' : mkExtraDiacriticsWord cs
+   c1 : cs -> c1 : spoolMarkup cs
diff --git a/src/GF/Text/Unicode.hs b/src/GF/Text/Unicode.hs
index 3c1b68c3f..4fef4a93e 100644
--- a/src/GF/Text/Unicode.hs
+++ b/src/GF/Text/Unicode.hs
@@ -10,11 +10,13 @@ import OCSCyrillic (mkOCSCyrillic)
 import LatinASupplement (mkLatinASupplement)
 import Devanagari (mkDevanagari)
 import Hiragana (mkJapanese)
+import ExtendedArabic (mkArabic0600)
 import ExtendedArabic (mkExtendedArabic)
+import ExtraDiacritics (mkExtraDiacritics)
 
 -- ad hoc Unicode conversions from different alphabets
 
--- AR 12/4/2000, 18/9/2001, 30/5/2002, HH 14/11/2003
+-- AR 12/4/2000, 18/9/2001, 30/5/2002
 
 mkUnicode s = case s of
  '/':'/':cs -> mkGreek   (remClosing cs)
@@ -22,13 +24,15 @@ mkUnicode s = case s of
  '/':'-':cs -> mkArabic  (remClosing cs)
  '/':'_':cs -> mkRussian (remClosing cs)
  '/':'*':cs -> mkRusKOI8 (remClosing cs)
- '/':'E':cs -> mkEthiopic (remClosing cs)           -- HH
- '/':'T':cs -> mkTamil (remClosing cs)              -- HH
- '/':'C':cs -> mkOCSCyrillic (remClosing cs)        -- HH
- '/':'&':cs -> mkDevanagari (remClosing cs)         -- HH
- '/':'L':cs -> mkLatinASupplement (remClosing cs)   -- HH
- '/':'J':cs -> mkJapanese (remClosing cs)           -- HH
- '/':'A':cs -> mkExtendedArabic (remClosing cs)     -- HH
+ '/':'E':cs -> mkEthiopic (remClosing cs)
+ '/':'T':cs -> mkTamil (remClosing cs)
+ '/':'C':cs -> mkOCSCyrillic (remClosing cs)
+ '/':'&':cs -> mkDevanagari (remClosing cs)
+ '/':'L':cs -> mkLatinASupplement (remClosing cs)
+ '/':'J':cs -> mkJapanese (remClosing cs)
+ '/':'6':cs -> mkArabic0600 (remClosing cs)
+ '/':'A':cs -> mkExtendedArabic (remClosing cs)
+ '/':'X':cs -> mkExtraDiacritics (remClosing cs)
  _      -> s
 
 remClosing cs 
diff --git a/src/Today.hs b/src/Today.hs
index 1490e4866..23b09ec65 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Tue Dec  9 18:22:33 CET 2003"
+module Today where today = "Fri Dec 19 18:43:03 CET 2003"