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]
(Int -> ReadS UnicodeData)
-> ReadS [UnicodeData]
-> ReadPrec UnicodeData
-> ReadPrec [UnicodeData]
-> Read UnicodeData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnicodeData
readsPrec :: Int -> ReadS UnicodeData
$creadList :: ReadS [UnicodeData]
readList :: ReadS [UnicodeData]
$creadPrec :: ReadPrec UnicodeData
readPrec :: ReadPrec UnicodeData
$creadListPrec :: ReadPrec [UnicodeData]
readListPrec :: ReadPrec [UnicodeData]
Read, Int -> UnicodeData -> [Char] -> [Char]
[UnicodeData] -> [Char] -> [Char]
UnicodeData -> [Char]
(Int -> UnicodeData -> [Char] -> [Char])
-> (UnicodeData -> [Char])
-> ([UnicodeData] -> [Char] -> [Char])
-> Show UnicodeData
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> UnicodeData -> [Char] -> [Char]
showsPrec :: Int -> UnicodeData -> [Char] -> [Char]
$cshow :: UnicodeData -> [Char]
show :: UnicodeData -> [Char]
$cshowList :: [UnicodeData] -> [Char] -> [Char]
showList :: [UnicodeData] -> [Char] -> [Char]
Show)
instance ExtensionClass UnicodeData where
initialValue :: UnicodeData
initialValue = [(Char, [Char])] -> UnicodeData
UnicodeData []
extensionType :: UnicodeData -> StateExtension
extensionType = UnicodeData -> StateExtension
forall a. ExtensionClass a => a -> StateExtension
StateExtension
populateEntries :: String -> X Bool
populateEntries :: [Char] -> X Bool
populateEntries [Char]
unicodeDataFilename = do
entries <- (UnicodeData -> [(Char, [Char])])
-> X UnicodeData -> X [(Char, [Char])]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnicodeData -> [(Char, [Char])]
getUnicodeData (X UnicodeData
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get :: X UnicodeData)
if null entries
then do
datE <- liftIO . tryIOError $ BS.readFile unicodeDataFilename
case datE of
Left IOError
e -> IO Bool -> X Bool
forall a. IO a -> X a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> X Bool) -> IO Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read file \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unicodeDataFilename [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
Handle -> IOError -> IO ()
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?"
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Right ByteString
dat -> do
UnicodeData -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (UnicodeData -> X ())
-> ([(Char, [Char])] -> UnicodeData) -> [(Char, [Char])] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, [Char])] -> UnicodeData
UnicodeData ([(Char, [Char])] -> UnicodeData)
-> ([(Char, [Char])] -> [(Char, [Char])])
-> [(Char, [Char])]
-> UnicodeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, [Char]) -> Int) -> [(Char, [Char])] -> [(Char, [Char])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int)
-> ((Char, [Char]) -> [Char]) -> (Char, [Char]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, [Char]) -> [Char]
forall a b. (a, b) -> b
snd) ([(Char, [Char])] -> X ()) -> [(Char, [Char])] -> X ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [(Char, [Char])]
parseUnicodeData ByteString
dat
Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else return True
parseUnicodeData :: BS.ByteString -> [(Char, String)]
parseUnicodeData :: ByteString -> [(Char, [Char])]
parseUnicodeData = (ByteString -> Maybe (Char, [Char]))
-> [ByteString] -> [(Char, [Char])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByteString -> Maybe (Char, [Char])
forall {m :: * -> *}. MonadFail m => ByteString -> m (Char, [Char])
parseLine ([ByteString] -> [(Char, [Char])])
-> (ByteString -> [ByteString]) -> ByteString -> [(Char, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines
where parseLine :: ByteString -> m (Char, [Char])
parseLine ByteString
l = do
field1 : field2 : _ <- [ByteString] -> m [ByteString]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BS.split Char
';' ByteString
l
[(c,"")] <- return . readHex $ BS.unpack field1
desc <- return . decodeString $ BS.unpack field2
return (chr c, 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 = ((Char, [Char]) -> Bool) -> [(Char, [Char])] -> [(Char, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char, [Char]) -> Bool
forall {a}. (a, [Char]) -> Bool
go [(Char, [Char])]
entries
where w :: [[Char]]
w = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([Char] -> Int) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s
go :: (a, [Char]) -> Bool
go (a
_, [Char]
d) = ([Char] -> Bool) -> [[Char]] -> Bool
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) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
entries <- (UnicodeData -> [(Char, [Char])])
-> X UnicodeData -> X [(Char, [Char])]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnicodeData -> [(Char, [Char])]
getUnicodeData (X UnicodeData
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get :: X UnicodeData)
mkXPrompt
Unicode
(xpCfg {sorter = sorter xpCfg . map toUpper})
(unicodeCompl entries $ searchPredicate xpCfg)
paste
where
unicodeCompl :: [(Char, String)] -> Predicate -> String -> IO [String]
unicodeCompl :: [(Char, [Char])] -> Predicate -> ComplFunction
unicodeCompl [(Char, [Char])]
_ Predicate
_ [Char]
"" = [[Char]] -> IO [[Char]]
forall a. a -> IO a
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
[[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]])
-> ([(Char, [Char])] -> [[Char]])
-> [(Char, [Char])]
-> IO [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, [Char]) -> [Char]) -> [(Char, [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c,[Char]
d) -> [Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s %s" [Char
c] [Char]
d) ([(Char, [Char])] -> IO [[Char]])
-> [(Char, [Char])] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ Int -> [(Char, [Char])] -> [(Char, [Char])]
forall a. Int -> [a] -> [a]
take Int
20 [(Char, [Char])]
m
paste :: [Char] -> m ()
paste [] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
paste (Char
c:[Char]
_) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
handle <- [Char] -> IO Handle
forall (m :: * -> *). MonadIO m => [Char] -> m Handle
spawnPipe ([Char] -> IO Handle) -> [Char] -> IO Handle
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
prog [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
args
hPutChar handle c
hClose handle
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]
"-"]