module XMonad.Prompt.Unicode (
unicodePrompt,
typeUnicodePrompt,
mkUnicodePrompt
) where
import Codec.Binary.UTF8.String (decodeString)
import qualified Data.ByteString.Char8 as BS
import Numeric
import System.IO
import System.IO.Error
import Text.Printf
import XMonad
import XMonad.Prelude
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Run
import XMonad.Prompt
data Unicode = Unicode
instance XPrompt Unicode where
showXPrompt :: Unicode -> [Char]
showXPrompt Unicode
Unicode = [Char]
"Unicode: "
commandToComplete :: Unicode -> [Char] -> [Char]
commandToComplete Unicode
Unicode [Char]
s = [Char]
s
nextCompletion :: Unicode -> [Char] -> [[Char]] -> [Char]
nextCompletion Unicode
Unicode = [Char] -> [[Char]] -> [Char]
getNextCompletion
newtype UnicodeData = UnicodeData { UnicodeData -> [(Char, [Char])]
getUnicodeData :: [(Char, String)] }
deriving (ReadPrec [UnicodeData]
ReadPrec UnicodeData
Int -> ReadS UnicodeData
ReadS [UnicodeData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnicodeData]
$creadListPrec :: ReadPrec [UnicodeData]
readPrec :: ReadPrec UnicodeData
$creadPrec :: ReadPrec UnicodeData
readList :: ReadS [UnicodeData]
$creadList :: ReadS [UnicodeData]
readsPrec :: Int -> ReadS UnicodeData
$creadsPrec :: Int -> ReadS UnicodeData
Read, Int -> UnicodeData -> [Char] -> [Char]
[UnicodeData] -> [Char] -> [Char]
UnicodeData -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [UnicodeData] -> [Char] -> [Char]
$cshowList :: [UnicodeData] -> [Char] -> [Char]
show :: UnicodeData -> [Char]
$cshow :: UnicodeData -> [Char]
showsPrec :: Int -> UnicodeData -> [Char] -> [Char]
$cshowsPrec :: Int -> UnicodeData -> [Char] -> [Char]
Show)
instance ExtensionClass UnicodeData where
initialValue :: UnicodeData
initialValue = [(Char, [Char])] -> UnicodeData
UnicodeData []
extensionType :: UnicodeData -> StateExtension
extensionType = forall a. ExtensionClass a => a -> StateExtension
StateExtension
populateEntries :: String -> X Bool
populateEntries :: [Char] -> X Bool
populateEntries [Char]
unicodeDataFilename = do
[(Char, [Char])]
entries <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnicodeData -> [(Char, [Char])]
getUnicodeData (forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get :: X UnicodeData)
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Char, [Char])]
entries
then do
Either IOError ByteString
datE <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either IOError a)
tryIOError forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile [Char]
unicodeDataFilename
case Either IOError ByteString
datE of
Left IOError
e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read file \"" forall a. [a] -> [a] -> [a]
++ [Char]
unicodeDataFilename forall a. [a] -> [a] -> [a]
++ [Char]
"\""
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr IOError
e
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"Do you have unicode-data installed?"
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Right ByteString
dat -> do
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, [Char])] -> UnicodeData
UnicodeData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ ByteString -> [(Char, [Char])]
parseUnicodeData ByteString
dat
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
parseUnicodeData :: BS.ByteString -> [(Char, String)]
parseUnicodeData :: ByteString -> [(Char, [Char])]
parseUnicodeData = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {m :: * -> *}. MonadFail m => ByteString -> m (Char, [Char])
parseLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines
where parseLine :: ByteString -> m (Char, [Char])
parseLine ByteString
l = do
ByteString
field1 : ByteString
field2 : [ByteString]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BS.split Char
';' ByteString
l
[(Int
c,[Char]
"")] <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => ReadS a
readHex forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack ByteString
field1
[Char]
desc <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
decodeString forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack ByteString
field2
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr Int
c, [Char]
desc)
type Predicate = String -> String -> Bool
searchUnicode :: [(Char, String)] -> Predicate -> String -> [(Char, String)]
searchUnicode :: [(Char, [Char])] -> Predicate -> [Char] -> [(Char, [Char])]
searchUnicode [(Char, [Char])]
entries Predicate
p [Char]
s = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, [Char]) -> Bool
go [(Char, [Char])]
entries
where w :: [[Char]]
w = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s
go :: (a, [Char]) -> Bool
go (a
_, [Char]
d) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Predicate
`p` [Char]
d) [[Char]]
w
mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()
mkUnicodePrompt :: [Char] -> [[Char]] -> [Char] -> XPConfig -> X ()
mkUnicodePrompt [Char]
prog [[Char]]
args [Char]
unicodeDataFilename XPConfig
xpCfg =
X Bool -> X () -> X ()
whenX ([Char] -> X Bool
populateEntries [Char]
unicodeDataFilename) forall a b. (a -> b) -> a -> b
$ do
[(Char, [Char])]
entries <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnicodeData -> [(Char, [Char])]
getUnicodeData (forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get :: X UnicodeData)
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> ([Char] -> X ()) -> X ()
mkXPrompt
Unicode
Unicode
(XPConfig
xpCfg {sorter :: [Char] -> [[Char]] -> [[Char]]
sorter = XPConfig -> [Char] -> [[Char]] -> [[Char]]
sorter XPConfig
xpCfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper})
([(Char, [Char])] -> Predicate -> ComplFunction
unicodeCompl [(Char, [Char])]
entries forall a b. (a -> b) -> a -> b
$ XPConfig -> Predicate
searchPredicate XPConfig
xpCfg)
forall {m :: * -> *}. MonadIO m => [Char] -> m ()
paste
where
unicodeCompl :: [(Char, String)] -> Predicate -> String -> IO [String]
unicodeCompl :: [(Char, [Char])] -> Predicate -> ComplFunction
unicodeCompl [(Char, [Char])]
_ Predicate
_ [Char]
"" = forall (m :: * -> *) a. Monad m => a -> m a
return []
unicodeCompl [(Char, [Char])]
entries Predicate
p [Char]
s = do
let m :: [(Char, [Char])]
m = [(Char, [Char])] -> Predicate -> [Char] -> [(Char, [Char])]
searchUnicode [(Char, [Char])]
entries Predicate
p [Char]
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c,[Char]
d) -> forall r. PrintfType r => [Char] -> r
printf [Char]
"%s %s" [Char
c] [Char]
d) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
20 [(Char, [Char])]
m
paste :: [Char] -> m ()
paste [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
paste (Char
c:[Char]
_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle
handle <- forall (m :: * -> *). MonadIO m => [Char] -> m Handle
spawnPipe forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ [Char]
prog forall a. a -> [a] -> [a]
: [[Char]]
args
Handle -> Char -> IO ()
hPutChar Handle
handle Char
c
Handle -> IO ()
hClose Handle
handle
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unicodePrompt :: String -> XPConfig -> X ()
unicodePrompt :: [Char] -> XPConfig -> X ()
unicodePrompt = [Char] -> [[Char]] -> [Char] -> XPConfig -> X ()
mkUnicodePrompt [Char]
"xsel" [[Char]
"-i"]
typeUnicodePrompt :: String -> XPConfig -> X ()
typeUnicodePrompt :: [Char] -> XPConfig -> X ()
typeUnicodePrompt = [Char] -> [[Char]] -> [Char] -> XPConfig -> X ()
mkUnicodePrompt [Char]
"xdotool" [[Char]
"type", [Char]
"--clearmodifiers", [Char]
"--file", [Char]
"-"]