diff --git a/XMonad/Actions/Volume.hs b/XMonad/Actions/Volume.hs --- a/XMonad/Actions/Volume.hs +++ b/XMonad/Actions/Volume.hs @@ -177,19 +177,19 @@ amixerGetAll :: [String] -> IO (Double, Bool) amixerGet :: String -> IO String amixerSetAll = (mapM_ .) . amixerSet -amixerSet v m s = outputOf $ "amixer set '" ++ s ++ "' " ++ show (clip v) ++ "% " ++ (if m then "" else "un") ++ "mute" +amixerSet v m s = outputOf $ "amixer set '" ++ s ++ "' playback " ++ show (clip v) ++ "% " ++ (if m then "" else "un") ++ "mute" amixerGetAll = fmap parseAmixerGetAll . mapM amixerGet amixerGet s = outputOf $ "amixer get \'" ++ s ++ "\'" amixerSetVolumeOnlyAll :: Double -> [String] -> IO () amixerSetVolumeOnly :: Double -> String -> IO String amixerSetVolumeOnlyAll = mapM_ . amixerSetVolumeOnly -amixerSetVolumeOnly v s = outputOf $ "amixer set '" ++ s ++ "' " ++ show (clip v) ++ "% " +amixerSetVolumeOnly v s = outputOf $ "amixer set '" ++ s ++ "' playback " ++ show (clip v) ++ "%" amixerSetMuteOnlyAll :: Bool -> [String] -> IO () amixerSetMuteOnly :: Bool -> String -> IO String amixerSetMuteOnlyAll = mapM_ . amixerSetMuteOnly -amixerSetMuteOnly m s = outputOf $ "amixer set '" ++ s ++ "' " ++ (if m then "" else "un") ++ "mute" +amixerSetMuteOnly m s = outputOf $ "amixer set '" ++ s ++ "' playback " ++ (if m then "" else "un") ++ "mute" parseAmixerGetAll :: [String] -> (Double, Bool) parseAmixerGetAll ss = (geomMean vols, mute) where diff --git a/XMonad/Config/Alt/Internal.hs b/XMonad/Config/Alt/Internal.hs --- a/XMonad/Config/Alt/Internal.hs +++ b/XMonad/Config/Alt/Internal.hs @@ -14,7 +14,8 @@ ,TypeSynonymInstances ,UndecidableInstances ,ViewPatterns #-} -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures + -fcontext-stack=81 #-} -- I can't figure out an acceptable type for 'set' and similar: -- ghc doesn't accept the type inferred by ghci diff --git a/XMonad/Config/Alt/Sample.hs b/XMonad/Config/Alt/Sample.hs --- a/XMonad/Config/Alt/Sample.hs +++ b/XMonad/Config/Alt/Sample.hs @@ -1,16 +1,19 @@ {-# LANGUAGE NoMonomorphismRestriction #-} -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures -fcontext-stack=81 #-} module XMonad.Config.Alt.Sample where import XMonad.Config.Alt as C import XMonad import qualified XMonad.Hooks.ManageDocks import qualified XMonad.Hooks.DynamicLog -ex1, ex2 :: IO () -ex1 = runConfig $ hBuild - (C.modify Workspaces (++["lol","hi"])) - (C.set ModMask mod4Mask) - (C.modify LayoutHook XMonad.Hooks.ManageDocks.avoidStruts) +-- for an unknown reason ex1 and ex2 cannot coexist with ghc-7.0.2, previously +-- they did +-- ex1, ex2 :: IO () +-- ex1 = runConfig $ hBuild +-- (C.modify Workspaces (++["lol","hi"])) +-- (C.set ModMask mod4Mask) +-- (C.modify LayoutHook XMonad.Hooks.ManageDocks.avoidStruts) + ex2 = runConfig ex2' diff --git a/XMonad/Hooks/PerWindowKbdLayout.hsc b/XMonad/Hooks/PerWindowKbdLayout.hsc new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/PerWindowKbdLayout.hsc @@ -0,0 +1,140 @@ +{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- GHC 6.10.4 complains about Foreign.C.Types, see Ticket #3419 + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.PerWindowKbdLayout +-- Copyright : (c) Konstantin Sobolev +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Konstantin Sobolev +-- Stability : unstable +-- Portability : unportable +-- +-- A hook that remembers per-window keyboard layouts and switches them +-- on focus changes. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.PerWindowKbdLayout ( + -- * Usage + -- $usage + perWindowKbdLayout) where + +import Foreign +import Foreign.C.Types (CUChar,CUShort,CUInt(..),CInt(..)) + +import Control.Monad (when) +import Data.List (find) +import qualified Data.Map as M +import Data.Monoid (All(..)) +import Data.Traversable (traverse) + +import XMonad +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS + +#include + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.PerWindowKbdLayout +-- +-- Then edit your @eventHook@ by adding 'perWindowKbdLayout', for example +-- +-- > main = xmonad defaultConfig { handleEventHook = perWindowKbdLayout } + +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) + 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 + +foreign import ccall unsafe "XkbLockGroup" xkbLockGroup :: Display -> CUInt -> CUInt -> IO () + +type KbdLayout = Int + +getKbdLayout :: Display -> IO KbdLayout +getKbdLayout d = alloca $ \stRecPtr -> do + xkbGetState d (#const XkbUseCoreKbd) stRecPtr + st <- peek stRecPtr + return $ fromIntegral (group st) + +setKbdLayout :: Display -> KbdLayout -> IO () +setKbdLayout d l = xkbLockGroup d (#const XkbUseCoreKbd) $ fromIntegral l + +data LayoutStorage = LayoutStorage (Maybe Window) (M.Map Window KbdLayout) deriving (Typeable,Read,Show) +instance ExtensionClass LayoutStorage where initialValue = LayoutStorage Nothing M.empty + +perWindowKbdLayout :: Event -> X All +perWindowKbdLayout (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do + when (et == destroyNotify) $ + XS.modify $ \(LayoutStorage mpf wtl) -> (LayoutStorage mpf (M.delete w wtl)) + return (All True) +perWindowKbdLayout _ = do + mst <- gets (W.stack . W.workspace . W.current . windowset) + traverse update $ W.focus `fmap` mst + return (All True) + +update :: Window -> X() +update foc = withDisplay $ \dpy -> do + (LayoutStorage mpf wtl) <- XS.get + curLayout <- io $ getKbdLayout dpy + case mpf of + Nothing -> + XS.put (LayoutStorage (Just foc) (M.insert foc curLayout wtl)) + Just pf -> when (pf /= foc) $ do + XS.put (LayoutStorage (Just foc) (M.insert pf curLayout wtl)) + io $ whenJust (M.lookup foc wtl) (setKbdLayout dpy) + +-- vim:ft=haskell:ts=4:shiftwidth=4:softtabstop=4:expandtab: diff --git a/XMonad/Prompt/MPD.hs b/XMonad/Prompt/MPD.hs --- a/XMonad/Prompt/MPD.hs +++ b/XMonad/Prompt/MPD.hs @@ -26,12 +26,14 @@ ) where import Control.Monad import Data.Char +import Data.Either import qualified Data.Map as M import Data.Maybe import Network.MPD import XMonad import XMonad.Prompt -import Data.List (nub,isPrefixOf,findIndex) +import Data.List as L (nub,isPrefixOf,find) +import qualified XMonad.Prompt.MPD.Compat as Compat -- $usage -- @@ -98,14 +100,14 @@ case resp of Left err -> trace ("XMonad.Prompt.MPD: MPD returned an error: " ++ show err) >> return [] - Right songs -> foldM (findMatching' xp) songs metas + Right songs -> foldM (findMatching' xp) (rights songs) metas -- | Determine playlist position of the song and add it, if it isn't present. findOrAdd :: Song -> MPD Int findOrAdd s = playlistInfo Nothing >>= \pl -> - case findIndex ((== sgFilePath s) . sgFilePath) pl of - Just i -> return . fromIntegral $ i - Nothing -> flip addId Nothing . sgFilePath $ s + case L.find ((== sgFilePath s) . sgFilePath) pl of + Just (Song { sgIndex = Just i }) -> return i + _ -> fmap Compat.unwrapId . flip addId Nothing . sgFilePath $ s -- | Add all selected songs to the playlist if they are not in it. addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int] @@ -115,5 +117,6 @@ -- | Add matching songs and play the first one. addAndPlay :: RunMPD -> XPConfig -> [Metadata] -> X () -addAndPlay runMPD xp ms = addMatching runMPD xp ms >>= - io . runMPD . play . listToMaybe >> return () +addAndPlay runMPD xp ms = do + ids <- addMatching runMPD xp ms + whenJust (listToMaybe ids) ((>> return ()) . io . runMPD . playId . Compat.wrapId) diff --git a/XMonad/Prompt/MPD/Compat.hs b/XMonad/Prompt/MPD/Compat.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/MPD/Compat.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE CPP #-} + +module XMonad.Prompt.MPD.Compat (wrapId, unwrapId) where + +#if MIN_VERSION_libmpd(0,7,0) + +import Network.MPD (Id(..)) +wrapId = Id +unwrapId (Id i) = i + +#else + +type Id = Int +wrapId = id +unwrapId = id + +#endif + +wrapId :: Int -> Id +unwrapId :: Id -> Int diff --git a/XMonad/Util/WindowPropertiesRE.hs b/XMonad/Util/WindowPropertiesRE.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/WindowPropertiesRE.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.WindowPropertiesRE +-- Copyright : (c) 2011 Ilya Portnov +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Ilya Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Similar to XMonad.Util.WindowProperties, but uses posix regular expressions matching +-- instead of exact match. +-- +----------------------------------------------------------------------------- +module XMonad.Util.WindowPropertiesRE + (PropertyRE (..), + (~?), + propertyToQueryRE, hasPropertyRE + ) where + +import Text.Regex.Posix ((=~)) + +import XMonad + +import XMonad.Util.WindowProperties +import XMonad.Layout.LayoutBuilderP + +-- | A wrapper for X.U.WindowProperties.Property. +-- Checks using regular expression. +data PropertyRE = RE Property + deriving (Show,Read,Typeable) + +-- | Regular expressions matching for ManageHooks +(~?) :: (Functor f) => f String -> String -> f Bool +q ~? x = fmap (=~ x) q + +-- | Similar to XMonad.Util.WindowProperties.propertyToQuery, +-- but uses regexp match instead of exact match +propertyToQueryRE :: Property -> Query Bool +propertyToQueryRE (Title s) = title ~? s +propertyToQueryRE (Resource s) = resource ~? s +propertyToQueryRE (ClassName s) = className ~? s +propertyToQueryRE (Role s) = stringProperty "WM_WINDOW_ROLE" ~? s +propertyToQueryRE (Machine s) = stringProperty "WM_CLIENT_MACHINE" ~? s +propertyToQueryRE (And p1 p2) = propertyToQueryRE p1 <&&> propertyToQueryRE p2 +propertyToQueryRE (Or p1 p2) = propertyToQueryRE p1 <||> propertyToQueryRE p2 +propertyToQueryRE (Not p) = not `fmap` propertyToQueryRE p +propertyToQueryRE (Const b) = return b + +-- | Does given window have this property? +hasPropertyRE :: PropertyRE -> Window -> X Bool +hasPropertyRE (RE p) w = runQuery (propertyToQueryRE p) w + +instance Predicate PropertyRE Window where + alwaysTrue _ = RE (Const True) + checkPredicate = hasPropertyRE + diff --git a/xmonad-extras.cabal b/xmonad-extras.cabal --- a/xmonad-extras.cabal +++ b/xmonad-extras.cabal @@ -1,5 +1,5 @@ name: xmonad-extras -version: 0.9.2 +version: 0.10 homepage: http://projects.haskell.org/xmonad-extras synopsis: Third party extensions for xmonad with wacky dependencies description: Various modules for xmonad that cannot be added to xmonad-contrib @@ -30,6 +30,9 @@ flag with_hlist description: Build modules depending on HList. +flag with_regex_posix + description: Build modules depending on posix-regex. + flag with_template_haskell description: Build modules depending on template haskell. @@ -43,7 +46,7 @@ else build-depends: base < 3 - build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.9 && <0.10, xmonad-contrib>=0.9 && <0.10 + build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.10 && <0.11, xmonad-contrib>=0.10 && <0.11 if true ghc-options: -fwarn-tabs -Wall @@ -58,15 +61,23 @@ build-depends: parsec >= 2 && < 4, split >= 0.1 && < 0.2 exposed-modules: XMonad.Actions.Volume - if flag(with_hint) + -- At the moment of writing, hint does not yet support + -- GHCs newer than 7.0.4; If that changes and no new release + -- of xmonad-extras has been made, please contact the maintainer. + if flag(with_hint) && impl (ghc < 7.2) build-depends: hint >= 0.3 && < 0.4, network exposed-modules: XMonad.Actions.Eval XMonad.Prompt.Eval -- XMonad.Hooks.EvalServer if flag(with_mpd) - build-depends: libmpd >= 0.5 && < 0.6 + build-depends: libmpd >= 0.6 && < 0.8 exposed-modules: XMonad.Prompt.MPD + other-modules: XMonad.Prompt.MPD.Compat + if flag(with_regex_posix) + build-depends: regex-posix + exposed-modules: XMonad.Util.WindowPropertiesRE + if impl(ghc >= 6.12.1) && flag(with_template_haskell) && flag(with_hlist) build-depends: template-haskell, HList >= 0.2.3 && < 0.3 exposed-modules: XMonad.Config.Alt @@ -77,7 +88,7 @@ other-modules: XMonad.Config.Alt.Types --- exposed-modules: XMonad.Hooks.PerWindowKbdLayout + exposed-modules: XMonad.Hooks.PerWindowKbdLayout if impl(ghc >= 6.12.1) ghc-options: -fno-warn-unused-do-bind