forked from GitHub/gf-core
Improved unicode output.
This commit is contained in:
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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"
|
||||||
|
|||||||
Reference in New Issue
Block a user