@@ -40,7 +40,7 @@ import Control.Monad (liftM, void, mzero, guard)
4040import Control.Monad.Except (throwError)
4141import Text.Pandoc.Class
4242 (getResourcePath, readFileFromDirs, PandocMonad(..), report)
43−import Data.Char (isHexDigit, chr, ord)
43+import Data.Char (isHexDigit, chr, ord, isAscii, isAlphaNum)
4444import Data.Default (Default)
4545import Data.Maybe (catMaybes)
4646import qualified Data.Map as M
@@ -60,6 +60,7 @@ import Text.Parsec.Pos (updatePosString)
6060import Text.Pandoc.GroffChar (characterCodes, combiningAccents)
6161import qualified Data.Sequence as Seq
6262import qualified Data.Foldable as Foldable
63+import qualified Data.Text.Normalize as Normalize
6364
6465-- import Debug.Trace (traceShowId)
6566
@@ -157,7 +158,11 @@ spacetab = char ' ' <|> char '\t'
157158
158159characterCodeMap :: M.Map String Char
159160characterCodeMap =
160− M.fromList $ map (\(x,y) -> (y,x)) $ characterCodes ++ combiningAccents
161+ M.fromList $ map (\(x,y) -> (y,x)) characterCodes
162+
163+combiningAccentsMap :: M.Map String Char
164+combiningAccentsMap =
165+ M.fromList $ map (\(x,y) -> (y,x)) combiningAccents
161166
162167escapeLexer :: PandocMonad m => ManLexer m String
163168escapeLexer = try $ do
@@ -189,7 +194,7 @@ escapeLexer = try $ do
189194 '\'' -> return "`"
190195 '.' -> return "`"
191196 '~' -> return "\160" -- nonbreaking space
192− _ -> escUnknown [c] "\xFFFD"
197+ _ -> escUnknown ['\\',c] "\xFFFD"
193198
194199 where
195200
@@ -199,10 +204,34 @@ escapeLexer = try $ do
199204 Just c -> return [c]
200205 Nothing -> escUnknown ('\\':'(':cs) "\xFFFD"
201206
202− bracketedGlyph =
203− ( ucharCode `sepBy1` (char '_')
204− <|> charCode `sepBy1` (many1 Parsec.space)
205− ) <* char ']'
207+ bracketedGlyph = unicodeGlyph <|> charGlyph
208+
209+ charGlyph = do
210+ cs <- manyTill (noneOf ['[',']','\n']) (char ']')
211+ (case words cs of
212+ [] -> mzero
213+ [s] -> case M.lookup s characterCodeMap of
214+ Nothing -> mzero
215+ Just c -> return [c]
216+ (s:ss) -> do
217+ basechar <- case M.lookup cs characterCodeMap of
218+ Nothing ->
219+ case s of
220+ [ch] | isAscii ch && isAlphaNum ch ->
221+ return ch
222+ _ -> mzero
223+ Just c -> return c
224+ let addAccents [] xs = return $ T.unpack .
225+ Normalize.normalize Normalize.NFC .
226+ T.pack $ reverse xs
227+ addAccents (a:as) xs =
228+ case M.lookup a combiningAccentsMap of
229+ Just x -> addAccents as (x:xs)
230+ Nothing -> mzero
231+ addAccents ss [basechar])
232+ <|> escUnknown ("\\[" ++ cs ++ "]") "\xFFFD"
233+
234+ unicodeGlyph = try $ ucharCode `sepBy1` (char '_') <* char ']'
206235
207236 ucharCode = try $ do
208237 char 'u'
@@ -210,16 +239,9 @@ escapeLexer = try $ do
210239 let lcs = length cs
211240 guard $ lcs >= 4 && lcs <= 6
212241 case chr <$> safeRead ('0':'x':cs) of
213− Nothing -> escUnknown ("\\[u" ++ cs ++ "]") '\xFFFD'
242+ Nothing -> mzero
214243 Just c -> return c
215244
216− charCode = do
217− cs <- many1 (noneOf ['[',']',' ','\t','\n'])
218− case M.lookup cs characterCodeMap of
219− Nothing -> escUnknown ("\\[" ++ cs ++ "]") '\xFFFD'
220− Just c -> return c
221−
222−
223245 escFont :: PandocMonad m => ManLexer m String
224246 escFont = do
225247 font <- choice [ S.singleton <$> letterFontKind