{-# LANGUAGE DeriveDataTypeable #-}
module XMonad.Prompt.Unicode (
unicodePrompt,
typeUnicodePrompt,
mkUnicodePrompt
) where
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Maybe
import Data.Ord
import Numeric
import System.Environment
import System.IO
import System.IO.Unsafe
import System.IO.Error
import Control.Arrow
import Data.List
import Text.Printf
import XMonad
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Run
import XMonad.Prompt
data Unicode = Unicode
instance XPrompt Unicode where
showXPrompt :: Unicode -> String
showXPrompt Unicode
Unicode = String
"Unicode: "
commandToComplete :: Unicode -> String -> String
commandToComplete Unicode
Unicode String
s = String
s
nextCompletion :: Unicode -> String -> [String] -> String
nextCompletion Unicode
Unicode = String -> [String] -> String
getNextCompletion
newtype UnicodeData = UnicodeData { UnicodeData -> [(Char, ByteString)]
getUnicodeData :: [(Char, BS.ByteString)] }
deriving (Typeable, 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
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 -> String -> String
[UnicodeData] -> String -> String
UnicodeData -> String
(Int -> UnicodeData -> String -> String)
-> (UnicodeData -> String)
-> ([UnicodeData] -> String -> String)
-> Show UnicodeData
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UnicodeData] -> String -> String
$cshowList :: [UnicodeData] -> String -> String
show :: UnicodeData -> String
$cshow :: UnicodeData -> String
showsPrec :: Int -> UnicodeData -> String -> String
$cshowsPrec :: Int -> UnicodeData -> String -> String
Show)
instance ExtensionClass UnicodeData where
initialValue :: UnicodeData
initialValue = [(Char, ByteString)] -> UnicodeData
UnicodeData []
extensionType :: UnicodeData -> StateExtension
extensionType = UnicodeData -> StateExtension
forall a. ExtensionClass a => a -> StateExtension
StateExtension
populateEntries :: String -> X Bool
populateEntries :: String -> X Bool
populateEntries String
unicodeDataFilename = do
[(Char, ByteString)]
entries <- (UnicodeData -> [(Char, ByteString)])
-> X UnicodeData -> X [(Char, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnicodeData -> [(Char, ByteString)]
getUnicodeData (X UnicodeData
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get :: X UnicodeData)
if [(Char, ByteString)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Char, ByteString)]
entries
then do
Either IOError ByteString
datE <- IO (Either IOError ByteString) -> X (Either IOError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError ByteString) -> X (Either IOError ByteString))
-> (IO ByteString -> IO (Either IOError ByteString))
-> IO ByteString
-> X (Either IOError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> IO (Either IOError ByteString)
forall a. IO a -> IO (Either IOError a)
tryIOError (IO ByteString -> X (Either IOError ByteString))
-> IO ByteString -> X (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
unicodeDataFilename
case Either IOError ByteString
datE of
Left IOError
e -> IO Bool -> X Bool
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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Could not read file \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
unicodeDataFilename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
Handle -> IOError -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr IOError
e
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Do you have unicode-data installed?"
Bool -> IO Bool
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, ByteString)] -> UnicodeData)
-> [(Char, ByteString)]
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, ByteString)] -> UnicodeData
UnicodeData ([(Char, ByteString)] -> UnicodeData)
-> ([(Char, ByteString)] -> [(Char, ByteString)])
-> [(Char, ByteString)]
-> UnicodeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, ByteString) -> (Char, ByteString) -> Ordering)
-> [(Char, ByteString)] -> [(Char, ByteString)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Char, ByteString) -> Int)
-> (Char, ByteString) -> (Char, ByteString) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ByteString -> Int
BS.length (ByteString -> Int)
-> ((Char, ByteString) -> ByteString) -> (Char, ByteString) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, ByteString) -> ByteString
forall a b. (a, b) -> b
snd)) ([(Char, ByteString)] -> X ()) -> [(Char, ByteString)] -> X ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [(Char, ByteString)]
parseUnicodeData ByteString
dat
Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
parseUnicodeData :: BS.ByteString -> [(Char, BS.ByteString)]
parseUnicodeData :: ByteString -> [(Char, ByteString)]
parseUnicodeData = (ByteString -> Maybe (Char, ByteString))
-> [ByteString] -> [(Char, ByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByteString -> Maybe (Char, ByteString)
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (Char, ByteString)
parseLine ([ByteString] -> [(Char, ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(Char, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines
where parseLine :: ByteString -> m (Char, ByteString)
parseLine ByteString
l = do
ByteString
field1 : ByteString
field2 : [ByteString]
_ <- [ByteString] -> m [ByteString]
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
[(Int
c,String
"")] <- [(Int, String)] -> m [(Int, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, String)] -> m [(Int, String)])
-> (String -> [(Int, String)]) -> String -> m [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Int, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> m [(Int, String)]) -> String -> m [(Int, String)]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.unpack ByteString
field1
(Char, ByteString) -> m (Char, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr Int
c, ByteString
field2)
searchUnicode :: [(Char, BS.ByteString)] -> String -> [(Char, String)]
searchUnicode :: [(Char, ByteString)] -> String -> [(Char, String)]
searchUnicode [(Char, ByteString)]
entries String
s = ((Char, ByteString) -> (Char, String))
-> [(Char, ByteString)] -> [(Char, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> String) -> (Char, ByteString) -> (Char, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> String
BS.unpack) ([(Char, ByteString)] -> [(Char, String)])
-> [(Char, ByteString)] -> [(Char, String)]
forall a b. (a -> b) -> a -> b
$ ((Char, ByteString) -> Bool)
-> [(Char, ByteString)] -> [(Char, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char, ByteString) -> Bool
forall a. (a, ByteString) -> Bool
go [(Char, ByteString)]
entries
where w :: [ByteString]
w = (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BS.pack ([String] -> [ByteString])
-> (String -> [String]) -> String -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> (String -> Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [ByteString]) -> String -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
s
go :: (a, ByteString) -> Bool
go (a
c,ByteString
d) = (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ByteString -> ByteString -> Bool
`BS.isInfixOf` ByteString
d) [ByteString]
w
mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()
mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()
mkUnicodePrompt String
prog [String]
args String
unicodeDataFilename XPConfig
config =
X Bool -> X () -> X ()
whenX (String -> X Bool
populateEntries String
unicodeDataFilename) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
[(Char, ByteString)]
entries <- (UnicodeData -> [(Char, ByteString)])
-> X UnicodeData -> X [(Char, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnicodeData -> [(Char, ByteString)]
getUnicodeData (X UnicodeData
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get :: X UnicodeData)
Unicode -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt Unicode
Unicode XPConfig
config ([(Char, ByteString)] -> ComplFunction
forall (m :: * -> *) a.
(Monad m, PrintfType a) =>
[(Char, ByteString)] -> String -> m [a]
unicodeCompl [(Char, ByteString)]
entries) String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
paste
where
unicodeCompl :: [(Char, ByteString)] -> String -> m [a]
unicodeCompl [(Char, ByteString)]
_ [] = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
unicodeCompl [(Char, ByteString)]
entries String
s = do
let m :: [(Char, String)]
m = [(Char, ByteString)] -> String -> [(Char, String)]
searchUnicode [(Char, ByteString)]
entries String
s
[a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a])
-> ([(Char, String)] -> [a]) -> [(Char, String)] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, String) -> a) -> [(Char, String)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
c,String
d) -> String -> String -> String -> a
forall r. PrintfType r => String -> r
printf String
"%s %s" [Char
c] String
d) ([(Char, String)] -> m [a]) -> [(Char, String)] -> m [a]
forall a b. (a -> b) -> a -> b
$ Int -> [(Char, String)] -> [(Char, String)]
forall a. Int -> [a] -> [a]
take Int
20 [(Char, String)]
m
paste :: String -> m ()
paste [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
paste (Char
c:String
_) = do
String -> [String] -> String -> m String
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> m String
runProcessWithInput String
prog [String]
args [Char
c]
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unicodePrompt :: String -> XPConfig -> X ()
unicodePrompt :: String -> XPConfig -> X ()
unicodePrompt = String -> [String] -> String -> XPConfig -> X ()
mkUnicodePrompt String
"xsel" [String
"-i"]
typeUnicodePrompt :: String -> XPConfig -> X ()
typeUnicodePrompt :: String -> XPConfig -> X ()
typeUnicodePrompt = String -> [String] -> String -> XPConfig -> X ()
mkUnicodePrompt String
"xdotool" [String
"type", String
"--clearmodifiers", String
"--file", String
"-"]