diff --git a/.gitignore b/.gitignore index f7bbe0d..1942664 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ * !*.hs +!*.lhs !lib/ !lib/*.hs !.gitignore diff --git a/lib/AppGroups.hs b/lib/AppGroups.hs deleted file mode 100644 index 03ffa55..0000000 --- a/lib/AppGroups.hs +++ /dev/null @@ -1,250 +0,0 @@ -{-# LANGUAGE ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-} -module AppGroups - (Key, App (..), Apps, Condition (..), Cond (..), - query, - oneOf, apps2hooks, apps2keys, - selectAppGroup, runNewApp, - switchToApp, - doFullscreen) - where - -import Control.Monad -import Data.Maybe -import Text.Printf - -import XMonad -import qualified XMonad.StackSet as W - -import XMonad.Actions.GridSelect -import XMonad.Actions.DynamicWorkspaces -import XMonad.Util.WindowProperties -import XMonad.Util.WindowPropertiesRE - -import CommonFunctions (selectOneWindow) - --- | Shortcut key -type Key = String - -type Apps = [App] - --- | Applications group description -data App = On App Key -- ^ Bind App to Key - | String ::: Conds -- ^ command ::: window classes - | X () :>> Conds -- ^ action ::: window classes - | Group Conds -- ^ just a list of window classes - | Fullscreen App -- ^ run App fullscreen - | Float App -- ^ run App in floating window - | App :-> String -- ^ move App to given workspace - | Named App String -- ^ Give a name for this App - -instance Show App where - show (On app key) = printf "%s `On` %s" (show app) key - show (cmd ::: conds) = printf "%s ::: %s" cmd (show conds) - show (_ :>> conds) = printf "<X()> :>> %s" (show conds) - show (Group conds) = printf "Group %s" (show conds) - show (Fullscreen app) = printf "Fullscreen %s" (show app) - show (Float app) = printf "Float %s" (show app) - show (app :-> wksp) = printf "%s :-> %s" (show app) wksp - show (Named app name) = printf "%s `Named` %s" (show app) name - --- | Container for different conditions -data Cond = forall c. Condition c => C c - -instance Show Cond where - show (C c) = show c - -type Conds = [Cond] - --- | Class for conditions -class (Show c) => Condition c where - toQuery :: c -> Query Bool - -instance Condition String where - toQuery s = className =? s - -instance Condition Property where - toQuery p = propertyToQuery p - -instance Condition PropertyRE where - toQuery (RE p) = propertyToQueryRE p - --- | Turn any X () operation on window into ManageHook -fromWindowOp :: (Window -> X()) -> ManageHook -fromWindowOp fn = ask >>= \w -> liftX (fn w) >> doF id - --- | Turn any X () operation into ManageHook -fromX :: X () -> ManageHook -fromX op = fromWindowOp $ const op - --- | Make window floating and fullscreen -fullscreen :: Window -> X () -fullscreen w = withDisplay $ fullscreen' w - where - fullscreen' :: Window -> Display -> X () - fullscreen' w d = let wd = widthOfScreen s - ht = heightOfScreen s - s = defaultScreenOfDisplay d - in do float w - io $ resizeWindow d w wd ht - -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 --- case mbw of --- Nothing -> return True --- Just _ -> return False - -conditions :: App -> Conds -conditions (On app _) = conditions app -conditions (_ ::: list) = list -conditions (_ :>> list) = list -conditions (Group list) = list -conditions (Fullscreen app) = conditions app -conditions (app :-> _) = conditions app -conditions (Float app) = conditions app -conditions (Named app _) = conditions app - --- | Get Query from applications group description -query :: App -> Query Bool -query app = oneOf [toQuery c | (C c) <- conditions app] - -hookAction :: App -> (Query Bool -> ManageHook) -hookAction (On app _) = hookAction app -hookAction (_ ::: _) = const idHook -hookAction (_ :>> _) = const idHook -hookAction (Group _) = const idHook -hookAction (Fullscreen app) = hookAction app -hookAction (_ :-> wksp) = (--> moveJump wksp) -hookAction (Float app) = (--> doFloat) -hookAction (Named app _) = hookAction app - -appHook :: App -> ManageHook -appHook (Fullscreen app) = query app --> doFullscreen -appHook app = hookAction app (query app) - -groupName :: App -> String -groupName (On app _) = groupName app -groupName (command ::: _) = command -groupName (_ :>> _) = "X ()" -groupName (Group _) = "Group" -groupName (Fullscreen app) = groupName app -groupName (_ :-> wksp) = wksp -groupName (Float app) = groupName app -groupName (Named _ name) = name - -appWorkspace :: App -> Maybe WorkspaceId -appWorkspace (On app _) = appWorkspace app -appWorkspace (_ ::: _) = Nothing -appWorkspace (_ :>> _) = Nothing -appWorkspace (Group _) = Nothing -appWorkspace (_ :-> wksp) = Just wksp -appWorkspace (Float app) = appWorkspace app -appWorkspace (Fullscreen app) = appWorkspace app -appWorkspace (Named app _) = appWorkspace app - -appAction :: App -> Maybe (X ()) -appAction (On app _) = appAction app -appAction (command ::: app) = Just $ spawn command -appAction (action :>> _) = Just action -appAction (Group _) = Nothing -appAction (Fullscreen app) = appAction app -appAction (Named app _) = appAction app -appAction (Float app) = appAction app -appAction (app :-> _) = appAction app - -runApp :: App -> X () -runApp (command ::: _) = spawn command -runApp (app :-> wksp) = runApp app -runApp (action :>> _) = action -runApp (On app _) = runApp app -runApp (Group _) = return () -runApp (Fullscreen ap) = runApp ap -runApp (Float app) = runApp app -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 - hotkey (On app key) = Just (key, selectWithQuery gsconfig (query app) (runApp app)) - 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 - case wins of - [] -> run - [w] -> focus w - _ -> selectOneWindow gsconfig wins - --- | Switch to selected appgroup. -switchToApp :: GSConfig Window -> Apps -> String -> X () -switchToApp gsconfig apps name = - case filter (\a -> groupName a == name) apps of - [app] -> do - ws <- matchingWindows (query app) - case ws of - [] -> runApp app - [w] -> focus w - _ -> selectOneWindow gsconfig ws - _ -> return () - --- | 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 - whenJust group $ \app -> - selectWithQuery gscW (query app) (runApp app) - -isNotEmpty :: App -> X Bool -isNotEmpty group = (not . null) `fmap` matchingWindows (query group) - -shouldRun :: App -> X Bool -shouldRun group = do - ws <- matchingWindows (query group) - if null ws - then return $ isJust $ appAction group - else return False - -runNewApp :: GSConfig App -> Apps -> X () -runNewApp gsconfig apps = do - empty <- filterM shouldRun apps - let names = map groupName empty - selected <- gridselect gsconfig $ zip names empty - whenJust selected runApp - diff --git a/lib/AppGroups.lhs b/lib/AppGroups.lhs new file mode 100644 index 0000000..6fec1bc --- /dev/null +++ b/lib/AppGroups.lhs @@ -0,0 +1,336 @@ +AppGroups — группы приложений +============================= + +Описание +-------- + +Группа приложений задаётся набором условий на окна. Этот модуль позволяет описать в одном месте +и ManageHook-и, и сочетания клавиш для групп приложений. Кроме того, с группой может быть связано +действие. Это действие запускается вместо переключения на группу, в том случае, если окон в группе +сейчас нет. + +Заголовки модуля +---------------- +Включаем нужные расширения языка. Здесь используются Existentials для +организации гетерогенных списков. + +> {-# LANGUAGE ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, DeriveDataTypeable, PatternGuards, ViewPatterns #-} + +Объявление модуля + +> module AppGroups +> (Key, App, Apps, Condition (..), Cond (..), +> group, on, full, float, +> nofocus, named, orSpawn, orRun, +> (~>), +> doFullscreen, query, +> oneOf, apps2hooks, apps2keys, +> selectAppGroup, switchToApp) +> where + +Импорты +------- + +Импорты из стандартной библиотеки: + +> import Control.Monad +> import Data.Maybe + +Импорты из библиотеки XMonad: + +> import XMonad hiding (float) +> import qualified XMonad +> import qualified XMonad.StackSet as W + +Импорты из xmonad-contrib + +> import XMonad.Actions.GridSelect +> import XMonad.Actions.DynamicWorkspaces +> import XMonad.Layout.Minimize +> import XMonad.Util.WindowProperties +> import XMonad.Util.NamedWindows +> import XMonad.Hooks.ManageHelpers hiding (C) + +Этот импорт из xmonad-extras, патч ещё не принят :/ + +> import XMonad.Util.WindowPropertiesRE + +Импорты других модулей конфига + +> import CommonFunctions (matchingWindows, selectOneWindow) + +Класс Condition +--------------- + +Класс типов для условий. Условие — это всё, из чего можно сделать +Query Bool+, +т.е. запрос, который для каждого окна будет возвращать Bool — подходящее это +окно или нет. + +> class Condition c where +> toQuery :: c -> Query Bool + +Если в качестве условия используется просто строка, считаем что эта строка +должна быть в классе окна. + +> instance Condition String where +> toQuery s = className =? s + +С типом +Property+ всё вроде ясно. + +> instance Condition Property where +> toQuery p = propertyToQuery p + +Тип +PropertyRE+ — из +X.U.WindowPropertiesRE+. Аналог +Property+, +но проверяет не точное совпадение строки со свойством окна, а +соответствие регулярному выражению. + +> instance Condition PropertyRE where +> toQuery (RE p) = propertyToQueryRE p + +Типы данных +----------- + +Тип для сочетаний клавиш + +> type Key = String + +Список групп приложений + +> type Apps = [App] + +Тип данных для описания группы приложений. + +> data App = App { +> hotkey :: Maybe Key, +> action :: X (), +> conditions :: Conds, +> makeFullscreen :: Bool, +> makeFloat :: Bool, +> noFocus :: Bool, +> moveToWksp :: Maybe WorkspaceId, +> shortName :: Maybe String } + +Тип-контейнер, который может хранить любой тип условий. + +> data Cond = forall c. Condition c => C c + +Список условий + +> type Conds = [Cond] + +EDSL для описания групп приложений +---------------------------------- + +Описывать группы приложений с использованием непосредственно конструктора +App+ +и record syntax длинно, неудобно и не наглядно. Поэтому ниже определяем набор +комбинаторов для конструирования значений типа +App+. + +Начальное значение. Определяет только набор условий на окна. + +> group :: Conds -> App +> group conds = App { +> hotkey = Nothing, +> action = return (), +> conditions = conds, +> makeFullscreen = False, +> makeFloat = False, +> noFocus = False, +> moveToWksp = Nothing, +> shortName = Nothing } + +Привязывает горячую клавишу к группе. + +> on :: App -> Key -> App +> on app key = app {hotkey = Just key} + +«Или запустить». Конструирует группу из набора условий и команды, которую нужно +запустить (+spawn+), если подходящих окон нет. + +> orSpawn :: Conds -> String -> App +> orSpawn conds command = (group conds) {action = spawn command} + +«Или выполнить». Аналогично +orSpawn+, но принимает не команду, а действие +X ()+. + +> orRun :: Conds -> X () -> App +> orRun conds x = (group conds) {action = x} + +Указывает, что окна этой группы надо разворачивать на весь экран. + +> full :: App -> App +> full app = app {makeFullscreen = True} + +Указывает, что окна этой группы надо делать плавающими. + +> float :: App -> App +> float app = app {makeFloat = True} + +Указывает, что при создании окон этой группы им не надо передавать фокус. + +> nofocus :: App -> App +> nofocus app = app {noFocus = True} + +Позволяет задать имя для группы, если почему-то не устраивает название рабочего места. + +> named :: App -> String -> App +> named app name = app {shortName = Just name} + +Окна этой группы должны открываться на указанном рабочем месте. + +> (~>) :: App -> WorkspaceId -> App +> app ~> wksp = app {moveToWksp = Just wksp} + +Утилиты +------- + +Делает +ManageHook+ из любой операции с окном. + +> fromWindowOp :: (Window -> X()) -> ManageHook +> fromWindowOp fn = ask >>= \w -> liftX (fn w) >> doF id + +Делает +ManageHook+ из любого действия. + +> fromX :: X () -> ManageHook +> fromX op = fromWindowOp $ const op + +Сделать окно плавающим и распахнуть на весь экран. + +> doFullscreen :: ManageHook +> doFullscreen = fromWindowOp (withDisplay . fullscreen) +> where +> fullscreen :: Window -> Display -> X () +> fullscreen w d = let wd = widthOfScreen s +> ht = heightOfScreen s +> s = defaultScreenOfDisplay d +> in do XMonad.float w +> io $ resizeWindow d w wd ht + +Переместить окно на заданное рабочее место. Если такого +рабочего места нет, создаёт его. + +> moveTo :: WorkspaceId -> ManageHook +> moveTo wksp = do +> fromX $ addWorkspace wksp +> doF $ W.shift wksp + +Перейти на заданное рабочее место. + +> jumpTo :: WorkspaceId -> X () +> jumpTo wksp = windows $ W.greedyView wksp + +Переместить окно на заданное рабочее место и переключиться туда. + +> moveJump :: WorkspaceId -> ManageHook +> moveJump wksp = (moveTo wksp) >> (fromX $ jumpTo wksp) + +Аналог +or+. + +> oneOf :: [Query Bool] -> Query Bool +> oneOf list = foldl1 (<||>) list + +Возвращает +True+, если окно *не* является вспомогательным к +какому-нибудь другому окну. + +> isNotTransient :: Query Bool +> isNotTransient = do +> mbw <- transientTo +> case mbw of +> Nothing -> return True +> Just _ -> return False + +Аналог +Control.Monad.when+ для +ManageHook+. + +> whenH :: Bool -> ManageHook -> ManageHook +> whenH condition action = if condition then action else doF id + +Аналог +XMonad.whenJust+ для +ManageHook+. + +> whenJustH :: Maybe a -> (a -> ManageHook) -> ManageHook +> whenJustH (Just x) action = action x +> whenJustH Nothing _ = doF id + +Утилиты для типа App +-------------------- + +Получить +Query Bool+ из описания группы приложений. + +> query :: App -> Query Bool +> query app = isNotTransient <&&> oneOf [toQuery c | (C c) <- conditions app] + +Получить +MaybeManageHook+ для группы приложений. + +> appHook :: App -> MaybeManageHook +> appHook app = query app -?> do +> whenH (makeFloat app) doFloat +> whenH (makeFullscreen app) doFullscreen +> whenJustH (moveToWksp app) moveJump +> whenH (noFocus app) $ doF W.focusDown + +Название группы приложений. + +> groupName :: App -> String +> groupName app +> | Just wksp <- moveToWksp app = wksp +> | Just name <- shortName app = name +> | otherwise = "unknown" + +Сделать список +MaybeManageHook+ из определений групп приложений. + +> apps2hooks :: Apps -> [MaybeManageHook] +> apps2hooks lst = map appHook lst + +Список привязок сочетаний клавиш. +Каждая комбинация клавиш будет переключать к одному из окон соответствующей +группы (окна выбираются с помощью +X.A.GridSelect+), или запускать связанное +с группой действие, если подходящих окон нет. + +> apps2keys :: GSConfig Window -> Apps -> [(String, X ())] +> apps2keys gsconfig apps = mapMaybe getHotkey apps +> where +> getHotkey app +> | Just key <- hotkey app = Just (key, selectWithQuery gsconfig (query app) (action app)) +> | otherwise = Nothing + +Выбрать окно из подходящих под запрос (с использованием +X.A.GridSelect+), +или запустить указанное действие, если таких окон нет. + +> selectWithQuery :: GSConfig Window -> Query Bool -> X () -> X () +> selectWithQuery gsconfig qry run = do +> wins <- matchingWindows qry +> case wins of +> [] -> run +> [w] -> focus w +> _ -> do +> titles <- mapM windowTitle wins +> selected <- gridselect gsconfig $ zip titles wins +> whenJust selected $ \w -> do +> focus w +> sendMessage (RestoreMinimizedWin w) +> where +> windowTitle w = show `fmap` getName w + +Выбрать группу приложений (переключиться на одно из окон группы или +запустить действие). Два +GSConfig+ нужны, потому что сначала выбирается +группа, а потом окно из группы. + +> 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 +> whenJust group $ \app -> +> selectWithQuery gscW (query app) (action app) +> where +> isNotEmpty :: App -> X Bool +> isNotEmpty group = (not . null) `fmap` matchingWindows (query group) + +> switchToApp :: GSConfig Window -> Apps -> String -> X () +> switchToApp gsconfig apps name = +> case filter (\a -> groupName a == name) apps of +> [app] -> do +> ws <- matchingWindows (query app) +> case ws of +> [] -> action app +> [w] -> focus w +> _ -> selectOneWindow gsconfig ws +> _ -> return () + diff --git a/lib/CommonFunctions.hs b/lib/CommonFunctions.hs deleted file mode 100644 index a437306..0000000 --- a/lib/CommonFunctions.hs +++ /dev/null @@ -1,275 +0,0 @@ --- | Some common functions -module CommonFunctions - (promptOSD, killIfNot, - chooseLayout, promptPublishShot, - trashWindow, emptyCurrentWorkspace, - moveToWorkspace, - gotoWorkspace, - selectOneWindow, searchInWorkspace, - specialMove, - vimsession, vimsessions, textEditors, - edit_config, - recent, - (~?), - isFloat, - rotateWindows, rotateWindows', - unmapEventHook) - where - -import System.FilePath.Glob -import System.FilePath -import System.Environment (getEnv) -import Control.Monad (when) -import qualified Data.Map as M -import Data.Maybe -import Data.Monoid -import Graphics.X11.Xlib.Extras -import Text.Regex.Posix ((=~)) - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Util.WindowProperties -import XMonad.Layout.LayoutCombinators -import XMonad.Layout.Minimize - -import XMonad.Prompt.Input -import XMonad.Util.NamedWindows - -import XMonad.Actions.DynamicWorkspaces -import XMonad.Actions.GridSelect -import XMonad.Actions.SpawnOn - -import Themes - --- | 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) -rotateStack stk = W.differentiate $ rotate $ W.integrate stk - -rotateStack' :: W.Stack a -> Maybe (W.Stack a) -rotateStack' stk = W.differentiate $ rotate' $ W.integrate stk - -rotateWinSet :: WindowSet -> WindowSet -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 () --- osdString n = do --- forkIO $ XOSD.runXOSD [XOSD.Timeout 2, --- XOSD.HAlign XOSD.HAlignCenter, --- XOSD.VOffset 900, --- XOSD.Font "-*-fixed-*-*-*-*-17-*-*-*-*-*-*-*"] $ --- \osd -> XOSD.display osd 0 (XOSD.String n) --- return () - ---------------------------------------------------- --- - -showOSD :: String -> X() -showOSD text = spawn $ "echo " ++ text ++ " | osd_cat -p bottom -A center -f '-*-*-*-*-*-*-32-*-*-*-*-*-*-*' -s 2 -c green" - -promptOSD :: X() -promptOSD = inputPrompt myXPConfig "Text" ?+ showOSD - -publishShot :: String -> X() -publishShot name = do - spawn $ "/usr/local/bin/publish-screen "++name - spawn ("xmessage http://iportnov.ru/files/screens/"++name++".png") - -promptPublishShot :: X() -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 - -getCurrentWorkspace :: X WorkspaceId -getCurrentWorkspace = withWindowSet (\ws -> return $ W.tag $ W.workspace $ W.current ws) - -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 win = withDisplay $ unmaximize' win - where - unmaximize' w d = - let swd = widthOfScreen s - sht = heightOfScreen s - wd = round $ 0.9*(fromIntegral swd) - ht = round $ 0.9*(fromIntegral sht) - x = round $ (fromIntegral (swd-wd))/2 - y = round $ (fromIntegral (sht-ht))/2 - s = defaultScreenOfDisplay d - in do float w - io $ resizeWindow d w wd ht - io $ moveWindow d w x y - -isFloat :: Window -> X Bool -isFloat w = do - fls <- withWindowSet (return . W.floating) - return (w `M.member` fls) - -specialMove :: Window -> X () -specialMove w = do - focus w - lst <- currentList - case lst of - [] -> return () - [x] -> do - is <- isFloat x - if is - then mouseMoveWindow w - else float x >> unmaximize x - _ -> mouseMoveWindow w - -gotoWorkspace :: WorkspaceId -> X () -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 - pairs = [("pdf", "application/pdf application/epub+zip"), - ("djvu", "application/djvu"), - ("doc", "application/msword application/vnd.oasis.opendocument.text"), - ("png", "image/png")] - --- | Open specified GVim session -vimsession :: String -> X () -vimsession name = do - home <- io $ getEnv "HOME" - let path = home </> ".vim/sessions" </> (name ++ ".vimsession") - spawn ("gvim -S " ++ path) - --- | Open selected GVim session -vimsessions :: X () -vimsessions = do - home <- io $ getEnv "HOME" - paths <- io $ (concat . fst) `fmap` globDir [compile "*.vimsession"] (home </> ".vim/sessions") - let sessions = map (dropExtension . takeFileName) paths - selected <- gridselect myGSConfig $ zip sessions sessions - whenJust selected vimsession - --- | Run the selected text editor -textEditors :: X () -textEditors = do - let editors = ["gvim", "kate", "gedit"] - selected <- gridselect myGSConfig $ zip editors editors - case selected of - Nothing -> return () - Just "gvim" -> vimsessions - Just editor -> spawn editor - --- | 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 - whenJust selected $ \w -> do - focus w - sendMessage (RestoreMinimizedWin w) - where - windowTitle w = show `fmap` getName w - -searchInWorkspace :: GSConfig Window -> X () -searchInWorkspace gsconfig = do - ws <- currentList - selectOneWindow gsconfig ws - --- | Move current window to `trash' workspace -trashWindow :: X () -trashWindow = do - addWorkspace "trash" - moveToWorkspace "trash" - --- | On window unmap, remove current workspace if it's empty. -unmapEventHook :: Event -> X All -unmapEventHook (UnmapEvent {}) = do - current <- getCurrentWorkspace - when (current /= "dashboard") removeEmptyWorkspace - return (All True) -unmapEventHook _ = return (All True) - --- | Regular expressions matching for ManageHooks -(~?) :: (Functor f) => f String -> String -> f Bool -q ~? x = fmap (=~ x) q - -edit_config :: X () -edit_config = do - vimsession "xmonad" - spawnOn "text" =<< asks (terminal . config) - - diff --git a/lib/CommonFunctions.lhs b/lib/CommonFunctions.lhs new file mode 100644 index 0000000..401d1e6 --- /dev/null +++ b/lib/CommonFunctions.lhs @@ -0,0 +1,196 @@ +Общие функции +============= + +Заголовок и импорты +------------------- + +> module CommonFunctions +> ( +> recent, vimsessions, textEditors, +> vimsession, +> searchInWorkspace, enshureMaster, +> caseLayoutOf, currentList, isFloat, +> matchingWindows, selectOneWindow, +> chooseLayout, +> togglePidginRoster, +> (~?), +> unmapEventHook, +> ) where + +Импорты из стандартной библиотеки: + +> import Control.Monad (filterM, when) +> import System.FilePath.Glob +> import System.FilePath +> import System.Environment (getEnv) +> import Data.Maybe +> import Data.Monoid +> import qualified Data.Map as M + +Импорты из дополнительных библиотек (X11 и какой-нибудь библиотеки для регулярных выражений, +например regex-posix). + +> import Graphics.X11.Xlib.Extras +> import Text.Regex.Posix ((=~)) + +Импорты из XMonad + +> import XMonad +> import qualified XMonad.StackSet as W + +Из xmonad-contrib + +> import XMonad.Util.NamedWindows +> import XMonad.Layout.LayoutCombinators +> import XMonad.Layout.Minimize + +> import XMonad.Actions.DynamicWorkspaces +> import XMonad.Actions.GridSelect + +Модуль из конфига. + +> import Themes + +Определения +----------- + +Выбрать алгоритм расположения окон по имени. + +> chooseLayout name = sendMessage $ JumpToLayout name + +Получить название текущего layout. + +> getLayout :: X String +> getLayout = withWindowSet (\s -> return $ description $ W.layout $ W.workspace $ W.current s) + +Список окон на текущем рабочем месте. + +> currentList :: X [Window] +> currentList = withWindowSet (\s -> return $ W.integrate' $ W.stack $ W.workspace $ W.current s) + +Получить название текущего рабочего места. + +> getCurrentWorkspace :: X WorkspaceId +> getCurrentWorkspace = withWindowSet (\ws -> return $ W.tag $ W.workspace $ W.current ws) + +Проверить, является ли окно плавающим. + +> isFloat :: Window -> X Bool +> isFloat w = do +> fls <- withWindowSet (return . W.floating) +> return (w `M.member` fls) + +Запустить скрипт +recently-used.py+ для заданных типов файлов. Этот скрипт показывает +список последних открывавшихся файлов заданных типов. + +> recent types = "recently-used.py " ++ unwords (map mime types) +> where +> mime t = fromMaybe "" $ lookup t pairs +> pairs = [("pdf", "application/pdf application/epub+zip"), +> ("djvu", "application/djvu"), +> ("doc", "application/msword"), +> ("png", "image/png")] + +Открыть указанную сессию GVim. + +> vimsession :: String -> X () +> vimsession name = do +> home <- io $ getEnv "HOME" +> let path = home </> ".vim/sessions" </> (name ++ ".vimsession") +> spawn ("gvim -S " ++ path) + +Выбрать сессию GVim и открыть её. + +> vimsessions :: X () +> vimsessions = do +> home <- io $ getEnv "HOME" +> paths <- io $ (concat . fst) `fmap` globDir [compile "*.vimsession"] (home </> ".vim/sessions") +> let sessions = map (dropExtension . takeFileName) paths +> selected <- gridselect myGSConfig $ zip sessions sessions +> whenJust selected vimsession + +Запустить один из нескольких текстовых редакторов. + +> textEditors = do +> let editors = ["gvim", "kate", "gedit"] +> selected <- gridselect myGSConfig $ zip editors editors +> case selected of +> Nothing -> return () +> Just "gvim" -> vimsessions +> Just editor -> spawn editor + +> role = stringProperty "WM_WINDOW_ROLE" + +Показать/спрятать ростер Pidgin. + +> togglePidginRoster = do +> rosters <- matchingWindows (role =? "buddy_list") +> if null rosters +> then spawn "purple-remote PurpleBlistSetVisible\\(1\\)" +> else spawn "purple-remote PurpleBlistSetVisible\\(0\\)" + +Получить список окон, подходящих под запрос. + +> matchingWindows :: Query Bool -> X [Window] +> matchingWindows query = withWindowSet (return . W.allWindows) >>= filterM (runQuery query) + +При закрытии (точнее, unmap) окна — удалить текущее рабочее пространство, если оно осталось пустым. +Пространство "dashboard" — не удалять. + +> unmapEventHook :: Event -> X All +> unmapEventHook (UnmapEvent {}) = do +> current <- getCurrentWorkspace +> when (current /= "dashboard") removeEmptyWorkspace +> return (All True) +> unmapEventHook _ = return (All True) + +Запустить одно из действий в зависимости от текущего layout. +Первый аргумент — список пар вида (+описание_layout+, +действие_на_этом_layout+) + +> caseLayoutOf :: [(String, X a)] -> X a -> X a +> caseLayoutOf pairs def = do +> layout <- getLayout +> case lookup layout pairs of +> Nothing -> def +> Just x -> x + +Если текущее окно — master, не делать ничего; иначе поменять его местами с master-окном. + +> enshureMaster :: X () +> enshureMaster = +> withFocused $ \w -> do +> ws <- currentList +> case ws of +> [] -> return () +> _ -> let master = head ws +> in if master == w +> then return () +> else windows W.swapMaster + +Аналог +(=?)+, но проверяет не точное совпадение, а соответствие регулярному выражению. + +> (~?) :: (Functor f) => f String -> String -> f Bool +> q ~? x = fmap (=~ x) q + +Переключиться на выбранное (с помощью +X.A.GridSelect+) окно из заданного списка. + +> selectOneWindow :: GSConfig Window -> [Window] -> X () +> selectOneWindow gsconfig wins = do +> titles <- mapM windowTitle wins +> selected <- gridselect gsconfig $ zip titles wins +> whenJust selected $ \w -> do +> focus w +> sendMessage (RestoreMinimizedWin w) +> where +> windowTitle w = show `fmap` getName w + +Выбрать окно на текущем рабочем месте. + +> searchInWorkspace :: GSConfig Window -> X () +> searchInWorkspace gsconfig = do +> ws <- currentList +> case ws of +> [] -> return () +> [x] -> return () +> _ -> selectOneWindow gsconfig ws + diff --git a/lib/GroupsSetup.hs b/lib/GroupsSetup.hs deleted file mode 100644 index 627f008..0000000 --- a/lib/GroupsSetup.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-} -module GroupsSetup where - -import XMonad.Util.WindowProperties -import XMonad.Util.WindowPropertiesRE - -import AppGroups -import CommonFunctions (textEditors, recent) - -regex = C . RE . ClassName - -defaultFM :: String -defaultFM = "konqueror --profile filemanagement" - -myApps = - [ "iceweasel" ::: [C "Epiphany-browser", C "Kontact", C "Iceweasel", - C "Firefox", C "Opera", C "Arora" ] :-> "inet" `On` "M1-x w" `Named` "internet", - "icedove" ::: [C "Icedove", C "Kontact" ] :-> "inet" `On` "M1-x y" `Named` "mail", - "rssowl" ::: [C "Liferea", C "RSSOwl"] :-> "inet" `Named` "rss", - "transmission-gtk" ::: [regex "Transmission"] :-> "torrents" `On` "M1-x r", - Group [C "Inkscape", C "Eog", C "Gwenview", C "Dia", - C "MyPaint"] :-> "graphics" `On` "M1-x d", - Group [regex "Gimp"] :-> "gimp" `On` "M1-x g", - Group [C "F-spot",C "Digikam"] :-> "photo" `On` "M1-x p", - "gnome-terminal" ::: [C "Gnome-terminal", C "Konsole"] :-> "term" `On` "M1-x t", - textEditors :>> [C "Gedit", C "Leafpad", - C "Gvim", C "Kate", C "Kwrite", C "Emacs"] :-> "text" `On` "M1-x e", - recent ["doc"] ::: [regex "libreoffice", C "TeXmacs"] :-> "office" `On` "M1-x o", - recent ["pdf","djvu"] ::: [C "Evince", C "Okular"] :-> "docs" `On` "M1-x k", - defaultFM ::: [C "Nautilus", C "Dolphin", C "Konqueror", - C "Krusader"] :-> "files" `On` "M1-x f", - Group [C "Amarok", C "Rhythmbox", - regex "Audacious" ] :-> "music" `On` "M1-x a", - Group [C "MPlayer", C "Totem"] :-> "video" `On` "M1-x v", - Group [C "Wxmaxima"] :-> "math" `On` "M1-x m", - "pidgin" ::: [C "Pidgin", C "Kopete"] :-> "im" `On` "M1-x i"] - diff --git a/lib/GroupsSetup.lhs b/lib/GroupsSetup.lhs new file mode 100644 index 0000000..05a2ed9 --- /dev/null +++ b/lib/GroupsSetup.lhs @@ -0,0 +1,59 @@ +Группы приложений +================= + +Заголовок и импорты +------------------- + +> {-# LANGUAGE NoMonomorphismRestriction #-} +> module GroupsSetup (myApps, defaultFM) where + +> import XMonad.Util.WindowProperties +> import XMonad.Util.WindowPropertiesRE + +Импорты других модулей из конфига: + +> import AppGroups +> import CommonFunctions + +Файл-менеджер по умолчанию: + +> defaultFM = "konqueror --profile filemanagement" + +> regex = C . RE . ClassName +> regexTitle = C . RE . Title + +> titleIsAnyOf :: [String] -> Property +> titleIsAnyOf list = foldl1 Or $ map Title list + +Список групп +------------ + +Собственно список групп приложений: + +> myApps = +> [ [C "Epiphany-browser", C "Kontact", +> C "Iceweasel", C "Firefox", +> C "Opera", C "Arora" ] `orSpawn` "iceweasel" ~> "inet" `on` "M1-x w", +> [C "Icedove", C "Kontact" ] `orSpawn` "icedove" ~> "inet" `on` "M1-x y", +> [C "Liferea", C "RSSOwl"] `orSpawn` "rssowl" ~> "inet", +> [regex "Transmission"] `orSpawn` "transmission-gtk" ~> "torrents" `on` "M1-x r", +> group [C "Inkscape", C "Eog", C "Gwenview", C "Dia", +> C "MyPaint"] ~> "graphics" `on` "M1-x d", +> group [regex "Gimp"] ~> "gimp" `on` "M1-x g", +> group [C "F-spot",C "Digikam"] ~> "photo" `on` "M1-x p", +> [C "Gnome-terminal", +> C "Konsole"] `orSpawn` "gnome-terminal" ~> "term" `on` "M1-x t", +> [C "Gedit", C "Leafpad", +> C "Text-terminal", C "Gvim", +> C "Kate", C "Kwrite", C "Emacs"] `orRun` textEditors ~> "text" `on` "M1-x e", +> [regex "libreoffice", +> C "TeXmacs"] `orSpawn` recent ["doc"] ~> "office" `on` "M1-x o", +> [C "Evince", C "Okular"] `orSpawn` recent ["pdf","djvu"] ~> "docs" `on` "M1-x k", +> [C "Nautilus", C "Dolphin", C "Konqueror", +> C "Krusader"] `orSpawn` defaultFM ~> "files" `on` "M1-x f", +> group [C "Amarok", C "Rhythmbox", C "Ario", +> C "Sonata", regex "Audacious" ] ~> "music" `on` "M1-x a", +> group [C "MPlayer", C "Totem"] ~> "video" `on` "M1-x v", +> group [C "Wxmaxima"] ~> "math" `on` "M1-x m", +> [C "Pidgin", C "Kopete"] `orSpawn` "pidgin" ~> "im" `on` "M1-x i"] + diff --git a/lib/KeyBindings.hs b/lib/KeyBindings.hs deleted file mode 100644 index 21e56e6..0000000 --- a/lib/KeyBindings.hs +++ /dev/null @@ -1,170 +0,0 @@ -module KeyBindings - (myKeys, - addKeys, - myMouseBindings) - where - -import System.Exit -import qualified Data.Map as M - -import XMonad -import qualified XMonad.StackSet as W - -import XMonad.Util.WindowProperties -import XMonad.Hooks.ManageDocks hiding (L,R) - -import XMonad.Actions.Plane -import XMonad.Actions.DwmPromote -import XMonad.Actions.GridSelect -import XMonad.Actions.GroupNavigation - -import XMonad.Layout.Maximize -import XMonad.Layout.Minimize -import XMonad.Layout.SubLayouts -import qualified XMonad.Layout.WindowNavigation as Nav - -import CommonFunctions -import Mouse -import Themes (myGSConfig, searchGS) -import AppGroups (switchToApp, runNewApp) -import GroupsSetup (myApps) - -workspaceOrder = ["inet","text","files","im","term"] - ------------------------------------------------------------------------- --- Key bindings --- -myKeys conf@(XConfig {XMonad.modMask = modMask}) = (M.fromList $ - - -- launch a terminal - [ ((0, xK_Menu), spawn $ XMonad.terminal conf), - -- Launch 1-5 - ((0, 0x1008FF41), switchToApp myGSConfig myApps "office"), - ((0, 0x1008FF42), switchToApp myGSConfig myApps "text"), - ((0, 0x1008FF43), switchToApp myGSConfig myApps "term"), - ((0, 0x1008FF44), switchToApp myGSConfig myApps "rss"), - ((0, 0x1008FF45), switchToApp myGSConfig myApps "im"), - - -- Increment/decrement the number of windows in the master area - ((modMask , xK_comma ), sendMessage (IncMasterN 1)), - ((modMask , xK_period), sendMessage (IncMasterN (-1))), - ((modMask .|. shiftMask, xK_space), setLayout $ XMonad.layoutHook conf) - ] - ++ - - -- To jump to specific desktop - [((m .|. modMask, k), f i) - | (i, k) <- zip workspaceOrder [xK_F1..] - , (f, m) <- [(gotoWorkspace, 0), (moveToWorkspace, shiftMask)]] ) - `M.union` planeKeys modMask (Lines 1) Circular - -addKeys = [-- ("M1-<F2>", gnomeRun), - ("M1-<F2>", spawn "gmrun"), - ("<Pause>", spawn "qwerty.py -a -f -g 640x400"), - ("M-v", vimsessions), - ("M-a", runNewApp searchGS myApps), - - -- close focused window - ("M1-<F4>", killIfNot (Role "buddy_list")), - -- Rotate through the available layout algorithms - ("M-<Space>", sendMessage NextLayout), - -- - -- Jump to specific layout - ("M-f", chooseLayout "Full"), - ("M-u", chooseLayout "autogrid"), - ("M-<Up>", withFocused (sendMessage . maximizeRestore)), - ("M-<Down>", withFocused minimizeWindow), - ("M-<Right>", withFocused (sendMessage . RestoreMinimizedWin)), - - ("M-b", sendMessage $ ToggleStruts), - - ("M1-e", windows (W.greedyView "dashboard")), - - -- Bring any window to current workspace - ("M1-w", bringSelected searchGS), - ("M1-<Tab>", searchInWorkspace searchGS), - ("M-<Tab>", gridselectWorkspace searchGS W.greedyView), - ("M1-/", goToSelected searchGS), - - ("M-<Backspace>", nextMatch History (return True)), - - -- Resize viewed windows to the correct size - ("M-n", refresh), - - -- Move focus to the next window --- ("M1-<Tab>", windows W.focusDown), - ("M-j", windows W.focusDown), - ("M-k", windows W.focusUp ), - - ("M1-j", sendButtonPress 5 ), - ("M1-k", sendButtonPress 4 ), - - -- Rotate windows list - ("M-C-j", rotateWindows ), - ("M-C-k", rotateWindows'), - - -- Swap the focused window and the master window - ("M-<Return>", dwmpromote), - - -- Swap the focused window with the next window - ("M-S-j", windows W.swapDown), - ("M-S-k", windows W.swapUp), - - -- Tab/Untab - ("M-M1-j", sendMessage $ pushWindow Nav.D), - ("M-M1-l", sendMessage $ pushWindow Nav.R), - ("M-M1-k", sendMessage $ pushWindow Nav.U), - ("M-M1-h", sendMessage $ pushWindow Nav.L), - - ("M-M1-u", withFocused (sendMessage . UnMerge)), - - -- Shrink/expand the master area - ("M-e", sendMessage Shrink), - ("M-r", sendMessage Expand), - - -- Push window back into tiling - ("M-S-f", withFocused $ windows . W.sink), - - ("M-<Home>", edit_config), - ("M-l", spawn "xscreensaver-command -lock"), - - - ("<XF86AudioPrev>", spawn "amarok --previous"), - ("<XF86AudioNext>", spawn "amarok --next"), - ("<XF86AudioStop>", spawn "amarok --stop"), - ("<XF86AudioPlay>", spawn "amarok --play-pause"), - ("<XF86AudioMute>", spawn "xvolume mute"), - ("<XF86AudioLowerVolume>", spawn "xvolume 5%-"), - ("<XF86AudioRaiseVolume>", spawn "xvolume 5%+"), - - ("<XF86Search>", switchToApp myGSConfig myApps "internet" ), - ("<XF86HomePage>", switchToApp myGSConfig myApps "files"), - ("<XF86Mail>", switchToApp myGSConfig myApps "mail"), - - ("<Print>", spawn "ksnapshot"), - ("S-<Print>", promptPublishShot), - - ("M-S-q", io $ exitWith ExitSuccess), - -- Restart xmonad --- ("M-q", broadcastMessage ReleaseResources >> restart "xmonad" True)] - ("M-q", broadcastMessage ReleaseResources >> restart "xmonad-restart" True)] - ------------------------------------------------------------------------- --- Mouse bindings: default actions bound to mouse events --- -myMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $ - - -- mod-button1, Set the window to floating mode and move by dragging --- [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w)) - [ ((modMask, button1), specialMove) - - -- mod-button2, Raise the window to the top of the stack - , ((modMask, button2), (\w -> focus w >> dwmpromote)) - - -- mod-button3, Set the window to floating mode and resize by dragging - , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w)) - - , ((modMask, button4), const rotateWindows) - , ((modMask, button5), const rotateWindows') - ] - diff --git a/lib/KeyBindings.lhs b/lib/KeyBindings.lhs new file mode 100644 index 0000000..b9d7abb --- /dev/null +++ b/lib/KeyBindings.lhs @@ -0,0 +1,247 @@ +Определения горячих клавиш +========================== + +Заголовок и импорты +------------------- + +> module KeyBindings +> (myKeys, +> addKeys, +> myMouseBindings) +> where + +Импорты из стандартной библиотеки: + +> import System.Exit +> import qualified Data.Map as M + +Импорты из XMonad: + +> import XMonad +> import qualified XMonad.StackSet as W + +Импорты из xmonad-contrib: + +> import XMonad.Util.Paste +> import XMonad.Hooks.ManageDocks hiding (L,R) + +> import XMonad.Actions.DwmPromote +> import XMonad.Actions.GridSelect +> import XMonad.Actions.GroupNavigation +> import XMonad.Actions.Warp + +> import XMonad.Layout.Maximize +> import XMonad.Layout.Minimize +> import XMonad.Layout.SubLayouts +> import qualified XMonad.Layout.Groups.Examples as Ex +> import qualified XMonad.Layout.WindowNavigation as Nav + +Импорты других модулей конфига: + +> import MPD +> import Volume +> import CommonFunctions +> import Themes +> import AppGroups +> import GroupsSetup +> import Mouse + +Основные сочетания клавиш +------------------------- + +> myKeys conf = M.fromList $ + +Запустить терминал: + +> [ ((0, xK_Menu), spawn myTerminal), +> ((shiftMask, xK_Menu), spawn textTerminal), +> ((0, 0x1008FF41), switchToApp myGSConfig myApps "office"), +> ((0, 0x1008FF42), switchToApp myGSConfig myApps "text"), +> ((0, 0x1008FF43), switchToApp myGSConfig myApps "term"), +> ((0, 0x1008FF44), switchToApp myGSConfig myApps "rss"), +> ((0, 0x1008FF45), switchToApp myGSConfig myApps "im"), + +Увеличить/уменьшить количество мастер-окон: + +> ((mod4Mask , xK_comma ), sendMessage (IncMasterN 1)), +> ((mod4Mask , xK_period), sendMessage (IncMasterN (-1))), +> ((mod4Mask .|. shiftMask, xK_space), setLayout $ XMonad.layoutHook conf) +> ] + +Расширенные сочетания клавиш +---------------------------- + +Запуск всякого разного: + +> addKeys = [ -- ("M1-<F2>", gnomeRun), +> ("M1-<F2>", spawn "gmrun"), +> ("<Pause>", spawn "qwerty.py -a -f -g 640x400"), +> ("M-v", vimsessions), + +Показать/спрятать ростер Pidgin: + +> ("M-<F12>", togglePidginRoster), + +Закрыть окно + +> ("M1-<F4>", kill), + +Переключиться на следующий layout + +> ("M-<Space>", sendMessage NextLayout), +> -- +> ("M1-x x", sendKey mod1Mask xK_x), + +> ("M1-e", windows (W.greedyView "dashboard")), + +Выбрать определённый layout + +> ("M-f", chooseLayout "Full"), +> ("M-o", chooseLayout "onebig"), +> ("M-u", chooseLayout "autogrid"), + +Свернуть/развернуть/восстановить. Работает только с соответствующими layouts. + +> ("M-<Up>", withFocused (sendMessage . maximizeRestore)), +> ("M-<Down>", withFocused minimizeWindow), +> ("M-<Right>", withFocused (sendMessage . RestoreMinimizedWin)), + +Спрятать/показать панели, if any. + +> ("M-b", sendMessage $ ToggleStruts), + +Выбрать окно и притащить его на текущее рабочее место: + +> ("M1-w", bringSelected searchGS), + +Выбрать окно среди всех и перейти к нему: + +> ("M1-/", goToSelected searchGS), + +Выбрать окно на текущем рабочем месте: + +> ("M1-<Tab>", searchInWorkspace searchGS), + +Выбрать рабочее место: + +> ("M-<Tab>", gridselectWorkspace searchGS W.greedyView), + +Переместить окно на выбранное рабочее место: + +> ("M-m", gridselectWorkspace searchGS W.shift), + +Перейти к предыдущему окну: + +> ("M-<Backspace>", nextMatch History (return True)), + +Пересчитать размеры окна + +> ("M-n", refresh), + +Переключиться на следующее/предыдущее окно: + +> ("M-j", caseLayoutOf [("tabgrid", Ex.focusDown)] (windows W.focusDown)), +> ("M-k", caseLayoutOf [("tabgrid", Ex.focusUp)] (windows W.focusUp) ), + +Действия мыши: + +> ("M1-k", sendButtonPress 4), -- колесо вверх +> ("M1-j", sendButtonPress 5), -- колесо вниз +> ("M-h", sendButtonPress 1), -- клик +> ("M-w", movePointer 0 (-5)), -- указатель вверх +> ("M-a", movePointer (-5) 0), -- влево +> ("M-s", movePointer 0 5), -- вниз +> ("M-d", movePointer 5 0), -- вправо + +> ("M-C-u", warpToWindow 0.1 0.1), +> ("M-C-i", warpToWindow 0.5 0.1), +> ("M-C-o", warpToWindow 0.9 0.1), +> ("M-C-j", warpToWindow 0.1 0.5), +> ("M-C-k", warpToWindow 0.5 0.5), +> ("M-C-l", warpToWindow 0.9 0.5), +> ("M-C-m", warpToWindow 0.1 0.9), +> ("M-C-^", warpToWindow 0.5 0.9), +> ("M-C-$", warpToWindow 0.9 0.9), + +Поменять текущее окно с мастер-окном. В случае layout «im» — развернуть/восстановить окно. + +> ("M-<Return>", caseLayoutOf [("tabgrid", Ex.swapGroupMaster), +> ("im", withFocused (sendMessage . maximizeRestore))] dwmpromote), + +Поменять текущее окно со следующим/предыдущим. + +> ("M-S-j", caseLayoutOf [("tabgrid", Ex.swapDown)] (windows W.swapDown)), +> ("M-S-k", caseLayoutOf [("tabgrid", Ex.swapUp)] (windows W.swapUp)), + +> -- ("M-C-j", caseLayoutOf [("tabgrid", Ex.focusGroupDown)] (return ()) ), +> -- ("M-C-k", caseLayoutOf [("tabgrid", Ex.focusGroupUp)] (return ()) ), + + +Перемещение вкладок с окнами между разными областями. + +> ("M-M1-j", caseLayoutOf [("tabgrid", Ex.moveToGroupDown False)] +> (sendMessage $ pushWindow Nav.D)), +> ("M-M1-l", caseLayoutOf [("tabgrid", Ex.moveToGroupUp False)] +> (sendMessage $ pushWindow Nav.R)), +> ("M-M1-k", sendMessage $ pushWindow Nav.U), +> ("M-M1-h", sendMessage $ pushWindow Nav.L), + +Разделить текущую группу вкладок. + +> ("M-M1-u", caseLayoutOf [("tabgrid", Ex.splitGroup)] +> (withFocused (sendMessage . UnMerge))), + +Увеличить/уменьшить область мастер-окна. + +> ("M-e", sendMessage Shrink), +> ("M-r", sendMessage Expand), + +Вернуть плавающее окно в обычный (tiled) режим. + +> ("M-S-f", withFocused $ windows . W.sink), + +Редактировать конфиг xmonad. + +> ("M-<Home>", spawn "gvim ~/.xmonad/xmonad.hs"), + +Заблокировать экран. + +> ("M-l", spawn "xscreensaver-command -lock"), + +Multimedia keys. + +> ("<XF86AudioPrev>", previousTrack), +> ("<XF86AudioNext>", nextTrack), +> ("<XF86AudioStop>", stopPlaying), +> ("<XF86AudioPlay>", togglePlaying), +> ("<XF86AudioMute>", toggleMute), +> ("<XF86AudioLowerVolume>", changeVolumeBy (-5)), +> ("<XF86AudioRaiseVolume>", changeVolumeBy 5), + +> ("<XF86Search>", switchToApp myGSConfig myApps "internet" ), +> ("<XF86HomePage>", switchToApp myGSConfig myApps "files"), +> ("<XF86Mail>", switchToApp myGSConfig myApps "mail"), + +Сделать скриншот. + +> ("<Print>", spawn "ksnapshot"), + +Выход из xmonad. + +> ("M-S-q", io $ exitWith ExitSuccess), + +Перезапустить xmonad. + +> ("M-q", broadcastMessage ReleaseResources >> restart "xmonad" True)] + +Привязки действий мыши. + +> myMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $ +> -- mod-button1, Set the window to floating mode and move by dragging +> [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w)) +> -- mod-button2, Raise the window to the top of the stack +> , ((modMask, button2), (\w -> focus w >> dwmpromote)) +> -- mod-button3, Set the window to floating mode and resize by dragging +> , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w)) +> ] + diff --git a/lib/LayoutBuilderP.hs b/lib/LayoutBuilderP.hs deleted file mode 100644 index 75eefd5..0000000 --- a/lib/LayoutBuilderP.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- | --- Module : LayoutBuilderP --- Copyright : (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru> --- License : BSD3-style (see LICENSE) --- --- Maintainer : Ilya Portnov <portnov84@rambler.ru> --- Stability : unstable --- Portability : unportable --- --- A layout combinator that sends windows matching given predicate to one rectangle --- and the rest to another. --- ------------------------------------------------------------------------------ - -module LayoutBuilderP ( - LayoutP (..), - layoutP, layoutAll, - B.relBox, B.absBox, - PropertyRE (..) - ) where - -import Control.Monad -import Data.Maybe (isJust) - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Util.WindowProperties - -import qualified XMonad.Layout.LayoutBuilder as B - --- (~?) is like (=?), but gives us regexp match instead of exact match -import CommonFunctions ((~?)) - --- | Type class for predicates. This enables us to manage not only Windows, --- but any objects, for which instance Predicate is defined. --- We assume that for all w checkPredicate (alwaysTrue undefined) == return True. -class Predicate p w where - alwaysTrue :: w -> p -- ^ A predicate that is always True. First argument is dummy, we always set it to undefined - checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate - --- | A wrapper for X.U.WindowProperties.Property. --- Checks using regular expression. -data PropertyRE = RE Property - deriving (Show,Read,Typeable) - --- | Data type for our layout. -data LayoutP p l1 l2 a = - LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a)) - deriving (Show,Read) - --- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain. --- It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout. -layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) => - p - -> B.SubBox -- ^ The box to place the windows in - -> Maybe B.SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left - -> l1 a -- ^ The layout to use in the specified area - -> LayoutP p l2 l3 a -- ^ Where to send the remaining windows - -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout -layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next) - --- | Use the specified layout in the described area for all remaining windows. -layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) => - B.SubBox -- ^ The box to place the windows in - -> l1 a -- ^ The layout to use in the specified area - -> LayoutP p l1 Full a -- ^ The resulting layout -layoutAll box sub = - let a = alwaysTrue (undefined :: a) - in LayoutP Nothing Nothing a box Nothing sub Nothing - -instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) => - LayoutClass (LayoutP p l1 l2) w where - - -- | Update window locations. - runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect - = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf - let selBox = if isJust nextf' - then box - else maybe box id mbox - - (sublist,sub') <- handle sub subs $ calcArea selBox rect - - (nextlist,next') <- case next of Nothing -> return ([],Nothing) - Just n -> do (res,l) <- handle n nexts rect - return (res,Just l) - - return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' ) - where - handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r - l' <- return $ maybe l id ml - return (res,l') - - -- | Propagate messages. - handleMessage l m - | Just (IncMasterN _) <- fromMessage m = sendFocus l m - | Just (Shrink) <- fromMessage m = sendFocus l m - | Just (Expand) <- fromMessage m = sendFocus l m - | otherwise = sendBoth l m - - -- | Descriptive name for layout. - description (LayoutP _ _ prop _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next - - -sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendSub (LayoutP subf nextf prop box mbox sub next) m = - do sub' <- handleMessage sub m - return $ if isJust sub' - then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next - else Nothing - -sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m -sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m = - do sub' <- handleMessage sub m - next' <- handleMessage next m - return $ if isJust sub' || isJust next' - then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next') - else Nothing - -sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing -sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m = - do next' <- handleMessage next m - return $ if isJust next' - then Just $ LayoutP subf nextf prop box mbox sub next' - else Nothing - -sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf - if foc then sendSub l m - else sendNext l m - -isFocus :: (Show a) => Maybe a -> X Bool -isFocus Nothing = return False -isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset - return $ maybe False (\s -> show w == (show $ W.focus s)) ms - - --- | Split given list of objects (i.e. windows) using predicate. -splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w]) -splitBy prop ws = foldM step ([], []) ws - where - step (good, bad) w = do - ok <- checkPredicate prop w - return $ if ok - then (w:good, bad) - else (good, w:bad) - -splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w) -splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing) -splitStack (Just s) prop subf nextf = do - let ws = W.integrate s - (good, other) <- splitBy prop ws - let subf' = foc good subf - nextf' = foc other nextf - return ( differentiate' subf' good - , differentiate' nextf' other - , subf' - , nextf' - ) - where - foc [] _ = Nothing - foc l f = if W.focus s `elem` l - then Just $ W.focus s - else if maybe False (`elem` l) f - then f - else Just $ head l - -calcArea :: B.SubBox -> Rectangle -> Rectangle -calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' - where - xpos' = calc False xpos $ rect_width rect - ypos' = calc False ypos $ rect_height rect - width' = calc True width $ rect_width rect - xpos' - height' = calc True height $ rect_height rect - ypos' - - calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ - case val of B.Rel v -> floor $ v * fromIntegral tot - B.Abs v -> if v<0 || (zneg && v==0) - then (fromIntegral tot)+v - else v - -differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) -differentiate' _ [] = Nothing -differentiate' Nothing w = W.differentiate w -differentiate' (Just f) w - | f `elem` w = Just $ W.Stack { W.focus = f - , W.up = reverse $ takeWhile (/=f) w - , W.down = tail $ dropWhile (/=f) w - } - | otherwise = W.differentiate w - --- | Similar to XMonad.Util.WindowProperties.propertyToQuery, --- but uses regexp match instead of exact match -propertyToQueryRE :: Property -> Query Bool -propertyToQueryRE (Title s) = title ~? s -propertyToQueryRE (Resource s) = resource ~? s -propertyToQueryRE (ClassName s) = className ~? s -propertyToQueryRE (Role s) = stringProperty "WM_WINDOW_ROLE" ~? s -propertyToQueryRE (Machine s) = stringProperty "WM_CLIENT_MACHINE" ~? s -propertyToQueryRE (And p1 p2) = propertyToQueryRE p1 <&&> propertyToQueryRE p2 -propertyToQueryRE (Or p1 p2) = propertyToQueryRE p1 <||> propertyToQueryRE p2 -propertyToQueryRE (Not p) = not `fmap` propertyToQueryRE p -propertyToQueryRE (Const b) = return b - --- | Does given window have this property? -hasPropertyRE :: PropertyRE -> Window -> X Bool -hasPropertyRE (RE p) w = runQuery (propertyToQueryRE p) w - -instance Predicate Property Window where - alwaysTrue _ = Const True - checkPredicate = hasProperty - -instance Predicate PropertyRE Window where - alwaysTrue _ = RE (Const True) - checkPredicate = hasPropertyRE - diff --git a/lib/Layouts.hs b/lib/Layouts.hs index 17fe481..2e1ac79 100644 --- a/lib/Layouts.hs +++ b/lib/Layouts.hs @@ -34,6 +34,8 @@ import XMonad.Layout.Minimize import XMonad.Layout.Simplest import XMonad.Layout.Groups import XMonad.Layout.LayoutBuilderP +import XMonad.Layout.AutoComboP +import XMonad.Layout.TwoPane import qualified XMonad.Layout.WindowNavigation as Nav @@ -83,18 +85,9 @@ forgimp = named "gimp" $ withButtons $ combineTwoP (TwoPane 0.03 0.75) column (r onebig = named "onebig" $ (OneBig (3/4) (3/4)) -- coding = named "coding" $ reflectHoriz $ mastered (1/100) (1/3) (Column 2) -minimax = maximize . minimize - -deco = defaultTheme {activeColor = myFocusedBorderColor, - activeTextColor = "#000000", - inactiveColor = "#E6DCD1", - inactiveTextColor = "#000000", - decoHeight = 24, - fontName = myFont } +fortext = autoCombineTwoP 0.1 0.1 0.03 (Mirror $ TwoPane 0.03 0.5) tabs grid (ClassName "Gvim") -decoB = defaultThemeWithButtons {activeColor = myFocusedBorderColor, - activeTextColor = "#000000", - fontName = myFont} +minimax = maximize . minimize withButtons = buttonDeco shrinkText decoB @@ -110,16 +103,9 @@ myLayout = trackFloating $ avoidStruts $ -- Tab.modify shrinkText deco $ onWorkspace "inet" (minimax full) $ - onWorkspace "text" (minimax full ||| minimax autogrid2 ||| minimax dwmtile ||| minimax mirrored ||| books ||| autogrid ||| onebig ) $ + onWorkspace "text" (minimax fortext ||| minimax autogrid2 ||| minimax dwmtile ||| minimax mirrored ||| books ||| autogrid ||| onebig ) $ onWorkspace "files" (minimax full ||| minimax dwmtile ||| autogrid) $ onWorkspace "im" forim $ onWorkspace "term" (minimax full ||| minimax mirrored ||| autogrid) $ onWorkspace "gimp" (forgimp ||| full ||| grid) $ onWorkspace "trash" (full ||| autogrid ||| grid) (minimax mirrored ||| full) - --- twoTabs = do --- chooseLayout "autogrid" --- sendMessage $ IncMasterN 1 --- sendMessage $ Tab.pull Nav.R --- sendMessage $ IncMasterN (-1) --- diff --git a/lib/MPD.hs b/lib/MPD.hs new file mode 100644 index 0000000..5af2e80 --- /dev/null +++ b/lib/MPD.hs @@ -0,0 +1,35 @@ +module MPD + (togglePlaying, + stopPlaying, + nextTrack, + previousTrack + ) where + +import XMonad + +import Network.MPD + +import Themes (mpdHost, mpdPort) + +mpd :: MPD a -> X () +mpd action = do + io $ withMPDEx mpdHost mpdPort "" action + return () + +togglePlaying :: X () +togglePlaying = mpd toggle + where + toggle = status >>= \st -> + case stState st of + Playing -> pause True + _ -> play Nothing + +stopPlaying :: X () +stopPlaying = mpd stop + +nextTrack :: X () +nextTrack = mpd next + +previousTrack :: X () +previousTrack = mpd previous + diff --git a/lib/Mouse.hs b/lib/Mouse.hs deleted file mode 100644 index 60e6685..0000000 --- a/lib/Mouse.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -module Mouse - (sendButtonPress, - movePointer) - where - -import Graphics.X11.Xlib -import Foreign.C.Types - -import XMonad -import XMonad.Util.XUtils (fi) -import qualified XMonad.StackSet as W - --- XTestFakeButtonEvent(display, button, is_press, delay) -foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeButtonEvent" - xFakeButtonEvent :: Display -> Button -> Bool -> Time -> IO Status - -foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeMotionEvent" - xFakeMotionEvent :: Display -> CInt -> CInt -> CInt -> Time -> IO Status - -fakeMotion :: CInt -> CInt -> X () -fakeMotion x y = do - sid <- withWindowSet (return . W.screen . W.current) - withDisplay $ \dpy -> do - io $ xFakeMotionEvent dpy (fromIntegral sid) x y 0 - return () - -sendButtonPress :: Button -> X () -sendButtonPress button = do - root <- asks theRoot - withDisplay $ \dpy -> do - io $ xFakeButtonEvent dpy button True 0 - io $ xFakeButtonEvent dpy button False 0 - return () - -movePointer :: Int -> Int -> X () -movePointer dx dy = do - root <- asks theRoot - withDisplay $ \dpy -> do - (_,_,_,x,y,_,_,_) <- io $ queryPointer dpy root - io $ warpPointer dpy root none 0 0 0 0 (fi $ x + fi dx) (fi $ y + fi dy) - return () diff --git a/lib/Mouse.lhs b/lib/Mouse.lhs new file mode 100644 index 0000000..cb9bd51 --- /dev/null +++ b/lib/Mouse.lhs @@ -0,0 +1,64 @@ +Mouse — действия мышью +====================== + +Заголовки и импорты +------------------- + +> {-# LANGUAGE ForeignFunctionInterface #-} +> module Mouse +> (sendButtonPress, +> movePointer) +> where + +> import Graphics.X11.Xlib +> import Foreign.C.Types + +> import XMonad +> import XMonad.Util.XUtils (fi) +> import qualified XMonad.StackSet as W + +Импорты FFI-функций +------------------- + +Используют расширение протокола X11 — XTest. Нужна соотв. клиентская библиотека +(флаг +-lXtst+). + +> -- XTestFakeButtonEvent(display, button, is_press, delay) +> foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeButtonEvent" +> xFakeButtonEvent :: Display -> Button -> Bool -> Time -> IO Status + +> foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeMotionEvent" +> xFakeMotionEvent :: Display -> CInt -> CInt -> CInt -> Time -> IO Status + +> fakeMotion :: CInt -> CInt -> X () +> fakeMotion x y = do +> sid <- withWindowSet (return . W.screen . W.current) +> withDisplay $ \dpy -> do +> io $ xFakeMotionEvent dpy (fromIntegral sid) x y 0 +> return () + +Экспортируемые функции +---------------------- + +Имитировать нажатие кнопки мыши. + +> sendButtonPress :: Button -> X () +> sendButtonPress button = do +> root <- asks theRoot +> withDisplay $ \dpy -> do +> -- (_,_,_,rootx,rooty,_,_,_) <- io $ queryPointer dpy root +> -- fakeMotion rootx rooty +> io $ xFakeButtonEvent dpy button True 0 +> io $ xFakeButtonEvent dpy button False 0 +> return () + +Переместить указатель мыши на вектор (dx,dy). + +> movePointer :: Int -> Int -> X () +> movePointer dx dy = do +> root <- asks theRoot +> withDisplay $ \dpy -> do +> (_,_,_,x,y,_,_,_) <- io $ queryPointer dpy root +> fakeMotion (fi $ x + fi dx) (fi $ y + fi dy) +> return () + diff --git a/lib/MyManageHooks.hs b/lib/MyManageHooks.hs index 89d1bed..e64b784 100644 --- a/lib/MyManageHooks.hs +++ b/lib/MyManageHooks.hs @@ -77,7 +77,7 @@ moveToOwnWorkspace apps = do doF (W.shift wksp) else doF id -basehooks = composeAll (apps2hooks myApps) <+> moveToOwnWorkspace myApps <+> transience' +basehooks = composeOne (apps2hooks myApps) <+> moveToOwnWorkspace myApps <+> transience' notCreateWorkspace = ["gmrun", "plasma", "gcolor2", "ksnapshot"] diff --git a/lib/Themes.hs b/lib/Themes.hs deleted file mode 100644 index 792a344..0000000 --- a/lib/Themes.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Themes where - -import qualified Data.Map as M - -import XMonad -import XMonad.Prompt -import XMonad.Actions.GridSelect - -myFont = "xft:Ubuntu-11" - --- | My XMonad Prompt config -myXPConfig :: XPConfig -myXPConfig = defaultXPConfig { - font = myFont, - bgColor = myFocusedBorderColor, - fgColor = "#000000" } - -myGSConfig :: HasColorizer a => GSConfig a -myGSConfig = defaultGSConfig { - gs_navigate = myNavigation, - gs_font = myFont } - -searchGS :: HasColorizer a => GSConfig a -searchGS = defaultGSConfig { - gs_navigate = search, - gs_font = myFont } - -search :: TwoD a (Maybe a) -search = makeXEventhandler $ shadowWithKeymap keymap handler - where keymap = M.fromList [ - ((0,xK_Escape), cancel) - ,((0,xK_Return), select) - ,((0,xK_Left) , move (-1,0) >> search) - ,((0,xK_Right) , move (1,0) >> search) - ,((0,xK_Down) , move (0,1) >> search) - ,((0,xK_Up) , move (0,-1) >> search) - ,((0,xK_Tab) , moveNext >> search) - ,((shiftMask,xK_Tab), movePrev >> search) - ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> search) - ] - handler (_,s,_) = do - transformSearchString (++ s) - search ------------------------------------------------------------------------ --- Some general settings -myWorkspaces :: [WorkspaceId] -myWorkspaces = ["dashboard"] - -myFocusedBorderColor :: String -myFocusedBorderColor = "#E3A775" - -myBorderWidth :: Dimension -myBorderWidth = 1 - -myNavigation :: TwoD a (Maybe a) -myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler - where navKeyMap = makeKeymap [ - (xK_Escape, cancel) - ,(xK_Return, select) - ,(xK_slash , substringSearch myNavigation) - ,(xK_Left , move (-1,0) >> myNavigation) - ,(xK_h , move (-1,0) >> myNavigation) - ,(xK_Right , move (1,0) >> myNavigation) - ,(xK_l , move (1,0) >> myNavigation) - ,(xK_Down , move (0,1) >> myNavigation) - ,(xK_j , move (0,1) >> myNavigation) - ,(xK_Up , move (0,-1) >> myNavigation) - ,(xK_k , move (0,-1) >> myNavigation) - ,(xK_y , move (-1,-1) >> myNavigation) - ,(xK_i , move (1,-1) >> myNavigation) - ,(xK_n , move (-1,1) >> myNavigation) - ,(xK_m , move (1,-1) >> myNavigation) - ,(xK_space , setPos (0,0) >> myNavigation) - ] - -- The navigation handler ignores unknown key symbols - navDefaultHandler = const myNavigation - makeKeymap pairs = M.fromList $ concatMap allMasks pairs - allMasks (keysym, action) = [((0, keysym), action), - ((8192, keysym), action)] - diff --git a/lib/Themes.lhs b/lib/Themes.lhs new file mode 100644 index 0000000..4b32d70 --- /dev/null +++ b/lib/Themes.lhs @@ -0,0 +1,132 @@ +Themes — настройки внешнего вида +================================ + +Заголовки и импорты +------------------- + +> module Themes where + +Импорты из стандартной библиотеки. + +> import qualified Data.Map as M + +Импорты из XMonad и xmonad-contrib + +> import XMonad +> import XMonad.Layout.Decoration +> import XMonad.Layout.DecorationAddons +> import XMonad.Prompt +> import XMonad.Actions.GridSelect + +Определения +----------- + +> mpdHost = "portnov.local" +> mpdPort = 6600 + +Шрифт. + +> myFont = "xft:Ubuntu-10" + +Тема для +X.Prompt+. + +> myXPConfig = defaultXPConfig { +> font = myFont, +> bgColor = myFocusedBorderColor, +> fgColor = "#000000" } + +Тема для +X.A.GridSelect+. + +> myGSConfig :: HasColorizer a => GSConfig a +> myGSConfig = defaultGSConfig { +> gs_navigate = myNavigation, +> gs_font = myFont } + +Тема для +X.A.GridSelect+, с поиском + +> searchGS :: HasColorizer a => GSConfig a +> searchGS = defaultGSConfig { +> gs_navigate = search, +> gs_font = myFont } + +Определения горячих клавиш для +searchGS+: + +> search :: TwoD a (Maybe a) +> search = makeXEventhandler $ shadowWithKeymap keymap handler +> where keymap = M.fromList [ +> ((0,xK_Escape), cancel) +> ,((0,xK_Return), select) +> ,((0,xK_Left) , move (-1,0) >> search) +> ,((0,xK_Right) , move (1,0) >> search) +> ,((0,xK_Down) , move (0,1) >> search) +> ,((0,xK_Up) , move (0,-1) >> search) +> ,((0,xK_Tab) , moveNext >> search) +> ,((shiftMask,xK_Tab), movePrev >> search) +> ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> search) +> ] +> -- The navigation handler ignores unknown key symbols, therefore we const +> handler (_,s,_) = do +> transformSearchString (++ s) +> search + +Определения горячих клавиш для +myGSConfig+: + +> myNavigation :: TwoD a (Maybe a) +> myNavigation = makeXEventhandler $ shadowWithKeymap keymap handler +> where keymap = M.fromList $ makeKeymap [ +> (xK_Escape, cancel) +> ,(xK_Return, select) +> ,(xK_slash , substringSearch myNavigation) +> ,(xK_Left , move (-1,0) >> myNavigation) +> ,(xK_h , move (-1,0) >> myNavigation) +> ,(xK_Right , move (1,0) >> myNavigation) +> ,(xK_l , move (1,0) >> myNavigation) +> ,(xK_Down , move (0,1) >> myNavigation) +> ,(xK_j , move (0,1) >> myNavigation) +> ,(xK_k , move (0,-1) >> myNavigation) +> ,(xK_Up , move (0,-1) >> myNavigation) +> ,(xK_y , move (-1,-1) >> myNavigation) +> ,(xK_i , move (1,-1) >> myNavigation) +> ,(xK_n , move (-1,1) >> myNavigation) +> ,(xK_m , move (1,-1) >> myNavigation) +> ,(xK_space , setPos (0,0) >> myNavigation) +> ] +> -- The navigation handler ignores unknown key symbols +> handler = const myNavigation +> makeKeymap = concatMap allMasks +> allMasks (key,action) = [((0, key), action), +> ((8192,key), action)] + +Обычная тема для вкладок: + +> deco = defaultTheme {activeColor = myFocusedBorderColor, +> activeTextColor = "#000000", +> inactiveColor = "#E6DCD1", +> urgentColor = "#EABA5C", +> inactiveTextColor = "#000000", +> decoHeight = 24, +> fontName = myFont} + +Тема для вкладок с кнопками: + +> decoB = defaultThemeWithButtons {activeColor = myFocusedBorderColor, +> activeTextColor = "#000000", +> fontName = myFont} + +Список рабочих мест при запуске + +> myWorkspaces = ["dashboard"] + +> myFocusedBorderColor = "#97ACC1" + +> myBorderWidth :: Dimension +> myBorderWidth = 1 + +Используемый терминал + +> myTerminal :: String +> myTerminal = "gnome-terminal" + +> textTerminal :: String +> textTerminal = "gnome-terminal --disable-factory --class=Text-terminal" + diff --git a/lib/Volume.hs b/lib/Volume.hs new file mode 100644 index 0000000..554190e --- /dev/null +++ b/lib/Volume.hs @@ -0,0 +1,29 @@ + +module Volume + (changeVolumeBy, + toggleMute) where + +import Control.Monad (when) + +import XMonad + +import Sound.ALSA.Mixer + +changeVolumeBy :: Integer -> X () +changeVolumeBy i = io $ do + result <- getControlByName "default" "Master" + whenJust result $ \control -> + whenJust (playback $ volume control) $ \playbackVolume -> do + (min, max) <- getRange playbackVolume + mbVol <- getChannel FrontLeft $ value $ playbackVolume + whenJust mbVol $ \vol -> + when ((i > 0 && vol < max) || (i < 0 && vol > min)) + $ setChannel FrontLeft (value $ playbackVolume) $ vol + i + +toggleMute :: X () +toggleMute = io $ do + result <- getControlByName "default" "Master" + whenJust result $ \control -> + whenJust (playback $ switch control) $ \playbackSwitch -> do + mbsw <- getChannel FrontLeft playbackSwitch + whenJust mbsw $ \sw -> setChannel FrontLeft playbackSwitch $ not sw diff --git a/lib/XKBLayout.hs b/lib/XKBLayout.hs deleted file mode 100644 index c0cafce..0000000 --- a/lib/XKBLayout.hs +++ /dev/null @@ -1,167 +0,0 @@ -{-# INCLUDE <X11/XKBlib.h> #-} -{-# INCLUDE <X11/extensions/XKBstr.h> #-} -{-# LINE 1 "XKBLayout.hsc" #-} -{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} -{-# LINE 2 "XKBLayout.hsc" #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.XKBLayout --- Copyright : (c) Konstantin Sobolev <konstantin.sobolev@gmail.com> --- License : BSD-style (see LICENSE) --- --- Maintainer : Konstantin Sobolev <konstantin.sobolev@gmail.com> --- Stability : unstable --- Portability : unportable --- --- A layout that remembers per-window keyboard layouts and switches them --- on focus changes. --- ------------------------------------------------------------------------------ - -module XKBLayout ( - -- * Usage - -- $usage - xkbLayout, - getKbdLayout, - setKbdLayout) where - -import Foreign -import Foreign.Ptr -import Foreign.C.Types (CUChar,CUShort,CUInt,CInt) - -import Graphics.X11.Xlib.Types -import qualified Data.Map as M -import Control.Monad - -import XMonad -import XMonad.Core (whenJust) -import XMonad.StackSet as W hiding (peek) -import XMonad.Layout.LayoutModifier - - -{-# LINE 39 "XKBLayout.hsc" #-} - -{-# LINE 40 "XKBLayout.hsc" #-} - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.XKBLayout --- --- Then edit your @layoutHook@ by adding 'xkbLayout', for example --- --- > myLayout = xkbLayout $ Tall 1 (3/100) (1/2) ||| Full || etc.. --- > main = xmonad defaultConfig { layoutHook = myLayout } --- --- For more instructions on editing the @layoutHook@ see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" - -data XkbStateRec = XkbStateRec { - group :: CUChar, - locked_group :: CUChar, - base_group :: CUShort, - latched_group :: CUShort, - mods :: CUChar, - base_mods :: CUChar, - latched_mods :: CUChar, - locked_mods :: CUChar, - compat_state :: CUChar, - grab_mods :: CUChar, - compat_grab_mods :: CUChar, - lookup_mods :: CUChar, - compat_lookup_mods :: CUChar, - ptr_buttons :: CUShort -} - -instance Storable XkbStateRec where - sizeOf _ = ((18)) -{-# LINE 74 "XKBLayout.hsc" #-} - alignment _ = alignment (undefined :: CUShort) - peek ptr = do - r_group <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr -{-# LINE 77 "XKBLayout.hsc" #-} - r_locked_group <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) ptr -{-# LINE 78 "XKBLayout.hsc" #-} - r_base_group <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) ptr -{-# LINE 79 "XKBLayout.hsc" #-} - r_latched_group <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr -{-# LINE 80 "XKBLayout.hsc" #-} - r_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 6)) ptr -{-# LINE 81 "XKBLayout.hsc" #-} - r_base_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 7)) ptr -{-# LINE 82 "XKBLayout.hsc" #-} - r_latched_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr -{-# LINE 83 "XKBLayout.hsc" #-} - r_locked_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 9)) ptr -{-# LINE 84 "XKBLayout.hsc" #-} - r_compat_state <- ((\hsc_ptr -> peekByteOff hsc_ptr 10)) ptr -{-# LINE 85 "XKBLayout.hsc" #-} - r_grab_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 11)) ptr -{-# LINE 86 "XKBLayout.hsc" #-} - r_compat_grab_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr -{-# LINE 87 "XKBLayout.hsc" #-} - r_lookup_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 13)) ptr -{-# LINE 88 "XKBLayout.hsc" #-} - r_compat_lookup_mods <- ((\hsc_ptr -> peekByteOff hsc_ptr 14)) ptr -{-# LINE 89 "XKBLayout.hsc" #-} - r_ptr_buttons <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr -{-# LINE 90 "XKBLayout.hsc" #-} - return XkbStateRec { - group = r_group, - locked_group = r_locked_group, - base_group = r_base_group, - latched_group = r_latched_group, - mods = r_mods, - base_mods = r_base_mods, - latched_mods = r_latched_mods, - locked_mods = r_locked_mods, - compat_state = r_compat_state, - grab_mods = r_grab_mods, - compat_grab_mods = r_compat_grab_mods, - lookup_mods = r_lookup_mods, - compat_lookup_mods = r_compat_lookup_mods, - ptr_buttons = r_ptr_buttons - } - -foreign import ccall unsafe "X11/XKBlib.h XkbGetState" - xkbGetState :: Display -> CUInt -> Ptr XkbStateRec -> IO CInt - -foreign import ccall unsafe "XkbLockGroup" xkbLockGroup :: Display -> XID -> XID -> IO () - -type KbdLayout = Int - -getKbdLayout :: Display -> IO KbdLayout -getKbdLayout d = alloca $ \stRecPtr -> do - xkbGetState d 0x100 stRecPtr - st <- peek stRecPtr - return $ fromIntegral (group st) - -setKbdLayout :: Display -> KbdLayout -> IO () -setKbdLayout d l = xkbLockGroup d 0x100 $ fromIntegral l - -data XKBLayout a = XKBLayout (Maybe Window) (M.Map Window KbdLayout) deriving (Read, Show) - -instance LayoutModifier XKBLayout a where - redoLayout (XKBLayout mlf lts) _ _ wrs = withDisplay $ \dpy -> do - -- we have to get real focused window here (can be floating) - mst <- gets (W.stack . W.workspace . W.current . windowset) - let mf = maybe Nothing (Just . W.focus) mst - case mf of - Nothing -> return (wrs, Nothing) - Just foc -> do - curLayout <- io $ getKbdLayout dpy - let lts' = maybe lts (\lf -> M.insert lf curLayout lts) mlf - -- remove all destroyed windows from our Window->KbdLayout map - -- not too efficient. Can somebody point me at - -- (Monad m) => (a -> m b) -> m (a -> b) ? - alive <- filterM isClient (M.keys lts') - let lts'' = M.filterWithKey (\w -> \_ -> w `elem` alive) lts' - io $ whenJust (M.lookup foc lts) (setKbdLayout dpy) - return (wrs, Just (XKBLayout (Just foc) lts'')) - -xkbLayout :: l a -> ModifiedLayout XKBLayout l a -xkbLayout = ModifiedLayout $ XKBLayout Nothing M.empty - --- vim:ft=haskell:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: diff --git a/xmonad.hs b/xmonad.hs index d56e8ac..1a450ef 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -12,6 +12,7 @@ import XMonad.Actions.SpawnOn import XMonad.Hooks.EwmhDesktops (ewmh) import XMonad.Hooks.SetWMName (setWMName) import XMonad.Hooks.Minimize (minimizeEventHook) +import XMonad.Util.Replace -- My local modules (from ~/.xmonad/lib/) import AppGroups (apps2keys) @@ -30,6 +31,7 @@ baseManageHook = manageHook baseConfig baseLogHook = logHook baseConfig main = do + replace xmonad $ ewmh $ baseConfig { terminal = "gnome-terminal", focusFollowsMouse = False,