diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Xmobar/Plugins/Kbd.hs | 72 |
1 files changed, 59 insertions, 13 deletions
diff --git a/src/Xmobar/Plugins/Kbd.hs b/src/Xmobar/Plugins/Kbd.hs index 2214628..3871ca8 100644 --- a/src/Xmobar/Plugins/Kbd.hs +++ b/src/Xmobar/Plugins/Kbd.hs @@ -14,9 +14,11 @@ module Xmobar.Plugins.Kbd(Kbd(..)) where -import Data.List (isPrefixOf) +import Data.Bifunctor (bimap) +import Data.List (find, tails, isPrefixOf) import Data.Maybe (fromMaybe) -import Data.Char (toLower) +import Data.Char (toLower, isLetter) +import Data.Function ((&)) import Control.Monad (forever) import Control.Applicative ((<|>)) import Graphics.X11.Xlib @@ -26,6 +28,13 @@ import Xmobar.Run.Exec import Xmobar.X11.Events (nextEvent') import Xmobar.System.Kbd +-- some strong typing +newtype Lay = Lay String deriving (Eq) +newtype Sym = Sym String +instance Show Sym where show (Sym s) = s +type KbdOpts' = [(Lay, Sym)] +typed :: [(String, String)] -> [(Lay, Sym)] +typed = map (bimap Lay Sym) -- 'Bad' prefixes of layouts noLaySymbols :: [String] @@ -49,15 +58,22 @@ split p s = case break p s of (pref, "") -> [pref] -- replaces input string if on search list (exact match) with corresponding --- element on replacement list. +-- element on replacement list, and returns it paired with the following item -- --- if not found, return string unchanged -searchReplaceLayout :: KbdOpts -> String -> String -searchReplaceLayout opts s = fromMaybe s $ lookup s opts - --- returns the active layout -getKbdLay :: Display -> KbdOpts -> IO String -getKbdLay dpy opts = do +-- if not found, return string unchanged, paired with empty string +searchReplaceLayout :: KbdOpts' -> String -> (Lay, Lay, Sym) +searchReplaceLayout opts curr + = maybe (Lay "", Lay "", Sym curr) + pickSymWithAdjLays + (find currLayout (tails $ cycle opts)) + where + pickSymWithAdjLays ((l1, _):(_, s):(l2, _):_) = (l1, l2, s) + pickSymWithAdjLays _ = error "This should never happen" + currLayout = (Lay curr ==) . (!! 1) . map fst + +-- returns the active layout and the following one +getCurAndNextKbdLays :: Display -> KbdOpts' -> IO (Lay, Lay, Sym) +getCurAndNextKbdLays dpy opts = do lay <- splitLayout <$> getLayoutStr dpy grps <- map (map toLower . take 2) <$> getGrpNames dpy curLay <- getKbdLayout dpy @@ -73,6 +89,37 @@ getKbdLay dpy opts = do newtype Kbd = Kbd [(String, String)] deriving (Read, Show) +attachClickAction :: (Lay, Lay, Sym) -> Sym +attachClickAction (Lay prv, Lay nxt, txt) = txt & linkTo nxt `onKey` "1" + & linkTo prv `onKey` "3" + where + splitLayParensPhon :: String -> (String, String, String) + splitLayParensPhon = (\(a, (b, c)) -> (a, b, c)) + . second (second (drop 1) . break (== ')') . drop 1) + . break (== '(') + parseLayPhon :: String -> (Maybe String, Maybe String) + parseLayPhon s = let (l, p, i) = splitLayParensPhon s + l' = if all isLetter l + then Just ("-layout " ++ l) + else Nothing + p' = if (p, i) == ("phonetic", "") + then Just "-variant phonetic" + else Nothing + in (l', p') + linkTo :: String -> String -> Sym -> Sym + linkTo linked button currLay = Sym $ case parseLayPhon linked of + (Nothing, _) -> "??" + (Just linkedLay, phon) -> wrapIn setxkbmap button currLay + where + setxkbmap = unwords ["setxkbmap", linkedLay, fromMaybe "" phon] + wrapIn :: String -> String -> Sym -> String + wrapIn action buttons (Sym sym) = openingTag ++ sym ++ closingTag + where + openingTag = "<action=`" ++ action ++ "` button=" ++ buttons ++ ">" + closingTag = "</action>" + onKey = ($) + second = fmap + instance Exec Kbd where alias (Kbd _) = "kbd" start (Kbd opts) cb = do @@ -80,7 +127,7 @@ instance Exec Kbd where dpy <- openDisplay "" -- initial set of layout - cb =<< getKbdLay dpy opts + cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) -- enable listing for -- group changes @@ -91,7 +138,6 @@ instance Exec Kbd where allocaXEvent $ \e -> forever $ do nextEvent' dpy e _ <- getEvent e - cb =<< getKbdLay dpy opts + cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) closeDisplay dpy - return () |