Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
699 lines (600 sloc) 27.7 KB
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, NoMonomorphismRestriction, DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
------------------------------------------------------------------------------
-- |
-- Module : Main
-- Description : XMonad configuration
-- Copyright : (C) 2014 Samuli Thomasson
-- License : BSD-3
-- Maintainer : Samuli Thomasson <samuli.thomasson@paivola.fi>
-- Stability : experimental
-- Portability : non-portable
--
-- Creation Date : Jun 15 2011 [22:30:53]
-- Last Modified : Sep 21 2014 [00:32:37]
--
--
-- NOTE: for flash to work fullscreen do this:
-- sed -i -re s/_NET_ACTIVE_WINDWW/XNET_ACTIVE_WINDWW/ /usr/lib/.../libflashplayer.so
-- (something to do ewmh IIRC)
--
-- NOTE: This config uses recentish xmonad and XMonadContrib (>=0.12), Some
-- features require programs like 'yeganesh', 'urxvtc', 'ncmpcpp', 'tmux',
-- 'ssh' and some custom scripts.
--
------------------------------------------------------------------------------
module Main (main) where
import Control.Monad
import Data.Char (toLower)
import Data.Function (on)
import qualified Data.List as L
import qualified Data.Map as M
import Data.Monoid
import System.Directory (doesFileExist, getHomeDirectory)
import System.Exit
import System.IO
-------------------------------------------------------------------------
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Actions.ConstrainedResize as Sqr
import XMonad.Actions.CycleWS
import XMonad.Actions.CycleRecentWS
import qualified XMonad.Actions.DynamicWorkspaces as DW -- Dynamic workspaces.
import qualified XMonad.Actions.DynamicWorkspaceGroups as DW
import qualified XMonad.Actions.DynamicWorkspaceOrder as DW -- Note custom withNthWorkspace function below
import qualified XMonad.Actions.FlexibleManipulate as Flex
import XMonad.Actions.NoBorders
import XMonad.Actions.CopyWindow
import qualified XMonad.Actions.RandomBackground as RB
import XMonad.Actions.Search as S
import XMonad.Actions.TopicSpace
import XMonad.Actions.RotSlaves
import XMonad.Actions.UpdatePointer
import XMonad.Actions.FloatSnap
import XMonad.Hooks.PositionStoreHooks
import XMonad.Hooks.DebugStack
import XMonad.Hooks.DynamicBars
import XMonad.Hooks.InsertPosition
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.FloatNext
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.Place
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.SimpleDecoration
import XMonad.Layout.DwmStyle
import XMonad.Layout.Simplest
import XMonad.Layout.Reflect
import XMonad.Layout.Fullscreen ( fullscreenFull )
import XMonad.Layout.Grid
import XMonad.Layout.LayoutBuilder
import XMonad.Layout.LayoutModifier
import XMonad.Layout.Maximize ( maximizeRestore, maximize )
import XMonad.Layout.MultiToggle
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.OneBig ( OneBig(OneBig) )
import XMonad.Layout.PerWorkspace
import XMonad.Layout.PerScreen as PerScreen
import XMonad.Layout.Spacing
import XMonad.Layout.SubLayouts
import XMonad.Layout.Tabbed
import XMonad.Layout.ThreeColumns
import XMonad.Layout.WindowNavigation
import XMonad.Layout.ZoomRow
import XMonad.Prompt
import XMonad.Prompt.AppendFile
import XMonad.Prompt.Window
import XMonad.Util.EZConfig ( mkNamedKeymap )
import XMonad.Util.Loggers
import XMonad.Util.NamedActions
import XMonad.Util.NamedScratchpad
import XMonad.Util.PositionStore
import XMonad.Util.Run ( spawnPipe )
main :: IO ()
main = do
ws <- getWorkspaces
xmonad myConfig { workspaces = ws }
myConfig = ewmh
$ myStatusBars
$ withUrgencyHook myDzenUrgencyHook
$ addDescrKeys' ((mod4Mask, xK_F1), xMessage) myKeys
$ def
{ borderWidth = 1
, focusFollowsMouse = True
, focusedBorderColor = colCyan
, normalBorderColor = colBase01
, handleEventHook = myHandleHook
, layoutHook = myLayout
, logHook = updatePointer (0.5, 0.5) (0.4, 0.4)
, manageHook = myManageHooks
, modMask = mod4Mask
, mouseBindings = myMouseBindings
, terminal = myTerminal
}
myHandleHook :: Event -> X All
myHandleHook =
fullscreenEventHook
<+> removeBordersEventHook
<+> positionStoreEventHook
<+> docksEventHook
myManageHooks :: ManageHook
myManageHooks =
manageDocks
<+> namedScratchpadManageHook scratchpads
<+> positionStoreManageHook Nothing
<+> floatNextHook
<+> composeOne
[ transience
, className =? "Xmessage" -?> doCenterFloat
, className =? "Display" -?> doCenterFloat
, className =? "mpv" -?> doFloat
, liftM Just $
-- When all else fails do smart placing (on floats) and insert
-- below focused (inserting floats below would fuck up ordering).
placeHook (withGaps (30, 30, 30, 30) $ smart (0.5,0.5))
<+> insertPosition Below Newer
]
-- * Variables
myDefaultWorkspaces :: [WorkspaceId]
myDefaultWorkspaces = [ "dashboard", "work1", "work2", "work3", "work4", "work5", "work6", "work7" ]
wsFile :: IO FilePath
wsFile = liftM (++ "/.xmonad/workspaces") getHomeDirectory
backlogFile :: IO FilePath
backlogFile = (++ "/cloud/Backlogs/current.md") <$> getHomeDirectory
myFont, myFontLarge :: String
myFont = "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*"
myFontLarge = "xft:Terminus"
-- ** Colors Solarized
colBase03 = "#002b36"
colBase02 = "#073642"
colBase01 = "#586e75"
colBase00 = "#657b83"
--colBase0 = "#839496"
colBase1 = "#93a1a1"
colBase2 = "#eee8d5"
colBase3 = "#fdf6e3"
colYellow = "#b58900"
colOrange = "#cb4b16"
colRed = "#dc322f"
colMagenta = "#d33682"
colViolet = "#6c71c4"
colBlue = "#268bd2"
colCyan = "#2aa198"
colGreen = "#859900"
myXPConfig :: XPConfig
myXPConfig = def
{ font = myFontLarge
, bgColor = colBase3
, fgColor = colBase00
, fgHLight = colBlue
, bgHLight = colBase3
, borderColor = colBase2
, searchPredicate = L.isInfixOf `on` map toLower
}
-- | XPConfig with 5s autocomplete
myXPConfig' :: XPConfig
myXPConfig' = myXPConfig { autoComplete = Just 500000 }
myTheme :: Theme
myTheme = def
{ activeTextColor = colBase1
, activeColor = colBase02
, activeBorderColor = colBase02
, inactiveTextColor = colBase1
, inactiveColor = colBase03
, inactiveBorderColor = colBase03
, urgentTextColor = colRed
, urgentColor = colBase01
, urgentBorderColor = colBase01
, fontName = myFontLarge
, decoWidth = 300
, decoHeight = 18
}
-- * Saved workspace names
-- | Get list of saved workspaceId's from "wsFile"
getWorkspaces :: IO [WorkspaceId]
getWorkspaces = wsFile >>= doesFileExist >>= \exists -> if exists
then wsFile >>= liftM read . readFile
else return myDefaultWorkspaces
saveWorkspaces :: X ()
saveWorkspaces = do
to <- liftIO wsFile
dynSort <- DW.getSortByOrder
withWindowSet $ liftIO . writeFile to . show . map W.tag . dynSort . W.workspaces
-- * Topic actions
myTopicConfig :: TopicConfig
myTopicConfig = def
{ topicDirs = M.fromList
[ ("animu", "/home/media/anime/")
, ("uni", "/home/sim/hy/")
, ("un2", "/home/sim/hy/")
]
, topicActions = M.fromList
[ ("gimp", spawn "gimp")
, ("animu", spawnShell)
, ("uni", spawn "dwb -r uni")
]
}
spawnShell :: X ()
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
where
spawnShellIn dir = spawn $ " urxvtc -cd '" ++ dir ++ "'"
myTopicAction :: X ()
myTopicAction = whenX noWindows $ currentTopicAction myTopicConfig
where noWindows = liftM (null . W.integrate') $
gets (W.stack . W.workspace . W.current . windowset)
-- * Layout Transformers
data MyTransformers = SPACING -- ^ Add spacing to tiled windows.
| MIRROR -- ^ Mirror the layout
| SUB -- ^ Add sub tab layout
| DECORATE -- ^ Show window titles in the corners of unfocused windows
deriving (Read, Show, Eq, Typeable)
instance Transformer MyTransformers Window where
transform SPACING x k = k (spacing 4 x) (\(ModifiedLayout _ l) -> l)
transform MIRROR x k = k (Mirror x) (\(Mirror x') -> x')
transform SUB x k = k (addTabs shrinkText myTheme $ subLayout [] Simplest x)
(\(ModifiedLayout _ (ModifiedLayout _ l)) -> l)
transform DECORATE x k = k (dwmStyle shrinkText myTheme x) (\(ModifiedLayout _ l) -> l)
-- * Layout
-- | Layout
myLayout =
-- Ignore status bars and all such in "full"
onWorkspace "full" layoutFull
-- Ability to maximize a window to temporarily mostly fill the screen.
. maximize
-- Navigate [hjkl] based on direction
. windowNavigation
-- Remove borders on single window in a screen, and respect docks
. lessBorders SingleTiledPerScreen . avoidStruts
. mkToggle (single DECORATE)
. mkToggle (single SUB)
. mkToggle (single SPACING)
. mkToggle (single MIRROR)
. mkToggle (single REFLECTX)
. mkToggle (single REFLECTY)
-- -- Allow grouping windows under tabs.
-- XXX: breaks prev focused with scratchpads
-- . subLayout [0] Simplest
-- Gimp layout on gimp workspace
. onWorkspace "gimp" layoutGimp
-- trackFloating
-- Switchable layouts
$ ThreeCol 1 (3/100) (9/20)
||| OneBig {-width-}(7/10) {-height-}(6/10)
||| ThreeColMid 1 (3/100) (9/20)
||| Grid
||| Full
-- ||| layoutSideTabbed
withNWindows = ModifiedLayout . OnNModifier
-- * Programs and launchers
myTerminal :: String
myTerminal = "urxvtc"
myProgramLauncher :: X ()
myProgramLauncher = spawn "sh -c '$(yeganesh -x)'"
scratchpads :: [NamedScratchpad]
scratchpads =
[ NS "music" "urxvtc -name ncmpcpp -geometry 140x40 -e sh -c 'ncmpcpp || bash'"
(resource =? "ncmpcpp")
doCenterFloat
, NS "term1" "urxvtc -name term1 -e sh -c 'ssh -t myshell tmux a || bash'"
(resource =? "term1")
(customFloating $ W.RationalRect (1/6) (1/6) (1/3) (1/3))
, NS "term2" "urxvtc -name term2 -e sh -c scratchpad-tmux.sh"
(resource =? "term2")
(customFloating $ W.RationalRect (3/6) (3/6) (1/3) (1/3))
]
-- * Status bar
myStatusBars :: XConfig l -> XConfig l
myStatusBars conf = conf
{ startupHook = startupHook conf >> dynStatusBarStartup myStatusBar (return ())
, handleEventHook = handleEventHook conf <+> dynStatusBarEventHook myStatusBar (return ())
, logHook = logHook conf >> multiPP focusedPP unfocusedPP
}
myStatusBar :: ScreenId -> IO Handle
myStatusBar (S n) = spawnPipe $ "xmobar -o -x " <> show n
unfocusedPP :: PP
unfocusedPP = focusedPP
{ ppCurrent = xmobarColor colYellow ""
}
focusedPP :: PP
focusedPP = def
{ ppCurrent = xmobarColor colOrange ""
, ppHidden = xmobarColor colBase1 "" . take 5
, ppVisible = xmobarColor colGreen ""
, ppHiddenNoWindows = xmobarColor colBase01 "" . take 5
, ppUrgent = xmobarColor colRed ""
, ppSep = colSep " : "
, ppTitle = xmobarColor colBase00 "" . shorten 30
, ppLayout = unwords . map smartSplit . words
, ppWsSep = "\0" -- changed by lastDecor
, ppOrder = \(x:xs) -> lastDecor x : xs
, ppSort = (namedScratchpadFilterOutWorkspace .) `liftM` DW.getSortByOrder
, ppExtras = [ wrapL (colSep "<") (colSep ">") $ ppWinCopies `fmap` wsContainingCopies ]
} where
-- This does some extra formatting, very last, to ws list (adds ws keys)
lastDecor = L.intercalate " "
. zipWith (\k ys -> k ++ dropWhile (== '\0') ys) wsKeys'
. L.groupBy (const (/= '\0'))
wsKeys' = map (xmobarColor colYellow "" . reverse . L.delete ' ') wsKeys
++ repeat "N/A"
ppWinCopies [] = Nothing
ppWinCopies xs = Just $ xmobarColor "white" "" $ L.intercalate ", " xs
colSep = xmobarColor colBase01 ""
-- | Truncate long strings by putting a … in the middle.
smartSplit :: String -> String
smartSplit str
| length str > 4 = take 2 str ++ "" ++ drop (length str - 2) str
| otherwise = str
-- * Urgency notifications
myDzenUrgencyHook :: DzenUrgencyHook
myDzenUrgencyHook = dzenUrgencyHook
{ args = [ "-bg", "darkred"
, "-h" , "12"
, "-fn", myFont
] }
-- * Search prompt
--
searchPrompt = S.promptSearchBrowser myXPConfig "chromium"
-- * Keys
wsKeys :: [String]
wsKeys = map (\x -> "; " ++ [x]) ['a'..'z']
myKeys :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
myKeys conf = let
subKeys str ks = subtitle str : mkNamedKeymap conf ks
screenKeys = ["w","v","z"]
directionKeys = ["j","k","h","l"]
directions = [ D, U, L, R ]
screenAction f = screenWorkspace >=> flip whenJust (windows . f)
zipMod nm ks as m f = zipWith (\k d -> (m ++ k, addName nm $ f d)) ks as
in
subKeys "Windows" (
[ ("M-S-c" , addName "Kill" kill1)
, ("M-!" , addName "Focus urgent" focusUrgent)
, ("M-m" , addName "(Un)maximize temporarily" $ withFocused (sendMessage . maximizeRestore))
, ("M-[" , addName "Rotate slaves up" rotSlavesUp)
, ("M-]" , addName "Rotate slaves down" rotSlavesDown)
, ("M-{" , addName "Rotate all up" rotAllUp)
, ("M-}" , addName "Rotate all down" rotAllDown)
]
++ zipMod "Focus dir" directionKeys directions "M-" (sendMessage . Go)
++ zipMod "Swap dir" directionKeys directions "M-S-" (sendMessage . Swap)
) ^++^
subKeys "M-s : WindowSet operations"
[ ("M-s M-m" , addName "Focus master" $ windows W.focusMaster)
, ("M-p" , addName "Focus up" $ windows W.focusUp)
, ("M-n" , addName "Focus down" $ windows W.focusDown)
, ("M-t" , addName "Focus next" $ windows W.focusDown)
, ("M-d" , addName "Focus prev" $ windows W.focusUp)
, ("M-s m" , addName "Swap master" $ windows W.swapMaster)
, ("M-s p" , addName "Swap next" $ windows W.swapUp)
, ("M-s n" , addName "Swap prev" $ windows W.swapDown)
] ^++^
subKeys "M-b : layout modfiers"
[ ("M-b b" , addName "Toggle window's border" $ withFocused toggleBorder >> refresh)
, ("M-b g" , addName "Toggle status bar" $ sendMessage ToggleStruts)
, ("M-b s" , addName "Toggle SPACING" $ sendMessage $ Toggle SPACING)
, ("M-b t" , addName "Toggle layout tabbed" $ sendMessage $ Toggle SUB)
, ("M-b d" , addName "Toggle decorations" $ sendMessage $ Toggle DECORATE)
, ("M-b m" , addName "Mirror" $ sendMessage $ Toggle MIRROR)
, ("M-b x" , addName "Reflect horizontally" $ sendMessage $ Toggle REFLECTX)
, ("M-b y" , addName "Reflect vertically" $ sendMessage $ Toggle REFLECTY)
, ("M-b <Esc>" , addName "DEBUG stack" $ debugStackString >>= io . appendFile "/home/sim/.xmonad.log") -- NOTE: this is here to make the submap definition possible
] ^++^
subKeys "M-f : Floating layer" (
[ ("M-f a", addName "Float all new" toggleFloatAllNew)
, ("M-f f", addName "Float current" myFloatCurrent)
, ("M-f r", addName "Remember location" $ withFocused saveFloatPosition)
, ("M-f s", addName "Sink focused" $ withFocused $ windows . W.sink)
]
++ zipMod "snapMove dir." directionKeys directions "M-f " (\d -> withFocused $ snapMove d Nothing)
) ^++^
subKeys "Layouts"
[ ("M-<Space>" , sendMessage' NextLayout)
, ("M-S-<Space>", addName "Reset layout" $ setLayout $ XMonad.layoutHook conf)
, ("M-x" , addName "Shrink/zoomOut" $ sendMessage Shrink >> sendMessage zoomOut)
, ("M-S-x" , addName "Expand/zoomIn" $ sendMessage Expand >> sendMessage zoomIn)
, ("M-S-r" , addName "ZoomReset" $ refresh >> sendMessage zoomReset)
, ("M-." , sendMessage' $ IncMasterN 1)
, ("M-," , sendMessage' $ IncMasterN (-1))
] ^++^
subKeys "Sublayouts"
[ ("M-C-m" , addName "Merge all windows under same tab" $ withFocused (sendMessage . MergeAll))
, ("M-C-u" , addName "" $ withFocused (sendMessage . UnMerge))
] ^++^
subKeys "M-g : Workspaces"
[ ("M-g g" , addName "Go to ws" $ DW.selectWorkspace myXPConfig')
, ("M-g n" , addName "Add a ws" $ DW.addWorkspacePrompt myXPConfig >> myTopicAction >> saveWorkspaces)
, ("M-g r" , addName "Rename current ws" $ DW.renameWorkspace myXPConfig >> saveWorkspaces)
, ("M-g d" , addName "Delete current empty ws" $ DW.removeEmptyWorkspace >> saveWorkspaces)
, ("M-g w" , addName "Prompt go to ws" $ windowPromptGoto myXPConfig')
, ("M-g m" , addName "Prompt move to ws" $ DW.withWorkspace myXPConfig' (windows . W.shift))
, ("M-g c" , addName "Prompt copy to ws" $ DW.withWorkspace myXPConfig' (windows . copy))
-- Groups - Note: under same M-g so cannot use subKeys
, ("M-g M-g" , addName "Prompt go to group" $ DW.promptWSGroupView myXPConfig' "View group: ")
, ("M-g M-n" , addName "Rename current group" $ DW.promptWSGroupAdd myXPConfig "Name this group: ")
, ("M-g M-d" , addName "Forget current group" $ DW.promptWSGroupForget myXPConfig' "Forget group: ")
] ^++^
subKeys "workspace focus/swap"
-- [ ("M-n" , addName "" $ DW.moveTo Next anyWS)
-- , ("M-p" , addName "" $ DW.moveTo Prev anyWS)
[ ("M-S-n" , addName "" $ DW.swapWith Next anyWS)
, ("M-S-p" , addName "" $ DW.swapWith Prev anyWS)
, ("M-y" , addName "Cycle previous" $ cycleWindowSets cycleOptions [xK_Super_L, xK_Alt_L] xK_y xK_p)
] ^++^
subKeys "{a,o,e,u,i,d,...} focus and move window between workspaces"
( zipMod "View ws" wsKeys [0..] "M-" (withNthWorkspace W.greedyView)
++ zipMod "Move w to ws" wsKeys [0..] "M-S-" (withNthWorkspace W.shift)
++ zipMod "Copy w to ws" wsKeys [0..] "M-S-C-" (withNthWorkspace copy)
) ^++^
subKeys "Screens"
([("M-C-<Right>", addName "Focus prev screen" prevScreen)
, ("M-C-<Left>" , addName "Focus next screen" nextScreen)
]
++ zipMod "Focus screen" screenKeys [0..] "M-" (screenAction W.view)
++ zipMod "Move client to screen" screenKeys [0..] "M-S-" (screenAction W.shift)
++ zipMod "Swap workspace with screen" screenKeys [0..] "M-M1-" (screenAction W.greedyView)
++ zipMod "Swap workspace with and focus screen" screenKeys [0..] "M-C-" (\s -> screenAction W.greedyView s >> screenAction W.view s)
) ^++^
subKeys "Launch programs"
[ ("M-r" , addName "yeganesh" myProgramLauncher)
, ("M-S-<Return>" , spawn' myTerminal)
, ("M-C-<Return>" , addName "Terminal with random bg" $ RB.randomBg $ RB.HSV 0x35 0x09)
, ("M-<Print>" , spawn' "scrot -m -e 'mkdir -p ~/screenshots && mv $f ~/screenshots/'")
, ("M-S-<Print>" , spawn' "scrot -s -e 'mkdir -p ~/screenshots && mv $f ~/screenshots/'")
, ("M-@" , addName "Take a note to ~/notes/from-xmonad" takeNote)
] ^++^
subKeys "Scratchpads"
[ ("M-\\" , addName "Term1" $ allNamedScratchpadAction scratchpads "term1")
, ("M-<Tab>" , addName "Term1" $ allNamedScratchpadAction scratchpads "term1")
, ("M-S-\\" , addName "Term2" $ allNamedScratchpadAction scratchpads "term2")
, ("M-S-<Tab>" , addName "Term2" $ allNamedScratchpadAction scratchpads "term2")
, ("M-<Backspace>", addName "Term2" $ allNamedScratchpadAction scratchpads "term2")
, ("M-#" , addName "ncmpcpp" $ allNamedScratchpadAction scratchpads "music")
] ^++^
subKeys "M-c : Sound and MPD"
[ ("M--" , addName "inc volume" $ spawn "amixer -M sset Master 2%-:2%-") -- NOTE: N%-:N%- would set volume to 0% , and + to 100% , on appl!
, ("M-+" , addName "dec volume" $ spawn "amixer -M sset Master 2%+:2%+") -- ^ This is fixed on newer ALSA, apparently
, ("M-c t" , mpc ["toggle"])
, ("M-c n" , mpc ["next"])
, ("M-c p" , mpc ["prev"])
, ("M-c c" , mpc ["crop"])
, ("M-c y" , mpc ["single"])
, ("M-c r" , mpc ["random"])
, ("M-c M-y", mpc ["single off", "random off"])
] ^++^
subKeys "M-/ : Searching"
[ ("M-/ p", addName "Google (chromium)" $ S.selectSearchBrowser "chromium" S.google)
, ("M-/ g", addName "Google" $ searchPrompt S.google)
, ("M-/ h", addName "Hoogle" $ searchPrompt S.hoogle)
, ("M-/ w", addName "Wikipedia" $ searchPrompt S.wikipedia)
, ("M-/ /", addName "Multi" $ searchPrompt S.multi)
] ^++^
subKeys "XMonad and misc."
[ ("M-q" , addName "Recompile && Restart XMonad" myRecompileRestart)
, ("M-S-q" , addName "Exit XMonad" $ io exitSuccess)
, ("M-<Esc>" , addName "Lock screen" $ spawn "~/bin/lock.sh")
, ("<XF86MonBrightnessUp>" , addName "Brightness Up" $ spawn "light -A 10")
, ("<XF86MonBrightnessDown>", addName "Brightness Down" $ spawn "light -U 10")
]
-- * Mouse bindings
myMouseBindings :: XConfig t -> M.Map (KeyMask, Button) (Window -> X ())
myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList
[ ((modm, button1), \w -> focus w >> Flex.mouseWindow Flex.linear w)
, ((modm .|. shiftMask, button1), \w -> focus w >> Flex.mouseWindow Flex.discrete w)
, ((modm, button2), \w -> focus w >> windows W.shiftMaster)
, ((modm, button3), \w -> focus w >> Sqr.mouseResizeWindow w False)
, ((modm .|. shiftMask, button3), \w -> focus w >> Sqr.mouseResizeWindow w True)
]
-- * Misc actions
-- | Serialize current windowset before recompiling and restarting.
myRecompileRestart :: X ()
myRecompileRestart = do
saveWorkspaces
spawn $ "stack exec " ++ stackArgs ++ " -- xmonad --recompile && xmonad --restart"
where
stackArgs = "--resolver lts-11.17 --package xmonad --package xmonad-contrib"
-- Note: at time of writing, this is newest snapshot that contains xmonad{,-contrib}
mpc :: [String] -> NamedAction
mpc actions = addName (L.intercalate ", " actions) $ spawn
$ "sh -c '. /home/sim/.secrets && "
++ L.intercalate " && " (map ("mpc -h $_SECRET_MPD_HOST " ++) actions)
++ "'"
takeNote :: X ()
takeNote = do file <- liftIO backlogFile
spawn ("date +'%n%a %F %R %Z%n%n- ' | head -c -1 >> " ++ file)
appendFilePrompt myXPConfig file
-- | Remove borders from every mpv window as soon as possible in an event
-- hook, because otherwise dimensions are messed and the fullscreen mpv is
-- stretched by a couple pixels.
--
-- Basically the effect is the same as with
-- "XMonad.Layout.NoBorders.lessBorders OnlyFloat", except that OnlyFloat
-- messes up the dimensions when used together with fullscreenEventHook
-- (e.g. NET_WM_STATE). Well at least in mplayer/mpv.
--
-- I have no idea how often/where the border is re-applied, but resetting
-- it to 0 whenever possible just works :)
removeBordersEventHook :: Event -> X All
removeBordersEventHook ev = do
whenX (className =? "mpv" `runQuery` w) $ withDisplay $ \d -> do
cw <- io $ wa_border_width <$> getWindowAttributes d w
unless (cw == 0) $ do
io $ setWindowBorderWidth d w 0
refresh
return (All True)
where
w = ev_window ev
-- | Float current according to saved position
myFloatCurrent :: X ()
myFloatCurrent = withFocused $ \window -> withWindowSet $ \ws -> do
ps <- getPosStore
let sr@(Rectangle _srX _srY srW srH) = screenRect . W.screenDetail $ W.current ws
case posStoreQuery ps window sr of
Just (Rectangle x y w h) -> do
let r' = W.RationalRect (fromIntegral x / fromIntegral srW)
(fromIntegral y / fromIntegral srH)
(fromIntegral w / fromIntegral srW)
(fromIntegral h / fromIntegral srH)
io $ writeFile "/tmp/xm" (show r')
windows $ W.float window r'
Nothing -> return ()
-- | Save float position of the window
saveFloatPosition :: Window -> X ()
saveFloatPosition window = do
sr <- withWindowSet $ return . screenRect . W.screenDetail . W.current
(_, rect) <- floatLocation window
modifyPosStore $ \ps -> posStoreInsert ps window (scaleRationalRect sr rect) sr
-- * Hiding tags in different extensions
-- | Cycle recently used windows but ignore "myIgnoredTags"
cycleOptions :: WindowSet -> [WindowSet]
cycleOptions w = map (W.view `flip` w) recentTags
where recentTags = map W.tag
$ namedScratchpadFilterOutWorkspace
$ W.hidden w ++ [W.workspace $ W.current w]
-- | The name is deceiving: "anyWS" actually filters out the workspace named NSP.
anyWS :: WSType
anyWS = WSIs $ return $ (/= "NSP") . W.tag
-- | This is a re-implementation of DW.withNthworkspace with "skipTags"
-- added to filter out NSP.
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = do
sort <- DW.getSortByOrder
ws <- gets (map W.tag . sort . namedScratchpadFilterOutWorkspace . W.workspaces . windowset)
case drop wnum ws of
(w:_) -> windows $ job w
[] -> return ()
-- * Custom layouts
-- | Full with no borders
layoutFull = named "Fullscreen" $ noBorders $ fullscreenFull Full
-- | Layout for gimp workspace
layoutGimp = named "Toolbox | Grid"
$ layoutN 1 (absBox 0 0 200 0) Nothing Full
$ layoutAll (absBox 200 0 0 0) Grid
-- XXX: very buggy with other things; causes a loop on xmonad --restart on
-- my setup! :(
-- layoutSideTabbed = named "Side-tabbed"
-- $ layoutN 1 (absBox 0 0 500 0) Nothing Full
-- $ layoutAll (absBox 500 0 0 0) (tabbed shrinkText myTheme)
-- * Custom layout modifiers
-- | Passed to "lessBorders". Remove borders on a tiled or floating window
-- covering the whole screen *on per screen basis*.
data SingleTiledPerScreen = SingleTiledPerScreen deriving (Read, Show)
instance SetsAmbiguous SingleTiledPerScreen where
hiddens _p _wset _mst = singleTiled
where
singleTiled [(x, _)] = [x]
singleTiled _ = []
-- | Apply a modifier when there are <= n windows
data OnNModifier a = OnNModifier
{ onNSwitch :: Int }
deriving (Show, Read)
instance (Typeable a, Show a, Read a, Eq a) => LayoutModifier OnNModifier a where
redoLayout _ _ Nothing ws = return (ws, Nothing)
redoLayout lm rt (Just stack) ws
| numWS <= onNSwitch lm = do
(ws', _) <- runLayout (W.Workspace "" zoomRow (Just stack)) rt
return (ws', Nothing)
| otherwise = return (ws, Nothing)
where
numWS = length $ W.integrate stack