xmonad-extras-0.12.1/0000755000000000000000000000000012513255116012554 5ustar0000000000000000xmonad-extras-0.12.1/xmonad-extras.cabal0000644000000000000000000000655312513255116016343 0ustar0000000000000000name: xmonad-extras version: 0.12.1 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 because of additional dependencies. category: System license: BSD3 license-file: LICENSE author: The Daniels Schoepe and Wagner maintainer: daniel@wagner-home.com, daniel.schoepe@googlemail.com cabal-version: >= 1.2.1 build-type: Simple flag small_base description: Choose the new smaller, split-up base package. flag with_parsec description: Build modules depending on the parsec package flag with_split description: Build modules depending on Data.Split flag with_hint description: Build modules depending on hint(for evaluating Haskell expressions at runtime). flag with_mpd description: Build modules depending on libmpd. flag with_hlist description: Build modules depending on HList. default: False flag with_regex_posix description: Build modules depending on posix-regex. flag with_template_haskell description: Build modules depending on template haskell. flag testing description: Testing mode default: False library if flag(small_base) build-depends: base >= 3 && < 5, containers, directory, process, random, old-time, old-locale else build-depends: base < 3 build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.10 && <0.13, xmonad-contrib>=0.10 && <0.13 if true ghc-options: -fwarn-tabs -Wall if flag(testing) ghc-options: -Werror if impl (ghc == 6.10.1) && arch (x86_64) ghc-options: --disable-optimizations if flag(with_parsec) && flag(with_split) build-depends: parsec >= 2 && < 4, split >= 0.1 && < 0.3 exposed-modules: XMonad.Actions.Volume if flag(with_hint) if impl(ghc < 7.2) build-depends: hint >= 0.3 && < 0.4, network else build-depends: hint >= 0.3.3.3 && < 0.5, network exposed-modules: XMonad.Actions.Eval XMonad.Prompt.Eval -- XMonad.Hooks.EvalServer if flag(with_mpd) build-depends: libmpd >= 0.8 && < 0.9, bytestring >= 0.9 && < 0.11 exposed-modules: XMonad.Prompt.MPD if flag(with_regex_posix) build-depends: regex-posix exposed-modules: XMonad.Util.WindowPropertiesRE if flag(with_template_haskell) && flag(with_hlist) build-depends: template-haskell, HList >= 0.4 && < 0.5 exposed-modules: XMonad.Config.Alt XMonad.Config.Alt.Desktop XMonad.Config.Alt.Sample1 XMonad.Config.Alt.Internal XMonad.Config.Alt.QQ other-modules: XMonad.Config.Alt.Types exposed-modules: XMonad.Hooks.PerWindowKbdLayout if impl(ghc >= 6.12.1) ghc-options: -fno-warn-unused-do-bind -- executable xmonadcmd -- main-is: XMonadCmd.hs -- build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.9 && <1.0, xmonad-contrib>=0.9 && <1.0 -- ghc-options: -Wall -- if !flag(with_hint) -- Buildable: False -- -- if flag(with_hint) -- build-depends: network -- -- if flag(testing) -- ghc-options: -Werror xmonad-extras-0.12.1/Setup.lhs0000644000000000000000000000011512513255116014361 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain xmonad-extras-0.12.1/LICENSE0000644000000000000000000000270012513255116013560 0ustar0000000000000000Copyright (c) The Xmonad Community All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xmonad-extras-0.12.1/XMonad/0000755000000000000000000000000012513255116013742 5ustar0000000000000000xmonad-extras-0.12.1/XMonad/Actions/0000755000000000000000000000000012513255116015342 5ustar0000000000000000xmonad-extras-0.12.1/XMonad/Actions/Eval.hs0000644000000000000000000001020712513255116016565 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Eval -- Copyright : (c) 2009 Daniel Schoepe -- License : BSD3-style (see LICENSE) -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- Evaluate haskell expressions at runtime in the running xmonad instance. -- ----------------------------------------------------------------------------- module XMonad.Actions.Eval ( -- * Usage -- $usage -- * Documentation -- $documentation evalExpression , evalExpressionWithReturn , EvalConfig(..) , defaultEvalConfig ) where import XMonad.Core import XMonad.Util.Run import Language.Haskell.Interpreter import Data.List -- $usage -- This module provides functions to evaluate haskell expressions at runtime -- To use it, bind a key to evalExpression, for example in combination with a prompt: -- -- > import XMonad -- > import XMonad.Actions.Eval -- > import XMonad.Prompt.Input -- > .. -- > , ((modMask,xK_t), inputPrompt defaultXPConfig "Eval" >>= flip whenJust (evalExpression defaultEvalConfig)) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- $documentation -- In here due to the apparent lack of a replace function in the standard library. -- (Used for correctly displaying newlines in error messages) replace :: Eq a => [a] -> [a] -> [a] -> [a] replace lst@(x:xs) sub repl | sub `isPrefixOf` lst = repl ++ replace (drop (length sub) lst) sub repl | otherwise = x:(replace xs sub repl) replace _ _ _ = [] -- | Configuration structure data EvalConfig = EvalConfig { handleError :: InterpreterError -> X String -- ^ Function to handle errors , imports :: [(ModuleName,Maybe String)] -- ^ Modules to import for interpreting the expression. -- The pair consists of the module name and an optional -- qualification of the imported module. , modules :: [String] -- ^ Other source files that should be loaded -- The definitions of these modules will be visible -- regardless of whether they are exported. } -- | Defaults for evaluating expressions. defaultEvalConfig :: EvalConfig defaultEvalConfig = EvalConfig { handleError = handleErrorDefault , imports = [("Prelude",Nothing),("XMonad",Nothing), ("XMonad.StackSet",Just "W"),("XMonad.Core",Nothing)] , modules = [] } -- | Default way to handle(in this case: display) an error during interpretation of an expression. handleErrorDefault :: InterpreterError -> X String handleErrorDefault err = io (safeSpawn "/usr/bin/xmessage" [replace (show err) "\\n" "\n"]) >> return "Error" -- | Returns an Interpreter action that loads the desired modules and interprets the expression. interpret' :: EvalConfig -> String -> Interpreter (X String) interpret' conf s = do loadModules $ modules conf setTopLevelModules =<< getLoadedModules setImportsQ $ imports conf interpret ("show `fmap` ("++s++")") (return "") -- | Evaluates a given expression whose result type has to be an instance of Show evalExpressionWithReturn :: EvalConfig -> String -> X String evalExpressionWithReturn conf s = io (runInterpreter $ interpret' conf s) >>= either (handleError conf) id -- | Evaluates a given expression, but discard the returned value. Provided for -- more convenient use in keybindings evalExpression :: EvalConfig -> String -> X () evalExpression cnf = (>> return ()) . evalExpressionWithReturn cnf xmonad-extras-0.12.1/XMonad/Actions/Volume.hs0000644000000000000000000002604012513255116017147 0ustar0000000000000000{-# LANGUAGE CPP #-} -- boilerplate {{{ ---------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Volume -- Copyright : (c) daniel@wagner-home.com -- License : BSD3-style (see LICENSE) -- -- Maintainer : daniel@wagner-home.com -- Stability : unstable -- Portability : unportable -- -- A minimal interface to the \"amixer\" command-line utility. -- ---------------------------------------------------------------------------- module XMonad.Actions.Volume ( -- * Usage -- $usage -- * Common functions toggleMute, raiseVolume, lowerVolume, -- * Low-level interface getVolume, getMute, getVolumeMute, setVolume, setMute, setVolumeMute, modifyVolume, modifyMute, modifyVolumeMute, -- * Variants that take a list of channels defaultChannels, toggleMuteChannels, raiseVolumeChannels, lowerVolumeChannels, getVolumeChannels, getMuteChannels, getVolumeMuteChannels, setVolumeChannels, setMuteChannels, setVolumeMuteChannels, modifyVolumeChannels, modifyMuteChannels, modifyVolumeMuteChannels, defaultOSDOpts, osdCat ) where import Control.Monad import Control.Monad.Trans import Data.List.Split (splitOn) import Data.Maybe import System.IO import System.Process import Text.ParserCombinators.Parsec import XMonad.Core #if MIN_VERSION_base(4,8,0) import Prelude hiding ((<*)) #endif infixl 1 <* (<*) :: Monad m => m a -> m b -> m a pa <* pb = pa >>= \a -> pb >> return a {- $usage You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: > import XMonad.Actions.Volume then add appropriate keybinds to adjust the volume; for example: > , ((modMask x, xK_F8 ), lowerVolume 3 >> return ()) > , ((modMask x, xK_F9 ), raiseVolume 3 >> return ()) > , ((modMask x, xK_F10), toggleMute >> return ()) For detailed instructions on editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". -} -- }}} -- API {{{ -- | Toggle mutedness on the default channels. Returns 'True' when this attempts to mute the speakers and 'False' when this attempts to unmute the speakers. toggleMute :: MonadIO m => m Bool -- | Raise the volume on the default channels the given number of percentage points. Returns the volume it attempts to set. raiseVolume :: MonadIO m => Double -> m Double -- | Lower the volume on the default channels the given number of percentage points. Returns the volume it attempts to set. lowerVolume :: MonadIO m => Double -> m Double -- | Get the geometric mean of the volumes on the default channels. getVolume :: MonadIO m => m Double -- | Get the mutedness of the default channels. Returns 'True' if any of the channels are muted, and 'False' otherwise. getMute :: MonadIO m => m Bool -- | Get both the volume and the mutedness of the default channels. getVolumeMute :: MonadIO m => m (Double, Bool) -- | Attempt to set the default channels to a volume given in percentage of maximum. setVolume :: MonadIO m => Double -> m () -- | Attempt to set the muting on the default channels. setMute :: MonadIO m => Bool -> m () -- | Attempt to set both the volume in percent and the muting on the default channels. setVolumeMute :: MonadIO m => Double -> Bool -> m () -- | Apply a function to the volume of the default channels, and return the modified value. modifyVolume :: MonadIO m => (Double -> Double ) -> m Double -- | Apply a function to the muting on the default channels, and return the modified value. modifyMute :: MonadIO m => (Bool -> Bool ) -> m Bool -- | Apply a function to both the volume and the muting of the default channels, and return the modified values. modifyVolumeMute :: MonadIO m => (Double -> Bool -> (Double, Bool)) -> m (Double, Bool) toggleMute = toggleMuteChannels defaultChannels raiseVolume = raiseVolumeChannels defaultChannels lowerVolume = lowerVolumeChannels defaultChannels getVolume = getVolumeChannels defaultChannels getMute = getMuteChannels defaultChannels getVolumeMute = getVolumeMuteChannels defaultChannels setVolume = setVolumeChannels defaultChannels setMute = setMuteChannels defaultChannels setVolumeMute = setVolumeMuteChannels defaultChannels modifyVolume = modifyVolumeChannels defaultChannels modifyMute = modifyMuteChannels defaultChannels modifyVolumeMute = modifyVolumeMuteChannels defaultChannels -- | Channels are what amixer calls \"simple controls\". The most common ones are \"Master\", \"Wave\", and \"PCM\", so these are included in 'defaultChannels'. It is guaranteed to be safe to pass channel names that don't exist on the default sound device to the *Channels family of functions. defaultChannels :: [String] defaultChannels = ["Master", "Wave", "PCM"] toggleMuteChannels :: MonadIO m => [String] -> m Bool raiseVolumeChannels :: MonadIO m => [String] -> Double -> m Double lowerVolumeChannels :: MonadIO m => [String] -> Double -> m Double getVolumeChannels :: MonadIO m => [String] -> m Double getMuteChannels :: MonadIO m => [String] -> m Bool getVolumeMuteChannels :: MonadIO m => [String] -> m (Double, Bool) setVolumeChannels :: MonadIO m => [String] -> Double -> m () setMuteChannels :: MonadIO m => [String] -> Bool -> m () setVolumeMuteChannels :: MonadIO m => [String] -> Double -> Bool -> m () modifyVolumeChannels :: MonadIO m => [String] -> (Double -> Double ) -> m Double modifyMuteChannels :: MonadIO m => [String] -> (Bool -> Bool ) -> m Bool modifyVolumeMuteChannels :: MonadIO m => [String] -> (Double -> Bool -> (Double, Bool)) -> m (Double, Bool) toggleMuteChannels cs = modifyMuteChannels cs not raiseVolumeChannels cs = modifyVolumeChannels cs . (+) lowerVolumeChannels cs = modifyVolumeChannels cs . (subtract) getVolumeChannels = liftIO . fmap fst . amixerGetAll getMuteChannels = liftIO . fmap snd . amixerGetAll getVolumeMuteChannels = liftIO . amixerGetAll setVolumeChannels cs v = liftIO (amixerSetVolumeOnlyAll v cs) setMuteChannels cs m = liftIO (amixerSetMuteOnlyAll m cs) setVolumeMuteChannels cs v m = liftIO (amixerSetAll v m cs) modifyVolumeChannels = modify getVolumeChannels setVolumeChannels modifyMuteChannels = modify getMuteChannels setMuteChannels modifyVolumeMuteChannels cs = modify getVolumeMuteChannels (\cs' -> uncurry (setVolumeMuteChannels cs')) cs . uncurry -- }}} -- internals {{{ geomMean :: Floating a => [a] -> a geomMean xs = product xs ** (recip . fromIntegral . length $ xs) clip :: (Num t, Ord t) => t -> t clip = min 100 . max 0 modify :: Monad m => (arg -> m value) -> (arg -> value -> m ()) -> arg -> (value -> value) -> m value modify get set cs f = do v <- liftM f $ get cs set cs v return v outputOf :: String -> IO String outputOf s = do uninstallSignalHandlers (hIn, hOut, hErr, p) <- runInteractiveCommand s mapM_ hClose [hIn, hErr] hGetContents hOut <* waitForProcess p <* installSignalHandlers amixerSetAll :: Double -> Bool -> [String] -> IO () amixerSet :: Double -> Bool -> String -> IO String amixerGetAll :: [String] -> IO (Double, Bool) amixerGet :: String -> IO String amixerSetAll = (mapM_ .) . amixerSet 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 ++ "' playback " ++ show (clip v) ++ "%" amixerSetMuteOnlyAll :: Bool -> [String] -> IO () amixerSetMuteOnly :: Bool -> String -> IO String amixerSetMuteOnlyAll = mapM_ . amixerSetMuteOnly amixerSetMuteOnly m s = outputOf $ "amixer set '" ++ s ++ "' playback " ++ (if m then "" else "un") ++ "mute" parseAmixerGetAll :: [String] -> (Double, Bool) parseAmixerGetAll ss = (geomMean vols, mute) where (vols, mutings) = unzip [v | Right p <- map (parse amixerGetParser "") ss, v <- p] mute = or . catMaybes $ mutings amixerGetParser :: Parser [(Double, Maybe Bool)] amixerGetParser = headerLine >> playbackChannels >>= volumes <* eof headerLine :: Parser String playbackChannels :: Parser [String] volumes :: [String] -> Parser [(Double, Maybe Bool)] headerLine = string "Simple mixer control " >> upTo '\n' playbackChannels = keyValueLine >>= \kv -> case kv of ("Playback channels", v) -> return (splitOn " - " v) _ -> playbackChannels volumes channels = fmap concat . many1 $ keyValueLine >>= \kv -> return $ case kv of (k, v) | k `elem` channels -> parseChannel v | otherwise -> [] upTo :: Char -> Parser String keyValueLine :: Parser (String, String) upTo c = many (satisfy (/= c)) <* char c keyValueLine = do string " " key <- upTo ':' value <- upTo '\n' return (key, drop 1 value) parseChannel :: String -> [(Double, Maybe Bool)] channelParser :: Parser [(Double, Maybe Bool)] parseChannel = either (const []) id . parse channelParser "" channelParser = fmap catMaybes (many1 playbackOrCapture) <* eof playbackOrCapture :: Parser (Maybe (Double, Maybe Bool)) playbackOrCapture = do f <- (string "Playback " >> return Just) <|> (string "Capture " >> return (const Nothing)) many1 digit char ' ' es <- extras case filter ('%' `elem`) es of [volume] -> return . f . (,) (read (init volume) :: Double) $ case ("off" `elem` es, "on" `elem` es) of (False, False) -> Nothing (mute, _) -> Just mute _ -> fail "no percentage-volume found in playback section" extras :: Parser [String] extras = sepBy' (char '[' >> upTo ']') (char ' ') sepBy' :: Parser a -> Parser b -> Parser [a] sepBy' p sep = liftM2 (:) p loop where loop = (sep >> (liftM2 (:) p loop <|> return [])) <|> return [] -- | Helper function to output current volume via osd_cat. (Needs the osd_cat executable). -- The second parameter is passed True when the speakers are muted and should -- return the options to pass to osd_cat. osdCat :: MonadIO m => Double -> (Bool -> String) -> m () osdCat vol opts = do m <- getMute spawn $ "osd_cat -b percentage -P " ++ show (truncate vol :: Integer) ++ opts m -- | Default options for displaying the volume. defaultOSDOpts :: Bool -> String defaultOSDOpts mute = "--align=center --pos=top --delay=1 --text=\"Volume" ++ (if mute then "[muted]\" " else "\" ") ++ "--font='-bitstream-bitstream vera sans-bold-r-*-*-10-*-*-*-*-*-*-*' " ++ "--outline=1" -- }}} xmonad-extras-0.12.1/XMonad/Hooks/0000755000000000000000000000000012513255116015025 5ustar0000000000000000xmonad-extras-0.12.1/XMonad/Hooks/PerWindowKbdLayout.hsc0000644000000000000000000001230012513255116021255 0ustar0000000000000000{-# 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: xmonad-extras-0.12.1/XMonad/Util/0000755000000000000000000000000012513255116014657 5ustar0000000000000000xmonad-extras-0.12.1/XMonad/Util/WindowPropertiesRE.hs0000644000000000000000000000404612513255116020772 0ustar0000000000000000{-# 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 xmonad-extras-0.12.1/XMonad/Config/0000755000000000000000000000000012513255116015147 5ustar0000000000000000xmonad-extras-0.12.1/XMonad/Config/Alt.hs0000644000000000000000000000167612513255116016235 0ustar0000000000000000{- | Module : XMonad.Config.Alt Copyright : Adam Vogt License : BSD3-style (see LICENSE) Maintainer : Adam Vogt Stability : unstable Portability : unportable Alternative, more composable config. This means the config can be assembled using pieces that encode: * correct composition when config options don't commute: @a (b conf)@ works, but @b (a (conf)@ is nonsense (ex. respecting layout hints and other layout modifiers). * features that must be enabled once-only * bundling multiple features in a single function: 'Config' captures IO * collect warnings (nothing uses this feature yet) For examples, refer to sources: * "XMonad.Config.Alt.Sample" Implementation * "XMonad.Config.Alt.Internal" -} module XMonad.Config.Alt ( module XMonad.Config.Alt.Desktop, module XMonad.Config.Alt.Internal) where import XMonad.Config.Alt.Internal import XMonad.Config.Alt.Desktop xmonad-extras-0.12.1/XMonad/Config/Alt/0000755000000000000000000000000012513255116015667 5ustar0000000000000000xmonad-extras-0.12.1/XMonad/Config/Alt/QQ.hs0000644000000000000000000000305512513255116016547 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {- | Shorthand. The following are equivalent: > hSucc (hSucc hZero) > [$nat'| 2 |] > $(nat 2) This is probably redundant given "GHC.TypeLits". But for now HList uses it's own 'HNat'. -} module XMonad.Config.Alt.QQ where import Language.Haskell.TH.Quote import Language.Haskell.TH import Data.HList.CommonMain import Data.Char import Text.ParserCombinators.ReadP nat' :: QuasiQuoter nat' = QuasiQuoter { quoteExp = \n -> nat (read n), quotePat = error "XMonad.Config.Alt.QQ.nat'.quotePat: unimplemented", quoteType = \n -> natTy (read n), quoteDec = \s -> case readP_to_S parseDecNat s of [((v,n), "")] -> decNat v n _ -> fail ("XMonad.Config.Alt.QQ.nat.quoteDec cannot parse " ++ show s) } parseDecNat :: ReadP (String, Int) parseDecNat = do skipSpaces v <- munch isAlpha skipSpaces char '=' skipSpaces n <- munch isNumber skipSpaces eof return (v, read n) nat :: Int -> ExpQ nat n = foldr appE [| hZero |] (replicate n [| hSucc |]) natTy :: Int -> TypeQ natTy n = foldr appT [t| HZero |] (replicate n [t| HSucc |]) decNat :: String -> Int -> Q [Dec] decNat t n = do d <- valD (varP (mkName t)) (normalB (nat n)) [] let ty = [t| Proxy $(natTy n) |] s <- sigD (mkName t) ty abbrev <- tySynD (mkName (headToUpper t)) [] ty return [s,d, abbrev] headToUpper (x:xs) = toUpper x : xs headToUpper [] = [] xmonad-extras-0.12.1/XMonad/Config/Alt/Desktop.hs0000644000000000000000000000517212513255116017641 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {- | Module : XMonad.Config.Alt.Desktop Copyright : Adam Vogt License : BSD3-style (see LICENSE) Maintainer : Adam Vogt Stability : unstable Portability : unportable Adapts functionality from some contrib modules -} module XMonad.Config.Alt.Desktop ( -- * "XMonad.Hooks.DynamicLog" dzen, xmobar, statusBar, -- * "XMonad.Hooks.EwmhDesktops" ewmh, -- * "XMonad.Hooks.ManageDocks" avoidStrutsOn, avoidStruts, -- * precedences (apply modifiers in what should be the right order) AvoidStrutsPrec, StatusBarPrec, EwmhPrec, ) where import qualified XMonad as X import qualified XMonad.Hooks.EwmhDesktops as E import qualified XMonad.Hooks.ManageDocks as ManageDocks import qualified XMonad.Hooks.DynamicLog as DynamicLog import XMonad.Config.Alt.Internal import Control.Monad.Trans $(decNat "avoidStrutsPrec" 1) $(decNat "statusBarPrec" 2) $(decNat "ewmhPrec" 6) -- | See 'E.ewmh' ewmh c = ins' ewmhPrec hTrue (liftM E.ewmh) c -- | See 'ManageDocks.avoidStrutsOn' avoidStrutsOn a c = ins' avoidStrutsPrec hTrue ((m (Proxy :: Proxy Modify) LayoutHook (ManageDocks.avoidStrutsOn a)) =<<) c -- | See 'ManageDocks.avoidStruts' avoidStruts c = ins' avoidStrutsPrec hTrue (m (Proxy :: Proxy Modify) LayoutHook ManageDocks.avoidStruts =<<) c -- | See 'DynamicLog.statusBar' -- doesn't set struts statusBar cmd pp k conf = {- avoidStruts . -- doesn't typecheck -} ins' statusBarPrec hTrue (\c -> do c' <- c c'' <- liftIO $ DynamicLog.statusBar cmd pp k c' return $ c'' { X.layoutHook = X.layoutHook c' } ) $ conf toggleStrutsKey c = (X.modMask c, X.xK_b) xmobar conf = statusBar "xmobar" DynamicLog.xmobarPP toggleStrutsKey conf dzen conf = statusBar ("dzen2" ++ flags) DynamicLog.xmobarPP toggleStrutsKey conf where fg = "'#a8a3f7'" -- n.b quoting bg = "'#3f3c6d'" flags = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg xmonad-extras-0.12.1/XMonad/Config/Alt/Internal.hs0000644000000000000000000003617212513255116020010 0ustar0000000000000000{-# LANGUAGE EmptyDataDecls ,ConstraintKinds ,DataKinds ,FlexibleContexts ,FlexibleInstances ,FunctionalDependencies ,GeneralizedNewtypeDeriving ,KindSignatures ,MultiParamTypeClasses ,NoMonomorphismRestriction ,PolyKinds ,ScopedTypeVariables ,TemplateHaskell ,TypeFamilies ,TypeOperators ,TypeSynonymInstances ,UndecidableInstances ,ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fcontext-stack=81 #-} {- | Module : XMonad.Config.Alt.Internal Copyright : Adam Vogt License : BSD3-style (see LICENSE) Maintainer : Adam Vogt Stability : unstable Portability : unportable (7.6 <= ghc <= 7.10) Import "XMonad.Config.Alt". -} module XMonad.Config.Alt.Internal ( module XMonad.Config.Alt.QQ, -- * Running runConfig, runConfig', -- * Actions -- $actions set, add, modify, modifyIO, -- ** less useful insertInto, -- * Fields -- $fields -- ** Special LayoutHook(LayoutHook), -- ** Others FocusFollowsMouse(FocusFollowsMouse), StartupHook(StartupHook), LogHook(LogHook), BorderWidth(BorderWidth), MouseBindings(MouseBindings), Keys(Keys), ModMask(ModMask), Workspaces(Workspaces), HandleEventHook(HandleEventHook), ManageHook(ManageHook), Terminal(Terminal), FocusedBorderColor(FocusedBorderColor), NormalBorderColor(NormalBorderColor), -- * Relatively private -- | You probably don't need these defaultPrec, -- ** Ordered Insertion into HLists like [(Nat,a)] insLt, insGeq, Ins2(..), Ins'(..), ins, -- ** Useful functions HCompose(hComp_), hComp, HSnd(HSnd), HPred', -- ** For overloading Mode(..), ModeAction(..), Config(..), -- test, module Data.HList, ) where import Control.Monad.Writer import Data.Char import Data.HList import Language.Haskell.TH import qualified XMonad as X import XMonad.Config.Alt.Types import XMonad.Config.Alt.QQ {- | Class whose instances are used for 'add' 'set' 'modify' of an 'X.XConfig'@ layout@, which can change the layout type. If we had lenses or other straightforward ways to adjust the entries of 'X.XConfig', this class might be unnecessary. Without it, you would have to manually write out things like: > ins' defaultPrec hFalse (liftM (\c -> c{ layoutHook = avoidStruts (layoutHook c) })) instead of > modify LayoutHook avoidStruts -} class Mode (action :: ModeAction) field e x y | action field e x -> y, action field x y -> e -- action field e y -> x where m :: Proxy action -> field x y -> e -> X.XConfig x -> Config (X.XConfig y) -- | The data type for the first argument of a 'Mode' instance. data ModeAction = Add -- ^ combines the old value like @new `mappend` old@ | Set | Modify | ModifyIO $(decNat "defaultPrec" 4) {- $actions Use 'set', 'add', 'modify', 'modifyIO' for most predefined fields in 'XConfig'. For constructing things to modify a config: > insertInto action hold prec field v * @action@ is an instance of 'Mode' so you only need to write 'ModifyIO' to describe how to access this field. * @hold@ is @proxy :: Proxy True@ if you don't want to overwrite a preexisting value at the same @prec@. This is for things that should be applied once-only. * @field@ used with the 'Mode' * @v@ the value that is being updated (or a function if you use 'Modify' or similar) -} set f v = insertInto defaultPrec hFalse (Proxy :: Proxy Set) f v add f v = insertInto defaultPrec hFalse (Proxy :: Proxy Add) f v modify f v = insertInto defaultPrec hFalse (Proxy :: Proxy Modify) f v modifyIO f v = insertInto defaultPrec hFalse (Proxy :: Proxy ModifyIO) f v insertInto prec hold action field e l = ins' prec hold (m action field e =<<) l -- | Represent setting layouts and layout modifiers data LayoutHook x y = LayoutHook instance Mode ModifyIO LayoutHook (l X.Window -> Config (m X.Window)) l m where m _ _ l c = do l' <- l $ X.layoutHook c return $ c { X.layoutHook = l' } -- | 'Add' means something else for 'X.layoutHook' because there's no suitable -- mempty for the general instance of 'X.LayoutClass' instance (X.LayoutClass l w, X.LayoutClass l' w, w ~ X.Window) => Mode Add LayoutHook (l' w) l (X.Choose l' l) where m _ _ l = \x -> return $ x { X.layoutHook = l X.||| X.layoutHook x } instance (w ~ X.Window, Read (l w), X.LayoutClass l w, Read (l' w), X.LayoutClass l' w) => Mode Modify LayoutHook (l w -> l' w) l l' where m _ _ l = \x -> return $ x { X.layoutHook = l (X.layoutHook x) } instance (X.LayoutClass l' w, w ~ X.Window) => Mode Set LayoutHook (l' w) l l' where m _ _ l = \x -> return $ x { X.layoutHook = l } data HSnd = HSnd instance ab ~ (a,b) => ApplyAB HSnd ab b where applyAB _ (_, b) = b data Id = Id deriving Show -- | The difference between HNats. Clamped to HZero type family HSubtract (a :: HNat) (b :: HNat) :: HNat type instance HSubtract (HSucc a) (HSucc b) = HSubtract a b type instance HSubtract a HZero = a type instance HSubtract HZero b = HZero hSubtract :: Proxy a -> Proxy b -> Proxy (HSubtract a b) hSubtract _ _ = undefined type family MergeEither (x :: Either HNat HNat) :: HNat type instance MergeEither (Left n) = HZero type instance MergeEither (Right n) = n -- | exactly like hPred, but accept HZero too type family HPred' (n :: HNat) :: HNat type instance HPred' (HSucc n) = n type instance HPred' HZero = HZero insLt n hold f l = l `hAppendList` (hReplicate (n `hSubtract` hLength l) (hFalse, Id)) `hAppendList` ((hold,f) `HCons` HNil) -- | to avoid ambiguous types, we use data Id instead of just id, -- and then instead of (.) we have to use this Compose class class Compose f g fog | f g -> fog where compose :: f -> g -> fog instance (b ~ b') => Compose (b -> c) (a -> b') (a -> c) where compose = (.) instance Compose (a -> b) Id (a -> b) where compose f _ = f instance Compose Id (a -> b) (a -> b) where compose _ f = f instance Compose Id Id Id where compose _ f = f instance (RunComposeIf b f g w, Compose w x y) => Compose (ComposeIf b f g) x y where compose bfg x = runComposeIf bfg `compose` x instance (RunComposeIf b f g x, Compose w x y) => Compose w (ComposeIf b f g) y where compose w bfg = w `compose` runComposeIf bfg instance (RunComposeIf b f g x, RunComposeIf b' f' g' w, Compose w x y) => Compose (ComposeIf b' f' g') (ComposeIf b f g) y where compose bfg' bfg = runComposeIf bfg' `compose` runComposeIf bfg class RunComposeIf b f g fg | b f g -> fg where runComposeIf :: ComposeIf b f g -> fg instance Compose f g fg => RunComposeIf True f g fg where runComposeIf (ComposeIf f g) = compose f g instance RunComposeIf False f g g where runComposeIf (ComposeIf _ g) = g data ComposeIf (b :: Bool) f g = ComposeIf f g composeIf :: Proxy b -> f -> g -> ComposeIf b f g composeIf _ = ComposeIf insGeq n a f l = let (b,g) = hLookupByHNat n l h = (hOr b a, composeIf (hNot b) f g) in hUpdateAtHNat n h l hNot :: Proxy b -> Proxy (HNot b) hNot _ = Proxy -- | utility class, so that we can use contexts that may not be satisfied, -- depending on the length of the accumulated list. class Ins2 (b :: Bool) (n :: HNat) (hold :: Bool) f l l' | b n hold f l -> l' ,b n hold f l' -> l ,b hold l l' -> f where ins2 :: Proxy b -> Proxy n -> Proxy hold -> f -> HList l -> HList l' -- | when l needs to be padded with id instance (HAppendList (HAppendListR l1 ids) '[(Proxy hold, t1)], l2 ~ HAppendListR (HAppendListR l1 ids) '[(Proxy hold, t1)], HAppendList l1 ids, HLengthEq l1 b, HReplicateFD (HSubtract n b) id ids, id ~ (Proxy 'False, Id)) => Ins2 True n hold t1 l1 l2 where ins2 _ = insLt -- | when l already has enough elements, just compose. But only add the new -- function when the existing HBool is HFalse instance (HUpdateAtHNat n e l, HLookupByHNat n l, (Proxy (HOr t t1), ComposeIf (HNot t) bc ab) ~ e, HLookupByHNatR n l ~ (Proxy t, ab), HLookupByHNatR n l' ~ e, HUpdateAtHNatR n e l ~ l') => Ins2 False n t1 bc l l' where ins2 _ = insGeq class Ins' (n :: HNat) (hold :: Bool) f l l' | n hold f l -> l' where ins' :: Proxy n -> Proxy hold -> f -> HList l -> HList l' instance ( HLt (HLength l) n ~ b, Ins2 (HLt (HLength l) n) n hold f l l') => Ins' n hold f l l' where ins' = ins2 (undefined :: Proxy b) -- ins' prec hold f l = ins2 ( hLt (hLength l) prec ) prec hold f l {- | @ins n f xs@ inserts at index @n@ the function f, or extends the list @xs@ with 'id' if there are too few elements. This way the precedence is not bounded. -} ins n e = ins' n hFalse (e =<<) {- | like @foldr (.) id@, but for a heteregenous list. This does the other order than hComposeList. To avoid ambiguous types (and allow the FD to be accepted by ghc-7.8) 'Id' is produced instead of 'id'. >>> hComposeList ((+1) .*. (*2) .*. HNil) 2 6 >>> hComp ((+1) .*. (*2) .*. HNil) 2 5 -} class HCompose l f | l -> f where hComp_ :: HList l -> f instance HCompose '[] Id where hComp_ _ = Id instance (Compose bc ab ac, HCompose rs ab) => HCompose (bc ': rs) ac where hComp_ (HCons g r) = g `compose` hComp_ r {- | handles the empty list case: >>> hComp HNil () () >>> hComp_ HNil Id -} hComp fs x = (hComp_ fs `compose` (\y -> y `asTypeOf` x)) x hMapSnd :: (HMapCxt HList HSnd x y, HMapSndR x ~ y) => HList x -> HList y hMapSnd = hMap HSnd -- | without this ghc cannot infer the result type of hMapSnd type family HMapSndR (xs :: [*]) :: [*] type instance HMapSndR ((a,b) ': xs) = b ': HMapSndR xs type instance HMapSndR '[] = '[] runConfig' defConfig x = do let returnConfig = return :: a -> Config a Config c = hComp (hMapSnd (hComp x HNil)) (returnConfig defConfig) (a,w) <- runWriterT c print (w []) return a runConfig x = X.xmonad =<< runConfig' X.defaultConfig x -- * Tests {- data T1 a = T1 a deriving Show data T2 a = T2 a deriving Show data T3 a = T3 a deriving Show data T3a a = T3a a deriving Show data RunMWR = RunMWR instance (Monad m, HCompose l (m () -> Writer w a)) => ApplyAB RunMWR (HList l) (a, w) where -- type ApplyB RunMWR (HList l) = Just ... fundeps and AT's don't really mix -- type ApplyA RunMWR (a,w ) = Nothing applyAB _ x = runWriter $ hComp x (return ()) -} {- should be able to app (HMap (HMap f)) data HHMap a = HHMap a instance HMap f a b => Apply (HHMap f) a b where apply (HHMap f) = hMap f -} {- | Verification that insertions happen in order > (T1 (),"3") > (T2 (T1 ()),"31") > (T2 (T3 (T1 ())),"321") > (T2 (T3a (T3 (T1 ()))),"3221") -- broken. Fixing probably involves nasty type signatures like for set get modify etc. test :: IO () test = sequence_ $ hMapM (HPrint `HComp` RunMWR) $ applyA' (HMap (HMap HSnd)) $ hEnd $ hBuild test1_ test2_ test3_ test3a_ where test1_ = ins (undefined `asTypeOf` hSucc (hSucc (hSucc hZero))) (\x -> tell "3" >> return (T1 x)) HNil test2_ = ins (hSucc hZero) (\x -> tell "1" >> return (T2 x)) test1_ test3_ = ins (hSucc (hSucc hZero)) (\x -> tell "2" >> return (T3 x)) test2_ test3a_ = ins (hSucc (hSucc hZero)) (\x -> tell "2" >> return (T3a x)) test3_ -} {- $fields Generated instances for monomorphic fields in 'X.XConfig' Follows the style of: > data FFM = FFM > instance Mode ModifyIO FFM (Bool -> Config Bool) l l where > m _ _ f c = do > r <- f (X.fFM c) > return $ c { X.fFM = r } And the same for Modify, Set > instance (Fail (Expected String)) => Mode ModifyIO FFM y z w where > instance (Fail (Expected String)) => Mode Modify FFM y z w where > instance (Fail (Expected String)) => Mode Set FFM y z w where The last set of overlapping instances exist to help type inference here: > :t m ModifyIO NormalBorderColor > m ModifyIO NormalBorderColor > :: (String -> Config String) -> XConfig x -> Config (XConfig x) Otherwise it would just give you: > m ModifyIO NormalBorderColor > :: Mode ModifyIO NormalBorderColor e x y => > e -> XConfig x -> Config (XConfig y) Which doesn't really matter overall since @x@ ends up fixed when you try to run the config. -} -- | Improve error messages maybe. data Expected a $(fmap concat $ sequence [ do -- do better by using quoted names in the first place? let accessor = "X." ++ (case nameBase d of x:xs -> toLower x:xs _ -> []) acc = mkName accessor VarI _ (ForallT _ _ (_ `AppT` (return -> ty))) _ _ <- reify acc l <- fmap varT $ newName "l" let mkId action tyIn body = instanceD (return []) [t| $(conT ''Mode) $(promotedT action) $(conT d) $(tyIn) $l $l |] [funD 'm [clause [wildP,wildP] (normalB body ) [] ] ] `const` (action, tyIn) -- suppress unused var warning let fallback act = instanceD (sequence [classP ''Fail [[t| Expected $ty |]]]) [t| $(conT ''Mode) $act $(conT d) $(varT =<< newName "x") $l $l |] [funD 'm [clause [] (normalB [| error "impossible to satisfy" |]) [] ]] `const` act -- suppress unused var warning xyTyVarBinders = [v "x", v "y"] where v x = KindedTV (mkName x) (ArrowT `AppT` StarT `AppT` StarT) sequence $ [dataD (return []) d xyTyVarBinders [normalC d []] [] ,mkId 'ModifyIO [t| $ty -> Config $ty |] [| \f c -> do r <- f ($(varE acc) c) return $(recUpdE [| c |] [fmap (\r' -> (acc,r')) [| r |]]) |] ,mkId 'Modify [t| $ty -> $ty |] [| \f c -> do r <- return $ f ($(varE acc) c) return $(recUpdE [| c |] [fmap (\r' -> (acc,r')) [| r |]]) |] ,mkId 'Set [t| $ty |] [| \f c -> do return $(recUpdE [| c |] [fmap ((,) acc) [| f |]]) |] ] | d <- map mkName -- fields in XConf -- XXX make these ' versions so we can be hygenic ["NormalBorderColor", "FocusedBorderColor", "Terminal", -- "LayoutHook", -- types $l and $l change with updates "ManageHook", "HandleEventHook", "Workspaces", "ModMask", "Keys", "MouseBindings", "BorderWidth", "LogHook", "StartupHook", "FocusFollowsMouse"] ] ) xmonad-extras-0.12.1/XMonad/Config/Alt/Sample1.hs0000644000000000000000000000232612513255116017530 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fcontext-stack=81 #-} module XMonad.Config.Alt.Sample1 where import XMonad.Config.Alt as C import XMonad import qualified XMonad.Hooks.ManageDocks import qualified XMonad.Hooks.DynamicLog ex1 = runConfig $ hBuild (C.modify Workspaces (++["lol","hi"])) (C.set ModMask mod4Mask) (C.set LayoutHook Full) (C.modify LayoutHook XMonad.Hooks.ManageDocks.avoidStruts) ex2 = runConfig ex2' ex2' = hEnd $ hBuild (C.statusBar "xmobar" XMonad.Hooks.DynamicLog.xmobarPP (\c -> (modMask c, xK_b))) (C.add LayoutHook Full) -- if this goes below the set, then you get -- ex2'' :: IO (XConfig (ModifiedLayout AvoidStruts Tall)) -- -- instead of -- -- ex2'' :: IO (XConfig (ModifiedLayout AvoidStruts (Choose Full Tall)) (C.set LayoutHook (Tall 2 0.5 0.02)) (C.avoidStruts) -- doesn't matter where this one goes (C.set LayoutHook (Tall 2 0.5 0.02)) (C.set LayoutHook (Tall 2 0.5 0.02)) ex2'' = runConfig' defaultConfig ex2' xmonad-extras-0.12.1/XMonad/Config/Alt/Types.hs0000644000000000000000000000076312513255116017335 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Types defined here to avoid template haskell stage restrictions module XMonad.Config.Alt.Types where import XMonad import Control.Monad.Writer import Control.Applicative -- TH stage restriction otherwise data Mode_ = Add_ | Modify_ | ModifyIO_ | Set_ type Warnings = [String] -> [String] newtype Config a = Config (WriterT Warnings IO a) deriving (Monad, Applicative, Functor, MonadIO, MonadWriter Warnings) xmonad-extras-0.12.1/XMonad/Prompt/0000755000000000000000000000000012513255116015223 5ustar0000000000000000xmonad-extras-0.12.1/XMonad/Prompt/MPD.hs0000644000000000000000000001122712513255116016202 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.MPD -- Copyright : Daniel Schoepe -- License : BSD3-style (see LICENSE) -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- This module lets the user select songs and have MPD add/play them by -- filtering them by user-supplied criteria(E.g. ask for an artist, then for -- the album..) -- ----------------------------------------------------------------------------- module XMonad.Prompt.MPD (-- * Usage -- $usage findMatching ,addMatching ,addAndPlay ,RunMPD ,findOrAdd ) where import Control.Monad import qualified Data.ByteString as B import Data.Char import qualified Data.Map as M import Data.Maybe import Network.MPD import XMonad import XMonad.Prompt import Data.List as L (nub,isPrefixOf,find) -- $usage -- -- To use this, import the following modules: -- -- > import XMonad.Prompt.MPD -- > import qualified Network.MPD as MPD -- -- You can then use this in a keybinding, to filter first by artist, then by -- album and add the matching songs: -- -- > addMatching MPD.withMPD defaultXPConfig [MPD.Artist, MPD.Album] >> return () -- -- That way you will first be asked for an artist name, then for an album by -- that artist etc.. -- -- If you need a password to connect to your MPD or need a different host/port, -- you can pass a partially applied withMPDEx to the function: -- -- > addMatching (MPD.withMPDEx "your.host" 4242 "very secret") .. -- -- | Allows the user to supply a custom way to connect to MPD (e.g. partially -- applied withMPDEx). type RunMPD = forall a . MPD a -> IO (Response a) -- | A new prompt type since Prompt.Input causes problems when completing -- strings with spaces in them data MPDPrompt = MPDPrompt String instance XPrompt MPDPrompt where showXPrompt (MPDPrompt s) = s ++ ": " nextCompletion = const getNextCompletion commandToComplete = const id -- | Extracts the given metadata attribute from a Song extractMetadata :: Metadata -> Song -> String extractMetadata meta = fromMaybe "Unknown" . join . fmap listToMaybe . M.lookup meta . M.map (map toString) . sgTags -- | Creates a case-insensitive completion function from a list. mkComplLst :: [String] -> String -> IO [String] mkComplLst lst s = return . filter isPrefix' $ lst where isPrefix' s' = map toLower s `isPrefixOf` map toLower s' -- | Helper function for 'findMatching' findMatching' :: XPConfig -> [Song] -> Metadata -> X [Song] findMatching' _ [] _ = return [] findMatching' xp songs meta = do answer <- mkXPromptWithReturn (MPDPrompt (show meta)) xp (mkComplLst . nub . map (extractMetadata meta) $ songs) return case answer of Just input -> return $ filter ((==input) . extractMetadata meta) songs Nothing -> return [] extractSongs :: [LsResult] -> [Song] extractSongs = mapMaybe extractSong where extractSong (LsSong s) = Just s extractSong _ = Nothing -- | Lets the user filter out non-matching songs. For example, if given -- [Artist, Album] as third argument, this will prompt the user for an -- artist(with tab-completion), then for an album by that artist and then -- returns the songs from that album. findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song] findMatching runMPD xp metas = do resp <- io . runMPD . fmap extractSongs . listAllInfo $ Path B.empty case resp of Left err -> trace ("XMonad.Prompt.MPD: MPD returned an error: " ++ show err) >> return [] Right songs -> foldM (findMatching' xp) 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 L.find ((== sgFilePath s) . sgFilePath) pl of Just (Song { sgIndex = Just i }) -> return i _ -> fmap unwrapId . flip addId Nothing . sgFilePath $ s where unwrapId (Id i) = i -- | Add all selected songs to the playlist if they are not in it. addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int] addMatching runMPD xp metas = do matches <- findMatching runMPD xp metas fmap (either (const []) id) . io . runMPD . mapM findOrAdd $ matches -- | Add matching songs and play the first one. addAndPlay :: RunMPD -> XPConfig -> [Metadata] -> X () addAndPlay runMPD xp ms = do ids <- addMatching runMPD xp ms whenJust (listToMaybe ids) ((>> return ()) . io . runMPD . playId . Id) xmonad-extras-0.12.1/XMonad/Prompt/Eval.hs0000644000000000000000000000501012513255116016442 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Eval -- Copyright : Daniel Schoepe -- License : BSD3 -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- A prompt for evaluating Haskell expressions(in the context of the running -- xmonad instance). -- ----------------------------------------------------------------------------- module XMonad.Prompt.Eval ( -- * Usage -- $usage evalPrompt ,evalPromptWithOutput ,showWithDzen ) where import XMonad import XMonad.Prompt import XMonad.Actions.Eval import XMonad.Util.Dzen -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Eval -- -- in your keybindings add: -- -- > , ((modMask x .|. controlMask, xK_x), evalPrompt defaultEvalConfig) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data EvalPrompt = EvalPrompt instance XPrompt EvalPrompt where showXPrompt EvalPrompt = "Eval: " -- | A prompt that evaluates the entered Haskell expression, whose type has -- to be an instance of Show. evalPrompt :: EvalConfig -> XPConfig -> X () evalPrompt evc c = evalPromptWithOutput evc c (const $ return ()) -- | The same as 'evalPrompt', but lets the user supply a function to be -- executed on the returned string, which is produced by applying show -- to the executed expression. (This is a crude solution, but the returned -- type has to be monomorphic) evalPromptWithOutput :: EvalConfig -> XPConfig -> (String -> X ()) -> X () evalPromptWithOutput evc c f = flip whenJust f =<< mkXPromptWithReturn EvalPrompt c (const $ return []) (evalExpressionWithReturn evc) -- | A nice default to have the result of an expression displayed by dzen, -- if it's interesting (i.e. not () or an empty string). -- The first parameter specifies the display time in microseconds, the second parameter -- allows to pass additional options to dzen. showWithDzen :: Int -> [String] -> String -> X () showWithDzen t args "Error" = dzenWithArgs "Error" (["-bg","#ff0000","-fg","#000000"]++args) t showWithDzen t args s | s `elem` ["","()"] = return () | otherwise = dzenWithArgs s (["-bg","#00c600","-fg","#000000"]++args) t