diff options
author | makefu <github@syntax-fehler.de> | 2015-11-14 01:51:36 +0100 |
---|---|---|
committer | makefu <github@syntax-fehler.de> | 2015-11-14 01:51:36 +0100 |
commit | 773a67a983cbe1928da6c524db24a25229a6f5fe (patch) | |
tree | 2a00ed5a39f85b837578625cf49d193f4d308f14 /lass/5pkgs/xmonad-lass/Main.hs | |
parent | a0fbe917ac45cda4de0f16bced3ce3ebfc556fe8 (diff) | |
parent | e7d22252dcad25fd5594e9a431f5a39aa620906d (diff) |
Merge remote-tracking branch 'cloudkrebs/master' into pre-merge
Diffstat (limited to 'lass/5pkgs/xmonad-lass/Main.hs')
-rw-r--r-- | lass/5pkgs/xmonad-lass/Main.hs | 190 |
1 files changed, 190 insertions, 0 deletions
diff --git a/lass/5pkgs/xmonad-lass/Main.hs b/lass/5pkgs/xmonad-lass/Main.hs new file mode 100644 index 000000000..10a3c5638 --- /dev/null +++ b/lass/5pkgs/xmonad-lass/Main.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE DeriveDataTypeable #-} -- for XS +{-# LANGUAGE FlexibleContexts #-} -- for xmonad' +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + + +module Main where + +import Control.Exception +import Text.Read (readEither) +import XMonad +import System.IO (hPutStrLn, stderr) +import System.Environment (getArgs, withArgs, getEnv, getEnvironment) +import System.Posix.Process (executeFile) +import XMonad.Prompt (defaultXPConfig) +import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace + , removeEmptyWorkspace) +import XMonad.Actions.GridSelect +import XMonad.Actions.CycleWS (toggleWS) +--import XMonad.Actions.CopyWindow ( copy ) +import XMonad.Layout.NoBorders ( smartBorders ) +import qualified XMonad.StackSet as W +import Data.Map (Map) +import qualified Data.Map as Map +-- TODO import XMonad.Layout.WorkspaceDir +import XMonad.Hooks.UrgencyHook (SpawnUrgencyHook(..), withUrgencyHook) +-- import XMonad.Layout.Tabbed +--import XMonad.Layout.MouseResizableTile +import XMonad.Layout.Reflect (reflectVert) +import XMonad.Layout.FixedColumn (FixedColumn(..)) +import XMonad.Hooks.Place (placeHook, smart) +import XMonad.Hooks.FloatNext (floatNextHook) +import XMonad.Actions.PerWorkspaceKeys (chooseAction) +import XMonad.Layout.PerWorkspace (onWorkspace) +--import XMonad.Layout.BinarySpacePartition +import XMonad.Util.EZConfig (additionalKeysP) + +import XMonad.Prompt (autoComplete, defaultXPConfig, XPConfig, mkXPrompt) +import XMonad.Hooks.UrgencyHook (focusUrgent, withUrgencyHook, urgencyBorderColor, BorderUrgencyHook(BorderUrgencyHook)) +import XMonad.Actions.DynamicWorkspaces (addWorkspacePrompt, removeEmptyWorkspace, renameWorkspace, withWorkspace) +import XMonad.Hooks.FloatNext (floatNext, floatNextHook) +import XMonad.Prompt.Workspace +import XMonad.Actions.CopyWindow (copy, kill1) +import qualified Data.Map as M +import XMonad.Hooks.ManageDocks (avoidStruts, manageDocks, ToggleStruts(ToggleStruts)) + +--import XMonad.Actions.Submap +import XMonad.Stockholm.Pager +import XMonad.Stockholm.Rhombus +import XMonad.Stockholm.Shutdown + +myTerm :: String +myTerm = "urxvtc" + +myRootTerm :: String +myRootTerm = "urxvtc -name root-urxvt -e su -" + +myFont :: String +myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*" + +main :: IO () +main = getArgs >>= \case + ["--shutdown"] -> sendShutdownEvent + _ -> mainNoArgs + +mainNoArgs :: IO () +mainNoArgs = do + xmonad' + -- $ withUrgencyHookC dzenUrgencyHook { args = ["-bg", "magenta", "-fg", "magenta", "-h", "2"], duration = 500000 } + -- urgencyConfig { remindWhen = Every 1 } + -- $ withUrgencyHook borderUrgencyHook "magenta" + -- $ withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "magenta" } urgencyConfig { suppressWhen = Never } + $ withUrgencyHook (SpawnUrgencyHook "echo emit Urgency ") + $ defaultConfig + { terminal = myTerm + , modMask = mod4Mask + , layoutHook = smartBorders $ myLayoutHook + -- , handleEventHook = myHandleEventHooks <+> handleTimerEvent + --, handleEventHook = handleTimerEvent + , manageHook = placeHook (smart (1,0)) <+> floatNextHook + , startupHook = spawn "echo emit XMonadStartup" + , normalBorderColor = "#1c1c1c" + , focusedBorderColor = "#f000b0" + , handleEventHook = handleShutdownEvent + } `additionalKeysP` myKeyMap + +myLayoutHook = defLayout + where + defLayout = (avoidStruts $ Tall 1 (3/100) (1/2) ||| Full ||| Mirror (Tall 1 (3/100) (1/2))) ||| FixedColumn 2 80 80 1 + + +xmonad' :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO () +xmonad' conf = do + path <- getEnv "XMONAD_STATE" + try (readFile path) >>= \case + Right content -> do + hPutStrLn stderr ("resuming from " ++ path) + withArgs ("--resume" : lines content) (xmonad conf) + Left e -> do + hPutStrLn stderr (displaySomeException e) + xmonad conf + + +displaySomeException :: SomeException -> String +displaySomeException = displayException + + +myKeyMap = + [ ("M4-<F11>", spawn "i3lock -i ~/lock.png -u" ) + , ("M4-p", spawn "passmenu --type") + , ("M4-r", spawn "exe=$(yeganesh -x) && eval \"exec $exe\"") + -- , ("M4-r", io (readProcess "yeganesh" ["-x"] "" >>= putStrLn ) ) + , ("<XF86AudioRaiseVolume>", spawn "pactl -- set-sink-volume 0 +4%") + , ("<XF86AudioLowerVolume>", spawn "pactl -- set-sink-volume 0 -4%") + , ("<XF86Launch1>", gridselectWorkspace myWSConfig W.view) + + , ("M4-a", focusUrgent) + , ("M4-S-r", renameWorkspace defaultXPConfig) + , ("M4-S-a", addWorkspacePrompt defaultXPConfig) + , ("M4-S-<Backspace>", removeEmptyWorkspace) + , ("M4-S-c", kill1) + , ("M4-<Esc>", toggleWS) + , ("M4-S-<Enter>", spawn myTerm) + , ("M4-x", floatNext True >> spawn myTerm) + , ("M4-f", floatNext True) + , ("M4-b", sendMessage ToggleStruts) + + , ("M4-v", withWorkspace myXPConfig (windows . W.view)) + , ("M4-S-v", withWorkspace myXPConfig (windows . W.shift)) + , ("M4-C-v", withWorkspace myXPConfig (windows . copy)) + + -- , (_4 , xK_q ) & \k -> (k, goToSelected myCNConfig { gs_navigate = makeGSNav k } ) + -- , (_4S, xK_q ) & \k -> (k, bringSelected myCNConfig { gs_navigate = makeGSNav k } ) + -- , (_4C, xK_q ) & \k -> (k, withSelectedWindow ( \a -> get >>= \s -> put s { windowset = copyWindow a (W.tag $ W.workspace $ W.current $ windowset s) (windowset s) } ) myCNConfig { gs_navigate = makeGSNav k } ) + + --, ("M4-<F1>", perWorkspaceAction workspaceConfigs) + , ("M4-S-q", return ()) + ] + +myGSConfig = defaultGSConfig + { gs_cellheight = 50 + , gs_cellpadding = 2 + , gs_navigate = navNSearch + , gs_font = myFont + } + +myXPConfig :: XPConfig +myXPConfig = defaultXPConfig + { autoComplete = Just 5000 + } + +myWSConfig = myGSConfig + { gs_cellwidth = 50 + } + +pagerConfig :: PagerConfig +pagerConfig = defaultPagerConfig + { pc_font = myFont + , pc_cellwidth = 64 + --, pc_cellheight = 36 -- TODO automatically keep screen aspect + --, pc_borderwidth = 1 + --, pc_matchcolor = "#f0b000" + , pc_matchmethod = MatchPrefix + --, pc_colors = pagerWorkspaceColors + , pc_windowColors = windowColors + } + where + windowColors _ _ _ True _ = ("#ef4242","#ff2323") + windowColors wsf m c u wf = do + let def = defaultWindowColors wsf m c u wf + if m == False && wf == True + then ("#402020", snd def) + else def + +wGSConfig :: GSConfig Window +wGSConfig = defaultGSConfig + { gs_cellheight = 20 + , gs_cellwidth = 192 + , gs_cellpadding = 5 + , gs_font = myFont + , gs_navigate = navNSearch + } + + +(&) :: a -> (a -> c) -> c +(&) = flip ($) + +allWorkspaceNames :: W.StackSet i l a sid sd -> X [i] +allWorkspaceNames ws = + return $ map W.tag (W.hidden ws) ++ [W.tag $ W.workspace $ W.current ws] |