From 2cf33f24be9de76d0a2d5818818b9826bf05a996 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 25 Oct 2015 02:06:37 +0100 Subject: tv xmonad service: save state on shutdown --- tv/2configs/xserver/default.nix | 39 +++++++++++++++------ tv/2configs/xserver/xmonad/Main.hs | 18 ++++++---- tv/2configs/xserver/xmonad/Util/Shutdown.hs | 53 +++++++++++++++++++++++++++++ 3 files changed, 92 insertions(+), 18 deletions(-) create mode 100644 tv/2configs/xserver/xmonad/Util/Shutdown.hs (limited to 'tv/2configs/xserver') diff --git a/tv/2configs/xserver/default.nix b/tv/2configs/xserver/default.nix index 5d3372609..9e20bda18 100644 --- a/tv/2configs/xserver/default.nix +++ b/tv/2configs/xserver/default.nix @@ -44,11 +44,14 @@ let systemd.services.display-manager = mkForce {}; services.xserver.enable = true; + systemd.services.xmonad = { wantedBy = [ "multi-user.target" ]; requires = [ "xserver.service" ]; + environment = xmonad-environment; serviceConfig = { - ExecStart = "${xmonad}/bin/xmonad"; + ExecStart = "${xmonad-start}/bin/xmonad"; + ExecStop = "${xmonad-stop}/bin/xmonad-stop"; User = user.name; WorkingDirectory = user.home; }; @@ -69,15 +72,19 @@ let }; }; - xmonad = let - pkg = pkgs.haskellPackages.callPackage src {}; - src = pkgs.runCommand "xmonad-package" {} '' - ${pkgs.cabal2nix}/bin/cabal2nix ${./xmonad} > $out - ''; - in pkgs.writeScriptBin "xmonad" '' - #! /bin/sh + xmonad-pkg = pkgs.haskellPackages.callPackage xmonad-src {}; + xmonad-src = pkgs.runCommand "xmonad-package" {} '' + ${pkgs.cabal2nix}/bin/cabal2nix ${./xmonad} > $out + ''; + + xmonad-environment = { + DISPLAY = ":${toString config.services.xserver.display}"; + XMONAD_STATE = "/tmp/xmonad.state"; + }; + + xmonad-start = pkgs.writeScriptBin "xmonad" '' + #! ${pkgs.bash}/bin/bash set -efu - export DISPLAY; DISPLAY=:${toString config.services.xserver.display} export PATH; PATH=${makeSearchPath "bin" [ pkgs.rxvt_unicode ]}:/var/setuid-wrappers @@ -93,7 +100,17 @@ let settle ${pkgs.xorg.xhost}/bin/xhost +LOCAL: settle ${pkgs.xorg.xrdb}/bin/xrdb -merge ${import ./Xresources.nix args} settle ${pkgs.xorg.xsetroot}/bin/xsetroot -solid '#1c1c1c' - exec ${pkg}/bin/xmonad + if test -e "$XMONAD_STATE"; then + IFS=''$'\n' + exec ${xmonad-pkg}/bin/xmonad --resume $(< "$XMONAD_STATE") + else + exec ${xmonad-pkg}/bin/xmonad + fi + ''; + + xmonad-stop = pkgs.writeScriptBin "xmonad-stop" '' + #! /bin/sh + exec ${xmonad-pkg}/bin/xmonad --shutdown ''; xserver-environment = { @@ -103,7 +120,7 @@ let [ "${pkgs.xorg.libX11}/lib" "${pkgs.xorg.libXext}/lib" ] ++ concatLists (catAttrs "libPath" config.services.xserver.drivers)); }; - + xserver = pkgs.writeScriptBin "xserver" '' #! /bin/sh set -efu 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 () -- cgit v1.2.3 From 7d8887386623b8807acba4afbbcc8c0843e60293 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 25 Oct 2015 02:16:26 +0100 Subject: gitignore tv xmonad shell.nix --- tv/2configs/xserver/xmonad/.gitignore | 1 + 1 file changed, 1 insertion(+) create mode 100644 tv/2configs/xserver/xmonad/.gitignore (limited to 'tv/2configs/xserver') diff --git a/tv/2configs/xserver/xmonad/.gitignore b/tv/2configs/xserver/xmonad/.gitignore new file mode 100644 index 000000000..616204547 --- /dev/null +++ b/tv/2configs/xserver/xmonad/.gitignore @@ -0,0 +1 @@ +/shell.nix -- cgit v1.2.3 From 6f470727a360bcf2f1c1f8a00c87e6bc4c775ba1 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 25 Oct 2015 02:19:14 +0100 Subject: tv xmonad: purge some stale comments --- tv/2configs/xserver/xmonad/Main.hs | 31 ------------------------------- 1 file changed, 31 deletions(-) (limited to 'tv/2configs/xserver') diff --git a/tv/2configs/xserver/xmonad/Main.hs b/tv/2configs/xserver/xmonad/Main.hs index 6e0be0579..b71b9a4de 100644 --- a/tv/2configs/xserver/xmonad/Main.hs +++ b/tv/2configs/xserver/xmonad/Main.hs @@ -35,18 +35,12 @@ 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-*" @@ -98,29 +92,6 @@ spawnTermAt :: String -> X () 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 $ [ ((_4 , xK_Escape ), spawn "/var/setuid-wrappers/slock") @@ -277,5 +248,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: -- cgit v1.2.3 From e281271239289a266777d0b429e604ec9aeaed41 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 25 Oct 2015 02:32:19 +0100 Subject: {tv cfgs => krebs pkgs} writeNixFromCabal --- tv/2configs/xserver/default.nix | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'tv/2configs/xserver') diff --git a/tv/2configs/xserver/default.nix b/tv/2configs/xserver/default.nix index 9e20bda18..facdf6df2 100644 --- a/tv/2configs/xserver/default.nix +++ b/tv/2configs/xserver/default.nix @@ -73,9 +73,7 @@ let }; xmonad-pkg = pkgs.haskellPackages.callPackage xmonad-src {}; - xmonad-src = pkgs.runCommand "xmonad-package" {} '' - ${pkgs.cabal2nix}/bin/cabal2nix ${./xmonad} > $out - ''; + xmonad-src = pkgs.writeNixFromCabal "xmonad.nix" ./xmonad; xmonad-environment = { DISPLAY = ":${toString config.services.xserver.display}"; -- cgit v1.2.3 From 39236213abc668d35fab45e6bb747f11862e992d Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 25 Oct 2015 12:21:46 +0100 Subject: tv xmonad: read initial workspaces from file --- tv/2configs/xserver/default.nix | 13 +++++++++++++ tv/2configs/xserver/xmonad/Main.hs | 33 ++++++++++++++++++++++----------- 2 files changed, 35 insertions(+), 11 deletions(-) (limited to 'tv/2configs/xserver') diff --git a/tv/2configs/xserver/default.nix b/tv/2configs/xserver/default.nix index facdf6df2..c5cffbb30 100644 --- a/tv/2configs/xserver/default.nix +++ b/tv/2configs/xserver/default.nix @@ -78,6 +78,19 @@ let xmonad-environment = { DISPLAY = ":${toString config.services.xserver.display}"; XMONAD_STATE = "/tmp/xmonad.state"; + + # XXX JSON is close enough :) + XMONAD_WORKSPACES0_FILE = pkgs.writeText "xmonad.workspaces0" (toJSON [ + "Dashboard" # we start here + "23" + "cr" + "ff" + "hack" + "im" + "mail" + "stockholm" + "za" "zj" "zs" + ]); }; xmonad-start = pkgs.writeScriptBin "xmonad" '' diff --git a/tv/2configs/xserver/xmonad/Main.hs b/tv/2configs/xserver/xmonad/Main.hs index b71b9a4de..186a5e22c 100644 --- a/tv/2configs/xserver/xmonad/Main.hs +++ b/tv/2configs/xserver/xmonad/Main.hs @@ -1,11 +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) +import System.Environment (getArgs, getEnv) import XMonad.Prompt (defaultXPConfig) import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace , removeEmptyWorkspace) @@ -51,6 +54,7 @@ main = getArgs >>= \case mainNoArgs :: IO () mainNoArgs = do + workspaces0 <- getWorkspaces0 xmonad -- $ withUrgencyHookC dzenUrgencyHook { args = ["-bg", "magenta", "-fg", "magenta", "-h", "2"], duration = 500000 } -- urgencyConfig { remindWhen = Every 1 } @@ -61,16 +65,7 @@ mainNoArgs = 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 @@ -86,6 +81,22 @@ mainNoArgs = 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 -- cgit v1.2.3