diff options
Diffstat (limited to 'tv/2configs/xserver/xmonad')
| -rw-r--r-- | tv/2configs/xserver/xmonad/Main.hs | 18 | ||||
| -rw-r--r-- | tv/2configs/xserver/xmonad/Util/Shutdown.hs | 53 |
2 files changed, 64 insertions, 7 deletions
diff --git a/tv/2configs/xserver/xmonad/Main.hs b/tv/2configs/xserver/xmonad/Main.hs index cca2902a0..6e0be0579 100644 --- a/tv/2configs/xserver/xmonad/Main.hs +++ b/tv/2configs/xserver/xmonad/Main.hs @@ -1,9 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-} -- for XS +{-# LANGUAGE LambdaCase #-} module Main where import XMonad +import System.Environment (getArgs) import XMonad.Prompt (defaultXPConfig) import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace , removeEmptyWorkspace) @@ -30,6 +32,7 @@ import XMonad.Layout.PerWorkspace (onWorkspace) import Util.Pager import Util.Rhombus import Util.Debunk +import Util.Shutdown --data MyState = MyState deriving Typeable @@ -48,11 +51,12 @@ 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 xmonad -- $ withUrgencyHookC dzenUrgencyHook { args = ["-bg", "magenta", "-fg", "magenta", "-h", "2"], duration = 500000 } -- urgencyConfig { remindWhen = Every 1 } @@ -80,6 +84,7 @@ main = do , startupHook = spawn "echo emit XMonadStartup" , normalBorderColor = "#1c1c1c" , focusedBorderColor = "#f000b0" + , handleEventHook = handleShutdownEvent } where myLayout = @@ -118,8 +123,7 @@ spawnTermAt _ = spawn myTerm 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) diff --git a/tv/2configs/xserver/xmonad/Util/Shutdown.hs b/tv/2configs/xserver/xmonad/Util/Shutdown.hs new file mode 100644 index 000000000..c5a3edb80 --- /dev/null +++ b/tv/2configs/xserver/xmonad/Util/Shutdown.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE LambdaCase #-} +module Util.Shutdown + ( sendShutdownEvent + , handleShutdownEvent + , shutdown + ) + where + +import Control.Monad +import Data.Monoid +import Data.Maybe (catMaybes) +import qualified Data.Map as Map +import System.Environment (getEnv) +import System.Exit (exitSuccess) +import XMonad +import qualified XMonad.StackSet as W + +sendShutdownEvent :: IO () +sendShutdownEvent = do + dpy <- openDisplay "" + rw <- rootWindow dpy $ defaultScreen dpy + a <- internAtom dpy "XMONAD_SHUTDOWN" False + allocaXEvent $ \e -> do + setEventType e clientMessage + setClientMessageEvent e rw a 32 0 currentTime + sendEvent dpy rw False structureNotifyMask e + sync dpy False + +handleShutdownEvent :: Event -> X All +handleShutdownEvent = \case + ClientMessageEvent { ev_message_type = mt } -> do + c <- (mt ==) <$> getAtom "XMONAD_SHUTDOWN" + when c shutdown + return (All c) + _ -> + return (All True) + +shutdown :: X () +shutdown = do + broadcastMessage ReleaseResources + io . flush =<< asks display + let wsData = show . W.mapLayout show . windowset + maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext) + maybeShow (t, Left str) = Just (t, str) + maybeShow _ = Nothing + extState = + return . show . catMaybes . map maybeShow . Map.toList . extensibleState + s <- gets (\s -> (wsData s : extState s)) + _ <- io $ do + path <- getEnv "XMONAD_STATE" + writeFile path (concatMap (++"\n") s) + exitSuccess + return () |