summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2024-05-07 15:08:34 +0100
committerjao <jao@gnu.org>2024-05-07 15:12:51 +0100
commitcfc2c9099ae1ef53efd21b5b413ff04192f539e9 (patch)
treeaf2305b458366cb80cedea16bbc29739c4e962d2 /src/Xmobar/Plugins
parentdb75381d16f5a9fe04d7bbb94df2166f58e7da13 (diff)
downloadxmobar-cfc2c9099ae1ef53efd21b5b413ff04192f539e9.tar.gz
xmobar-cfc2c9099ae1ef53efd21b5b413ff04192f539e9.tar.bz2
Revert "Make the Kbd monitor clickable, with click selecting the next layout"
This reverts commit 0fec9d3fdf9bc86187f9f670dafd2ef57fe03f29. Mouse actions can already be attached to the monitor, and for instance use there invocations to setxbdmap to switch layouts. Fixes #703.
Diffstat (limited to 'src/Xmobar/Plugins')
-rw-r--r--src/Xmobar/Plugins/Kbd.hs72
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 ()