Difference between revisions of "Xmonad/Config archive/adamvo's xmonad.hs"
< Xmonad | Config archive
Jump to navigation
Jump to search
(update) |
(updates for gridselect changes) |
||
(17 intermediate revisions by the same user not shown) | |||
Line 1: | Line 1: | ||
+ | [[Category:XMonad configuration]] |
||
− | <haskell> |
||
+ | [[../adamvo's xmobarrc]] (0.9.2) |
||
− | {-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-} |
||
− | {-# LANGUAGE NoMonomorphismRestriction, ImplicitParams #-} |
||
− | module Main where |
||
+ | [[../obtoxmd]] -- script called to temporarily run another wm |
||
− | import XMonad |
||
− | import qualified XMonad.StackSet as W |
||
− | import qualified Data.Map as M |
||
+ | <haskell> |
||
− | -- Update these with: ghc -ddump-minimal-imports |
||
+ | -- current darcs as of 2010-12-31 |
||
− | import Control.Applicative((<*), liftA2) |
||
+ | {-# LANGUAGE |
||
− | import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), (=<<), mapM, sequence, zipWithM_) |
||
+ | DeriveDataTypeable, |
||
− | import Data.List((++), zip, map, concatMap, repeat, zipWith, nub, isPrefixOf, intercalate, isInfixOf) |
||
+ | FlexibleContexts, |
||
− | import Data.Map(fromList) |
||
+ | FlexibleInstances, |
||
− | import Data.Maybe(catMaybes,fromMaybe) |
||
+ | MultiParamTypeClasses, |
||
− | import Graphics.X11.ExtraTypes.XF86(xF86XK_AudioLowerVolume, xF86XK_AudioMute, xF86XK_AudioNext, xF86XK_AudioPlay, xF86XK_AudioPrev, xF86XK_AudioRaiseVolume, xF86XK_AudioStop, xF86XK_Sleep) |
||
+ | NoMonomorphismRestriction, |
||
− | import Graphics.X11.Xinerama(getScreenInfo) |
||
+ | PatternGuards, |
||
− | import System.IO(IO, Handle, hPutStrLn) |
||
+ | ScopedTypeVariables, |
||
+ | TypeSynonymInstances, |
||
+ | UndecidableInstances |
||
+ | #-} |
||
+ | {-# OPTIONS_GHC -W -fwarn-unused-imports -fno-warn-missing-signatures #-} |
||
+ | import Control.Applicative |
||
− | import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..), moveTo) |
||
+ | import Control.Monad |
||
− | import XMonad.Actions.DwmPromote(dwmpromote) |
||
+ | import Control.Monad.Instances () |
||
− | import XMonad.Actions.FloatSnap(Direction(..), snapGrow, snapMove, snapShrink) |
||
+ | import Control.Monad.Writer |
||
− | import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected) |
||
+ | import Data.List |
||
− | import XMonad.Actions.RandomBackground(randomBg', RandomColor(HSV)) |
||
+ | import Data.Maybe |
||
− | import XMonad.Actions.Search(mathworld, wikipedia, multi, promptSearch) |
||
+ | import Data.Traversable(traverse) |
||
− | import XMonad.Actions.SpawnOn(mkSpawner, spawnOn, manageSpawn, shellPromptHere, spawnHere) |
||
− | import |
+ | import Graphics.X11.Xinerama |
+ | import qualified Data.Map as M |
||
− | import XMonad.Actions.TopicSpace(TopicConfig(..), Topic, (>*>), checkTopicConfig, currentTopicAction, currentTopicDir, pprWindowSet, shiftNthLastFocused, switchNthLastFocused, switchTopic) |
||
+ | import qualified XMonad.StackSet as W |
||
− | import XMonad.Actions.UpdatePointer(PointerPosition(TowardsCentre), updatePointer) |
||
+ | import qualified XMonad.Util.ExtensibleState as XS |
||
− | import XMonad.Hooks.DynamicLog(PP(ppUrgent, ppTitle, ppLayout, ppVisible, ppHidden, ppCurrent, ppSep), dynamicLogString, defaultPP, xmobarColor, wrap) |
||
+ | import System.IO |
||
− | import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook, ewmhDesktopsLogHook) |
||
+ | import XMonad |
||
− | import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts), avoidStruts, manageDocks) |
||
− | import XMonad. |
+ | import XMonad.Actions.DwmPromote |
− | import XMonad. |
+ | import XMonad.Actions.FloatSnap |
− | import XMonad. |
+ | import XMonad.Actions.GridSelect |
− | import XMonad. |
+ | import XMonad.Actions.Search |
− | import XMonad. |
+ | import XMonad.Actions.SpawnOn |
− | import XMonad. |
+ | import XMonad.Actions.Submap |
− | import XMonad. |
+ | import XMonad.Actions.TopicSpace |
+ | import XMonad.Actions.UpdatePointer |
||
+ | import XMonad.Actions.Warp |
||
+ | import XMonad.Hooks.DynamicLog |
||
+ | import XMonad.Hooks.EwmhDesktops |
||
+ | import XMonad.Hooks.ManageDocks |
||
+ | import XMonad.Hooks.ManageHelpers |
||
+ | import XMonad.Hooks.UrgencyHook |
||
+ | import XMonad.Layout.BoringWindows |
||
+ | import XMonad.Layout.Drawer |
||
+ | import XMonad.Layout.Grid |
||
+ | import XMonad.Layout.IM |
||
+ | import XMonad.Layout.LayoutHints |
||
+ | import XMonad.Layout.LayoutModifier |
||
+ | import XMonad.Layout.Magnifier |
||
+ | import XMonad.Layout.Master |
||
+ | import XMonad.Layout.Mosaic |
||
+ | import XMonad.Layout.MosaicAlt |
||
+ | import XMonad.Layout.MouseResizableTile |
||
+ | import XMonad.Layout.Named |
||
+ | import XMonad.Layout.NoBorders |
||
+ | import XMonad.Layout.PerWorkspace |
||
+ | import XMonad.Layout.Simplest |
||
+ | import XMonad.Layout.SimplestFloat |
||
import XMonad.Layout.SubLayouts |
import XMonad.Layout.SubLayouts |
||
− | import XMonad.Layout.Tabbed |
+ | import XMonad.Layout.Tabbed |
− | import XMonad.Layout. |
+ | import XMonad.Layout.TrackFloating |
+ | import XMonad.Layout.WindowNavigation |
||
− | import XMonad.Prompt(XPConfig(font), XPrompt(showXPrompt), greenXPConfig, mkXPrompt) |
||
− | import XMonad.Prompt |
+ | import XMonad.Prompt |
− | import XMonad.Prompt. |
+ | import XMonad.Prompt.RunOrRaise |
− | import XMonad.Prompt. |
+ | import XMonad.Prompt.Ssh |
− | import XMonad.Prompt. |
+ | import XMonad.Prompt.Window |
− | import XMonad.Prompt.XMonad |
+ | import XMonad.Prompt.XMonad |
− | import XMonad.Util.EZConfig |
+ | import XMonad.Util.EZConfig |
− | import XMonad.Util. |
+ | import XMonad.Util.Replace |
− | import XMonad.Util. |
+ | import XMonad.Util.Run |
+ | |||
main :: IO () |
main :: IO () |
||
main = do |
main = do |
||
+ | replace |
||
− | spawner <- mkSpawner |
||
− | let ?spawner = spawner |
||
checkTopicConfig myTopics myTopicConfig |
checkTopicConfig myTopics myTopicConfig |
||
+ | let urgency |
||
− | xmonad . withUrgencyHook FocusHook . myConfig =<< mapM xmobarScreen =<< getScreens |
||
+ | | True = withUrgencyHook FocusHook |
||
+ | | True = withUrgencyHook NoUrgencyHook |
||
+ | xmonad . ewmh . urgency . myConfig |
||
+ | =<< mapM xmobarScreen =<< getScreens |
||
+ | |||
+ | sofficeToolbox = className =? "OpenOffice.org 3.1" |
||
+ | <&&> isInProperty "WM_PROTOCOLS" "WM_TAKE_FOCUS" |
||
myConfig hs = let c = defaultConfig { |
myConfig hs = let c = defaultConfig { |
||
layoutHook = myLayout |
layoutHook = myLayout |
||
− | , |
+ | , focusFollowsMouse = False |
+ | , focusedBorderColor = "red" |
||
+ | , startupHook = do |
||
+ | return () -- supposedly to avoid inf. loops with checkKeymap |
||
+ | checkKeymap (myConfig []) (myKeys c) |
||
, terminal = "urxvt" |
, terminal = "urxvt" |
||
, modMask = mod4Mask |
, modMask = mod4Mask |
||
, logHook = do |
, logHook = do |
||
− | ewmhDesktopsLogHook |
||
multiPP' |
multiPP' |
||
− | (mergePPOutputs [pprWindowSet myTopicConfig, |
+ | (mergePPOutputs [XMonad.Actions.TopicSpace.pprWindowSet myTopicConfig, |
+ | dynamicLogString . onlyTitle]) |
||
myPP |
myPP |
||
− | myPP |
+ | myPP{ ppTitle = const "" } |
hs |
hs |
||
updatePointer (TowardsCentre 0.2 0.2) |
updatePointer (TowardsCentre 0.2 0.2) |
||
− | , handleEventHook = ewmhDesktopsEventHook |
+ | , handleEventHook = ewmhDesktopsEventHook <+> fullscreenEventHook <+> focusFollow <+> |
+ | (\e -> case e of |
||
+ | PropertyEvent{ ev_window = w } -> do |
||
+ | isURXVT <- runQuery (className =? "URxvt") w |
||
+ | if not isURXVT then hintsEventHook e else return (All True) |
||
+ | _ -> return (All True)) |
||
, workspaces = myTopics |
, workspaces = myTopics |
||
+ | , manageHook = mconcat |
||
− | , manageHook = fmap ("Gran Paradiso" `isInfixOf`) className --> doShift "web" <+> manageSpawn ?spawner <+> manageDocks |
||
+ | [manageSpawn |
||
− | } in additionalKeys c (myKeys c) |
||
+ | ,isFullscreen --> doFullFloat |
||
+ | -- ,className =? "MPlayer" --> doFullFloat |
||
+ | ,className =? "XTerm" --> queryMerge (className =? "XTerm") |
||
+ | ,manageDocks |
||
+ | ] |
||
+ | } in additionalKeysP c (myKeys c) |
||
myXPConfig :: XPConfig |
myXPConfig :: XPConfig |
||
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" } |
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" } |
||
+ | |||
+ | gsConfig = defaultGSConfig { gs_navigate = fix $ \self -> |
||
+ | let navKeyMap = M.mapKeys ((,) 0) $ M.fromList $ |
||
+ | [(xK_Escape, cancel) |
||
+ | ,(xK_Return, select) |
||
+ | ,(xK_slash , substringSearch self)] |
||
+ | ++ |
||
+ | map (\(k,a) -> (k,a >> self)) |
||
+ | [(xK_Left , move (-1,0 )) |
||
+ | ,(xK_h , move (-1,0 )) |
||
+ | ,(xK_n , move (-1,0 )) |
||
+ | ,(xK_Right , move (1,0 )) |
||
+ | ,(xK_l , move (1,0 )) |
||
+ | ,(xK_i , move (1,0 )) |
||
+ | ,(xK_Down , move (0,1 )) |
||
+ | ,(xK_j , move (0,1 )) |
||
+ | ,(xK_e , move (0,1 )) |
||
+ | ,(xK_Up , move (0,-1 )) |
||
+ | ,(xK_u , move (0,-1 )) |
||
+ | ,(xK_y , move (-1,-1)) |
||
+ | ,(xK_m , move (1,-1 )) |
||
+ | ,(xK_space , setPos (0,0)) |
||
+ | ] |
||
+ | in makeXEventhandler $ shadowWithKeymap navKeyMap (const self) } |
||
+ | |||
+ | data ExpandEdges a = ExpandEdges Int deriving (Read,Show) |
||
+ | |||
+ | instance LayoutModifier ExpandEdges Window where |
||
+ | modifyLayout (ExpandEdges n) ws (Rectangle x y w h) = let |
||
+ | bigRect = Rectangle (x - fromIntegral n) (y - fromIntegral n) |
||
+ | (w + 2*fromIntegral n) (h + 2*fromIntegral n) |
||
+ | in |
||
+ | runLayout ws bigRect |
||
+ | |||
+ | -- | push edges off-screen |
||
+ | expandEdges n layout = ModifiedLayout (ExpandEdges n) layout |
||
+ | |||
+ | |||
-------------------- Layout ---------------------------------- |
-------------------- Layout ---------------------------------- |
||
+ | myLayout = |
||
− | myLayout = avoidStruts $ named "M" m ||| named "F" (noBorders Full) |
||
+ | trackFloating . smartBorders |
||
− | where m = lessBorders Screen |
||
+ | . onWorkspace "movie" (magnifier m ||| layoutHints Full) |
||
− | $ addTabs shrinkText defaultTheme |
||
+ | . avoidStruts |
||
− | $ configurableNavigation (navigateColor "#ffff00") |
||
+ | . onWorkspace "test" (multimastered 2 (1/100) (1/2) Grid) |
||
− | $ boringAuto |
||
− | + | . onWorkspace "gimp" (named "G" gimp) |
|
+ | . onWorkspace "xm-conf" ((nav $ ModifiedLayout (ExpandEdges 1) (Tall 1 0.3 0.5)) ||| Full) |
||
− | $ layoutHintsToCenter |
||
− | + | $ m ||| named "F" (noBorders Full) |
|
+ | where nav = configurableNavigation (navigateColor "#ffff00") |
||
+ | m = named "M" |
||
+ | . lessBorders Screen |
||
+ | . layoutHintsToCenter |
||
+ | . addTabs shrinkText defaultTheme |
||
+ | . nav |
||
+ | . boringAuto |
||
+ | . subLayout [] (Simplest ||| simplestFloat) |
||
+ | $ mosaic 1.5 [7,5,2] |
||
+ | gimp = nav |
||
+ | . onLeft (simpleDrawer 0.01 0.3 $ Role "gimp-toolbox") |
||
+ | . withIM 0.15 (Role "gimp-dock") |
||
+ | . addTabs shrinkText defaultTheme |
||
+ | . nav |
||
+ | . boringAuto |
||
+ | . subLayout [] Simplest |
||
+ | $ mouseResizableTile ||| Full |
||
-------------------------------------------------------------- |
-------------------------------------------------------------- |
||
− | |||
-------------------- Keys ------------------------------------ |
-------------------- Keys ------------------------------------ |
||
− | myKeys c |
+ | myKeys c = |
− | [ |
+ | [("M-<Left>" , withFocused $ snapMove L Nothing ) |
− | , |
+ | ,("M-<Right>" , withFocused $ snapMove R Nothing ) |
− | , |
+ | ,("M-<Up>" , withFocused $ snapMove U Nothing ) |
− | , |
+ | ,("M-<Down>" , withFocused $ snapMove D Nothing ) |
− | , |
+ | ,("M-S-<Left>" , withFocused $ snapShrink R Nothing) |
− | , |
+ | ,("M-S-<Right>", withFocused $ snapGrow R Nothing) |
− | , |
+ | ,("M-S-<Up>" , withFocused $ snapShrink D Nothing) |
− | , |
+ | ,("M-S-<Down>" , withFocused $ snapGrow D Nothing) |
+ | |||
+ | , ("M-l", withFocused (sendMessage . expandWindowAlt) >> sendMessage Expand) |
||
+ | , ("M-h", withFocused (sendMessage . shrinkWindowAlt) >> sendMessage Shrink) |
||
+ | |||
+ | ,("M-;", withFocused (sendMessage . tallWindowAlt) >> sendMessage Taller) |
||
+ | ,("M-o", withFocused (sendMessage . wideWindowAlt) >> sendMessage Wider ) |
||
+ | |||
+ | ,("M-v", toggleFF) |
||
+ | ,("M-S-b", restart "/home/aavogt/bin/obtoxmd" True) |
||
− | ,((modm .|. controlMask, xK_o), withFocused $ sendMessage . UnMerge) |
||
+ | ,("M-S-d", restart "urxvt -e xmonad" False) |
||
− | ,((modm .|. shiftMask .|. controlMask, xK_o), withFocused $ sendMessage . UnMergeAll) |
||
− | ,((modm .|. controlMask, xK_m), withFocused $ sendMessage . MergeAll) |
||
− | ,((modm .|. controlMask, xK_period), onGroup W.focusDown') |
||
− | ,((modm .|. controlMask, xK_comma), onGroup W.focusUp') |
||
− | ,( |
+ | ,("M-S-o" , withFocused $ sendMessage . UnMerge ) |
− | ,( |
+ | ,("M-S-C-o", withFocused $ sendMessage . UnMergeAll) |
+ | ,("M-C-m" , withFocused $ sendMessage . MergeAll ) |
||
+ | ,("M-C-." , onGroup W.focusDown') |
||
+ | ,("M-C-," , onGroup W.focusUp' ) |
||
− | ,( |
+ | ,("M-p", shellPromptHere myXPConfig) |
− | ,( |
+ | ,("M-x", submap $ M.fromList subMaps) |
+ | ,("M-g", submap $ defaultSublMap c ) |
||
+ | ,("M-S-.", focusDown) |
||
− | ,((modm, xK_period), moveTo Next NonEmptyWS) |
||
− | ,( |
+ | ,("M-S-,", focusUp ) |
− | ,((modm .|. shiftMask, xK_period), focusDown) |
||
− | ,((modm .|. shiftMask, xK_comma ), focusUp) |
||
− | ,( |
+ | ,("M-S-a", currentTopicAction myTopicConfig) |
− | ,( |
+ | ,("M-a", warpToCentre >> goToSelected gsConfig) |
+ | -- workaround |
||
− | ,((modm, xK_Tab), switchNthLastFocused myTopicConfig 1) |
||
+ | ,("M-<Tab>", switchNthLastFocused myTopicConfig . succ . length . W.visible . windowset =<< get ) |
||
− | ,((modm, xK_g), promptedGoto) |
||
− | ,((modm .|. shiftMask, xK_g), promptedShift) |
||
+ | ,("M-s" , warpToCentre >> promptedGoto ) |
||
− | ,((modm, xK_Return), dwmpromote) |
||
+ | ,("M-S-s", warpToCentre >> promptedShift) |
||
− | ,((modm .|. shiftMask, xK_Return), spawnShell) |
||
− | ,((modm, xK_q), spawn "~/.xmonad/xmonad-recomp.lhs && xmonad --restart") |
||
− | ,((modm .|. shiftMask, xK_q), spawn "~/wip/x11-wm/xmonad/rebuild.sh") |
||
− | ,((0, xK_Print), spawn "scrot") |
||
+ | ,("M-b", sendMessage ToggleStruts) |
||
+ | ,("M-<Return>", dwmpromote) |
||
+ | ,("M-S-<Return>", spawnShell) |
||
+ | -- don't force a recompile, if nothing has changed (xmonad --recompile runs XMonad.recompile True) |
||
+ | ,("M-q", spawn "ghc -e ':m +XMonad Control.Monad System.Exit' -e 'flip unless exitFailure =<< recompile False' && xmonad --restart") |
||
+ | ,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh") |
||
+ | ,("<Print>", spawn "scrot") |
||
] |
] |
||
++ |
++ |
||
− | concatMap (\(m,f) -> lrud ( |
+ | concatMap (\(m,f) -> lrud ("M-"++m) f) |
− | [( |
+ | [("S-" , sendMessage . Swap) |
− | ,( |
+ | ,("C-" , sendMessage . pullGroup) |
− | ,( |
+ | ,("S-C-", sendMessage . pushWindow) |
− | ,( |
+ | ,("" , sendMessage . Go)] |
− | ] |
||
++ mediaKeys ++ |
++ mediaKeys ++ |
||
− | [( |
+ | [("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f)) |
− | (f, m) <- [(W.view, |
+ | | (f, m) <- [(W.view, ""), (W.shift, "S-")] |
− | (key, sc) <- zip |
+ | , (key, sc) <- zip "wf" [0 .. ]] |
++ |
++ |
||
− | [ ( |
+ | [ ("M-"++m++[k], a i) |
− | | (a, m) <- [(switchNthLastFocused myTopicConfig, |
+ | | (a, m) <- [(switchNthLastFocused myTopicConfig,""),(shiftNthLastFocused, "S-")] |
− | , (i, k) <- zip [1..] |
+ | , (i, k) <- zip [1..] "123456789"] |
-- helper for windowNavigation keys |
-- helper for windowNavigation keys |
||
-- note: with colemak neiu are placed where jkli are with qwerty layout |
-- note: with colemak neiu are placed where jkli are with qwerty layout |
||
− | lrud :: |
+ | lrud :: String -> (Direction2D -> b) -> [(String, b)] |
lrud m cmd = zip ks cmds |
lrud m cmd = zip ks cmds |
||
where |
where |
||
− | ks = |
+ | ks = map (\x -> m ++ [x]) "niue" |
cmds = zipWith ($) (repeat cmd) [L,R,U,D] |
cmds = zipWith ($) (repeat cmd) [L,R,U,D] |
||
subMaps = [((0, xK_o), runOrRaisePrompt myXPConfig), |
subMaps = [((0, xK_o), runOrRaisePrompt myXPConfig), |
||
− | ((0, xK_p), shellPromptHere |
+ | ((0, xK_p), shellPromptHere myXPConfig), |
((0, xK_x), xmonadPrompt myXPConfig), |
((0, xK_x), xmonadPrompt myXPConfig), |
||
((0, xK_z), sshPrompt myXPConfig), |
((0, xK_z), sshPrompt myXPConfig), |
||
Line 166: | Line 275: | ||
((0, xK_f), withFocused $ windows . W.sink), |
((0, xK_f), withFocused $ windows . W.sink), |
||
((0, xK_v), refresh), |
((0, xK_v), refresh), |
||
− | ((0, xK_c), asks config >>= spawnHere |
+ | ((0, xK_c), asks config >>= spawnHere . terminal), |
((0, xK_k), kill) |
((0, xK_k), kill) |
||
] |
] |
||
+ | |||
− | mediaKeys = [((0, xF86XK_AudioPlay), mpcAct "toggle"), |
||
+ | amarok = False |
||
− | ((0, xF86XK_AudioStop), hostPrompt), |
||
+ | |||
− | ((0, xF86XK_AudioNext), mpcAct "next"), |
||
+ | mediaKeys = [("<XF86AudioPlay>", do mpcAct "toggle"; when amarok $ spawn "amarok -t"), |
||
− | ((0, xF86XK_AudioPrev), mpcAct "prev"), |
||
− | ( |
+ | ("<XF86AudioStop>", promptHost), |
− | ( |
+ | ("<XF86AudioNext>", do mpcAct "next"; when amarok $ spawn "amarok -f"), |
− | ( |
+ | ("<XF86AudioPrev>", do mpcAct "prev"; when amarok $ spawn "amarok -r"), |
− | ( |
+ | ("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"), |
− | ( |
+ | ("<XF86AudioLowerVolume>", spawn "amixer sset PCM 1-"), |
− | ( |
+ | ("<XF86AudioRaiseVolume>", spawn "amixer sset PCM 1+"), |
− | ( |
+ | ("<XF86Sleep>", spawn "sudo pm-suspend") |
+ | ] |
||
where mpcAct c = do |
where mpcAct c = do |
||
− | h <- |
+ | h <- XS.gets hostPrompt |
− | spawn $ unwords ["export MPD_HOST="++ |
+ | spawn $ unwords ["export MPD_HOST="++h,";","mpc",c] |
+ | -- Prompt for mpd host |
||
− | mpdHost = "XMONAD_MPD_HOST" |
||
+ | newtype HostPrompt = HostPrompt { hostPrompt :: String } deriving (Read,Show,Typeable) |
||
+ | instance ExtensionClass HostPrompt where |
||
+ | initialValue = HostPrompt "/home/aavogt/.mpd/socket" |
||
+ | extensionType = PersistentExtension |
||
− | -- Prompt for host |
||
− | data HostPrompt = HostPrompt |
||
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: " |
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: " |
||
− | + | promptHost = mkXPrompt (HostPrompt "") myXPConfig (return . compl) (XS.put . HostPrompt) |
|
− | where compl s = nub $ filter (s `isPrefixOf`) [" |
+ | where compl s = nub $ filter (s `isPrefixOf`) ["127.0.0.1","dell"] |
− | f x = withDisplay $ \d -> setStringProp d mpdHost x |
||
-------------------------------------------------------------- |
-------------------------------------------------------------- |
||
+ | |||
+ | warpToCentre = gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x 0.5 0.5 |
||
-------------------- Support for per-screen xmobars --------- |
-------------------- Support for per-screen xmobars --------- |
||
Line 201: | Line 314: | ||
where f = fmap (zipWith const [0..]) . getScreenInfo |
where f = fmap (zipWith const [0..]) . getScreenInfo |
||
− | + | multiPP :: PP -- ^ The PP to use if the screen is focused |
|
− | + | -> PP -- ^ The PP to use otherwise |
|
+ | -> [Handle] -- ^ Handles for the status bars, in order of increasing X |
||
− | -- second PP. |
||
+ | -- screen number |
||
− | multiPP :: PP -> PP -> [Handle] -> X () |
||
+ | -> X () |
||
multiPP = multiPP' dynamicLogString |
multiPP = multiPP' dynamicLogString |
||
Line 210: | Line 324: | ||
multiPP' dynlStr focusPP unfocusPP handles = do |
multiPP' dynlStr focusPP unfocusPP handles = do |
||
state <- get |
state <- get |
||
+ | let pickPP :: WorkspaceId -> WriterT (Last XState) X String |
||
− | let viewWs n = put state { windowset = W.view n $ windowset state } |
||
+ | pickPP ws = do |
||
− | focused = W.tag . W.workspace . W.current $ windowset state |
||
+ | let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset state |
||
− | choosePP w = if w == focused then focusPP else unfocusPP |
||
+ | put state{ windowset = W.view ws $ windowset state } |
||
− | io . zipWithM_ hPutStrLn handles |
||
− | + | out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP |
|
− | + | when isFoc $ get >>= tell . Last . Just |
|
+ | return out |
||
− | put state |
||
+ | traverse put . getLast |
||
+ | =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes |
||
+ | =<< mapM screenWorkspace (zipWith const [0..] handles) |
||
+ | return () |
||
mergePPOutputs :: [PP -> X String] -> PP -> X String |
mergePPOutputs :: [PP -> X String] -> PP -> X String |
||
− | mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence |
+ | mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence . sequence x $ pp |
onlyTitle :: PP -> PP |
onlyTitle :: PP -> PP |
||
− | onlyTitle pp = defaultPP { ppCurrent = const "" |
+ | onlyTitle pp = defaultPP { ppCurrent = const "" |
+ | , ppHidden = const "" |
||
+ | , ppVisible = const "" |
||
+ | , ppLayout = ppLayout pp |
||
+ | , ppTitle = ppTitle pp } |
||
− | -- | Requires a recent addition to xmobar (>0.9.2) |
+ | -- | Requires a recent addition to xmobar (>0.9.2), otherwise you have to use |
+ | -- multiple configuration files, which gets messy |
||
xmobarScreen :: Int -> IO Handle |
xmobarScreen :: Int -> IO Handle |
||
− | xmobarScreen = spawnPipe . ("xmobar -x " ++) . show |
+ | xmobarScreen = spawnPipe . ("~/.cabal/bin/xmobar -x " ++) . show |
myPP :: PP |
myPP :: PP |
||
+ | myPP = sjanssenPP { ppLayout = xmobarColor "orange" "", ppUrgent = xmobarColor "red" "" . ('^':) } |
||
− | myPP = defaultPP |
||
− | { ppTitle = xmobarColor "orange" "" |
||
− | , ppCurrent = xmobarColor "white" "" |
||
− | , ppSep = " : " |
||
− | , ppLayout = xmobarColor "green" "" |
||
− | , ppVisible = xmobarColor "white" "" . wrap "(" ")" |
||
− | , ppUrgent = xmobarColor "red" "" . ("^"++)} |
||
-------------------------------------------------------------- |
-------------------------------------------------------------- |
||
Line 241: | Line 358: | ||
myTopics :: [Topic] |
myTopics :: [Topic] |
||
myTopics = |
myTopics = |
||
+ | [ "a" |
||
− | [ "dashboard" -- the first one |
||
+ | , "web" |
||
− | , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc" |
||
+ | , "haskell" |
||
− | , "mail", "movie", "music", "talk", "text", "web" |
||
+ | , "mail" |
||
− | , "yi", "documents", "pdf", "xmobar", "xmonad-conf", "xmonad-extras", "xmonad-newconfig", "xmonad-contrib" |
||
− | , " |
+ | , "irc" |
+ | , "xm-conf" |
||
+ | , "gimp" |
||
+ | , "gitit" |
||
+ | , "admin" |
||
+ | , "movie" |
||
+ | , "music" |
||
+ | , "pdf" |
||
+ | , "doc" |
||
+ | , "xmc" |
||
+ | , "xme" |
||
+ | , "xm" |
||
+ | , "xmobar" |
||
+ | , "wip" |
||
+ | , "test" |
||
] |
] |
||
+ | |||
myTopicConfig = TopicConfig |
myTopicConfig = TopicConfig |
||
{ topicDirs = M.fromList $ |
{ topicDirs = M.fromList $ |
||
− | [ (" |
+ | [ ("a", "./") |
− | , ("dashboard", "./") |
||
− | , ("yi", "wip/dev-haskell/yi") |
||
− | , ("darcs", "wip/dev-haskell/darcs") |
||
, ("haskell", "haskell") |
, ("haskell", "haskell") |
||
− | , (" |
+ | , ("xm-conf", ".xmonad") |
− | , (" |
+ | , ("xme", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad") |
− | , (" |
+ | , ("xm", "wip/x11-wm/xmonad/core/xmonad") |
− | , (" |
+ | , ("xmc", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad") |
, ("xmobar", "wip/x11-wm/xmobar") |
, ("xmobar", "wip/x11-wm/xmobar") |
||
, ("movie", "media/movie") |
, ("movie", "media/movie") |
||
, ("music", "media/music") |
, ("music", "media/music") |
||
− | , (" |
+ | , ("doc", "doc") |
, ("pdf", "ref") |
, ("pdf", "ref") |
||
, ("gitit", "wip/gitit") |
, ("gitit", "wip/gitit") |
||
, ("gimp", "./") |
, ("gimp", "./") |
||
+ | , ("wip", "wip") |
||
] |
] |
||
, defaultTopicAction = const $ spawnShell >*> 2 |
, defaultTopicAction = const $ spawnShell >*> 2 |
||
− | , defaultTopic = " |
+ | , defaultTopic = "a" |
, maxTopicHistory = 10 |
, maxTopicHistory = 10 |
||
, topicActions = M.fromList $ |
, topicActions = M.fromList $ |
||
− | [ (" |
+ | [ ("xm-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >> |
spawn "urxvt -e vim ~/.xmonad/xmonad.hs") |
spawn "urxvt -e vim ~/.xmonad/xmonad.hs") |
||
− | , (" |
+ | , ("xmc" , spawnShell >*> 2) |
− | , (" |
+ | , ("xmobar" , spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2) |
+ | , ("music" , spawn "urxvt -e ncmpc -h /home/aavogt/.mpd/socket" >> spawn "export MPD_HOST=192.168.1.2; mpc && urxvt -e ncmpc -h 192.168.1.2") |
||
− | , ("xmobar", spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2) |
||
− | , (" |
+ | , ("mail" , spawnOn "mail" "urxvt -e mutt") |
− | , (" |
+ | , ("irc" , spawnOn "irc" "urxvt --title irc -e ssh engage") |
− | , (" |
+ | , ("web" , spawnOn "web" "firefox") |
− | , (" |
+ | , ("pdf" , spawnOn "pdf" "okular") |
− | , (" |
+ | , ("gimp" , spawnHere "gimp") |
− | , ("movie", spawnShell) |
||
− | , ("pdf", spawn "okular") |
||
− | , ("gimp", spawnOn ?spawner "gimp" "gimp") |
||
] |
] |
||
} |
} |
||
Line 291: | Line 418: | ||
spawnShellIn dir = do |
spawnShellIn dir = do |
||
− | color <- randomBg' (HSV |
+ | -- color <- randomBg' (HSV 255 255) |
t <- asks (terminal . config) |
t <- asks (terminal . config) |
||
− | spawnHere |
+ | spawnHere $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color |
+ | |||
+ | wsgrid = gridselect gsConfig <=< asks $ map (\x -> (x,x)) . workspaces . config |
||
+ | |||
+ | promptedGoto = wsgrid >>= flip whenJust (switchTopic myTopicConfig) |
||
+ | |||
+ | promptedShift = wsgrid >>= \x -> whenJust x $ \y -> windows (W.greedyView y . W.shift y) |
||
+ | -------------------------------------------------------------------------------- |
||
+ | |||
+ | -------------------------------------------------------------------------------- |
||
+ | -- A nice little example of extensiblestate |
||
+ | newtype FocusFollow = FocusFollow {getFocusFollow :: Bool } deriving (Typeable,Read,Show) |
||
+ | instance ExtensionClass FocusFollow where |
||
+ | initialValue = FocusFollow True |
||
+ | extensionType = PersistentExtension |
||
+ | |||
+ | -- this eventHook is the same as from xmonad for handling crossing events |
||
+ | focusFollow e@(CrossingEvent {ev_window=w, ev_event_type=t}) |
||
+ | | t == enterNotify, ev_mode e == notifyNormal = |
||
+ | whenX (XS.gets getFocusFollow) (focus w) >> return (All True) |
||
+ | focusFollow _ = return (All True) |
||
+ | |||
+ | toggleFF = XS.modify $ FocusFollow . not . getFocusFollow |
||
+ | -------------------------------------------------------------------------------- |
||
+ | |||
+ | {- | Sometimes this picks the wrong element to merge into (that is, not the |
||
+ | 'focused' element of the group), and SubLayouts breaks up the whole group |
||
+ | -} |
||
+ | queryMerge pGrp = do |
||
+ | w <- ask |
||
+ | aws <- liftX $ filterM (runQuery pGrp) =<< gets |
||
+ | (W.integrate' . W.stack . W.workspace . W.current . windowset) |
||
+ | |||
+ | let addRem = False -- run the query with window removed?? |
||
+ | when addRem |
||
+ | (liftX $ modify (\ws -> ws { windowset = W.insertUp w (windowset ws) })) |
||
+ | liftX $ windows (W.insertUp w) |
||
+ | |||
+ | mapM_ (liftX . sendMessage . XMonad.Layout.SubLayouts.Merge w) aws |
||
+ | when addRem |
||
− | promptedGoto = workspacePrompt myXPConfig $ switchTopic myTopicConfig |
||
+ | (liftX $ modify (\ws -> ws { windowset = W.delete' w (windowset ws) })) |
||
+ | idHook |
||
− | promptedShift = workspacePrompt myXPConfig $ \x -> windows (W.greedyView x . W.shift x) |
||
</haskell> |
</haskell> |
Latest revision as of 16:00, 31 December 2010
Xmonad/Config archive/adamvo's xmobarrc (0.9.2)
Xmonad/Config archive/obtoxmd -- script called to temporarily run another wm
-- current darcs as of 2010-12-31
{-# LANGUAGE
DeriveDataTypeable,
FlexibleContexts,
FlexibleInstances,
MultiParamTypeClasses,
NoMonomorphismRestriction,
PatternGuards,
ScopedTypeVariables,
TypeSynonymInstances,
UndecidableInstances
#-}
{-# OPTIONS_GHC -W -fwarn-unused-imports -fno-warn-missing-signatures #-}
import Control.Applicative
import Control.Monad
import Control.Monad.Instances ()
import Control.Monad.Writer
import Data.List
import Data.Maybe
import Data.Traversable(traverse)
import Graphics.X11.Xinerama
import qualified Data.Map as M
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import System.IO
import XMonad
import XMonad.Actions.DwmPromote
import XMonad.Actions.FloatSnap
import XMonad.Actions.GridSelect
import XMonad.Actions.Search
import XMonad.Actions.SpawnOn
import XMonad.Actions.Submap
import XMonad.Actions.TopicSpace
import XMonad.Actions.UpdatePointer
import XMonad.Actions.Warp
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.BoringWindows
import XMonad.Layout.Drawer
import XMonad.Layout.Grid
import XMonad.Layout.IM
import XMonad.Layout.LayoutHints
import XMonad.Layout.LayoutModifier
import XMonad.Layout.Magnifier
import XMonad.Layout.Master
import XMonad.Layout.Mosaic
import XMonad.Layout.MosaicAlt
import XMonad.Layout.MouseResizableTile
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.PerWorkspace
import XMonad.Layout.Simplest
import XMonad.Layout.SimplestFloat
import XMonad.Layout.SubLayouts
import XMonad.Layout.Tabbed
import XMonad.Layout.TrackFloating
import XMonad.Layout.WindowNavigation
import XMonad.Prompt
import XMonad.Prompt.RunOrRaise
import XMonad.Prompt.Ssh
import XMonad.Prompt.Window
import XMonad.Prompt.XMonad
import XMonad.Util.EZConfig
import XMonad.Util.Replace
import XMonad.Util.Run
main :: IO ()
main = do
replace
checkTopicConfig myTopics myTopicConfig
let urgency
| True = withUrgencyHook FocusHook
| True = withUrgencyHook NoUrgencyHook
xmonad . ewmh . urgency . myConfig
=<< mapM xmobarScreen =<< getScreens
sofficeToolbox = className =? "OpenOffice.org 3.1"
<&&> isInProperty "WM_PROTOCOLS" "WM_TAKE_FOCUS"
myConfig hs = let c = defaultConfig {
layoutHook = myLayout
, focusFollowsMouse = False
, focusedBorderColor = "red"
, startupHook = do
return () -- supposedly to avoid inf. loops with checkKeymap
checkKeymap (myConfig []) (myKeys c)
, terminal = "urxvt"
, modMask = mod4Mask
, logHook = do
multiPP'
(mergePPOutputs [XMonad.Actions.TopicSpace.pprWindowSet myTopicConfig,
dynamicLogString . onlyTitle])
myPP
myPP{ ppTitle = const "" }
hs
updatePointer (TowardsCentre 0.2 0.2)
, handleEventHook = ewmhDesktopsEventHook <+> fullscreenEventHook <+> focusFollow <+>
(\e -> case e of
PropertyEvent{ ev_window = w } -> do
isURXVT <- runQuery (className =? "URxvt") w
if not isURXVT then hintsEventHook e else return (All True)
_ -> return (All True))
, workspaces = myTopics
, manageHook = mconcat
[manageSpawn
,isFullscreen --> doFullFloat
-- ,className =? "MPlayer" --> doFullFloat
,className =? "XTerm" --> queryMerge (className =? "XTerm")
,manageDocks
]
} in additionalKeysP c (myKeys c)
myXPConfig :: XPConfig
myXPConfig = greenXPConfig { font = "xft:Profont:pixelsize=15:autohint=true" }
gsConfig = defaultGSConfig { gs_navigate = fix $ \self ->
let navKeyMap = M.mapKeys ((,) 0) $ M.fromList $
[(xK_Escape, cancel)
,(xK_Return, select)
,(xK_slash , substringSearch self)]
++
map (\(k,a) -> (k,a >> self))
[(xK_Left , move (-1,0 ))
,(xK_h , move (-1,0 ))
,(xK_n , move (-1,0 ))
,(xK_Right , move (1,0 ))
,(xK_l , move (1,0 ))
,(xK_i , move (1,0 ))
,(xK_Down , move (0,1 ))
,(xK_j , move (0,1 ))
,(xK_e , move (0,1 ))
,(xK_Up , move (0,-1 ))
,(xK_u , move (0,-1 ))
,(xK_y , move (-1,-1))
,(xK_m , move (1,-1 ))
,(xK_space , setPos (0,0))
]
in makeXEventhandler $ shadowWithKeymap navKeyMap (const self) }
data ExpandEdges a = ExpandEdges Int deriving (Read,Show)
instance LayoutModifier ExpandEdges Window where
modifyLayout (ExpandEdges n) ws (Rectangle x y w h) = let
bigRect = Rectangle (x - fromIntegral n) (y - fromIntegral n)
(w + 2*fromIntegral n) (h + 2*fromIntegral n)
in
runLayout ws bigRect
-- | push edges off-screen
expandEdges n layout = ModifiedLayout (ExpandEdges n) layout
-------------------- Layout ----------------------------------
myLayout =
trackFloating . smartBorders
. onWorkspace "movie" (magnifier m ||| layoutHints Full)
. avoidStruts
. onWorkspace "test" (multimastered 2 (1/100) (1/2) Grid)
. onWorkspace "gimp" (named "G" gimp)
. onWorkspace "xm-conf" ((nav $ ModifiedLayout (ExpandEdges 1) (Tall 1 0.3 0.5)) ||| Full)
$ m ||| named "F" (noBorders Full)
where nav = configurableNavigation (navigateColor "#ffff00")
m = named "M"
. lessBorders Screen
. layoutHintsToCenter
. addTabs shrinkText defaultTheme
. nav
. boringAuto
. subLayout [] (Simplest ||| simplestFloat)
$ mosaic 1.5 [7,5,2]
gimp = nav
. onLeft (simpleDrawer 0.01 0.3 $ Role "gimp-toolbox")
. withIM 0.15 (Role "gimp-dock")
. addTabs shrinkText defaultTheme
. nav
. boringAuto
. subLayout [] Simplest
$ mouseResizableTile ||| Full
--------------------------------------------------------------
-------------------- Keys ------------------------------------
myKeys c =
[("M-<Left>" , withFocused $ snapMove L Nothing )
,("M-<Right>" , withFocused $ snapMove R Nothing )
,("M-<Up>" , withFocused $ snapMove U Nothing )
,("M-<Down>" , withFocused $ snapMove D Nothing )
,("M-S-<Left>" , withFocused $ snapShrink R Nothing)
,("M-S-<Right>", withFocused $ snapGrow R Nothing)
,("M-S-<Up>" , withFocused $ snapShrink D Nothing)
,("M-S-<Down>" , withFocused $ snapGrow D Nothing)
, ("M-l", withFocused (sendMessage . expandWindowAlt) >> sendMessage Expand)
, ("M-h", withFocused (sendMessage . shrinkWindowAlt) >> sendMessage Shrink)
,("M-;", withFocused (sendMessage . tallWindowAlt) >> sendMessage Taller)
,("M-o", withFocused (sendMessage . wideWindowAlt) >> sendMessage Wider )
,("M-v", toggleFF)
,("M-S-b", restart "/home/aavogt/bin/obtoxmd" True)
,("M-S-d", restart "urxvt -e xmonad" False)
,("M-S-o" , withFocused $ sendMessage . UnMerge )
,("M-S-C-o", withFocused $ sendMessage . UnMergeAll)
,("M-C-m" , withFocused $ sendMessage . MergeAll )
,("M-C-." , onGroup W.focusDown')
,("M-C-," , onGroup W.focusUp' )
,("M-p", shellPromptHere myXPConfig)
,("M-x", submap $ M.fromList subMaps)
,("M-g", submap $ defaultSublMap c )
,("M-S-.", focusDown)
,("M-S-,", focusUp )
,("M-S-a", currentTopicAction myTopicConfig)
,("M-a", warpToCentre >> goToSelected gsConfig)
-- workaround
,("M-<Tab>", switchNthLastFocused myTopicConfig . succ . length . W.visible . windowset =<< get )
,("M-s" , warpToCentre >> promptedGoto )
,("M-S-s", warpToCentre >> promptedShift)
,("M-b", sendMessage ToggleStruts)
,("M-<Return>", dwmpromote)
,("M-S-<Return>", spawnShell)
-- don't force a recompile, if nothing has changed (xmonad --recompile runs XMonad.recompile True)
,("M-q", spawn "ghc -e ':m +XMonad Control.Monad System.Exit' -e 'flip unless exitFailure =<< recompile False' && xmonad --restart")
,("M-S-q", spawn "~/wip/x11-wm/xmonad/rebuild.sh")
,("<Print>", spawn "scrot")
]
++
concatMap (\(m,f) -> lrud ("M-"++m) f)
[("S-" , sendMessage . Swap)
,("C-" , sendMessage . pullGroup)
,("S-C-", sendMessage . pushWindow)
,("" , sendMessage . Go)]
++ mediaKeys ++
[("M-"++m++[key], screenWorkspace sc >>= flip whenJust (windows . f))
| (f, m) <- [(W.view, ""), (W.shift, "S-")]
, (key, sc) <- zip "wf" [0 .. ]]
++
[ ("M-"++m++[k], a i)
| (a, m) <- [(switchNthLastFocused myTopicConfig,""),(shiftNthLastFocused, "S-")]
, (i, k) <- zip [1..] "123456789"]
-- helper for windowNavigation keys
-- note: with colemak neiu are placed where jkli are with qwerty layout
lrud :: String -> (Direction2D -> b) -> [(String, b)]
lrud m cmd = zip ks cmds
where
ks = map (\x -> m ++ [x]) "niue"
cmds = zipWith ($) (repeat cmd) [L,R,U,D]
subMaps = [((0, xK_o), runOrRaisePrompt myXPConfig),
((0, xK_p), shellPromptHere myXPConfig),
((0, xK_x), xmonadPrompt myXPConfig),
((0, xK_z), sshPrompt myXPConfig),
((shiftMask, xK_w), windowPromptGoto myXPConfig),
((0, xK_w), promptSearch myXPConfig wikipedia),
((0, xK_s), promptSearch myXPConfig multi),
((0, xK_m), promptSearch myXPConfig mathworld),
((0, xK_b), sendMessage ToggleStruts),
((0, xK_f), withFocused $ windows . W.sink),
((0, xK_v), refresh),
((0, xK_c), asks config >>= spawnHere . terminal),
((0, xK_k), kill)
]
amarok = False
mediaKeys = [("<XF86AudioPlay>", do mpcAct "toggle"; when amarok $ spawn "amarok -t"),
("<XF86AudioStop>", promptHost),
("<XF86AudioNext>", do mpcAct "next"; when amarok $ spawn "amarok -f"),
("<XF86AudioPrev>", do mpcAct "prev"; when amarok $ spawn "amarok -r"),
("<XF86AudioMute>", spawn "ossmix vmix0-outvol 0"),
("<XF86AudioLowerVolume>", spawn "amixer sset PCM 1-"),
("<XF86AudioRaiseVolume>", spawn "amixer sset PCM 1+"),
("<XF86Sleep>", spawn "sudo pm-suspend")
]
where mpcAct c = do
h <- XS.gets hostPrompt
spawn $ unwords ["export MPD_HOST="++h,";","mpc",c]
-- Prompt for mpd host
newtype HostPrompt = HostPrompt { hostPrompt :: String } deriving (Read,Show,Typeable)
instance ExtensionClass HostPrompt where
initialValue = HostPrompt "/home/aavogt/.mpd/socket"
extensionType = PersistentExtension
instance XPrompt HostPrompt where showXPrompt _ = "Pick MPD Host: "
promptHost = mkXPrompt (HostPrompt "") myXPConfig (return . compl) (XS.put . HostPrompt)
where compl s = nub $ filter (s `isPrefixOf`) ["127.0.0.1","dell"]
--------------------------------------------------------------
warpToCentre = gets (W.screen . W.current . windowset) >>= \x -> warpToScreen x 0.5 0.5
-------------------- Support for per-screen xmobars ---------
-- Some parts of this should be merged into contrib sometime
getScreens :: IO [Int]
getScreens = openDisplay "" >>= liftA2 (<*) f closeDisplay
where f = fmap (zipWith const [0..]) . getScreenInfo
multiPP :: PP -- ^ The PP to use if the screen is focused
-> PP -- ^ The PP to use otherwise
-> [Handle] -- ^ Handles for the status bars, in order of increasing X
-- screen number
-> X ()
multiPP = multiPP' dynamicLogString
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' dynlStr focusPP unfocusPP handles = do
state <- get
let pickPP :: WorkspaceId -> WriterT (Last XState) X String
pickPP ws = do
let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset state
put state{ windowset = W.view ws $ windowset state }
out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
when isFoc $ get >>= tell . Last . Just
return out
traverse put . getLast
=<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
=<< mapM screenWorkspace (zipWith const [0..] handles)
return ()
mergePPOutputs :: [PP -> X String] -> PP -> X String
mergePPOutputs x pp = fmap (intercalate (ppSep pp)) . sequence . sequence x $ pp
onlyTitle :: PP -> PP
onlyTitle pp = defaultPP { ppCurrent = const ""
, ppHidden = const ""
, ppVisible = const ""
, ppLayout = ppLayout pp
, ppTitle = ppTitle pp }
-- | Requires a recent addition to xmobar (>0.9.2), otherwise you have to use
-- multiple configuration files, which gets messy
xmobarScreen :: Int -> IO Handle
xmobarScreen = spawnPipe . ("~/.cabal/bin/xmobar -x " ++) . show
myPP :: PP
myPP = sjanssenPP { ppLayout = xmobarColor "orange" "", ppUrgent = xmobarColor "red" "" . ('^':) }
--------------------------------------------------------------
-------------------- X.Actions.TopicSpace --------------------
myTopics :: [Topic]
myTopics =
[ "a"
, "web"
, "haskell"
, "mail"
, "irc"
, "xm-conf"
, "gimp"
, "gitit"
, "admin"
, "movie"
, "music"
, "pdf"
, "doc"
, "xmc"
, "xme"
, "xm"
, "xmobar"
, "wip"
, "test"
]
myTopicConfig = TopicConfig
{ topicDirs = M.fromList $
[ ("a", "./")
, ("haskell", "haskell")
, ("xm-conf", ".xmonad")
, ("xme", "wip/x11-wm/xmonad/extras/xmonad-extras/XMonad")
, ("xm", "wip/x11-wm/xmonad/core/xmonad")
, ("xmc", "wip/x11-wm/xmonad/contrib/XMonadContrib/XMonad")
, ("xmobar", "wip/x11-wm/xmobar")
, ("movie", "media/movie")
, ("music", "media/music")
, ("doc", "doc")
, ("pdf", "ref")
, ("gitit", "wip/gitit")
, ("gimp", "./")
, ("wip", "wip")
]
, defaultTopicAction = const $ spawnShell >*> 2
, defaultTopic = "a"
, maxTopicHistory = 10
, topicActions = M.fromList $
[ ("xm-conf", spawnShellIn ".xmonad/lib/XMonad/Layout" >>
spawn "urxvt -e vim ~/.xmonad/xmonad.hs")
, ("xmc" , spawnShell >*> 2)
, ("xmobar" , spawnShellIn "wip/x11-wm/xmobar/Plugins" >*> 2)
, ("music" , spawn "urxvt -e ncmpc -h /home/aavogt/.mpd/socket" >> spawn "export MPD_HOST=192.168.1.2; mpc && urxvt -e ncmpc -h 192.168.1.2")
, ("mail" , spawnOn "mail" "urxvt -e mutt")
, ("irc" , spawnOn "irc" "urxvt --title irc -e ssh engage")
, ("web" , spawnOn "web" "firefox")
, ("pdf" , spawnOn "pdf" "okular")
, ("gimp" , spawnHere "gimp")
]
}
-- From the sample config in TopicSpace, these should probably be exported from that module
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
spawnShellIn dir = do
-- color <- randomBg' (HSV 255 255)
t <- asks (terminal . config)
spawnHere $ "cd " ++ dir ++ " && " ++ t -- ++ " -bg " ++ color
wsgrid = gridselect gsConfig <=< asks $ map (\x -> (x,x)) . workspaces . config
promptedGoto = wsgrid >>= flip whenJust (switchTopic myTopicConfig)
promptedShift = wsgrid >>= \x -> whenJust x $ \y -> windows (W.greedyView y . W.shift y)
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- A nice little example of extensiblestate
newtype FocusFollow = FocusFollow {getFocusFollow :: Bool } deriving (Typeable,Read,Show)
instance ExtensionClass FocusFollow where
initialValue = FocusFollow True
extensionType = PersistentExtension
-- this eventHook is the same as from xmonad for handling crossing events
focusFollow e@(CrossingEvent {ev_window=w, ev_event_type=t})
| t == enterNotify, ev_mode e == notifyNormal =
whenX (XS.gets getFocusFollow) (focus w) >> return (All True)
focusFollow _ = return (All True)
toggleFF = XS.modify $ FocusFollow . not . getFocusFollow
--------------------------------------------------------------------------------
{- | Sometimes this picks the wrong element to merge into (that is, not the
'focused' element of the group), and SubLayouts breaks up the whole group
-}
queryMerge pGrp = do
w <- ask
aws <- liftX $ filterM (runQuery pGrp) =<< gets
(W.integrate' . W.stack . W.workspace . W.current . windowset)
let addRem = False -- run the query with window removed??
when addRem
(liftX $ modify (\ws -> ws { windowset = W.insertUp w (windowset ws) }))
liftX $ windows (W.insertUp w)
mapM_ (liftX . sendMessage . XMonad.Layout.SubLayouts.Merge w) aws
when addRem
(liftX $ modify (\ws -> ws { windowset = W.delete' w (windowset ws) }))
idHook