diff --git a/lib/AppGroups.hs b/lib/AppGroups.hs
index 6450532..0b2a27e 100644
--- a/lib/AppGroups.hs
+++ b/lib/AppGroups.hs
@@ -1,9 +1,10 @@
{-# LANGUAGE ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-}
module AppGroups
--- (Key, App (..), Apps, Condition (..), Cond (..), Regex (..),
--- oneOf, apps2hooks, apps2keys,
--- selectAppGroup,
--- switchToApp )
+ (Key, App (..), Apps, Condition (..), Cond (..), Regex (..),
+ oneOf, apps2hooks, apps2keys,
+ selectAppGroup,
+ switchToApp,
+ doFullscreen)
where
import Control.Monad
@@ -20,7 +21,7 @@ import XMonad.Util.WindowProperties
import XMonad.Util.NamedWindows
import XMonad.Hooks.ManageHelpers hiding (C)
-import CommonFunctions
+import CommonFunctions ((~?))
-- | Shortcut key
type Key = String
@@ -74,6 +75,7 @@ instance (Show a, Condition a) => Show (Regex a) where
instance Condition (Regex String) where
toQuery (Regex s) = className ~? s
+-- | Query WM_WINDOW_ROLE atom
role :: Query String
role = stringProperty "WM_WINDOW_ROLE"
@@ -110,20 +112,26 @@ fullscreen w = withDisplay $ fullscreen' w
doFullscreen :: ManageHook
doFullscreen = fromWindowOp fullscreen
+-- | Move window to specified workspace
moveTo :: WorkspaceId -> ManageHook
moveTo wksp = do
fromX $ addWorkspace wksp
doF $ W.shift wksp
+-- | Jump to specified workspace
jumpTo :: WorkspaceId -> X ()
jumpTo wksp = windows $ W.greedyView wksp
+-- | Move window to specified workspace and then jump to
+-- that workspace.
moveJump :: WorkspaceId -> ManageHook
moveJump wksp = (moveTo wksp) >> (fromX $ jumpTo wksp)
+-- | Sort of `or'.
oneOf :: [Query Bool] -> Query Bool
oneOf list = foldl1 (<||>) list
+-- | Checks if window is transient to another
isNotTransient :: Query Bool
isNotTransient = do
mbw <- transientTo
@@ -181,6 +189,7 @@ runApp (Named app _) = runApp app
apps2hooks :: Apps -> [ManageHook]
apps2hooks lst = map appHook lst
+-- | Get keybindings for Apps
apps2keys :: GSConfig Window -> Apps -> [(String, X ())]
apps2keys gsconfig apps = mapMaybe hotkey apps
where
@@ -188,6 +197,8 @@ apps2keys gsconfig apps = mapMaybe hotkey apps
hotkey (Named app _) = hotkey app
hotkey _ = Nothing
+-- | Switch to selected (from that are matching given query),
+-- or run given action, if there is no matching windows.
selectWithQuery :: GSConfig Window -> Query Bool -> X () -> X ()
selectWithQuery gsconfig qry run = do
wins <- matchingWindows qry
@@ -196,16 +207,18 @@ selectWithQuery gsconfig qry run = do
[w] -> focus w
_ -> selectOneWindow gsconfig wins
+-- | Switch to window, which is selected from given list
selectOneWindow :: GSConfig Window -> [Window] -> X ()
selectOneWindow gsconfig wins = do
titles <- mapM windowTitle wins
- selected <- gridselect' gsconfig $ zip titles wins
+ selected <- gridselect gsconfig $ zip titles wins
whenJust selected $ \w -> do
focus w
sendMessage (RestoreMinimizedWin w)
where
windowTitle w = show `fmap` getName w
+-- | Switch to selected appgroup.
switchToApp :: GSConfig Window -> Apps -> String -> X ()
switchToApp gsconfig apps name =
case filter (\a -> groupName a == name) apps of
@@ -217,27 +230,16 @@ switchToApp gsconfig apps name =
_ -> selectOneWindow gsconfig ws
_ -> return ()
--- Applies the given action to every list element in turn until
--- the first element is found for which the action returns true. The
--- remaining elements in the list are ignored.
-findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
-findM cond xs = findM' cond xs
- where
- findM' _ [] = return Nothing
- findM' qry (x':xs') = do
- isMatch <- qry x'
- if isMatch
- then return (Just x')
- else findM qry xs'
-
+-- | Get list of windows matching the query
matchingWindows :: Query Bool -> X [Window]
matchingWindows query = withWindowSet (return . W.allWindows) >>= filterM (runQuery query)
+-- | Select one of applications groups
selectAppGroup :: GSConfig App -> GSConfig Window -> Apps -> X ()
selectAppGroup gscA gscW apps = do
nonempty <- filterM isNotEmpty apps
let names = map groupName nonempty
- group <- gridselect' gscA $ zip names nonempty
+ group <- gridselect gscA $ zip names nonempty
whenJust group $ \app ->
selectWithQuery gscW (query app) (runApp app)
where
diff --git a/lib/CommonFunctions.hs b/lib/CommonFunctions.hs
index 657ead7..55e9506 100644
--- a/lib/CommonFunctions.hs
+++ b/lib/CommonFunctions.hs
@@ -1,5 +1,17 @@
-
-module CommonFunctions where
+-- | Some common functions
+module CommonFunctions
+ (promptOSD, killIfNot,
+ chooseLayout, promptPublishShot,
+ trashWindow, emptyCurrentWorkspace,
+ moveToWorkspace,
+ gotoWorkspace,
+ specialMove,
+ vimsessions, textEditors,
+ recent,
+ (~?),
+ rotateWindows, rotateWindows',
+ unmapEventHook)
+ where
import System.FilePath.Glob
import System.FilePath
@@ -24,26 +36,31 @@ import XMonad.Actions.GridSelect
import Themes
-gridselect' :: GSConfig a -> [(String, a)] -> X (Maybe a)
-gridselect' = gridselect
-
+-- | Run specified window operation on selected window,
+-- if that window does not match given Property
doWithAnyBut :: Property -> (Window -> X ()) -> Window -> X ()
doWithAnyBut prop action w = do
hasProp <- hasProperty prop w
when (not hasProp) $ action w
+-- | Close the Window, if it does not match given Property
closeAnyBut :: Property -> Window -> X ()
closeAnyBut prop = doWithAnyBut prop killWindow
+-- | Close current window, if it does not match given Property
killIfNot :: Property -> X ()
killIfNot prop = withFocused $ closeAnyBut prop
------------------------------------------------------------------------
-- Rotate window list
+-- | Rotate list
+rotate :: [a] -> [a]
rotate [] = []
rotate (x:xs) = xs ++ [x]
+-- | Rotate list backwards
+rotate' :: [a] -> [a]
rotate' = reverse . rotate . reverse
rotateStack :: W.Stack a -> Maybe (W.Stack a)
@@ -58,11 +75,16 @@ rotateWinSet = W.modify Nothing rotateStack
rotateWinSet' :: WindowSet -> WindowSet
rotateWinSet' = W.modify Nothing rotateStack'
+rotateWindows :: X ()
rotateWindows = windows rotateWinSet
+
+rotateWindows' :: X ()
rotateWindows' = windows rotateWinSet'
-----------------------------------------------------------------------
+-- | Select specified layout for current workspace
+chooseLayout :: String -> X ()
chooseLayout name = sendMessage $ JumpToLayout name
-- osdString :: String -> IO ()
@@ -74,18 +96,8 @@ chooseLayout name = sendMessage $ JumpToLayout name
-- \osd -> XOSD.display osd 0 (XOSD.String n)
-- return ()
-------------------------------------------------------------------------
--- Layouts:
-
-getLayout :: X String
-getLayout = withWindowSet (\s -> return $ description $ W.layout $ W.workspace $ W.current s)
-
-getCurrentWorkspace :: X String
-getCurrentWorkspace = withWindowSet (\s -> return $ W.tag $ W.workspace $ W.current s)
-
---------------------------------------------------
--
-spawnMany lst = foldr1 (>>) (map spawn lst)
showOSD :: String -> X()
showOSD text = spawn $ "echo " ++ text ++ " | osd_cat -p bottom -A center -f '-*-*-*-*-*-*-32-*-*-*-*-*-*-*' -s 2 -c green"
@@ -104,31 +116,39 @@ promptPublishShot = inputPrompt myXPConfig "Screenshot name" ?+ publishShot
----------------------------------------------------
-- Window tags
--
+stackPlus :: W.Stack a -> W.Stack a -> Maybe (W.Stack a)
stackPlus s1 s2 = Just W.Stack {W.focus = W.focus s1,
W.up = (W.up s1) ++ (W.up s2),
W.down = (W.down s1) ++ (W.down s2) ++ [W.focus s2]}
+stackPlus' :: Maybe (W.Stack a) -> W.Stack a -> Maybe (W.Stack a)
stackPlus' Nothing st = Just st
stackPlus' (Just s1) s2 = stackPlus s1 s2
+modifyWs :: (Eq s, Eq i) => i-> Maybe (W.Stack a)-> (W.Stack a -> Maybe (W.Stack a))-> W.StackSet i l a s sd-> W.StackSet i l a s sd
modifyWs i d f s = W.modify d f (W.view i s)
+emptyCurrentWs :: W.StackSet i l a s sd -> W.StackSet i l a s sd
emptyCurrentWs = W.modify Nothing (const Nothing)
+addStackToTarget :: (Eq s, Eq i) =>i-> Maybe (W.Stack a)-> W.StackSet i l a s sd-> W.StackSet i l a s sd
addStackToTarget target st = modifyWs target st (stackPlus' st)
+returnToCurrent :: (Eq s1, Eq i) =>W.StackSet i l a s sd-> W.StackSet i l1 a1 s1 sd1-> W.StackSet i l1 a1 s1 sd1
returnToCurrent c s = W.view curtag s
where curtag = W.currentTag c
+curstack :: W.StackSet i l a sid sd -> Maybe (W.Stack a)
curstack s = W.stack $ W.workspace $ W.current s
+emptyCurrentWorkspace :: (Eq s) => W.StackSet String l a s sd -> W.StackSet String l a s sd
emptyCurrentWorkspace s = returnToCurrent s (addStackToTarget "trash" (curstack s) $ emptyCurrentWs s)
currentList :: X [Window]
currentList = withWindowSet (\s -> return $ W.integrate' $ curstack s)
unmaximize :: Window -> X ()
-unmaximize w = withDisplay $ unmaximize' w
+unmaximize win = withDisplay $ unmaximize' win
where
unmaximize' w d =
let swd = widthOfScreen s
@@ -147,6 +167,7 @@ isFloat w = do
fls <- withWindowSet (return . W.floating)
return (w `M.member` fls)
+specialMove :: Window -> X ()
specialMove w = do
focus w
lst <- currentList
@@ -164,9 +185,12 @@ gotoWorkspace n = do
windows $ W.greedyView n
-- io $ osdString n
+-- | Move current window to given workspace
moveToWorkspace :: WorkspaceId -> X ()
moveToWorkspace n = windows $ W.shift n
+-- | Run recently-used.py for given mime-types
+recent :: [String] -> String
recent types = "recently-used.py " ++ unwords (map mime types)
where
mime t = fromMaybe "" $ lookup t pairs
@@ -175,36 +199,37 @@ recent types = "recently-used.py " ++ unwords (map mime types)
("doc", "application/msword application/vnd.oasis.opendocument.text"),
("png", "image/png")]
+-- | Open selected GVim session
vimsessions :: X ()
vimsessions = do
home <- io $ getEnv "HOME"
paths <- io $ (concat . fst) `fmap` globDir [compile "*.vimsession"] (home </> ".vim/sessions")
let actions = map ("gvim -S " ++) paths
sessions = map (dropExtension . takeFileName) paths
- selected <- gridselect' myGSConfig $ zip sessions actions
+ selected <- gridselect myGSConfig $ zip sessions actions
whenJust selected spawn
+-- | Run the selected text editor
+textEditors :: X ()
textEditors = do
let editors = ["gvim", "kate", "gedit"]
- selected <- gridselect' myGSConfig $ zip editors editors
+ selected <- gridselect myGSConfig $ zip editors editors
case selected of
Nothing -> return ()
Just "gvim" -> vimsessions
Just editor -> spawn editor
+-- | Move current window to `trash' workspace
+trashWindow :: X ()
trashWindow = do
addWorkspace "trash"
moveToWorkspace "trash"
-
--- On window unmap, remove current workspace if it's empty.
+-- | On window unmap, remove current workspace if it's empty.
unmapEventHook :: Event -> X All
-unmapEventHook e@(UnmapEvent {}) = removeEmptyWorkspace >> return (All True)
+unmapEventHook (UnmapEvent {}) = removeEmptyWorkspace >> return (All True)
unmapEventHook _ = return (All True)
-cls ?> action = nextMatchOrDo Forward (className ~? cls) action
-infixr 5 ?>
-
-- | Regular expressions matching for ManageHooks
(~?) :: (Functor f) => f String -> String -> f Bool
q ~? x = fmap (=~ x) q
diff --git a/lib/GroupsSetup.hs b/lib/GroupsSetup.hs
index f6d213f..85b484b 100644
--- a/lib/GroupsSetup.hs
+++ b/lib/GroupsSetup.hs
@@ -1,11 +1,13 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-}
module GroupsSetup where
import AppGroups
-import CommonFunctions
+import CommonFunctions (textEditors, recent)
+regex :: (Condition (Regex a), Condition a) => a -> Cond
regex = C . Regex
+defaultFM :: String
defaultFM = "konqueror --profile filemanagement"
myApps =
diff --git a/lib/KeyBindings.hs b/lib/KeyBindings.hs
index 9ece3af..9c37844 100644
--- a/lib/KeyBindings.hs
+++ b/lib/KeyBindings.hs
@@ -30,9 +30,9 @@ import qualified XMonad.Layout.WindowNavigation as Nav
import XMonad.Prompt.Window
import CommonFunctions
-import Themes
-import AppGroups
-import GroupsSetup
+import Themes (myXPConfig, myGSConfig)
+import AppGroups (selectAppGroup, switchToApp)
+import GroupsSetup (myApps)
workspaceOrder = ["inet","text","files","im","term"]
diff --git a/lib/MyManageHooks.hs b/lib/MyManageHooks.hs
index 4a65406..1201688 100644
--- a/lib/MyManageHooks.hs
+++ b/lib/MyManageHooks.hs
@@ -11,9 +11,9 @@ import Control.Monad (liftM)
import XMonad
import XMonad.Hooks.ManageHelpers hiding (C)
-import AppGroups
-import GroupsSetup
-import CommonFunctions
+import AppGroups (doFullscreen, apps2hooks)
+import GroupsSetup (myApps)
+import CommonFunctions ((~?))
myManageHook = basehooks <+> manageMenus <+> manageDialogs <+> floatPlasma
@@ -38,31 +38,19 @@ checkAtom name value = ask >>= \w -> liftX $ do
checkMenu = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_MENU"
-- Check if window is a dialog
checkDialog = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
-checkDesktop = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DESKTOP"
-checkDockAtom = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DOCK"
-checkOverride = checkAtom "_NET_WM_WINDOW_TYPE" "_KDE_NET_WM_WINDOW_TYPE_OVERRIDE"
-checkFullscreen = checkAtom "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN"
+-- checkDesktop = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DESKTOP"
+-- checkDockAtom = checkAtom "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DOCK"
+-- checkOverride = checkAtom "_NET_WM_WINDOW_TYPE" "_KDE_NET_WM_WINDOW_TYPE_OVERRIDE"
+-- checkFullscreen = checkAtom "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN"
-- | Helper to read a property
getProp :: Window -> Atom -> X (Maybe [CLong])
getProp w a = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
-mNot = liftM not
-
-floatclasses :: [String] -> [ManageHook]
-floatclasses clss = [ className =? cls --> doCenterFloat | cls <- clss ]
-
-ignoresome = composeAll
- [ className =? "trayer" --> doIgnore
- , className =? "fbpanel" --> doIgnore
- , checkOverride --> doFloat
- , checkDesktop --> doIgnore
- , checkDockAtom --> doIgnore]
+-- mNot = liftM not
basehooks = composeAll (apps2hooks myApps) <+> transience'
-role = stringProperty "WM_WINDOW_ROLE"
-
floatPlasma = composeAll
[ className =? "Qt-subapplication" --> doFloat,
title =? "Qt-subapplication" --> doFloat,
diff --git a/lib/Themes.hs b/lib/Themes.hs
index c65fe85..3a48f8c 100644
--- a/lib/Themes.hs
+++ b/lib/Themes.hs
@@ -6,6 +6,8 @@ import XMonad
import XMonad.Prompt
import XMonad.Actions.GridSelect
+-- | My XMonad Prompt config
+myXPConfig :: XPConfig
myXPConfig = defaultXPConfig {
font = "xft:Arial-10",
bgColor = myFocusedBorderColor,
@@ -18,7 +20,10 @@ myGSConfig = defaultGSConfig {
-----------------------------------------------------------------------
-- Some general settings
-myWorkspaces = ["main"]
+myWorkspaces :: [WorkspaceId]
+myWorkspaces = ["main"]
+
+myFocusedBorderColor :: String
myFocusedBorderColor = "#97ACC1"
myBorderWidth :: Dimension
@@ -45,7 +50,7 @@ myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
,(xK_space , setPos (0,0) >> myNavigation)
]
-- The navigation handler ignores unknown key symbols
- navDefaultHandler (ks,str,mask) = myNavigation
+ navDefaultHandler = const myNavigation
makeKeymap pairs = M.fromList $ concatMap allMasks pairs
allMasks (keysym, action) = [((0, keysym), action),
((8192, keysym), action)]