summaryrefslogtreecommitdiffhomepage
path: root/src/lib/Xmobar/Plugins
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/Xmobar/Plugins')
-rw-r--r--src/lib/Xmobar/Plugins/BufferedPipeReader.hs2
-rw-r--r--src/lib/Xmobar/Plugins/CommandReader.hs2
-rw-r--r--src/lib/Xmobar/Plugins/DateZone.hs1
-rw-r--r--src/lib/Xmobar/Plugins/Kbd.hs96
-rw-r--r--src/lib/Xmobar/Plugins/Kbd.hsc404
-rw-r--r--src/lib/Xmobar/Plugins/Locks.hs4
-rw-r--r--src/lib/Xmobar/Plugins/Mail.hs2
-rw-r--r--src/lib/Xmobar/Plugins/PipeReader.hs2
8 files changed, 102 insertions, 411 deletions
diff --git a/src/lib/Xmobar/Plugins/BufferedPipeReader.hs b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs
index 9bb421e..0b55cf7 100644
--- a/src/lib/Xmobar/Plugins/BufferedPipeReader.hs
+++ b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs
@@ -12,7 +12,7 @@
--
-----------------------------------------------------------------------------
-module Xmobar.Plugins.BufferedPipeReader where
+module Xmobar.Plugins.BufferedPipeReader(BufferedPipeReader(..)) where
import Control.Monad(forM_, when, void)
import Control.Concurrent
diff --git a/src/lib/Xmobar/Plugins/CommandReader.hs b/src/lib/Xmobar/Plugins/CommandReader.hs
index 87cf5a4..4c71c96 100644
--- a/src/lib/Xmobar/Plugins/CommandReader.hs
+++ b/src/lib/Xmobar/Plugins/CommandReader.hs
@@ -13,7 +13,7 @@
--
-----------------------------------------------------------------------------
-module Xmobar.Plugins.CommandReader where
+module Xmobar.Plugins.CommandReader(CommandReader(..)) where
import System.IO
import Xmobar.Commands
diff --git a/src/lib/Xmobar/Plugins/DateZone.hs b/src/lib/Xmobar/Plugins/DateZone.hs
index d3d4341..5dad871 100644
--- a/src/lib/Xmobar/Plugins/DateZone.hs
+++ b/src/lib/Xmobar/Plugins/DateZone.hs
@@ -23,7 +23,6 @@
module Xmobar.Plugins.DateZone (DateZone(..)) where
import Xmobar.Commands
-import Xmobar.Commands(tenthSeconds)
#ifdef DATEZONE
import Control.Concurrent.STM
diff --git a/src/lib/Xmobar/Plugins/Kbd.hs b/src/lib/Xmobar/Plugins/Kbd.hs
new file mode 100644
index 0000000..76914cc
--- /dev/null
+++ b/src/lib/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.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 (\x -> x /= ':')) $ filter (\x -> length x > 0) 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)
+
+
+
+data 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 ()
diff --git a/src/lib/Xmobar/Plugins/Kbd.hsc b/src/lib/Xmobar/Plugins/Kbd.hsc
deleted file mode 100644
index 5439785..0000000
--- a/src/lib/Xmobar/Plugins/Kbd.hsc
+++ /dev/null
@@ -1,404 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-}
------------------------------------------------------------------------------
--- |
--- 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 where
-
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Foreign
-import Foreign.C.Types
-import Foreign.C.String
-import Control.Monad (forever)
-import Xmobar.Commands
-import Xmobar.Utils (nextEvent')
-import Data.List (isPrefixOf, findIndex)
-import Data.Maybe (fromJust)
-
-#include <X11/XKBlib.h>
-#include <X11/extensions/XKB.h>
-#include <X11/extensions/XKBstr.h>
-
---
--- Definition for XkbStaceRec and getKbdLayout taken from
--- XMonad.Layout.XKBLayout
---
-data XkbStateRec = XkbStateRec {
- group :: CUChar,
- locked_group :: CUChar,
- base_group :: CUShort,
- latched_group :: CUShort,
- mods :: CUChar,
- base_mods :: CUChar,
- latched_mods :: CUChar,
- locked_mods :: CUChar,
- compat_state :: CUChar,
- grab_mods :: CUChar,
- compat_grab_mods :: CUChar,
- lookup_mods :: CUChar,
- compat_lookup_mods :: CUChar,
- ptr_buttons :: CUShort
-}
-
-instance Storable XkbStateRec where
- sizeOf _ = (#size XkbStateRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_group <- (#peek XkbStateRec, group) ptr
- r_locked_group <- (#peek XkbStateRec, locked_group) ptr
- r_base_group <- (#peek XkbStateRec, base_group) ptr
- r_latched_group <- (#peek XkbStateRec, latched_group) ptr
- r_mods <- (#peek XkbStateRec, mods) ptr
- r_base_mods <- (#peek XkbStateRec, base_mods) ptr
- r_latched_mods <- (#peek XkbStateRec, latched_mods) ptr
- r_locked_mods <- (#peek XkbStateRec, locked_mods) ptr
- r_compat_state <- (#peek XkbStateRec, compat_state) ptr
- r_grab_mods <- (#peek XkbStateRec, grab_mods) ptr
- r_compat_grab_mods <- (#peek XkbStateRec, compat_grab_mods) ptr
- r_lookup_mods <- (#peek XkbStateRec, lookup_mods) ptr
- r_compat_lookup_mods <- (#peek XkbStateRec, compat_lookup_mods) ptr
- r_ptr_buttons <- (#peek XkbStateRec, ptr_buttons) ptr
- return XkbStateRec {
- group = r_group,
- locked_group = r_locked_group,
- base_group = r_base_group,
- latched_group = r_latched_group,
- mods = r_mods,
- base_mods = r_base_mods,
- latched_mods = r_latched_mods,
- locked_mods = r_locked_mods,
- compat_state = r_compat_state,
- grab_mods = r_grab_mods,
- compat_grab_mods = r_compat_grab_mods,
- lookup_mods = r_lookup_mods,
- compat_lookup_mods = r_compat_lookup_mods,
- ptr_buttons = r_ptr_buttons
- }
-
-foreign import ccall unsafe "X11/XKBlib.h XkbGetState"
- xkbGetState :: Display -> CUInt -> Ptr XkbStateRec -> IO CInt
-
-
-getKbdLayout :: Display -> IO Int
-getKbdLayout d = alloca $ \stRecPtr -> do
- xkbGetState d 0x100 stRecPtr
- st <- peek stRecPtr
- return $ fromIntegral (group st)
-
---
---
---
-
-data XkbKeyNameRec = XkbKeyNameRec {
- name :: Ptr CChar -- array
-}
-
---
--- the t_ before alias is just because of name collisions
---
-data XkbKeyAliasRec = XkbKeyAliasRec {
- real :: Ptr CChar, -- array
- t_alias :: Ptr CChar -- array
-}
-
---
--- the t_ before geometry is just because of name collisions
---
-data XkbNamesRec = XkbNamesRec {
- keycodes :: Atom,
- t_geometry :: Atom,
- symbols :: Atom,
- types :: Atom,
- compat :: Atom,
- vmods :: Ptr Atom,
- indicators :: Ptr Atom, -- array
- groups :: Ptr Atom, -- array
- keys :: Ptr XkbKeyNameRec,
- key_aliases :: Ptr CChar, -- dont care XkbKeyAliasRec,
- radio_groups :: Ptr Atom,
- phys_symbols :: Atom,
- num_keys :: CUChar,
- num_key_aliases :: CUChar,
- num_rg :: CUShort
-}
-
---
--- the t_ before map, indicators and compat are just because of name collisions
---
-data XkbDescRec = XkbDescRec {
- t_dpy :: Ptr CChar, -- struct _XDisplay* ; don't care
- flags :: CUShort,
- device_spec :: CUShort,
- min_key_code :: KeyCode,
- max_key_code :: KeyCode,
- ctrls :: Ptr CChar, -- XkbControlsPtr ; dont' care
- server :: Ptr CChar, -- XkbServerMapPtr ; dont' care
- t_map :: Ptr CChar, --XkbClientMapPtr ; dont' care
- t_indicators :: Ptr CChar, -- XkbIndicatorPtr ; dont' care
- names :: Ptr XkbNamesRec, -- array
- t_compat :: Ptr CChar, -- XkbCompatMap ; dont' care
- geom :: Ptr CChar -- XkbGeometryPtr ; dont' care
-
-}
-
-instance Storable XkbKeyNameRec where
- sizeOf _ = (#size XkbKeyNameRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_name <- (#peek XkbKeyNameRec, name) ptr
-
- return XkbKeyNameRec {
- name = r_name
- }
-
-instance Storable XkbKeyAliasRec where
- sizeOf _ = (#size XkbKeyAliasRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_real <- (#peek XkbKeyAliasRec, real) ptr
- r_alias <- (#peek XkbKeyAliasRec, alias) ptr
-
- return XkbKeyAliasRec {
- real = r_real,
- t_alias = r_alias
- }
-
-instance Storable XkbNamesRec where
- sizeOf _ = (#size XkbNamesRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_keycodes <- (#peek XkbNamesRec, keycodes) ptr
- r_geometry <- (#peek XkbNamesRec, geometry) ptr
- r_symbols <- (#peek XkbNamesRec, symbols ) ptr
- r_types <- (#peek XkbNamesRec, types ) ptr
- r_compat <- (#peek XkbNamesRec, compat ) ptr
- r_vmods <- (#peek XkbNamesRec, vmods ) ptr
- r_indicators <- (#peek XkbNamesRec, indicators ) ptr
- r_groups <- (#peek XkbNamesRec, groups ) ptr
- r_keys <- (#peek XkbNamesRec, keys ) ptr
- r_key_aliases <- (#peek XkbNamesRec, key_aliases ) ptr
- r_radio_groups <- (#peek XkbNamesRec, radio_groups ) ptr
- r_phys_symbols <- (#peek XkbNamesRec, phys_symbols ) ptr
- r_num_keys <- (#peek XkbNamesRec,num_keys ) ptr
- r_num_key_aliases <- (#peek XkbNamesRec, num_key_aliases ) ptr
- r_num_rg <- (#peek XkbNamesRec, num_rg ) ptr
-
- return XkbNamesRec {
- keycodes = r_keycodes,
- t_geometry = r_geometry,
- symbols = r_symbols,
- types = r_types,
- compat = r_compat,
- vmods = r_vmods,
- indicators = r_indicators,
- groups = r_groups,
- keys = r_keys,
- key_aliases = r_key_aliases,
- radio_groups = r_radio_groups,
- phys_symbols = r_phys_symbols,
- num_keys = r_num_keys,
- num_key_aliases = r_num_key_aliases,
- num_rg = r_num_rg
- }
-
-instance Storable XkbDescRec where
- sizeOf _ = (#size XkbDescRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_dpy <- (#peek XkbDescRec, dpy) ptr
- r_flags <- (#peek XkbDescRec, flags) ptr
- r_device_spec <- (#peek XkbDescRec, device_spec) ptr
- r_min_key_code <- (#peek XkbDescRec, min_key_code) ptr
- r_max_key_code <- (#peek XkbDescRec, max_key_code) ptr
- r_ctrls <- (#peek XkbDescRec, ctrls) ptr
- r_server <- (#peek XkbDescRec, server) ptr
- r_map <- (#peek XkbDescRec, map) ptr
- r_indicators <- (#peek XkbDescRec, indicators) ptr
- r_names <- (#peek XkbDescRec, names) ptr
- r_compat <- (#peek XkbDescRec, compat) ptr
- r_geom <- (#peek XkbDescRec, geom) ptr
-
- return XkbDescRec {
- t_dpy = r_dpy,
- flags = r_flags,
- device_spec = r_device_spec,
- min_key_code = r_min_key_code,
- max_key_code = r_max_key_code,
- ctrls = r_ctrls,
- server = r_server,
- t_map = r_map,
- t_indicators = r_indicators,
- names = r_names,
- t_compat = r_compat,
- geom = r_geom
- }
-
---
--- C bindings
---
-
-foreign import ccall unsafe "X11/XKBlib.h XkbAllocKeyboard"
- xkbAllocKeyboard :: IO (Ptr XkbDescRec)
-
-foreign import ccall unsafe "X11/XKBlib.h XkbGetNames"
- xkbGetNames :: Display -> CUInt -> (Ptr XkbDescRec) -> IO Status
-
-foreign import ccall unsafe "X11/XKBlib.h XGetAtomName"
- xGetAtomName :: Display -> Atom -> IO CString
-
-foreign import ccall unsafe "X11/XKBlib.h XkbFreeNames"
- xkbFreeNames :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO ()
-
-foreign import ccall unsafe "X11/XKBlib.h XkbFreeKeyboard"
- xkbFreeKeyboard :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO ()
-
-foreign import ccall unsafe "X11/XKBlib.h XkbSelectEventDetails"
- xkbSelectEventDetails :: Display -> CUInt -> CUInt -> CULong -> CULong -> IO CUInt
-
-foreign import ccall unsafe "X11/XKBlib.h XkbSelectEvents"
- xkbSelectEvents :: Display -> CUInt -> CUInt -> CUInt -> IO CUInt
-
-
-xkbUseCoreKbd :: CUInt
-xkbUseCoreKbd = #const XkbUseCoreKbd
-
-xkbStateNotify :: CUInt
-xkbStateNotify = #const XkbStateNotify
-
-xkbIndicatorStateNotify :: CUInt
-xkbIndicatorStateNotify = #const XkbIndicatorStateNotify
-
-xkbMapNotify :: CUInt
-xkbMapNotify = #const XkbMapNotify
-
-xkbMapNotifyMask :: CUInt
-xkbMapNotifyMask = #const XkbMapNotifyMask
-
-xkbNewKeyboardNotifyMask :: CUInt
-xkbNewKeyboardNotifyMask = #const XkbNewKeyboardNotifyMask
-
-xkbAllStateComponentsMask :: CULong
-xkbAllStateComponentsMask = #const XkbAllStateComponentsMask
-
-xkbGroupStateMask :: CULong
-xkbGroupStateMask = #const XkbGroupStateMask
-
-xkbSymbolsNameMask :: CUInt
-xkbSymbolsNameMask = #const XkbSymbolsNameMask
-
-xkbGroupNamesMask :: CUInt
-xkbGroupNamesMask = #const XkbGroupNamesMask
-
-type KbdOpts = [(String, String)]
-
--- gets the layout string
-getLayoutStr :: Display -> IO String
-getLayoutStr dpy = do
- kbdDescPtr <- xkbAllocKeyboard
- status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr
- str <- getLayoutStr' status dpy kbdDescPtr
- xkbFreeNames kbdDescPtr xkbGroupNamesMask 1
- xkbFreeKeyboard kbdDescPtr 0 1
- return str
-
-getLayoutStr' :: Status -> Display -> (Ptr XkbDescRec) -> IO String
-getLayoutStr' st dpy kbdDescPtr =
- if st == 0 then -- Success
- do
- kbdDesc <- peek kbdDescPtr
- nameArray <- peek (names kbdDesc)
- atom <- xGetAtomName dpy (symbols nameArray)
- str <- peekCString atom
- return str
- else -- Behaviour on error
- do
- return "Error while requesting layout!"
-
-
--- '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 (\x -> x /= ':')) $ filter (\x -> length x > 0) 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)
-
-
-
-data 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 ()
-
--- vim:ft=haskell:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:
diff --git a/src/lib/Xmobar/Plugins/Locks.hs b/src/lib/Xmobar/Plugins/Locks.hs
index c086464..1f73f1f 100644
--- a/src/lib/Xmobar/Plugins/Locks.hs
+++ b/src/lib/Xmobar/Plugins/Locks.hs
@@ -12,7 +12,7 @@
--
-----------------------------------------------------------------------------
-module Xmobar.Plugins.Locks where
+module Xmobar.Plugins.Locks(Locks(..)) where
import Graphics.X11
import Data.List
@@ -20,7 +20,7 @@ import Data.Bits
import Control.Monad
import Graphics.X11.Xlib.Extras
import Xmobar.Commands
-import Xmobar.Plugins.Kbd
+import Xmobar.System.Kbd
import Xmobar.Utils (nextEvent')
data Locks = Locks
diff --git a/src/lib/Xmobar/Plugins/Mail.hs b/src/lib/Xmobar/Plugins/Mail.hs
index 8c0321f..aa28b98 100644
--- a/src/lib/Xmobar/Plugins/Mail.hs
+++ b/src/lib/Xmobar/Plugins/Mail.hs
@@ -13,7 +13,7 @@
--
-----------------------------------------------------------------------------
-module Xmobar.Plugins.Mail where
+module Xmobar.Plugins.Mail(Mail(..)) where
import Xmobar.Commands
#ifdef INOTIFY
diff --git a/src/lib/Xmobar/Plugins/PipeReader.hs b/src/lib/Xmobar/Plugins/PipeReader.hs
index ac59356..d04f747 100644
--- a/src/lib/Xmobar/Plugins/PipeReader.hs
+++ b/src/lib/Xmobar/Plugins/PipeReader.hs
@@ -12,7 +12,7 @@
--
-----------------------------------------------------------------------------
-module Xmobar.Plugins.PipeReader where
+module Xmobar.Plugins.PipeReader(PipeReader(..)) where
import System.IO
import Xmobar.Commands(Exec(..))
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-01 13:09:33 +0000