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 c7f9e8a..0000000 --- a/lib/AppGroups.hs +++ /dev/null @@ -1,209 +0,0 @@ -{-# LANGUAGE ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-} -module AppGroups - (Key, App (..), Apps, Condition (..), Cond (..), Regex (..), - oneOf, apps2hooks, apps2keys, - selectAppGroup, - (~?)) - where - -import Control.Monad -import Data.Maybe -import Text.Regex.Posix ((=~)) - -import XMonad -import qualified XMonad.StackSet as W - -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) - --- | 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 - | NoFocus App -- ^ Do not give focus for such windows on open - --- | Container for different conditions -data Cond = forall c. Condition c => C c - -type Conds = [Cond] - --- | Class for conditions -class Condition c where - toQuery :: c -> Query Bool - -instance Condition String where - toQuery s = className =? s - -instance Condition Property where - toQuery p = propertyToQuery p - --- | Regular expression over condition -data (Condition a) => Regex a = Regex a - -instance Condition (Regex String) where - toQuery (Regex s) = className ~? s - -role :: Query String -role = stringProperty "WM_WINDOW_ROLE" - -instance Condition (Regex Property) where - toQuery (Regex (Title s)) = title ~? s - toQuery (Regex (Resource s)) = resource ~? s - toQuery (Regex (ClassName s)) = className ~? s - toQuery (Regex (Role s)) = role ~? s - toQuery (Regex (Machine s)) = stringProperty "WM_CLIENT_MACHINE" ~? s - toQuery (Regex (And p1 p2)) = toQuery p1 <&&> toQuery p2 - toQuery (Regex (Or p1 p2)) = toQuery p1 <||> toQuery p2 - toQuery (Regex (Not p)) = not `fmap` toQuery p - toQuery (Regex (Const b)) = return b - --- | Regular expressions matching for ManageHooks -(~?) :: (Functor f) => f String -> String -> f Bool -q ~? x = fmap (=~ x) q - --- | 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 - -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) - -oneOf :: [Query Bool] -> Query Bool -oneOf list = foldl1 (<||>) list - -isNotTransient :: Query Bool -isNotTransient = do - mbw <- transientTo - case mbw of - Nothing -> return True - Just _ -> return False - --- | Get Query from applications group description -query :: App -> Query Bool -query (On app _) = query app -query (_ ::: list) = isNotTransient <&&> oneOf [toQuery c | (C c) <- list] -query (_ :>> list) = isNotTransient <&&> oneOf [toQuery c | (C c) <- list] -query (Group list) = isNotTransient <&&> oneOf [toQuery c | (C c) <- list] -query (Fullscreen app) = query app -query (app :-> _) = query app -query (Float app) = query app -query (Named app _) = query app -query (NoFocus app) = query 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 -hookAction (NoFocus app) = \qry -> qry --> (appHook app >> doF W.focusDown) - -appHook :: App -> ManageHook -appHook (Fullscreen app) = query app --> doFullscreen -appHook (NoFocus app) = query app --> (appHook app >> doF W.focusDown) -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 -groupName (NoFocus app) = groupName app - -runApp :: App -> X () -runApp (On app _) = runApp app -runApp (command ::: _) = spawn command -runApp (action :>> _) = action -runApp (Group _) = return () -runApp (Fullscreen app) = runApp app -runApp (app :-> _) = runApp app -runApp (Named app _) = runApp app -runApp (NoFocus app) = runApp app - -apps2hooks :: Apps -> [ManageHook] -apps2hooks lst = map appHook lst - -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 (NoFocus app) = hotkey app - hotkey _ = Nothing - -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 - -matchingWindows :: Query Bool -> X [Window] -matchingWindows query = withWindowSet (return . W.allWindows) >>= filterM (runQuery query) - -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) - where - isNotEmpty :: App -> X Bool - isNotEmpty group = (not . null) `fmap` matchingWindows (query group) - diff --git a/lib/AppGroups.lhs b/lib/AppGroups.lhs new file mode 100644 index 0000000..f756d55 --- /dev/null +++ b/lib/AppGroups.lhs @@ -0,0 +1,324 @@ +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, +> (~>), +> oneOf, apps2hooks, apps2keys, +> selectAppGroup) +> 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) + +Класс 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) + diff --git a/lib/CommonFunctions.hs b/lib/CommonFunctions.hs deleted file mode 100644 index eee993b..0000000 --- a/lib/CommonFunctions.hs +++ /dev/null @@ -1,246 +0,0 @@ - -module CommonFunctions 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 XMonad -import qualified XMonad.StackSet as W -import XMonad.Util.WindowProperties -import XMonad.Layout.LayoutCombinators - -import XMonad.Prompt.Input - -import XMonad.Actions.DynamicWorkspaces -import XMonad.Actions.GridSelect - --- import FixedBoxes -import Themes - --- Get / set an atom on the root window - -setRootAtom :: String -> String -> X () -setRootAtom name value = withDisplay (io . setRootAtom' name value) - where setRootAtom' atom name d = do - a <- internAtom d atom False - rw <- rootWindow d $ defaultScreen d - setTextProperty d rw name a - -getRootAtom :: String -> X [String] -getRootAtom name = withDisplay (io . getRootAtom' name) - where getRootAtom' atom d = do - a <- internAtom d atom False - rw <- rootWindow d $ defaultScreen d - tp <- getTextProperty d rw a - wcTextPropertyToTextList d tp - -getMouseMode :: X Bool -getMouseMode = do - xs <- getRootAtom "MOUSE_MODE" - return $ case xs of - ["TRUE"] -> True - _ -> False - -toggleMouseMode :: X () -toggleMouseMode = do - mode <- getMouseMode - case mode of - True -> setRootAtom "MOUSE_MODE" "FALSE" - False -> setRootAtom "MOUSE_MODE" "TRUE" - ------------------------------------------------------------------------- --- -doWithAnyBut :: Property -> (Window -> X ()) -> Window -> X () -doWithAnyBut prop action w = do - hasProp <- hasProperty prop w - when (not hasProp) $ action w - -closeAnyBut :: Property -> Window -> X () -closeAnyBut prop = doWithAnyBut prop killWindow - -killIfNot :: Property -> X () -killIfNot prop = withFocused $ closeAnyBut prop - ------------------------------------------------------------------------- --- Rotate window list - -rotate [] = [] -rotate (x:xs) = xs ++ [x] - -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 = windows rotateWinSet -rotateWindows' = windows rotateWinSet' - ------------------------------------------------------------------------ - -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 () - ------------------------------------------------------------------------- --- 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" - -promptOSD :: X() -promptOSD = inputPrompt myXPConfig "Text" ?+ showOSD - --- promptBox :: X () --- promptBox = inputPrompt myXPConfig "Move to box" ?+ moveToBox --- --- moveToBox :: String -> X () --- moveToBox name = withFocused $ \w -> sendMessage (Place name w) - -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 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' Nothing st = Just st -stackPlus' (Just s1) s2 = stackPlus s1 s2 - -modifyWs i d f s = W.modify d f (W.view i s) - -emptyCurrentWs = W.modify Nothing (const Nothing) - -addStackToTarget target st = modifyWs target st (stackPlus' st) - -returnToCurrent c s = W.view curtag s - where curtag = W.currentTag c - -curstack s = W.stack $ W.workspace $ W.current s - -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 - 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 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 - -moveToWorkspace :: WorkspaceId -> X () -moveToWorkspace n = windows $ W.shift n - -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")] - -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 - whenJust selected spawn - -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 - -trashWindow = do - addWorkspace "trash" - moveToWorkspace "trash" - - --- On window unmap, remove current workspace if it's empty. -unmapEventHook :: Event -> X All -unmapEventHook e@(UnmapEvent {}) = removeEmptyWorkspace >> return (All True) -unmapEventHook _ = return (All True) - -caseLayoutOf :: [(String, X a)] -> X a -> X a -caseLayoutOf pairs def = do - layout <- getLayout - case lookup layout pairs of - Nothing -> def - Just x -> x - diff --git a/lib/CommonFunctions.lhs b/lib/CommonFunctions.lhs new file mode 100644 index 0000000..7aba761 --- /dev/null +++ b/lib/CommonFunctions.lhs @@ -0,0 +1,170 @@ +Общие функции +============= + +Заголовок и импорты +------------------- + +> module CommonFunctions +> ( +> recent, vimsessions, textEditors, +> searchInWorkspace, enshureMaster, +> caseLayoutOf, currentList, +> matchingWindows, chooseLayout, +> togglePidginRoster, +> (~?), +> unmapEventHook, +> ) where + +Импорты из стандартной библиотеки: + +> import Control.Monad (filterM) +> import System.FilePath.Glob +> import System.FilePath +> import System.Environment (getEnv) +> import Data.Maybe +> import Data.Monoid + +Импорты из дополнительных библиотек (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) + +Запустить скрипт +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 и открыть её. + +> 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 searchGS $ zip sessions actions +> whenJust selected spawn + +Запустить один из нескольких текстовых редакторов. + +> 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) окна — удалить текущее рабочее пространство, если оно осталось пустым. + +> unmapEventHook :: Event -> X All +> unmapEventHook e@(UnmapEvent {}) = 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/FixedBoxes.hs b/lib/FixedBoxes.hs deleted file mode 100644 index 232ff85..0000000 --- a/lib/FixedBoxes.hs +++ /dev/null @@ -1,116 +0,0 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} -module FixedBoxes where - -import Control.Monad -import Control.Arrow (second) -import Data.Ord (comparing) -import Data.Function (on) -import Data.Maybe -import Data.List - -import XMonad -import XMonad.Util.XUtils (fi) -import qualified XMonad.StackSet as W - -data Box = Box { - boxname :: String, - boxX :: Rational, - boxY :: Rational, - boxW :: Rational, - boxH :: Rational } - deriving (Eq, Show, Read) - -data BoxMessage a = Place String a - | Unbox a - deriving (Eq, Typeable) - -instance (Eq a, Typeable a) => Message (BoxMessage a) - -data FixedBoxes l back a = FixedBoxes (back a) [(Box, Maybe (W.Stack a), l a)] - deriving (Read, Show) - -fixedBoxes :: (LayoutClass l a, LayoutClass back a) => [Box] -> l a -> back a -> FixedBoxes l back a -fixedBoxes boxes l back = FixedBoxes back (map (\box -> (box, Nothing, l)) boxes) - -instance (LayoutClass l a, LayoutClass back a, Read a, Show a, Eq a, Typeable a) => LayoutClass (FixedBoxes l back) a where - runLayout wksp rect = boxedLayout wksp rect - pureMessage = boxedMessage - -snd3 (a,b,c) = b - -boxedLayout :: (Eq a, LayoutClass back a, LayoutClass l a) - => W.Workspace WorkspaceId (FixedBoxes l back a) a - -> Rectangle - -> X ([(a, Rectangle)], Maybe (FixedBoxes l back a)) -boxedLayout wksp@(W.Workspace tag (FixedBoxes back boxes) stack) rect = do - let ws = W.integrate' stack - w = W.focus `fmap` stack - unboxed = tryFocus w `fmap` unboxedWindows (map snd3 boxes) ws - (backWs, backL) <- runLayout (W.Workspace tag back unboxed) rect - boxed <- mapM (runSubLayout w tag rect) boxes - let boxedWs = concat $ map fst boxed - boxedLs = map snd boxed - l' = FixedBoxes (fromMaybe back backL) $ zipWith (mergeLayouts w) boxedLs boxes - return (boxedWs ++ backWs, Just l') - -mergeLayouts :: (Eq a) => a -> Maybe (l a) -> (Box, Maybe (W.Stack a), l a) -> (Box, Maybe (W.Stack a), l a) -mergeLayouts w ml (box, stack, l) = (box, tryFocus w `fmap` stack, fromMaybe l ml) - -tryFocus :: (Eq a) => (Maybe a) -> W.Stack a -> W.Stack a -tryFocus Nothing stack = stack -tryFocus (Just w) stack@(W.Stack focus up down) - | w == focus = stack - | w `elem` up = W.Stack w (delete w up) down - | w `elem` down = W.Stack w up (delete w down) - | otherwise = stack - -runSubLayout :: (LayoutClass layout a, Eq a) - => Maybe a - -> WorkspaceId - -> Rectangle - -> (Box, Maybe (W.Stack a), layout a) - -> X ([(a, Rectangle)], Maybe (layout a)) -runSubLayout w tag rect (box, stack, l) = do --- let stack' = tryFocus w `fmap` stack - (res, ml) <- runLayout (W.Workspace tag l stack) (box2rect rect box) - return (res, Just $ fromMaybe l ml) - -box2rect :: Rectangle -> Box -> Rectangle -box2rect (Rectangle x y w h) (Box _ bx by bw bh) = Rectangle x' y' (round w') (round h') - where - x' = fi x + round (fi w* bx) - y' = fi y + round (fi h* by) - w' = fi w* bw - h' = fi h* bh - -unboxedWindows :: (Eq a) => [Maybe (W.Stack a)] -> [a] -> Maybe (W.Stack a) -unboxedWindows stacks ws = - let boxed = concatMap W.integrate' stacks - unboxed = ws \\ boxed - in W.differentiate unboxed - -boxedMessage :: (Eq a, Typeable a) => FixedBoxes l back a -> SomeMessage -> Maybe (FixedBoxes l back a) -boxedMessage (FixedBoxes back boxes) m - | Just (Place name w) <- fromMessage m = Just $ FixedBoxes back (place boxes name w) - | Just (Unbox w) <- fromMessage m = Just $ FixedBoxes back (unbox boxes w) - | otherwise = Nothing - -place :: (Eq a) => [(Box, Maybe (W.Stack a), l)] -> String -> a -> [(Box, Maybe (W.Stack a), l)] -place boxes name w = place' [] boxes - where - place' acc [] = acc - place' acc ((box, stack, l):other) - | boxname box == name = place' ((box, add w stack, l):acc) other - | otherwise = place' ((box, stack, l):acc) other - -unbox :: (Eq a) => [(Box, Maybe (W.Stack a), l)] -> a -> [(Box, Maybe (W.Stack a), l)] -unbox boxes w = map (second3 $ del w) boxes - -second3 f (a,b,c) = (a, f b, c) - -add :: a -> Maybe (W.Stack a) -> Maybe (W.Stack a) -add w stack = W.differentiate $ w: (W.integrate' stack) - -del :: (Eq a) => a -> Maybe (W.Stack a) -> Maybe (W.Stack a) -del w stack = W.differentiate $ delete w $ W.integrate' stack - diff --git a/lib/GroupsSetup.hs b/lib/GroupsSetup.hs deleted file mode 100644 index 960d0da..0000000 --- a/lib/GroupsSetup.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} -module GroupsSetup where - -import XMonad.Util.WindowProperties - -import AppGroups -import CommonFunctions - -regex = C . Regex - -defaultFM = "konqueror --profile filemanagement" - -myApps = - [ NoFocus $ "firefox" ::: [C "Epiphany-browser", - C "Firefox", C "Opera"] :-> "inet" `On` "M1-x w" `Named` "internet", - "thunderbird" ::: [C "Thunderbird", C "Evolution"] :-> "mail" `On` "M1-x y", - Group [C "Inkscape", C "Eog", - C "Gwenview", C "Dia", C "Shutter"] :-> "graphics" `On` "M1-x d", - Group [regex "Gimp"] :-> "gimp" `On` "M1-x g", - "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", C "Totem"] :-> "music" `On` "M1-x a", - Group [C "MPlayer"] :-> "video" `On` "M1-x v", - Group [C "Wxmaxima"] :-> "math" `On` "M1-x g", - "pidgin" ::: [C "Pidgin", C "Kopete"] :-> "im" `On` "M1-x i", - Group [regex "Qt Jambi", - regex (Title "Инстанция")] :-> "RX Explorer" `On` "M1-x s", - Group [regex (Title "RadixWare Designer"), - regex (Title "RadixWare Manager")] :-> "RX Designer" `On` "M1-x r" ] - diff --git a/lib/GroupsSetup.lhs b/lib/GroupsSetup.lhs new file mode 100644 index 0000000..f0c3b1d --- /dev/null +++ b/lib/GroupsSetup.lhs @@ -0,0 +1,50 @@ +Группы приложений +================= + +Заголовок и импорты +------------------- + +> {-# LANGUAGE NoMonomorphismRestriction #-} +> module GroupsSetup (myApps, defaultFM) where + +Импорты других модулей из конфига: + +> import AppGroups +> import CommonFunctions +> import Predicates + +Файл-менеджер по умолчанию: + +> defaultFM = "konqueror --profile filemanagement" + +Список групп +------------ + +Собственно список групп приложений: + +> myApps = +> [ nofocus $ [C "Epiphany-browser", +> C "Firefox", C "Opera"] `orSpawn` "firefox" ~> "inet" `on` "M1-x w" `named` "internet", +> [C "Thunderbird", C "Evolution"] `orSpawn` "thunderbird" ~> "mail" `on` "M1-x y", +> group [C "Inkscape", C "Eog", +> C "Gwenview", C "Dia", C "Shutter"] ~> "graphics" `on` "M1-x d", +> group [regex "Gimp"] ~> "gimp" `on` "M1-x g", +> [C "Gedit", C "Leafpad", +> C "Gvim", C "Kate", +> C "Kwrite", C "Emacs"] `orRun` textEditors ~> "text" `on` "M1-x e", +> group [C workChats, C workApps] ~> "work" `on` "M1-x p", +> [C "Gnome-terminal"] `orSpawn` "gnome-terminal" ~> "term" `on` "M1-x t", +> [regex "libreoffice", +> regex "VCLSalFrame"] `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 "Totem"] ~> "music" `on` "M1-x a", +> group [C "MPlayer"] ~> "video" `on` "M1-x v", +> group [C "Wxmaxima"] ~> "math" `on` "M1-x g", +> [C otherChats] `orSpawn` "pidgin" ~> "im" `on` "M1-x i", +> group [regex "Qt Jambi", +> regexTitle "Инстанция"] ~> "RX Explorer" `on` "M1-x s", +> group [regexTitle "RadixWare Designer", +> regexTitle "RadixWare Manager"] ~> "RX Designer" `on` "M1-x r" ] + diff --git a/lib/KeyBindings.hs b/lib/KeyBindings.hs deleted file mode 100644 index ea15b2a..0000000 --- a/lib/KeyBindings.hs +++ /dev/null @@ -1,182 +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.Hooks.UrgencyHook - -import XMonad.Actions.Plane -import XMonad.Actions.DwmPromote -import XMonad.Actions.GridSelect -import XMonad.Actions.FindEmptyWorkspace -import XMonad.Actions.GroupNavigation -import XMonad.Actions.PerWorkspaceKeys -import XMonad.Actions.DynamicWorkspaces - -import XMonad.Layout.MultiToggle -import XMonad.Layout.MultiToggle.Instances -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 XMonad.Prompt.Window - -import CommonFunctions -import Themes -import AppGroups -import GroupsSetup -import Mouse - -workspaceOrder = ["inet","text","files","im","term"] - ------------------------------------------------------------------------- --- Key bindings --- -myKeys conf@(XConfig {XMonad.modMask = modMask}) = (M.fromList $ - - -- launch a terminal - [ ((0, xK_Super_R), spawn $ XMonad.terminal conf), - -- 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), - -- close focused window - ("M1-<F4>", killIfNot (Role "buddy_list")), - -- Rotate through the available layout algorithms - ("M-<Space>", sendMessage NextLayout), - -- - -- Jump to specific layout - ("M-d", chooseLayout "dwm"), - ("M-c", chooseLayout "coding"), - ("M-m", chooseLayout "mirror"), - ("M-f", chooseLayout "Full"), - ("M-g", chooseLayout "gimp"), - ("M-i", chooseLayout "im"), - ("M-a", chooseLayout "Grid"), - ("M-o", chooseLayout "onebig"), - ("M-w", chooseLayout "mgrid"), - ("M-u", chooseLayout "autogrid"), - ("M-<Up>", withFocused (sendMessage . maximizeRestore)), - ("M-<Down>", withFocused minimizeWindow), - ("M-<Right>", withFocused (sendMessage . RestoreMinimizedWin)), - - ("M-M1-m", sendMessage $ Toggle MIRROR), - ("M-b", sendMessage $ ToggleStruts), - - -- Focus urgent window - ("M-<F12>", focusUrgent), - - -- Bring any window to current workspace - ("M1-w", windowPromptBring myXPConfig), - ("M1-z", goToSelected myGSConfig), - ("M-x", selectAppGroup myGSConfig myGSConfig myApps), --- ("M-p", promptBox), - - ("M1-e", addWorkspace "new"), - ("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), - ("M1-k", sendButtonPress 4), - ("M1-j", sendButtonPress 5), - ("M-j", caseLayoutOf [("tabgrid", Ex.focusDown)] (windows W.focusDown)), - ("M-k", caseLayoutOf [("tabgrid", Ex.focusUp)] (windows W.focusUp) ), - - -- Rotate windows list - ("M-C-j", caseLayoutOf [("tabgrid", Ex.focusGroupDown)] rotateWindows ), - ("M-C-k", caseLayoutOf [("tabgrid", Ex.focusGroupUp)] rotateWindows'), - - -- Swap the focused window and the master window - ("M-<Return>", caseLayoutOf [("tabgrid", Ex.swapGroupMaster)] dwmpromote), - - -- Swap the focused window with the next window - ("M-S-j", caseLayoutOf [("tabgrid", Ex.swapDown)] (windows W.swapDown)), - ("M-S-k", caseLayoutOf [("tabgrid", Ex.swapUp)] (windows W.swapUp)), - - -- Tab/Untab - ("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))), - - -- 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>", spawn "gvim ~/.xmonad/xmonad.hs"), - ("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>", spawn "iceweasel"), - ("<XF86HomePage>", spawn defaultFM), - ("<XF86Mail>", spawn "kontact"), - - ("<Print>", spawn "ksnapshot"), - ("S-<Print>", promptPublishShot), - - ("M-S-q", io $ exitWith ExitSuccess), - -- Restart xmonad - ("M-q", broadcastMessage ReleaseResources >> restart "xmonad" 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..44a96cb --- /dev/null +++ b/lib/KeyBindings.lhs @@ -0,0 +1,241 @@ +Определения горячих клавиш +========================== + +Заголовок и импорты +------------------- + +> 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 CommonFunctions +> import Themes +> import GroupsSetup +> import Mouse + +Основные сочетания клавиш +------------------------- + +> myKeys conf = M.fromList $ + +Запустить терминал: + +> [ ((0, xK_Super_R), spawn myTerminal), + +Запустить терминал в директории `~/Work`, он будет открыт на соответствующем +рабочем месте: + +> ((shiftMask, xK_Super_R), spawn workTerminal), + +Увеличить/уменьшить количество мастер-окон: + +> ((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), + +Выбрать определённый 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>", 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>", spawn "iceweasel"), +> ("<XF86HomePage>", spawn defaultFM), +> ("<XF86Mail>", spawn "kontact"), + +Сделать скриншот. + +> ("<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/Layouts.hs b/lib/Layouts.hs deleted file mode 100644 index 495e9fe..0000000 --- a/lib/Layouts.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE ExistentialQuantification, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable, NoMonomorphismRestriction #-} -module Layouts where - -import Data.Ratio ((%)) - -import XMonad hiding ((|||)) -import XMonad.Hooks.ManageDocks hiding (L,R) - --- Import contrib layouts -import XMonad.Layout.AutoMaster -import XMonad.Layout.Column -import XMonad.Layout.Decoration -import XMonad.Layout.PerWorkspace -import XMonad.Layout.LayoutCombinators -import XMonad.Layout.Named -import XMonad.Layout.GridVariants -import XMonad.Layout.IM -import XMonad.Layout.Reflect -import XMonad.Layout.MagicFocus -import XMonad.Layout.CenteredMaster -import XMonad.Layout.OneBig -import XMonad.Layout.MultiToggle -import XMonad.Layout.MultiToggle.Instances -import XMonad.Layout.NoBorders -import XMonad.Layout.ComboP -import XMonad.Layout.TwoPane -import XMonad.Layout.DecorationAddons -import XMonad.Layout.ButtonDecoration -import XMonad.Layout.WindowSwitcherDecoration -import XMonad.Layout.DraggingVisualizer -import XMonad.Layout.Tabbed -import XMonad.Layout.TrackFloating -import XMonad.Layout.Maximize -import XMonad.Layout.Minimize -import XMonad.Layout.SubLayouts -import XMonad.Layout.Simplest -import XMonad.Layout.Groups - -import qualified XMonad.Layout.WindowNavigation as Nav - --- import FixedBoxes -import Themes - ----------------------------------------------------- --- Layout modifier toggle -toggleMirror = mkToggle (single MIRROR) -tWithIM = withIM (1%6) ((Role "buddy_list") `Or` (Role "MainWindow") `Or` (Role "MainWindow#1")) - -isGfxPanel = (Role "gimp-toolbox") `Or` (Role "Brush selector") `Or` (Role "toolbox_window") `Or` (Role "Layers") - -imlayout = (addTabs shrinkText deco $ subLayout [] Simplest autogrid2) ||| (tabbed shrinkText deco) --- imlayout = fixedBoxes boxes (tabbed shrinkText deco) $ Grid 2 -tabgrid = named "tabgrid" $ group (tabbed shrinkText deco) (Mirror $ Tall 1 (1/100) (2/3)) - --- boxes :: [Box] --- boxes = [Box "one" 0 0 0.5 0.5, --- Box "two" 0 0.5 0.5 0.5, --- Box "three" 0.5 0 0.5 0.5, --- Box "four" 0.5 0.5 0.5 0.5] - -grid = named "grid" $ Grid (2) -vgrid = Grid (1/2) -tiled = Tall 1 (1/100) (1/2) -dwmtile = named "dwm" tiled -full = named "Full" $ tabbed shrinkText deco -mix = named "mix" $ Tall 1 (1/100) (2/3) -mirrored = named "mirror" $ Mirror tiled --- forgimp = named "gimp" $ reflectHoriz (Tall 1 (1/100) (1/4)) -zgrid = magicFocus (centerMaster grid) -autogrid = named "autogrid" (autoMaster 1 (1/100) grid) -autotall = Mirror (autoMaster 1 (1/100) vgrid) -autogrid2 = autoMaster 2 (1/100) grid -books = named "books" (Tall 1 (1/100) (2/3)) --- rowtile = Mirror hortile -mgrid = centerMaster grid -forim = named "im" (tWithIM imlayout) -column = Column 1.8 -forgimp = named "gimp" $ withButtons $ combineTwoP (TwoPane 0.03 0.75) column (reflectVert $ Column 0.4) $ Not isGfxPanel -onebig = named "onebig" $ (OneBig (3/4) (3/4)) --- coding = named "coding" $ reflectHoriz $ mastered (1/100) (1/3) (Column 2) - -minimax = maximize . minimize - -withButtons = buttonDeco shrinkText decoB - -draggable layout = windowSwitcherDecorationWithButtons shrinkText decoB (draggingVisualizer $ layout) --- draggableButtons = id - --- draggable layout = windowSwitcherDecoration shrinkText decoB (draggingVisualizer $ layout) --- draggable = id - -myLayout = trackFloating $ - smartBorders $ - Nav.configurableNavigation (Nav.navigateBrightness 0.0) $ - avoidStruts $ - onWorkspace "inet" (minimax full ||| tabgrid ||| onebig) $ - onWorkspace "text" (minimax full ||| 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 "dashboard" (forgimp ||| full ||| grid) $ - onWorkspace "trash" (full ||| autogrid ||| grid) (minimax mirrored ||| full) - diff --git a/lib/Layouts.lhs b/lib/Layouts.lhs new file mode 100644 index 0000000..3a0cf54 --- /dev/null +++ b/lib/Layouts.lhs @@ -0,0 +1,124 @@ +Layouts — раскладки окон +======================== + +Заголовки и импорты +------------------- + +> {-# LANGUAGE ExistentialQuantification, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable, NoMonomorphismRestriction, UndecidableInstances, IncoherentInstances #-} +> module Layouts (myLayout) where + +Импорты из стандартной библиотеки. + +> import Data.Ratio ((%)) + +Импорты из XMonad. + +> import XMonad hiding ((|||)) +> import XMonad.Hooks.ManageDocks hiding (L,R) + +Импорты из xmonad-contrib + +> import XMonad.Layout.AutoMaster +> import XMonad.Layout.Column +> import XMonad.Layout.Decoration +> import XMonad.Layout.PerWorkspace +> import XMonad.Layout.LayoutCombinators +> import XMonad.Layout.Named +> import XMonad.Layout.GridVariants +> import XMonad.Layout.IM +> import XMonad.Layout.Reflect +> import XMonad.Layout.OneBig +> import XMonad.Layout.NoBorders +> import XMonad.Layout.ComboP +> import XMonad.Layout.TwoPane +> import XMonad.Layout.ButtonDecoration +> import XMonad.Layout.Tabbed +> import XMonad.Layout.TrackFloating +> import XMonad.Layout.Maximize +> import XMonad.Layout.Minimize +> import XMonad.Layout.Groups +> import XMonad.Layout.LayoutBuilderP +> import XMonad.Layout.AutoComboP + +> import qualified XMonad.Layout.WindowNavigation as Nav +> import XMonad.Util.WindowPropertiesRE + +Импорты других модулей конфига. + +> import Themes +> import Predicates + +Модификаторы итп +---------------- + +Модификатор для всяческих ростеров. + +> withRoster = withIM (1%6) ((Role "buddy_list") `Or` (Role "MainWindow") `Or` (Role "MainWindow#1")) + +Различные панели графических редакторов — Gimp, MyPaint. + +> isGfxPanel = (Role "gimp-toolbox") `Or` (Role "Brush selector") `Or` (Role "toolbox_window") `Or` (Role "Layers") + +Layout для основного рабочего места. Экран разделён на две части, в верхней — +вкладки, в нижней — другой layout (grid или тоже вкладки). В верхнюю часть +попадают «рабочие» приложения, в нижнюю — всё остальное. Размеры частей +меняются автоматически в зависимости от количества окон в них, а также размеры +частей можно менять по "Mod-e/r". + +> work l = withRoster $ autoCombineTwoP 0.1 0.1 0.02 (Mirror $ TwoPane 0.03 0.5) tabs l +> (RE $ workApps `Or` ClassName "Evince") + +Разрешает разворачивать/восстанавливать/сворачивать окна + +> minimax = maximize . minimize + +> withButtons = buttonDeco shrinkText decoB + +Описания layouts +---------------- + +Простой layout со вкладками. + +> tabs = tabbed shrinkText deco + +Раскладывает окна чатов по разным областям со вкладками, по тематике. + +> imlayout = ( (layoutP (RE programmingChats) (relBox 0 0 0.55 1) (Just $ relBox 0 0 1 1) tabs) +> $ (layoutP (RE miscChats) (relBox 0.55 0 1 0.6) (Just $ relBox 0.55 0 1 1) tabs) +> $ (layoutAll (relBox 0.55 0.6 1 1) tabs) +> ) + +Области со вкладками, разложенные как +Mirror Tall+. Окна можно двигать между областями +клавишами "Mod+Alt+h/j/k/l". + +> tabgrid = named "tabgrid" $ group tabs (Mirror $ Tall 1 (1/100) (2/3)) + +> grid = named "grid" $ Grid (2) +> tiled = Tall 1 (1/100) (1/2) +> dwmtile = named "dwm" tiled +> full = named "Full" $ minimax tabs +> docs = named "docs" $ Tall 1 (1/100) (2/3) +> mirrored = named "mirror" $ Mirror tiled +> autogrid = named "autogrid" (autoMaster 1 (1/100) grid) +> autogrid2 = autoMaster 2 (1/100) grid +> books = named "books" (Tall 1 (1/100) (2/3)) +> column = Column 1.8 +> forgimp = named "gimp" $ withButtons $ combineTwoP (TwoPane 0.03 0.75) column (reflectVert $ Column 0.4) $ Not isGfxPanel +> onebig = named "onebig" $ (OneBig (3/4) (3/4)) + +Главное определение +------------------- + +> myLayout = trackFloating $ +> smartBorders $ +> Nav.configurableNavigation (Nav.navigateBrightness 0.0) $ +> avoidStruts $ +> onWorkspace "inet" (full ||| tabgrid ||| onebig) $ +> onWorkspace "text" (full ||| autogrid2 ||| dwmtile ||| mirrored ||| books ||| autogrid ||| onebig ) $ +> onWorkspace "work" (work grid ||| work tabs ||| full) $ +> onWorkspace "files" (full ||| dwmtile ||| autogrid) $ +> onWorkspace "im" (named "im" (withRoster $ maximize imlayout) ||| withRoster tabs) $ +> onWorkspace "term" (full ||| mirrored ||| autogrid) $ +> onWorkspace "gimp" (forgimp ||| full ||| grid) $ +> onWorkspace "dashboard" (full ||| autogrid ||| grid) (minimax mirrored ||| docs ||| full) + diff --git a/lib/Mouse.hs b/lib/Mouse.hs deleted file mode 100644 index db863e5..0000000 --- a/lib/Mouse.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -module Mouse - (sendButtonPress, - movePointer) - where - -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Types -import Graphics.X11.Xlib.Misc -import Foreign -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 - (_,_,_,rootx,rooty,_,_,_) <- io $ queryPointer dpy root - fakeMotion rootx rooty - 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 deleted file mode 100644 index 2fb3e28..0000000 --- a/lib/MyManageHooks.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} -module MyManageHooks - (myManageHook) - where - --- To be able to query X11 atoms and such on -import Foreign.C.Types (CLong) - -import Control.Monad (liftM) - -import XMonad -import XMonad.Hooks.ManageHelpers hiding (C) - -import AppGroups -import GroupsSetup - -myManageHook = basehooks <+> manageMenus <+> manageDialogs <+> floatPlasma - ------------------------------------------------------------------------- --- Window rules: - --- Float all menus -manageMenus = checkMenu --> doFloat --- Float all dialogs -manageDialogs = checkDialog --> doFloat - --- Check if window has named atom with given value -checkAtom name value = ask >>= \w -> liftX $ do - a <- getAtom name - val <- getAtom value - mbr <- getProp w a - case mbr of - Just [r] -> return $ elem (fromIntegral r) [val] - _ -> return False - --- Check if window is a menu (for Gimp tear-off menus, for example) -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" - --- | 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] - -basehooks = composeAll (apps2hooks myApps) <+> transience' - -role = stringProperty "WM_WINDOW_ROLE" - -floatPlasma = composeAll - [ className =? "Qt-subapplication" --> doFloat, - title =? "Qt-subapplication" --> doFloat, - title =? "Recently opened documents" --> doCenterFloat, - className ~? "[pP]lasma-desktop" --> doFloat, - className =? "XCalendar" --> doFloat, - className =? "Qwerty.py" --> doCenterFloat, - title =? "Копирование" --> doFloat, - title =? "Перемещение" --> doFloat ] - diff --git a/lib/MyManageHooks.lhs b/lib/MyManageHooks.lhs new file mode 100644 index 0000000..ee59906 --- /dev/null +++ b/lib/MyManageHooks.lhs @@ -0,0 +1,51 @@ +ManageHooks +=========== + +Заголовки и импорты +------------------- + +> {-# LANGUAGE NoMonomorphismRestriction #-} +> module MyManageHooks +> (myManageHook) +> where + +> import XMonad +> import XMonad.Hooks.ManageHelpers hiding (C) + +> import CommonFunctions ((~?)) +> import AppGroups (apps2hooks) +> import GroupsSetup (myApps) + +Правила для окон +---------------- + +Главное определение. + +> myManageHook = basehooks <+> manageMenus <+> manageDialogs <+> floatPlasma + +Сделать плавающими отрывающиеся меню + +> manageMenus = checkMenu --> doFloat +> where +> checkMenu = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_MENU" + +Сделать плавающими диалоги + +> manageDialogs = isDialog --> doFloat + +Основная часть +ManageHook+-ов + +> basehooks = composeOne (apps2hooks myApps) <+> transience' + +Сделать плавающими некоторые окна. + +> floatPlasma = composeAll +> [ className =? "Qt-subapplication" --> doFloat, +> title =? "Qt-subapplication" --> doFloat, +> title =? "Recently opened documents" --> doCenterFloat, +> className ~? "[pP]lasma-desktop" --> doFloat, +> className =? "XCalendar" --> doFloat, +> className =? "Qwerty.py" --> doCenterFloat, +> title =? "Копирование" --> doFloat, +> title =? "Перемещение" --> doFloat ] + diff --git a/lib/Predicates.lhs b/lib/Predicates.lhs new file mode 100644 index 0000000..2d3a02c --- /dev/null +++ b/lib/Predicates.lhs @@ -0,0 +1,39 @@ +Predicates — условия для окон +============================= + +Заголовки и импорты +------------------- + +> {-# LANGUAGE NoMonomorphismRestriction #-} +> module Predicates where + +> import XMonad.Util.WindowProperties +> import XMonad.Util.WindowPropertiesRE + +> import AppGroups + +Утилиты +------- + +> regex = C . RE . ClassName +> regexTitle = C . RE . Title + +> titleIsAnyOf :: [String] -> Property +> titleIsAnyOf list = foldl1 Or $ map Title list + +Определения предикатов +---------------------- + +> programmingChats = titleIsAnyOf ["programming", "haskell", "python", "java"] +> miscChats = titleIsAnyOf ["lug", "math", "linux", "xmonad"] +> workChats = titleIsAnyOf [ +> "odergunova", "dvelichko", "eandrushko", +> "msaratova", "egorelova", "szaytseva", +> "akaptsan", "abelyaev", "akiliyevich", "aemelyanov", +> "akrylov", "yremizov", "kvlasov" ] + +> otherChats = ClassName "Pidgin" `And` Not workChats `And` Not (Role "buddy_list") + +> workApps = ClassName "Work" `Or` Title "Work" `Or` ClassName "Qt Jambi" + + diff --git a/lib/Themes.hs b/lib/Themes.hs deleted file mode 100644 index d1e11e3..0000000 --- a/lib/Themes.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Themes where - -import qualified Data.Map as M - -import XMonad -import XMonad.Layout.Decoration -import XMonad.Layout.DecorationAddons -import XMonad.Prompt -import XMonad.Actions.GridSelect - -myFont = "xft:Ubuntu-10" - -myXPConfig = defaultXPConfig { - font = myFont, - bgColor = myFocusedBorderColor, - fgColor = "#000000" } - -myGSConfig :: HasColorizer a => GSConfig a -myGSConfig = defaultGSConfig { - gs_navigate = myNavigation, - gs_font = myFont } - -myNavigation :: TwoD a (Maybe a) -myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler - where navKeyMap = 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 - navDefaultHandler = const myNavigation - makeKeymap = concatMap allMasks - allMasks (key,action) = [((0, key), action), - ((8192,key), action)] - - -deco = defaultTheme {activeColor = myFocusedBorderColor, - activeTextColor = "#000000", - inactiveColor = "#E6DCD1", - inactiveTextColor = "#000000", - decoHeight = 24, - fontName = myFont} - -decoB = defaultThemeWithButtons {activeColor = myFocusedBorderColor, - activeTextColor = "#000000", - fontName = myFont} - ------------------------------------------------------------------------ --- Some general settings -myWorkspaces = ["main"] -myFocusedBorderColor = "#97ACC1" - -myBorderWidth :: Dimension -myBorderWidth = 1 - diff --git a/lib/Themes.lhs b/lib/Themes.lhs new file mode 100644 index 0000000..6905a7e --- /dev/null +++ b/lib/Themes.lhs @@ -0,0 +1,129 @@ +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 + +Определения +----------- + +Шрифт. + +> 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 = ["main"] + +> myFocusedBorderColor = "#97ACC1" + +> myBorderWidth :: Dimension +> myBorderWidth = 1 + +Используемый терминал + +> myTerminal :: String +> myTerminal = "gnome-terminal" + +> workTerminal :: String +> workTerminal = "gnome-terminal --profile=Work --class=Work --disable-factory --working-directory=/home/portnov/Work" + diff --git a/xmonad.hs b/xmonad.hs index b69cfd9..9687c57 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -36,7 +36,7 @@ baseLogHook = logHook baseConfig main = do xmonad $ ewmh $ baseConfig { - terminal = "gnome-terminal", + terminal = myTerminal, focusFollowsMouse = False, borderWidth = myBorderWidth, modMask = mod4Mask, @@ -58,5 +58,5 @@ main = do historyHook setWMName "LG3D" updatePointer (Relative 0.5 0.5) - } `additionalKeysP` (addKeys ++ apps2keys myGSConfig myApps) + } `additionalKeysP` (addKeys ++ apps2keys searchGS myApps)