summaryrefslogtreecommitdiffstats
path: root/tv/2configs/xserver/xmonad/Main.hs
diff options
context:
space:
mode:
authormakefu <github@syntax-fehler.de>2015-10-25 18:17:14 +0100
committermakefu <github@syntax-fehler.de>2015-10-25 18:17:14 +0100
commitbb16a38df6ad33c7339d4875e948853927015045 (patch)
tree3cd41d5d52c8facf55e48e05c65b6bad887ae4c3 /tv/2configs/xserver/xmonad/Main.hs
parentcca25c7b66c44e0ec826d466bd48f2463df03fe9 (diff)
parent4b22988392f940c705e7f3fddc39481635777895 (diff)
Merge remote-tracking branch 'cd/master'
Diffstat (limited to 'tv/2configs/xserver/xmonad/Main.hs')
-rw-r--r--tv/2configs/xserver/xmonad/Main.hs80
1 files changed, 32 insertions, 48 deletions
diff --git a/tv/2configs/xserver/xmonad/Main.hs b/tv/2configs/xserver/xmonad/Main.hs
index cca2902a0..186a5e22c 100644
--- a/tv/2configs/xserver/xmonad/Main.hs
+++ b/tv/2configs/xserver/xmonad/Main.hs
@@ -1,9 +1,14 @@
{-# LANGUAGE DeriveDataTypeable #-} -- for XS
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Main where
+import Control.Exception
+import Text.Read (readEither)
import XMonad
+import System.Environment (getArgs, getEnv)
import XMonad.Prompt (defaultXPConfig)
import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace
, removeEmptyWorkspace)
@@ -30,29 +35,26 @@ import XMonad.Layout.PerWorkspace (onWorkspace)
import Util.Pager
import Util.Rhombus
import Util.Debunk
+import Util.Shutdown
---data MyState = MyState deriving Typeable
-
myTerm :: String
myTerm = "urxvtc"
myRootTerm :: String
myRootTerm = "urxvtc -name root-urxvt -e su -"
--- TODO execRootTerm = exec (shlex "urxvtc -e su -")
--- [ ("XENVIRONMENT", HOME ++ "/.Xdefaults/root-urxvt") ]
-
-
myFont :: String
myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
main :: IO ()
-main = do
- -- TODO exec (shlex "xrdb -merge" ++ [HOME ++ "/.Xresources"])
- -- TODO exec (shlex "xsetroot -solid '#1c1c1c'")
- --spawn "xrdb -merge \"$HOME/.Xresources\""
- --spawn "xsetroot -solid '#1c1c1c'"
+main = getArgs >>= \case
+ ["--shutdown"] -> sendShutdownEvent
+ _ -> mainNoArgs
+
+mainNoArgs :: IO ()
+mainNoArgs = do
+ workspaces0 <- getWorkspaces0
xmonad
-- $ withUrgencyHookC dzenUrgencyHook { args = ["-bg", "magenta", "-fg", "magenta", "-h", "2"], duration = 500000 }
-- urgencyConfig { remindWhen = Every 1 }
@@ -63,16 +65,7 @@ main = do
{ terminal = myTerm
, modMask = mod4Mask
, keys = myKeys
- , workspaces =
- [ "Dashboard" -- we start here
- , "23"
- , "cr"
- , "ff"
- , "hack"
- , "im"
- , "mail"
- , "zalora", "zjournal", "zskype"
- ]
+ , workspaces = workspaces0
, layoutHook = smartBorders $ myLayout
-- , handleEventHook = myHandleEventHooks <+> handleTimerEvent
--, handleEventHook = handleTimerEvent
@@ -80,6 +73,7 @@ main = do
, startupHook = spawn "echo emit XMonadStartup"
, normalBorderColor = "#1c1c1c"
, focusedBorderColor = "#f000b0"
+ , handleEventHook = handleShutdownEvent
}
where
myLayout =
@@ -87,39 +81,31 @@ main = do
(FixedColumn 1 20 80 10 ||| Full)
+getWorkspaces0 :: IO [String]
+getWorkspaces0 =
+ try (getEnv "XMONAD_WORKSPACES0_FILE") >>= \case
+ Left e -> warn (displaySomeException e)
+ Right p -> try (readFile p) >>= \case
+ Left e -> warn (displaySomeException e)
+ Right x -> case readEither x of
+ Left e -> warn e
+ Right y -> return y
+ where
+ warn msg = putStrLn ("getWorkspaces0: " ++ msg) >> return []
+
+displaySomeException :: SomeException -> String
+displaySomeException = displayException
+
+
spawnTermAt :: String -> X ()
--spawnTermAt _ = floatNext True >> spawn myTerm
--spawnTermAt "ff" = floatNext True >> spawn myTerm
spawnTermAt _ = spawn myTerm
-
---jojo w = withDisplay $ \d -> liftIO $ do
--- wa <- getWindowAttributes d w
--- printToErrors (wa_width wa, wa_height wa, wa_x wa, wa_y wa)
-
- --sh <- getWMNormalHints d w
- --bw <- fmap (fi . wa_border_width) $ getWindowAttributes d w
- --return $ applySizeHints bw sh
-
-
---data WindowDetails = WindowDetails
--- { wd_name :: Maybe String
--- , wd_rect :: Rectangle
--- } deriving (Show)
-
--- urxvtc
--- -title sets {,_NET_}WM_NAME but not WM_CLASS and {,_NET_}WM_ICON_NAME res: title
--- -name sets all res:
---mySpawn cmd = do
--- p <- xfork $ executeFile "/run/current-system/sw/bin/urxvtc" False [] Nothing
--- liftIO $ printToErrors $ (cmd, p)
-
-
myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
myKeys conf = Map.fromList $
- [ ((_4C , xK_Delete ), spawn "make -C $HOME/.xmonad reload")
- , ((_4 , xK_Escape ), spawn "/var/setuid-wrappers/slock")
+ [ ((_4 , xK_Escape ), spawn "/var/setuid-wrappers/slock")
, ((_4S , xK_c ), kill)
, ((_4 , xK_x ), chooseAction spawnTermAt)
@@ -273,5 +259,3 @@ wGSConfig = defaultGSConfig
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]
-
--- vim:set fdm=marker: