summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
authorEnrico Maria De Angelis <enricomaria.dean6elis@gmail.com>2024-03-14 00:08:42 +0000
committerEnrico Maria De Angelis <enricomaria.dean6elis@gmail.com>2024-03-17 22:29:01 +0000
commit0fec9d3fdf9bc86187f9f670dafd2ef57fe03f29 (patch)
treed4c21d50cc9c71432a04dd6a2597998944385d7d /src/Xmobar
parent5f9c0e179f25b5d74ef8e10d43d5761c82fff8e8 (diff)
downloadxmobar-0fec9d3fdf9bc86187f9f670dafd2ef57fe03f29.tar.gz
xmobar-0fec9d3fdf9bc86187f9f670dafd2ef57fe03f29.tar.bz2
Make the Kbd monitor clickable, with click selecting the next layout
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/Plugins/Kbd.hs72
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 ()