1
0
forked from GitHub/gf-core

Improved unicode output.

This commit is contained in:
aarne
2004-01-26 08:39:52 +00:00
parent 7362e70af9
commit f807f76211
6 changed files with 39 additions and 28 deletions

View File

@@ -178,7 +178,7 @@ evalPrintname gr c ppr lin =
case ppr of case ppr of
Yes pr -> comp pr Yes pr -> comp pr
_ -> case lin of _ -> case lin of
Yes t -> return $ K $ prt $ oneBranch t ---- stringFromTerm Yes t -> return $ K $ clean $ prt $ oneBranch t ---- stringFromTerm
_ -> return $ K $ prt c ---- _ -> return $ K $ prt c ----
where where
comp = computeConcrete gr comp = computeConcrete gr
@@ -193,3 +193,11 @@ evalPrintname gr c ppr lin =
P x _ -> oneBranch x P x _ -> oneBranch x
Alts (d,_) -> oneBranch d Alts (d,_) -> oneBranch d
_ -> t _ -> t
--- very unclean cleaner
clean s = case s of
'+':'+':' ':cs -> clean cs
'"':cs -> clean cs
c:cs -> c: clean cs
_ -> s

View File

@@ -414,7 +414,7 @@ displaySStateJavaX isNew env state = unlines $ tagXML "gfedit" $ concat [
opts = addOptions (optsSState state) -- state opts override opts = addOptions (optsSState state) -- state opts override
(addOption (markLin mark) (globalOptions env)) (addOption (markLin mark) (globalOptions env))
lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where
uni = optEncodeUTF8 gr . mkUnicode uni = {- optEncodeUTF8 gr . -} mkUnicode
exp = prprTree $ loc2tree zipper exp = prprTree $ loc2tree zipper
zipper = stateSState state zipper = stateSState state
linAll = map lin lgrs linAll = map lin lgrs

View File

@@ -56,5 +56,5 @@ initEditMsgJavaX env = encodeUTF8 $ unlines $ tagXML "gfinit" $
concat [tagAttrXML "language" ("file",file) [prLanguage lang] | concat [tagAttrXML "language" ("file",file) [prLanguage lang] |
(file,lang) <- zip (allGrammarFileNames env) (allLanguages env)] (file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]
initAndEditMsgJavaX isNew env state = initAndEditMsgJavaX isNew env state = encodeUTF8 $
initEditMsgJavaX env ++++ displaySStateJavaX isNew env state initEditMsgJavaX env ++++ displaySStateJavaX isNew env state

View File

@@ -1,13 +1,15 @@
module Hebrew where module Hebrew where
mkHebrew :: String -> String mkHebrew :: String -> String
mkHebrew = mkHebrewWord mkHebrew = reverse . mkHebrewWord
--- reverse : assumes everything's on same line --- reverse : assumes everything's on same line
type HebrewChar = Char type HebrewChar = Char
-- HH 031103 added code for spooling the markup -- HH 031103 added code for spooling the markup
-- removed reverse, words, unwords (seemed obsolete and come out wrong on the screen) -- removed reverse, words, unwords
-- (seemed obsolete and come out wrong on the screen)
-- AR 26/1/2004 put reverse back - needed in Fudgets (but not in Java?)
mkHebrewWord :: String -> [HebrewChar] mkHebrewWord :: String -> [HebrewChar]
-- mkHebrewWord = map mkHebrewChar -- mkHebrewWord = map mkHebrewChar

View File

@@ -16,27 +16,28 @@ import ExtraDiacritics (mkExtraDiacritics)
-- ad hoc Unicode conversions from different alphabets -- ad hoc Unicode conversions from different alphabets
-- AR 12/4/2000, 18/9/2001, 30/5/2002 -- AR 12/4/2000, 18/9/2001, 30/5/2002, 26/1/2004
mkUnicode s = case s of mkUnicode s = case s of
'/':'/':cs -> mkGreek (remClosing cs) '/':'/':cs -> mkGreek unic ++ mkUnicode rest
'/':'+':cs -> mkHebrew (remClosing cs) '/':'+':cs -> mkHebrew unic ++ mkUnicode rest
'/':'-':cs -> mkArabic (remClosing cs) '/':'-':cs -> mkArabic unic ++ mkUnicode rest
'/':'_':cs -> mkRussian (remClosing cs) '/':'_':cs -> mkRussian unic ++ mkUnicode rest
'/':'*':cs -> mkRusKOI8 (remClosing cs) '/':'*':cs -> mkRusKOI8 unic ++ mkUnicode rest
'/':'E':cs -> mkEthiopic (remClosing cs) '/':'E':cs -> mkEthiopic unic ++ mkUnicode rest
'/':'T':cs -> mkTamil (remClosing cs) '/':'T':cs -> mkTamil unic ++ mkUnicode rest
'/':'C':cs -> mkOCSCyrillic (remClosing cs) '/':'C':cs -> mkOCSCyrillic unic ++ mkUnicode rest
'/':'&':cs -> mkDevanagari (remClosing cs) '/':'&':cs -> mkDevanagari unic ++ mkUnicode rest
'/':'L':cs -> mkLatinASupplement (remClosing cs) '/':'L':cs -> mkLatinASupplement unic ++ mkUnicode rest
'/':'J':cs -> mkJapanese (remClosing cs) '/':'J':cs -> mkJapanese unic ++ mkUnicode rest
'/':'6':cs -> mkArabic0600 (remClosing cs) '/':'6':cs -> mkArabic0600 unic ++ mkUnicode rest
'/':'A':cs -> mkExtendedArabic (remClosing cs) '/':'A':cs -> mkExtendedArabic unic ++ mkUnicode rest
'/':'X':cs -> mkExtraDiacritics (remClosing cs) '/':'X':cs -> mkExtraDiacritics unic ++ mkUnicode rest
_ -> s c:cs -> c:mkUnicode cs
_ -> s
remClosing cs where
| lcs > 1 && last cs == '/' = take (lcs-2) cs (unic,rest) = remClosing [] $ drop 2 s
| otherwise = cs remClosing u s = case s of
where lcs = length cs c:'/':s | elem c "/+-_*ETC&LJ6AX" -> (reverse u, s) --- end need not match
c:cs -> remClosing (c:u) cs
_ -> (reverse u,[]) -- forgiving missing end

View File

@@ -1 +1 @@
module Today where today = "Wed Jan 21 15:14:24 CET 2004" module Today where today = "Mon Jan 26 10:15:46 CET 2004"