diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/XMonad/Layout/TopicDir.hs | 43 | ||||
-rw-r--r-- | src/XMonad/Local/Actions.hs | 71 | ||||
-rw-r--r-- | src/XMonad/Local/Keys.hs | 106 | ||||
-rw-r--r-- | src/XMonad/Local/Layout.hs | 10 | ||||
-rw-r--r-- | src/XMonad/Local/ManageHook.hs | 5 | ||||
-rw-r--r-- | src/XMonad/Local/TopicSpace.hs | 4 |
6 files changed, 146 insertions, 93 deletions
diff --git a/src/XMonad/Layout/TopicDir.hs b/src/XMonad/Layout/TopicDir.hs index fa2eb62..47e732e 100644 --- a/src/XMonad/Layout/TopicDir.hs +++ b/src/XMonad/Layout/TopicDir.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UnicodeSyntax #-} module XMonad.Layout.TopicDir ( -- * Usage @@ -8,24 +13,25 @@ module XMonad.Layout.TopicDir ( TopicDir, ) where -import qualified Data.Map as M -import Control.Exception -import System.Directory (setCurrentDirectory, getCurrentDirectory) +import Control.Exception +import qualified Data.Map as M +import System.Directory (getCurrentDirectory, + setCurrentDirectory) -import XMonad hiding (focus) -import XMonad.Util.Run (runProcessWithInput) -import XMonad.Prompt (XPConfig) -import XMonad.Prompt.Directory (directoryPrompt) -import XMonad.Layout.LayoutModifier -import XMonad.StackSet (tag, currentTag) +import XMonad hiding (focus) +import XMonad.Layout.LayoutModifier +import XMonad.Prompt (XPConfig) +import XMonad.Prompt.Directory (directoryPrompt) +import XMonad.StackSet (currentTag, tag) +import XMonad.Util.Run (runProcessWithInput) -econst :: Monad m => a -> IOException -> m a +econst ∷ Monad m ⇒ a → IOException → m a econst = const . return -data Chdir = Chdir String deriving ( Typeable ) +newtype Chdir = Chdir String deriving ( Typeable ) instance Message Chdir -data TopicDir a = TopicDir (M.Map WorkspaceId String, String) +newtype TopicDir a = TopicDir (M.Map WorkspaceId String, String) deriving (Read, Show) instance LayoutModifier TopicDir Window where @@ -36,7 +42,7 @@ instance LayoutModifier TopicDir Window where Nothing -> return () runLayout w r where - mdir :: WorkspaceId -> Maybe String + mdir ∷ WorkspaceId → Maybe String mdir tc | tc == tag w && d == "" = M.lookup tc tds | tc == tag w = Just d | otherwise = Nothing @@ -48,17 +54,16 @@ instance LayoutModifier TopicDir Window where return $ Just $ TopicDir (dds, wd') | otherwise = return Nothing -topicDir :: M.Map WorkspaceId String -> l a -> ModifiedLayout TopicDir l a +topicDir ∷ M.Map WorkspaceId String → l a → ModifiedLayout TopicDir l a topicDir m = ModifiedLayout (TopicDir (m, "")) -cleanDir :: String -> X String +cleanDir ∷ String → X String cleanDir x = scd x >> io getCurrentDirectory -scd :: String -> X () +scd ∷ String → X () scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` econst x) catchIO $ setCurrentDirectory x' -changeDir :: XPConfig -> X () +changeDir ∷ XPConfig → X () changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir) - diff --git a/src/XMonad/Local/Actions.hs b/src/XMonad/Local/Actions.hs index 4bc8d7b..71549a1 100644 --- a/src/XMonad/Local/Actions.hs +++ b/src/XMonad/Local/Actions.hs @@ -1,34 +1,39 @@ {-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE UnicodeSyntax #-} module XMonad.Local.Actions where -import Control.Monad -import Data.Maybe -import System.Posix.Directory -import System.Posix.Env -import System.Posix.Signals (Signal, signalProcess) +import Codec.Binary.UTF8.String +import Control.Monad +import Data.Maybe +import System.IO +import System.Posix.Directory +import System.Posix.Env +import System.Posix.Signals (Signal, signalProcess) +import System.Process (runInteractiveProcess) -import XMonad -import qualified XMonad.Actions.TopicSpace as TS +import XMonad +import qualified XMonad.Actions.TopicSpace as TS +import qualified XMonad.Util.Paste as Paste import qualified XMonad.Util.WindowProperties as WP -- local modules ************************************************************** -import qualified XMonad.Local.Config as Local +import qualified XMonad.Local.Config as Local -- launch applications ******************************************************** -spawnExplorer :: X () -spawnExplorer = do +spawnExplorer ∷ X () +spawnExplorer = do cwd <- liftIO getWorkingDirectory pth <- liftIO $ getEnvDefault "HOME" cwd spawnExplorerIn pth - -spawnExplorerIn :: String -> X () + +spawnExplorerIn ∷ String → X () spawnExplorerIn dir = spawn $ Local.explorer ++ " --no-desktop --browser " ++ dir -spawnShell :: Maybe String -> X() +spawnShell ∷ Maybe String → X() spawnShell = spawnShellIn "" -spawnShellIn :: TS.Dir -> Maybe String -> X() +spawnShellIn ∷ TS.Dir → Maybe String → X() spawnShellIn dir command = do t <- asks (terminal . config) spawn $ cmd' t @@ -39,18 +44,18 @@ spawnShellIn dir command = do cmd' t | dir == "" = t ++ run command | otherwise = "cd " ++ dir ++ " && " ++ t ++ run command -spawnTmux :: String -> X() +spawnTmux ∷ String → X() spawnTmux project = spawnShell $ Just ("tmux -c 'tmuxinator " ++ project ++ "'") -killWindowPID :: Signal -> Window -> X() +killWindowPID ∷ Signal → Window → X() killWindowPID s w = do pid <- WP.getProp32s "_NET_WM_PID" w when (isJust pid) (liftIO $ mapM_ (signalProcess s . fromIntegral) (fromJust pid)) -signalCurrentWindow :: Signal -> X() +signalCurrentWindow ∷ Signal → X() signalCurrentWindow s = withFocused (killWindowPID s) -mateRun :: X () +mateRun ∷ X () mateRun = withDisplay $ \dpy -> do rw <- asks theRoot mate_panel <- getAtom "_MATE_PANEL_ACTION" @@ -61,3 +66,33 @@ mateRun = withDisplay $ \dpy -> do setClientMessageEvent e rw mate_panel 32 panel_run 0 sendEvent dpy rw False structureNotifyMask e sync dpy False + +clipboardManager ∷ String +clipboardManager = "/usr/bin/clipit" + +runProcessAndLogError ∷ MonadIO m ⇒ FilePath → [String] → String → m (Maybe String) +runProcessAndLogError cmd args input = io $ do + (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd) (map encodeString args) Nothing Nothing + hPutStr pin input + hClose pin + output <- hGetContents pout + when (output == output) $ return () + err <- hGetContents perr + when (err == err) $ return () + hClose pout + hClose perr + unless (null err) $ hPrint stderr $ "failed to run " ++ clipboardManager ++ ": " ++ err + -- no need to waitForProcess, we ignore SIGCHLD + return $ Just output + +getClipboardText ∷ X (Maybe String) +getClipboardText = catchX + (runProcessAndLogError clipboardManager ["-c"] "") + (io $ return Nothing) + +pasteTextFromClipboard ∷ X () +pasteTextFromClipboard = do + t <- getClipboardText + case t of + Just text -> catchX (Paste.pasteString text) (io $ return ()) + Nothing -> io (return ()) diff --git a/src/XMonad/Local/Keys.hs b/src/XMonad/Local/Keys.hs index f746933..626e781 100644 --- a/src/XMonad/Local/Keys.hs +++ b/src/XMonad/Local/Keys.hs @@ -1,63 +1,64 @@ +{-# LANGUAGE UnicodeSyntax #-} module XMonad.Local.Keys ( emacsKeys , keyBindings , modMask ) where -import Control.Monad -import Data.Either.Utils -import qualified Data.Map as M -import Data.Maybe -import qualified Network.MPD as MPD -import qualified Network.MPD.Commands.Extensions as MPD -import System.Posix.Signals (sigCONT, sigSTOP) - -import XMonad hiding (modMask, keys) -import XMonad.Actions.CycleWS +import Control.Monad +import Data.Either.Utils +import qualified Data.Map as M +import Data.Maybe +import qualified Network.MPD as MPD +import qualified Network.MPD.Commands.Extensions as MPD +import System.Posix.Signals (sigCONT, sigSTOP) + +import XMonad hiding (keys, modMask) +import XMonad.Actions.CycleWS +import qualified XMonad.Actions.DwmPromote as DwmP import qualified XMonad.Actions.DynamicWorkspaces as DW -import qualified XMonad.Actions.DwmPromote as DwmP -import XMonad.Actions.GridSelect as GS -import qualified XMonad.Actions.Submap as SUB -import qualified XMonad.Actions.TopicSpace as TS -import XMonad.Actions.Volume -import qualified XMonad.Actions.WithAll as WithAll -import XMonad.Hooks.ManageDocks -import qualified XMonad.Layout.BoringWindows as BW -import XMonad.Layout.Minimize -import qualified XMonad.Layout.MultiToggle as MT -import XMonad.Layout.Reflect -import XMonad.Layout.SubLayouts -import qualified XMonad.Layout.TopicDir as TD -import XMonad.Layout.ToggleLayouts -import XMonad.Layout.WindowNavigation -import qualified XMonad.Prompt.Shell as Shell -import qualified XMonad.Prompt.Ssh as PSsh -import qualified XMonad.StackSet as W -import qualified XMonad.Util.EZConfig as EZ -import XMonad.Util.NamedScratchpad -import XMonad.Util.WorkspaceCompare (getSortByIndex) +import XMonad.Actions.GridSelect as GS +import qualified XMonad.Actions.Submap as SUB +import qualified XMonad.Actions.TopicSpace as TS +import XMonad.Actions.Volume +import qualified XMonad.Actions.WithAll as WithAll +import XMonad.Hooks.ManageDocks +import qualified XMonad.Layout.BoringWindows as BW +import XMonad.Layout.Minimize +import qualified XMonad.Layout.MultiToggle as MT +import XMonad.Layout.Reflect +import XMonad.Layout.SubLayouts +import XMonad.Layout.ToggleLayouts +import qualified XMonad.Layout.TopicDir as TD +import XMonad.Layout.WindowNavigation +import qualified XMonad.Prompt.Shell as Shell +import qualified XMonad.Prompt.Ssh as PSsh +import qualified XMonad.StackSet as W +import qualified XMonad.Util.EZConfig as EZ +import XMonad.Util.NamedScratchpad +import XMonad.Util.WorkspaceCompare (getSortByIndex) -- local modules ************************************************************** -import qualified XMonad.Local.Actions as Local -import XMonad.Local.Config -import qualified XMonad.Local.GridSelect as Local -import qualified XMonad.Local.Music as Local -import XMonad.Local.NamedScratchpad -import XMonad.Local.TopicSpace -import qualified XMonad.Local.Workspaces as Local - -modMask :: KeyMask +import qualified XMonad.Local.Actions as Local +import XMonad.Local.Config +import qualified XMonad.Local.GridSelect as Local +import qualified XMonad.Local.Music as Local +import XMonad.Local.NamedScratchpad +import XMonad.Local.TopicSpace +import qualified XMonad.Local.Workspaces as Local + +modMask ∷ KeyMask modMask = mod4Mask -modm :: String +modm ∷ String modm = "M4" -keyBindings :: XConfig l -> M.Map (KeyMask, KeySym) (X()) +keyBindings ∷ XConfig l → M.Map (KeyMask, KeySym) (X()) keyBindings conf = EZ.mkKeymap conf $ emacsKeys conf -emacsKeys :: XConfig l -> [(String, X())] +emacsKeys ∷ XConfig l → [(String, X())] emacsKeys = \conf -> map prefix (keysMissingPrefix conf) ++ unprefixedKeys where - prefix :: (String, a) -> (String, a) + prefix ∷ (String, a) → (String, a) prefix (k, a) = (modm ++ "-" ++ k, a) keysMissingPrefix conf = concat @@ -67,7 +68,7 @@ emacsKeys = \conf -> map prefix (keysMissingPrefix conf) ++ unprefixedKeys ] -- need to be prefixed with modifier -genericKeys :: XConfig l -> [(String, X())] +genericKeys ∷ XConfig l → [(String, X())] genericKeys conf = [ -- Applications (";", Local.spawnShell Nothing) @@ -201,6 +202,7 @@ genericKeys conf = [ -- misc , ("S-h", PSsh.sshPrompt xpConfig) + , ("v", Local.pasteTextFromClipboard) --, ("<Print>", spawn "xfce4-screenshooter") , ("y", SUB.submap $ EZ.mkKeymap conf $ concat [ [(k, a), (modm ++ "-" ++ k, a)] @@ -228,7 +230,7 @@ genericKeys conf = [ ] -switchWorkspaceKeys :: [(String, X())] +switchWorkspaceKeys ∷ [(String, X())] switchWorkspaceKeys = [ (m ++ show i, withNthWorkspace f ((i + 9) `mod` 10)) | i <- [1..9] ++ [0] @@ -238,7 +240,7 @@ switchWorkspaceKeys = ] ] -switchScreenKeys :: [(String, X())] +switchScreenKeys ∷ [(String, X())] switchScreenKeys = [ (m ++ k, screenWorkspace sc >>= flip whenJust (windows . f)) | (k, sc) <- zip ["w", "e"] [0..] @@ -246,7 +248,7 @@ switchScreenKeys = ] -- no prefix -unprefixedKeys :: [(String, X())] +unprefixedKeys ∷ [(String, X())] unprefixedKeys = [ ("<XF86Calculator>", namedScratchpadAction namedScratchpads "calculator") @@ -275,16 +277,16 @@ unprefixedKeys = [ , ("C-<XF86MonBrightnessDown>", spawn "xbacklight -set 0") ] -withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () +withNthWorkspace ∷ (String → WindowSet → WindowSet) → Int → X () withNthWorkspace job wnum = do sortfunc <- getSortByIndex ws <- gets ( map W.tag . sortfunc . namedScratchpadFilterOutWorkspace . W.workspaces . windowset ) case drop wnum ws of (w:_) -> windows $ job w - [] -> return () + [] -> return () -nonEmptyWsPred :: X (WindowSpace -> Bool) +nonEmptyWsPred ∷ X (WindowSpace → Bool) nonEmptyWsPred = do let ne = isJust . W.stack hs <- gets (map W.tag . W.hidden . windowset) @@ -292,5 +294,5 @@ nonEmptyWsPred = do return $ \w -> hi w && ne w && W.tag w /= "NSP" -- cykle only NonEmpty, Hidden workspaces and not NSP workspaces -nonEmptyWs :: WSType +nonEmptyWs ∷ WSType nonEmptyWs = WSIs nonEmptyWsPred diff --git a/src/XMonad/Local/Layout.hs b/src/XMonad/Local/Layout.hs index 6ea0dde..cadad99 100644 --- a/src/XMonad/Local/Layout.hs +++ b/src/XMonad/Local/Layout.hs @@ -11,6 +11,7 @@ import XMonad.Layout.Accordion import qualified XMonad.Layout.BoringWindows as BW import XMonad.Layout.Column import qualified XMonad.Layout.ComboP as CP +import XMonad.Layout.Fullscreen import qualified XMonad.Layout.IM as IM import qualified XMonad.Layout.MultiToggle as MT import qualified XMonad.Layout.Named as LN @@ -36,9 +37,10 @@ layoutHook = avoidStruts $ PW.onWorkspace "chat" chatL $ PW.onWorkspace "gimp" gimpL $ PW.onWorkspace "BG" bgL - $ PW.onWorkspace "witcher" witcherL $ PW.onWorkspace "remote" remoteL $ PW.onWorkspace "web" webL + $ PW.onWorkspace "witcher" gameDictL + $ PW.onWorkspaces ["gothic", "morrowind"] fullscreenGameL $ PW.onWorkspaces ["homam5", "civ4", "pst", "ciV"] wineGameL easyLay @@ -91,8 +93,10 @@ webL = IM.withIM (1%4) (matchChrome `IM.And` IM.Title "Tabs Outliner") easyLay bgL = windowNavigation $ BW.boringWindows $ smartBorders $ IM.withIM (2%7) matchChrome tiled -witcherL = windowNavigation $ BW.boringWindows $ noBorders - $ IM.withIM (2%7) (IM.ClassName "Firefox") tiled +gameDictL = windowNavigation $ BW.boringWindows $ noBorders + $ IM.withIM (2%7) matchChrome simpleFloat + +fullscreenGameL = noBorders $ fullscreenFull Full remoteL = windowNavigation $ BW.boringWindows $ smartBorders $ Tab.tabbed Tab.shrinkText myTabTheme diff --git a/src/XMonad/Local/ManageHook.hs b/src/XMonad/Local/ManageHook.hs index bfd77fa..156ac47 100644 --- a/src/XMonad/Local/ManageHook.hs +++ b/src/XMonad/Local/ManageHook.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UnicodeSyntax #-} + module XMonad.Local.ManageHook ( manageHook ) where @@ -7,6 +8,7 @@ import Data.List import XMonad hiding (manageHook) import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers +import XMonad.Layout.Fullscreen import qualified XMonad.StackSet as W import XMonad.Util.NamedScratchpad as NS @@ -23,6 +25,8 @@ manageHook = composeAll [ [checkDock -?> doIgnore] , [(matchChrome <&&> appName =? tabsOutlinerAppName) -?> doTOFloat] , [className =? c -?> doIgnore | c <- myCIgnores] + , [appName =? "GOTHIC.EXE" -?> doMyShift "gothic" <+> fullscreenManageHook] + , [appName =? "Morrowind.exe" <||> title =? "Morrowind" -?> doMyShift "morrowind" <+> fullscreenManageHook] , [className =? "Wine" -?> doFloat ] , [isFullscreen -?> doMaster <+> doFullFloat] , [transience] @@ -125,4 +129,3 @@ matchChrome = className =? "google-chrome" <||> className =? "Google-chrome" windowRole ∷ Query String windowRole = stringProperty "WM_WINDOW_ROLE" - diff --git a/src/XMonad/Local/TopicSpace.hs b/src/XMonad/Local/TopicSpace.hs index 6607139..f3a03d7 100644 --- a/src/XMonad/Local/TopicSpace.hs +++ b/src/XMonad/Local/TopicSpace.hs @@ -62,8 +62,10 @@ homeScoped = , "earth" , "ebook" , "gimp" + , "gothic" , "graphics" , "incognito" + , "morrowind" , "music" , "p2p" , "remote" @@ -113,6 +115,8 @@ topicConfig = TS.def , ("scrum", spawn $ browser ++ " --new-window https://bluejeans.com/3046463974/") , ("BG", spawn "steam steam://rungameid/228280" >> spawn (browser ++ " --new-window http://slovnik.seznam.cz/de-cz/")) + , ("gothic", spawn "wine 'C:/Program Files (x86)/Steam/Steam.exe' steam://rungameid/65540") + , ("morrowind", spawn "wine 'C:/Program Files (x86)/Steam/Steam.exe' steam://rungameid/22320") , ("witcher", spawn "wine 'C:/Program Files (x86)/Steam/Steam.exe' steam://rungameid/20900" >> spawn (browser ++ " --new-window http://slovnik.seznam.cz/de-cz/")) , ("drive", spawnShell Nothing >> spawnExplorerIn "~/gdrive") |