diff options
Diffstat (limited to 'src/Xmobar/Plugins')
| -rw-r--r-- | src/Xmobar/Plugins/Kbd.hs | 72 | 
1 files changed, 13 insertions, 59 deletions
| diff --git a/src/Xmobar/Plugins/Kbd.hs b/src/Xmobar/Plugins/Kbd.hs index 3871ca8..2214628 100644 --- a/src/Xmobar/Plugins/Kbd.hs +++ b/src/Xmobar/Plugins/Kbd.hs @@ -14,11 +14,9 @@  module Xmobar.Plugins.Kbd(Kbd(..)) where -import Data.Bifunctor (bimap) -import Data.List (find, tails, isPrefixOf) +import Data.List (isPrefixOf)  import Data.Maybe (fromMaybe) -import Data.Char (toLower, isLetter) -import Data.Function ((&)) +import Data.Char (toLower)  import Control.Monad (forever)  import Control.Applicative ((<|>))  import Graphics.X11.Xlib @@ -28,13 +26,6 @@ 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] @@ -58,22 +49,15 @@ 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, and returns it paired with the following item +-- element on replacement list.  -- --- 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 +-- 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    lay <- splitLayout <$> getLayoutStr dpy    grps <- map (map toLower . take 2) <$> getGrpNames dpy    curLay <- getKbdLayout dpy @@ -89,37 +73,6 @@ getCurAndNextKbdLays 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 @@ -127,7 +80,7 @@ instance Exec Kbd where              dpy <- openDisplay ""              -- initial set of layout -            cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) +            cb =<< getKbdLay dpy opts              -- enable listing for              -- group changes @@ -138,6 +91,7 @@ instance Exec Kbd where              allocaXEvent $ \e -> forever $ do                  nextEvent' dpy e                  _ <- getEvent e -                cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) +                cb =<< getKbdLay dpy opts              closeDisplay dpy +            return () | 
