From eada656879b12c12a9744a066f70d8a03399210c Mon Sep 17 00:00:00 2001 From: Ilya Portnov Date: Mon, 2 May 2011 15:46:27 +0600 Subject: [PATCH] Cleanup & some docs. --- lib/AppGroups.hs | 42 ++++++++++++++------------- lib/CommonFunctions.hs | 73 ++++++++++++++++++++++++++++++++---------------- lib/GroupsSetup.hs | 6 ++- lib/KeyBindings.hs | 6 ++-- lib/MyManageHooks.hs | 28 +++++------------- lib/Themes.hs | 9 ++++- 6 files changed, 93 insertions(+), 71 deletions(-) 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)] -- 1.7.2.3