summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Kbd.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2018-11-25 15:10:29 +0000
committerjao <jao@gnu.org>2018-11-25 15:10:29 +0000
commit77df1ac30fa7af5948f7ff64f5fee9aed64552b3 (patch)
tree647a4eb67ff1c293a5c530538ee88fc0093b577a /src/Xmobar/Plugins/Kbd.hs
parente0d6da82de8d0d1cef98896164c6016b84e47068 (diff)
downloadxmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.gz
xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.bz2
Back to app/src, since it seems they're the default convention for stack
Diffstat (limited to 'src/Xmobar/Plugins/Kbd.hs')
-rw-r--r--src/Xmobar/Plugins/Kbd.hs96
1 files changed, 96 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/Kbd.hs b/src/Xmobar/Plugins/Kbd.hs
new file mode 100644
index 0000000..f4dad36
--- /dev/null
+++ b/src/Xmobar/Plugins/Kbd.hs
@@ -0,0 +1,96 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Kbd
+-- Copyright : (c) Martin Perner
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : Martin Perner <martin@perner.cc>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A keyboard layout indicator for Xmobar
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Kbd(Kbd(..)) where
+
+import Data.List (isPrefixOf, findIndex)
+import Data.Maybe (fromJust)
+import Control.Monad (forever)
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+import Xmobar.Run.Commands
+import Xmobar.Utils (nextEvent')
+import Xmobar.System.Kbd
+
+
+-- 'Bad' prefixes of layouts
+noLaySymbols :: [String]
+noLaySymbols = ["group", "inet", "ctr", "pc", "ctrl"]
+
+
+-- splits the layout string into the actual layouts
+splitLayout :: String -> [String]
+splitLayout s = splitLayout' noLaySymbols $ split s '+'
+
+splitLayout' :: [String] -> [String] -> [String]
+-- end of recursion, remove empty strings
+splitLayout' [] s = map (takeWhile (/= ':')) $ filter (not . null) s
+-- remove current string if it has a 'bad' prefix
+splitLayout' bad s =
+ splitLayout' (tail bad) [x | x <- s, not $ isPrefixOf (head bad) x]
+
+-- split String at each Char
+split :: String -> Char -> [String]
+split [] _ = [""]
+split (c:cs) delim
+ | c == delim = "" : rest
+ | otherwise = (c : head rest) : tail rest
+ where
+ rest = split cs delim
+
+-- replaces input string if on search list (exact match) with corresponding
+-- element on replacement list.
+--
+-- if not found, return string unchanged
+searchReplaceLayout :: KbdOpts -> String -> String
+searchReplaceLayout opts s = let c = findIndex (\x -> fst x == s) opts in
+ case c of
+ Nothing -> s
+ x -> let i = fromJust x in snd $ opts!!i
+
+-- returns the active layout
+getKbdLay :: Display -> KbdOpts -> IO String
+getKbdLay dpy opts = do
+ lay <- getLayoutStr dpy
+ curLay <- getKbdLayout dpy
+ return $ searchReplaceLayout opts $ splitLayout lay!!curLay
+
+
+
+newtype Kbd = Kbd [(String, String)]
+ deriving (Read, Show)
+
+instance Exec Kbd where
+ alias (Kbd _) = "kbd"
+ start (Kbd opts) cb = do
+
+ dpy <- openDisplay ""
+
+ -- initial set of layout
+ cb =<< getKbdLay dpy opts
+
+ -- enable listing for
+ -- group changes
+ _ <- xkbSelectEventDetails dpy xkbUseCoreKbd xkbStateNotify xkbAllStateComponentsMask xkbGroupStateMask
+ -- layout/geometry changes
+ _ <- xkbSelectEvents dpy xkbUseCoreKbd xkbNewKeyboardNotifyMask xkbNewKeyboardNotifyMask
+
+ allocaXEvent $ \e -> forever $ do
+ nextEvent' dpy e
+ _ <- getEvent e
+ cb =<< getKbdLay dpy opts
+
+ closeDisplay dpy
+ return ()