Merge remote-tracking branch 'cd/master'

3 files changed, 86 insertions, 48 deletions

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
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:
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 ()