diff options
author | Michal Minar <miminar@redhat.com> | 2015-07-19 16:05:30 +0200 |
---|---|---|
committer | Michal Minar <miminar@redhat.com> | 2015-07-19 16:05:30 +0200 |
commit | 440e7b875b7addb57049c235d177702722e3d75f (patch) | |
tree | 3011122215b0ffa86263a354c4ad93670211f975 /src/XMonad | |
parent | 42185e2919472e34e1de70a5f5e84441b91cd553 (diff) | |
download | xminad-440e7b875b7addb57049c235d177702722e3d75f.tar.gz xminad-440e7b875b7addb57049c235d177702722e3d75f.tar.xz xminad-440e7b875b7addb57049c235d177702722e3d75f.zip |
Moved key bindings to library
Diffstat (limited to 'src/XMonad')
-rw-r--r-- | src/XMonad/Local/Actions.hs | 21 | ||||
-rw-r--r-- | src/XMonad/Local/Config.hs | 23 | ||||
-rw-r--r-- | src/XMonad/Local/GridSelect.hs | 86 | ||||
-rw-r--r-- | src/XMonad/Local/Keys.hs | 268 | ||||
-rw-r--r-- | src/XMonad/Local/NamedScratchpad.hs | 33 | ||||
-rw-r--r-- | src/XMonad/Local/TopicSpace.hs | 48 | ||||
-rw-r--r-- | src/XMonad/Local/Workspaces.hs | 91 |
7 files changed, 545 insertions, 25 deletions
diff --git a/src/XMonad/Local/Actions.hs b/src/XMonad/Local/Actions.hs index 2ca3a8b..baf738b 100644 --- a/src/XMonad/Local/Actions.hs +++ b/src/XMonad/Local/Actions.hs @@ -1,13 +1,16 @@ +{-# LANGUAGE DoAndIfThenElse #-} + module XMonad.Local.Actions where import XMonad import qualified XMonad.Actions.TopicSpace as TS -myExplorer :: String -myExplorer = "caja" +-- local modules ************************************************************** +import qualified XMonad.Local.Config as Local +-- launch applications ******************************************************** spawnExplorer :: MonadIO m => m () -spawnExplorer = spawn myExplorer +spawnExplorer = spawn Local.explorer spawnShell :: Maybe String -> X() spawnShell = spawnShellIn "" @@ -22,3 +25,15 @@ spawnShellIn dir command = do cmd' t | dir == "" = t ++ run command | otherwise = "cd " ++ dir ++ " && " ++ t ++ run command + +mateRun :: X () +mateRun = withDisplay $ \dpy -> do + rw <- asks theRoot + mate_panel <- getAtom "_MATE_PANEL_ACTION" + panel_run <- getAtom "_MATE_PANEL_ACTION_RUN_DIALOG" + + io $ allocaXEvent $ \e -> do + setEventType e clientMessage + setClientMessageEvent e rw mate_panel 32 panel_run 0 + sendEvent dpy rw False structureNotifyMask e + sync dpy False diff --git a/src/XMonad/Local/Config.hs b/src/XMonad/Local/Config.hs new file mode 100644 index 0000000..1f7420d --- /dev/null +++ b/src/XMonad/Local/Config.hs @@ -0,0 +1,23 @@ +module XMonad.Local.Config ( + explorer + , xpConfig + , terminal + ) where + +import qualified XMonad.Prompt as P + +explorer :: String +explorer = "caja" + +terminal :: String +terminal = "mate-terminal" + +xpConfig :: P.XPConfig +xpConfig = P.defaultXPConfig + { P.fgColor = "#dfdfdf" + , P.bgColor = "#3c3c3c" + , P.fgHLight = "#ffffff" + , P.bgHLight = "#3c3c3c" + , P.font = "-*-terminus-*-*-*-*-14-*-*-*-*-*-*-*" + , P.height = 24 + } diff --git a/src/XMonad/Local/GridSelect.hs b/src/XMonad/Local/GridSelect.hs new file mode 100644 index 0000000..359cda5 --- /dev/null +++ b/src/XMonad/Local/GridSelect.hs @@ -0,0 +1,86 @@ +module XMonad.Local.GridSelect ( + gsConfig + , gsw + , gswShift + ) where + +import Control.Monad +import Data.List (subsequences) +import XMonad +import qualified Data.Map as M +import XMonad.Actions.GridSelect +import qualified XMonad.Actions.TopicSpace as TS +import qualified XMonad.StackSet as W + +-- local modules ************************************************************** +import qualified XMonad.Local.TopicSpace as Local + + +gsConfig :: HasColorizer a => GSConfig a +gsConfig = defaultGSConfig + { gs_cellheight = 40 + , gs_cellwidth = 100 + , gs_navigate = navigation' + } + where + navigation' :: TwoD a (Maybe a) + navigation' = makeXEventhandler + $ shadowWithKeymap navKeyMap navHandler + + navKeyMap = M.fromList (allowModifs modifs + [ ((0,xK_Escape) , cancel) + , ((0,xK_Return) , select) + , ((0,xK_slash) , substringSearch navigation') + , ((0,xK_question) , substringSearch navigation') + , ((0,xK_Left) , move (-1,0) >> navigation') + , ((0,xK_h) , move (-1,0) >> navigation') + , ((0,xK_H) , move (-1,0) >> navigation') + , ((0,xK_Right) , move (1,0) >> navigation') + , ((0,xK_l) , move (1,0) >> navigation') + , ((0,xK_L) , move (1,0) >> navigation') + , ((0,xK_Down) , move (0,1) >> navigation') + , ((0,xK_j) , move (0,1) >> navigation') + , ((0,xK_J) , move (0,1) >> navigation') + , ((0,xK_Up) , move (0,-1) >> navigation') + , ((0,xK_k) , move (0,-1) >> navigation') + , ((0,xK_K) , move (0,-1) >> navigation') + , ((0,xK_n) , moveNext >> navigation') + , ((0,xK_N) , moveNext >> navigation') + , ((0,xK_p) , movePrev >> navigation') + , ((0,xK_P) , movePrev >> navigation') + ] + ++ allowModifs (drop 1 modifs) + [ ((0,xK_Tab) , moveNext >> navigation') + , ((shiftMask,xK_Tab) , moveNext >> navigation') + ] + ) + modifs :: [KeyMask] + modifs = [ shiftMask, lockMask, mod1Mask, mod2Mask + , mod3Mask, mod4Mask, mod5Mask ] + + allowModifs :: [ KeyMask ] -> [((KeyMask, a), b)] -> [((KeyMask, a), b)] + allowModifs mods keymap = [ ((m .|. o, k), a) + | m <- map (foldl (.|.) 0) $ subsequences mods + , ((o, k), a) <- keymap ] + + -- The navigation handler ignores unknown key symbols + navHandler = const navigation' + +gsw :: X() +gsw = gsw' W.greedyView + where + gsw' :: (WorkspaceId -> WindowSet -> WindowSet) -> X () + gsw' viewFunc = withWindowSet $ \ws -> do + let wss = map W.tag $ fHidden ws ++ map W.workspace (W.current ws : W.visible ws) + gridselect gsConfig (zip wss wss) >>= flip whenJust (switchTopic' viewFunc) + fHidden = filter ((/=) "NSP" . W.tag) . W.hidden + +gswShift :: X() +gswShift = gridselectWorkspace gsConfig (\ws -> W.greedyView ws . W.shift ws) + +switchTopic' :: (WorkspaceId -> WindowSet -> WindowSet) + -> TS.Topic -> X () +switchTopic' viewMethod topic = do + windows $ viewMethod topic + wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) + when (null wins) $ TS.topicAction Local.topicConfig topic diff --git a/src/XMonad/Local/Keys.hs b/src/XMonad/Local/Keys.hs new file mode 100644 index 0000000..826db3d --- /dev/null +++ b/src/XMonad/Local/Keys.hs @@ -0,0 +1,268 @@ +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 qualified XMonad as X +import XMonad.Actions.CycleWS +import qualified XMonad.Actions.DynamicWorkspaces as DW +import qualified XMonad.Actions.DwmPromote as DwmP +import XMonad.Actions.GridSelect +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) + +-- local modules ************************************************************** +import qualified XMonad.Local.Actions as Local +import XMonad.Local.Config +import XMonad.Local.GridSelect as Local +import XMonad.Local.NamedScratchpad +import XMonad.Local.TopicSpace +import XMonad.Local.Workspaces as Local + +modMask :: X.KeyMask +modMask = X.mod4Mask +modm :: String +modm = "M4" + +keyBindings :: X.XConfig l -> M.Map (X.KeyMask, X.KeySym) (X.X()) +keyBindings conf = EZ.mkKeymap conf $ emacsKeys conf + +emacsKeys :: X.XConfig l -> [(String, X.X())] +emacsKeys = \conf -> map prefix (emacsKeys' conf) ++ keys + where + prefix :: (String, a) -> (String, a) + prefix (k, a) = (modm ++ "-" ++ k, a) + + emacsKeys' :: X.XConfig l -> [(String, X.X())] + emacsKeys' conf = [ + -- Applications + (";", Local.spawnShell Nothing) + , ("S-;", Local.spawnExplorer) + , ("S-.", namedScratchpadAction namedScratchpads "guake") + , ("p", Shell.shellPrompt xpConfig) + , ("S-p", Local.mateRun) + + -- Layouts + , ("<Space>", X.sendMessage X.NextLayout) + , ("C-<Space>", SUB.submap $ EZ.mkKeymap conf $ concat + [ [(k, a), (modm ++ "-C-" ++ k, a)] + | (k, a) <- [ ("3", X.sendMessage (Toggle "ThreeCol")) + , ("x", X.sendMessage (MT.Toggle REFLECTX)) + , ("y", X.sendMessage (MT.Toggle REFLECTY)) + ] + ]) + , ("<F5>", X.refresh) + , ("C-j", X.sendMessage $ Go D) + , ("C-k", X.sendMessage $ Go U) + , ("C-h", X.sendMessage $ Go L) + , ("C-l", X.sendMessage $ Go R) + , ("j", BW.focusDown) + , ("k", BW.focusUp) + , ("m", X.windows W.focusMaster) + , ("S-j", X.windows W.swapDown) + , ("S-k", X.windows W.swapUp) + , ("C-.", onGroup W.focusUp') + , ("C-,", onGroup W.focusDown') + , ("h", X.sendMessage X.Shrink) + , ("l", X.sendMessage X.Expand) + , ("<Return>", X.windows W.focusMaster) + , ("S-<Return>", DwmP.dwmpromote) + , ("t", X.withFocused $ X.windows . W.sink) + , (",", X.sendMessage (X.IncMasterN 1)) + , (".", X.sendMessage (X.IncMasterN (-1))) + + -- keybindings for sublayouts + , ("g", SUB.submap $ defaultSublMap conf) + , ("<Left>", X.sendMessage $ pullGroup L) + , ("<Right>", X.sendMessage $ pullGroup R) + , ("<Up>", X.sendMessage $ pullGroup U) + , ("<Down>", X.sendMessage $ pullGroup D) + , ("C-m", X.withFocused (X.sendMessage . MergeAll)) + , ("C-u", X.withFocused (X.sendMessage . UnMerge)) + + -- boring X.windows + , ("b", BW.markBoring) + , ("S-b", BW.clearBoring) + + -- minimized widnows + , ("z", X.withFocused minimizeWindow) + , ("S-z", X.sendMessage RestoreNextMinimizedWin) + + -- Toggle full screen + , ("<F12>", X.sendMessage ToggleStruts >> X.refresh) + + -- Windows + , ("S-c", X.kill) + , ("C-S-c", WithAll.killAll) + , ("x", X.spawn "xkill") + + -- Compositing + , ("S-x", SUB.submap $ EZ.mkKeymap conf $ concat + [ [(k, a), (modm ++ "-S-" ++ k, a)] + | (k, a) <- [ ("r", X.spawn "systemctl --user restart compositing") + , ("s", X.spawn "systemctl --user stop compositing")] + ]) + + -- Workspaces + , ("<Tab>", Local.toggleWS) + , ("S-<Tab>", Local.toggleWSSwitch) + , ("C-<Right>", moveTo Next nonEmptyWs) + , ("]", moveTo Next $ WSIs nonEmptyWsPred) + , ("C-<Left>", moveTo Prev $ WSIs nonEmptyWsPred) + , ("[", moveTo Prev $ WSIs nonEmptyWsPred) + , ("-", SUB.submap $ EZ.mkKeymap conf + [ (m ++ show k, _withNthWorkspace f i) + | (k, i) <- (zip ([1..9] ++ [0]) [10..] :: [(Int, Int)]) + , (f, m) <- concat + [ [ -- switch to ith workspace + (W.greedyView, m) + -- shift focused to ith workspace + , (\ws -> W.greedyView ws . W.shift ws, m ++ "S-") + ] + | m <- ["", modm ++ "-"] + ] + ]) + + , ("n", promptedNewWorkspace False) + , ("S-n", promptedNewWorkspace True) + , ("S-<Backspace>", WithAll.killAll >> DW.removeWorkspace) + , ("S-r", DW.renameWorkspace xpConfig) + , ("c", TD.changeDir xpConfig) + + , ("r", swapScreens) + + , ("a", TS.currentTopicAction topicConfig) + + -- Grid Select workspace + , ("i", goToSelected Local.gsConfig) + , ("s", gsw) + , ("S-s", gswShift) + + -- xmonad + , ("q", SUB.submap $ EZ.mkKeymap conf $ concat + [ [(k, a), (modm ++ "-" ++ k, a)] + | (k, a) <- [ ("c", X.spawn "xmonad --recompile; xmonad --restart") + , ("r", X.spawn "xmonad --restart") + , ("u", X.spawn "undock") + , ("S-u", X.spawn "undock -s") + , ("e", X.spawn "monitor-hotplug") + , ("s", X.spawn "mate-session-save --shutdown-dialog") + , ("q", X.spawn "mate-session-save --logout") + , ("l", X.spawn "mate-screensaver-command --lock") + ] + ]) + , ("C-q", X.spawn "mate-screensaver-command --lock") + + -- namedScratchpads + , ("C-S-t", namedScratchpadAction namedScratchpads "htop") + , ("C-S-a", namedScratchpadAction namedScratchpads "stardict") + , ("C-S-n", namedScratchpadAction namedScratchpads "notes") + , ("C-S-u", namedScratchpadAction namedScratchpads "charmap") + , ("C-S-l", namedScratchpadAction namedScratchpads "alarm") + , ("C-S-p", namedScratchpadAction namedScratchpads "volctl") + + -- misc + , ("S-h", PSsh.sshPrompt xpConfig) + --, ("<Print>", X.spawn "xfce4-screenshooter") + , ("y", X.spawn "xfce4-popup-clipman") + , ("<Print>", X.spawn "mate-screenshot") + , ("C-<Print>", X.spawn "mate-screenshot -w") + , ("S-<Print>", X.spawn "mate-screenshot -a") + + -- MPD + -- mov current playing song in mpd to thrash + , ("<Delete>", X.spawn "mpcrm") + , ("<XF86Forward>", + X.io $ return . fromRight =<< MPD.withMPD MPD.next) + , ("<XF86Back>", + X.io $ return . fromRight =<< MPD.withMPD MPD.previous) + ] + ++ [ (m ++ show i, _withNthWorkspace f ((i + 9) `mod` 10)) + | i <- [1..9] ++ [0] + , (f, m) <- [ (W.greedyView, "") -- switch to ith workspace + -- shift focused to ith workspace + , (\ws -> W.greedyView ws . W.shift ws, "S-") + ] + ] + ++ [ (m ++ k, X.screenWorkspace sc >>= flip X.whenJust (X.windows . f)) + | (k, sc) <- zip ["w", "e"] [0..] + , (f, m) <- [(W.view, ""), (W.shift, "S-")] + ] + + -- no prefix + keys :: [(String, X.X())] + keys = [ + ("<XF86Calculator>", + namedScratchpadAction namedScratchpads "calculator") + , ("<XF86Mail>", TS.switchTopic topicConfig "mail") + , ("<XF86Terminal>", Local.spawnShell Nothing) + , ("<XF86Explorer>", X.spawn "Terminal") + , ("<XF86HomePage>", TS.switchTopic topicConfig "web") + + -- mpc + , ("<XF86AudioPlay>", + X.io $ return . fromRight =<< MPD.withMPD MPD.toggle) + , ("<XF86AudioStop>", + X.io $ return . fromRight =<< MPD.withMPD MPD.stop) + , ("<XF86AudioNext>", + X.io $ return . fromRight =<< MPD.withMPD MPD.next) + , ("<XF86AudioPrev>", + X.io $ return . fromRight =<< MPD.withMPD MPD.previous) + + -- volume + , ("<XF86AudioMute>", void toggleMute) + , ("<XF86AudioRaiseVolume>", void (raiseVolume 4)) + , ("<XF86AudioLowerVolume>", void (lowerVolume 4)) + + -- brightness + , ("<XF86MonBrightnessUp>", X.spawn "xbacklight +10") + , ("<XF86MonBrightnessDown>", X.spawn "xbacklight -10") + , ("S-<XF86MonBrightnessUp>", X.spawn "xbacklight +20") + , ("S-<XF86MonBrightnessDown>", X.spawn "xbacklight -20") + , ("C-<XF86MonBrightnessUp>", X.spawn "xbacklight -set 100") + , ("C-<XF86MonBrightnessDown>", X.spawn "xbacklight -set 0") + ] + + _withNthWorkspace :: (String -> X.WindowSet -> X.WindowSet) -> Int -> X.X () + _withNthWorkspace job wnum = do + sortfunc <- getSortByIndex + ws <- X.gets ( map W.tag . sortfunc . namedScratchpadFilterOutWorkspace + . W.workspaces . X.windowset ) + case drop wnum ws of + (w:_) -> X.windows $ job w + [] -> return () + +nonEmptyWsPred :: X.X (X.WindowSpace -> Bool) +nonEmptyWsPred = do + let ne = isJust . W.stack + hs <- X.gets (map W.tag . W.hidden . X.windowset) + let hi w = W.tag w `elem` hs + return $ \w -> hi w && ne w && W.tag w /= "NSP" + +-- cykle only NonEmpty, Hidden workspaces and not NSP workspaces +nonEmptyWs :: WSType +nonEmptyWs = WSIs nonEmptyWsPred diff --git a/src/XMonad/Local/NamedScratchpad.hs b/src/XMonad/Local/NamedScratchpad.hs new file mode 100644 index 0000000..c89fd93 --- /dev/null +++ b/src/XMonad/Local/NamedScratchpad.hs @@ -0,0 +1,33 @@ +module XMonad.Local.NamedScratchpad (namedScratchpads) where + +import Data.String.Utils (startswith) +import XMonad.ManageHook +import qualified XMonad.StackSet as W +import XMonad.Util.NamedScratchpad + +-- local modules ************************************************************** +import XMonad.Local.Config + +namedScratchpads :: [NamedScratchpad] +namedScratchpads = + [ NS "htop" (terminal ++ " -t htop -e htop") (title =? "htop") + cTopFloat + , NS "stardict" "stardict" (className =? "Stardict") cFloating + , NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes") + cFloating + , NS "charmap" "charmap" (className =? "Gucharmap") cFloating + , NS "alarm" "alarm-clock-applet" + (className =? "Alarm-clock-applet") cFloating + , NS "calculator" (terminal ++ " -e python --title PCalculator") + (title =? "PCalculator") cFloating + , NS "volctl" "mate-volume-control" (className =? "Mate-volume-control") cFloating + , NS "guake" (terminal ++ " --window-with-profile=Guake-normal --tab-with-profile=Guake-root") + (className =? "Mate-terminal" <&&> (startsWith title "Guake")) cBottomFloat + ] + where + role = stringProperty "WM_WINDOW_ROLE" + cFloating = customFloating $ W.RationalRect (1/3) (1/9) (1/3) (1/3) + cTopFloat = customFloating $ W.RationalRect (1/5) (1/32) (3/5) (1/2) + cBottomFloat = customFloating $ W.RationalRect (1/5) (5/8) (3/5) (3/8) + startsWith q x = fmap (startswith x) q + diff --git a/src/XMonad/Local/TopicSpace.hs b/src/XMonad/Local/TopicSpace.hs index 93da894..e2ab5b0 100644 --- a/src/XMonad/Local/TopicSpace.hs +++ b/src/XMonad/Local/TopicSpace.hs @@ -1,16 +1,17 @@ module XMonad.Local.TopicSpace ( topicConfig , topicDirs + , workspaces ) where import qualified Data.Map as M -import XMonad +import qualified XMonad as X import qualified XMonad.Actions.TopicSpace as TS -- local modules ************************************************************** import XMonad.Local.Actions -topicDirs :: M.Map WorkspaceId String +topicDirs :: M.Map X.WorkspaceId String topicDirs = M.fromList $ [ ("dashboard" , "~") , ("xmonad" , "~/.xmonad") @@ -45,21 +46,21 @@ topicConfig :: TS.TopicConfig topicConfig = TS.defaultTopicConfig { TS.topicDirs = topicDirs , TS.topicActions = M.fromList $ - [ ("music", spawn "gmpc") - -- ("music", spawn $ myTerminal ++ " -depth 32 -bg rgba:0000/0000/0000/7777 -fg white -e ncmpcpp") - , ("mail", spawn "thunderbird") - , ("web", spawn "google-chrome") - , ("firefox", spawn "firefox") - , ("opera", spawn "opera") - , ("pdf", spawn "atril") - , ("chat", spawn "xchat" >> spawn "pidgin") + [ ("music", X.spawn "gmpc") + -- ("music", X.spawn $ myTerminal ++ " -depth 32 -bg rgba:0000/0000/0000/7777 -fg white -e ncmpcpp") + , ("mail", X.spawn "thunderbird") + , ("web", X.spawn "google-chrome") + , ("firefox", X.spawn "firefox") + , ("opera", X.spawn "opera") + , ("pdf", X.spawn "atril") + , ("chat", X.spawn "xchat" >> X.spawn "pidgin") , ("admin", spawnShell Nothing >> spawnShell Nothing) - , ("virt", spawn "virt-manager") - , ("vbox", spawn "VirtualBox") - , ("gimp", spawn "gimp") - , ("eclipse", spawn "eclipse") - , ("ebook", spawn "calibre") - , ("video", spawn "vlc") + , ("virt", X.spawn "virt-manager") + , ("vbox", X.spawn "VirtualBox") + , ("gimp", X.spawn "gimp") + , ("eclipse", X.spawn "eclipse") + , ("ebook", X.spawn "calibre") + , ("video", X.spawn "vlc") , ("xmonad", spawnShell (Just "vim -S xmonad.vim") >> spawnShell Nothing) , ("remote", spawnShell Nothing >> spawnShell Nothing) @@ -68,8 +69,8 @@ topicConfig = TS.defaultTopicConfig , ("providers", spawnShell Nothing >> spawnShell Nothing) , ("cim", spawnShell Nothing >> spawnShellIn "/usr/lib/python2.7/site-packages/pywbem" Nothing) - , ("bank", spawn "google-chrome https://www.mojebanka.cz/InternetBanking/") - , ("p2p", spawn "deluge-gtk") + , ("bank", X.spawn "google-chrome https://www.mojebanka.cz/InternetBanking/") + , ("p2p", X.spawn "deluge-gtk") , ("hwdata", spawnShell Nothing >> spawnShellIn "~/fedora-scm/hwdata" Nothing >> @@ -82,12 +83,15 @@ topicConfig = TS.defaultTopicConfig , ("distribution", spawnShell Nothing >> spawnShell Nothing >> spawnShellIn "~/workspace/go/distribution" (Just "bash --rcfile .bashrc")) , ("scripts", spawnShell Nothing >> spawnShell Nothing) - , ("ciV", spawn "launch-ciV.sh -m -b") - , ("scrum", spawn "firefox https://bluejeans.com/3046463974/") - , ("BG", spawn "steam steam://rungameid/228280" >> - spawn "firefox http://slovnik.seznam.cz/de-cz/") + , ("ciV", X.spawn "launch-ciV.sh -m -b") + , ("scrum", X.spawn "firefox https://bluejeans.com/3046463974/") + , ("BG", X.spawn "steam steam://rungameid/228280" >> + X.spawn "firefox http://slovnik.seznam.cz/de-cz/") ] ++ map (\w -> (w, spawnShell Nothing >> spawnShell Nothing)) [ "ae", "aet", "aes", "aea" ] , TS.defaultTopicAction = const $ return () , TS.defaultTopic = "dashboard" } + +workspaces :: [X.WorkspaceId] +workspaces = ["dashboard", "devel"] diff --git a/src/XMonad/Local/Workspaces.hs b/src/XMonad/Local/Workspaces.hs new file mode 100644 index 0000000..eed5fda --- /dev/null +++ b/src/XMonad/Local/Workspaces.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE DoAndIfThenElse #-} + +module XMonad.Local.Workspaces ( + newWorkspace + , newWorkspaceDir + , promptedNewWorkspace + , swapScreens + , toggleWS + , toggleWSSwitch + ) where + +import Control.Monad +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as S +import XMonad +import qualified XMonad.Actions.CycleWS as WS +import qualified XMonad.Actions.DynamicWorkspaces as DW +import qualified XMonad.Actions.TopicSpace as TS +import qualified XMonad.Layout.TopicDir as TD +import qualified XMonad.Prompt.Input as PI +import qualified XMonad.StackSet as W + +-- local modules ************************************************************** +import qualified XMonad.Local.Config as Local +import qualified XMonad.Local.TopicSpace as Local + +-- workspace creation ********************************************************* +promptedNewWorkspace :: Bool -> X() +promptedNewWorkspace shiftFocused = PI.inputPrompt Local.xpConfig "New Workspace" + PI.?+ action shiftFocused + where + action :: Bool -> String -> X() + action True = newWorkspaceDir shiftto + action _ = newWorkspaceDir goto + +newWorkspace :: WorkspaceId -> X() +newWorkspace w = do + exists <- widExists w + unless exists $ DW.addHiddenWorkspace w + +newWorkspaceDir :: (TS.Topic -> X()) -> WorkspaceId -> X() +newWorkspaceDir gotofunc w = do + exists <- widExists w + if not exists then do + DW.addHiddenWorkspace w + gotofunc w + unless (w `S.member` doNotAskForDir) $ TD.changeDir Local.xpConfig + else + gotofunc w + where + doNotAskForDir :: S.Set WorkspaceId + doNotAskForDir = S.fromList $ + ["mail", "chat", "virt", "vbox", "web"] ++ M.keys Local.topicDirs + +widExists :: WorkspaceId -> X Bool +widExists wid = do + xs <- get + return $ widExists' wid (windowset xs) + where + widExists' :: WorkspaceId -> W.StackSet WorkspaceId l a s sd -> Bool + widExists' w ws = w `elem` map W.tag (W.workspaces ws) + +-- workspace switching ******************************************************** +toggleWS :: X() +toggleWS = do + hs' <- cleanHiddens ["NSP"] + unless (null hs') (windows . W.greedyView . W.tag $ head hs') + where + cleanHiddens :: [WorkspaceId] -> X [WindowSpace] + cleanHiddens skips = gets $ flip WS.skipTags skips . W.hidden . windowset + +toggleWSSwitch :: X() +toggleWSSwitch = do + hs' <- cleanHiddens [] + unless (null hs') (windows . (\ws -> W.greedyView ws . W.shift ws) . W.tag $ head hs') + where + cleanHiddens :: [WorkspaceId] -> X [WindowSpace] + cleanHiddens skips = gets $ flip WS.skipTags skips . W.hidden . windowset + +-- creates the workspace if needed +goto :: TS.Topic -> X() +goto t = newWorkspace t >> TS.switchTopic Local.topicConfig t +shiftto :: TS.Topic -> X() +shiftto t = newWorkspace t >> windows (W.greedyView t . W.shift t) + +-- swap workspaces between screens +swapScreens :: X () +swapScreens = do + screen <- gets (listToMaybe . W.visible . windowset) + whenJust screen $ windows . W.greedyView . W.tag . W.workspace |