From 71aef1f0b75f8030160b9b98a7dd5cea17a528cd Mon Sep 17 00:00:00 2001 From: tv Date: Mon, 4 Apr 2022 15:19:19 +0200 Subject: tv xmonad: move my* to Build This prevents Main from getting rebuilt due to TH whenever one of its imported modules changes. --- tv/5pkgs/haskell/xmonad-tv/src/Build.hs | 24 ++++++++++++++++++++++++ tv/5pkgs/haskell/xmonad-tv/src/main.hs | 17 +---------------- 2 files changed, 25 insertions(+), 16 deletions(-) create mode 100644 tv/5pkgs/haskell/xmonad-tv/src/Build.hs (limited to 'tv/5pkgs/haskell/xmonad-tv/src') diff --git a/tv/5pkgs/haskell/xmonad-tv/src/Build.hs b/tv/5pkgs/haskell/xmonad-tv/src/Build.hs new file mode 100644 index 0000000..553a129 --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/src/Build.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Build where + +import XMonad (Dimension) +import THEnv.JSON (getCompileEnvJSONExp) + + +myFont :: String +myFont = + "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*" + +myScreenWidth :: Dimension +myScreenWidth = + $(getCompileEnvJSONExp (id @Dimension) "XMONAD_BUILD_SCREEN_WIDTH") + +myTermFontWidth :: Dimension +myTermFontWidth = + $(getCompileEnvJSONExp (id @Dimension) "XMONAD_BUILD_TERM_FONT_WIDTH") + +myTermPadding :: Dimension +myTermPadding = + 2 diff --git a/tv/5pkgs/haskell/xmonad-tv/src/main.hs b/tv/5pkgs/haskell/xmonad-tv/src/main.hs index 81373f4..b82f398 100644 --- a/tv/5pkgs/haskell/xmonad-tv/src/main.hs +++ b/tv/5pkgs/haskell/xmonad-tv/src/main.hs @@ -1,6 +1,4 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} module Main (main) where @@ -35,22 +33,9 @@ import XMonad.Actions.PerWorkspaceKeys (chooseAction) import XMonad.Stockholm.Pager import XMonad.Stockholm.Shutdown -import THEnv.JSON (getCompileEnvJSONExp) -myFont :: String -myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*" - -myScreenWidth :: Dimension -myScreenWidth = - $(getCompileEnvJSONExp (id @Dimension) "XMONAD_BUILD_SCREEN_WIDTH") - -myTermFontWidth :: Dimension -myTermFontWidth = - $(getCompileEnvJSONExp (id @Dimension) "XMONAD_BUILD_TERM_FONT_WIDTH") - -myTermPadding :: Dimension -myTermPadding = 2 +import Build (myFont, myScreenWidth, myTermFontWidth, myTermPadding) main :: IO () -- cgit v1.2.3 From a55064d787e0f1bca999b23e23fff2393e8c6858 Mon Sep 17 00:00:00 2001 From: tv Date: Mon, 5 Dec 2022 16:25:33 +0100 Subject: tv: deprecated xmonad-stockholm --- tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs | 113 +++++++++++++++++++++++++ tv/5pkgs/haskell/xmonad-tv/src/main.hs | 27 +----- tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal | 5 +- 3 files changed, 117 insertions(+), 28 deletions(-) create mode 100644 tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs (limited to 'tv/5pkgs/haskell/xmonad-tv/src') diff --git a/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs b/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs new file mode 100644 index 0000000..d4a4d93 --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/src/Shutdown.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE LambdaCase #-} + +module Shutdown + ( newShutdownEventHandler + , shutdown + ) + where + +import Control.Applicative ((<|>), empty) +import Control.Concurrent (threadDelay) +import Control.Monad (forever, guard, when) +import Data.Monoid (All(All)) +import System.Directory (XdgDirectory(XdgData), createDirectoryIfMissing, doesFileExist, getAppUserDataDirectory, getXdgDirectory) +import System.Exit (exitSuccess) +import System.Environment (lookupEnv) +import System.FilePath (()) +import System.IO.Error (isDoesNotExistError, tryIOError) +import System.IO (hPutStrLn, stderr) +import System.Posix.Process (getProcessID) +import System.Posix.Signals (nullSignal, signalProcess) +import System.Posix.Types (ProcessID) +import XMonad hiding (getXMonadDataDir) + + +-- XXX this is for compatibility with both xmonad<0.17 and xmonad>=0.17 +getXMonadDataDir :: IO String +getXMonadDataDir = xmEnvDir <|> xmDir <|> xdgDir + where + -- | Check for xmonad's environment variables first + xmEnvDir :: IO String + xmEnvDir = + maybe empty pure =<< lookupEnv "XMONAD_DATA_DIR" + + -- | Check whether the config file or a build script is in the + -- @~\/.xmonad@ directory + xmDir :: IO String + xmDir = do + d <- getAppUserDataDirectory "xmonad" + conf <- doesFileExist $ d "xmonad.hs" + build <- doesFileExist $ d "build" + pid <- doesFileExist $ d "xmonad.pid" + + -- Place *everything* in ~/.xmonad if yes + guard $ conf || build || pid + pure d + + -- | Use XDG directories as a fallback + xdgDir :: IO String + xdgDir = do + d <- getXdgDirectory XdgData "xmonad" + d <$ createDirectoryIfMissing True d + + +newShutdownEventHandler :: IO (Event -> X All) +newShutdownEventHandler = do + writeProcessIDToFile + return handleShutdownEvent + +handleShutdownEvent :: Event -> X All +handleShutdownEvent = \case + ClientMessageEvent { ev_message_type = mt } -> do + isShutdownEvent <- (mt ==) <$> getAtom "XMONAD_SHUTDOWN" + when isShutdownEvent $ do + broadcastMessage ReleaseResources + writeStateToFile + io exitSuccess >> return () + return (All (not isShutdownEvent)) + _ -> + return (All True) + +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 + +shutdown :: IO () +shutdown = do + pid <- readProcessIDFromFile + sendShutdownEvent + hPutStrLn stderr ("waiting for: " <> show pid) + result <- tryIOError (waitProcess pid) + if isSuccess result + then hPutStrLn stderr ("result: " <> show result <> " [AKA success^_^]") + else hPutStrLn stderr ("result: " <> show result) + where + isSuccess = either isDoesNotExistError (const False) + +waitProcess :: ProcessID -> IO () +waitProcess pid = forever (signalProcess nullSignal pid >> threadDelay 10000) + +-- +-- PID file stuff +-- + +getProcessIDFileName :: IO FilePath +getProcessIDFileName = ( "xmonad.pid") <$> getXMonadDataDir + +writeProcessIDToFile :: IO () +writeProcessIDToFile = do + pidFileName <- getProcessIDFileName + pid <- getProcessID + writeFile pidFileName (show pid) + +readProcessIDFromFile :: IO ProcessID +readProcessIDFromFile = do + pidFileName <- getProcessIDFileName + read <$> readFile pidFileName diff --git a/tv/5pkgs/haskell/xmonad-tv/src/main.hs b/tv/5pkgs/haskell/xmonad-tv/src/main.hs index b82f398..d346bfd 100644 --- a/tv/5pkgs/haskell/xmonad-tv/src/main.hs +++ b/tv/5pkgs/haskell/xmonad-tv/src/main.hs @@ -30,10 +30,7 @@ import Data.Ratio import XMonad.Hooks.Place (placeHook, smart) import XMonad.Actions.PerWorkspaceKeys (chooseAction) -import XMonad.Stockholm.Pager -import XMonad.Stockholm.Shutdown - - +import Shutdown (shutdown, newShutdownEventHandler) import Build (myFont, myScreenWidth, myTermFontWidth, myTermPadding) @@ -139,8 +136,6 @@ myKeys conf = Map.fromList $ , ((_4 , xK_x ), chooseAction spawnTermAt) , ((_4C , xK_x ), spawnRootTerm) - , ((0 , xK_Menu ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.view) ) - , ((_S , xK_Menu ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.shift) ) , ((_C , xK_Menu ), toggleWS) , ((_4 , xK_space ), withFocused $ \w -> ifM (isFloatingX w) xdeny $ sendMessage NextLayout) @@ -218,23 +213,3 @@ xdeny = , "-e", "sleep", "0.05" ] Nothing - - -pagerConfig :: PagerConfig -pagerConfig = def - { pc_font = myFont - , pc_cellwidth = 64 - , pc_matchmethod = MatchPrefix - , pc_windowColors = windowColors - } - where - windowColors _ _ _ True _ = ("#ef4242","#ff2323") - windowColors wsf m c u wf = do - let y = defaultWindowColors wsf m c u wf - if m == False && wf == True - then ("#402020", snd y) - else y - - -allWorkspaceNames :: W.StackSet i l a sid sd -> X [i] -allWorkspaceNames = return . map W.tag . W.workspaces diff --git a/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal b/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal index f3bd2e0..a3ddcb0 100644 --- a/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal +++ b/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal @@ -15,14 +15,15 @@ executable xmonad containers, directory, extra, + filepath, template-haskell, th-env, unix, X11, xmonad, - xmonad-contrib, - xmonad-stockholm + xmonad-contrib other-modules: + Shutdown, THEnv.JSON default-language: Haskell2010 ghc-options: -O2 -Wall -threaded -- cgit v1.2.3 From be9274b6c2b213c376bf9f0efeefb6275d0224fd Mon Sep 17 00:00:00 2001 From: tv Date: Fri, 9 Dec 2022 04:42:09 +0100 Subject: =?UTF-8?q?tv:=20XMONAD=5FSPAWN=5FWORKSPACE=20=E2=86=92=20=5FCURRE?= =?UTF-8?q?NT=5FDESKTOP=5FNAME?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- tv/5pkgs/haskell/xmonad-tv/src/main.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) (limited to 'tv/5pkgs/haskell/xmonad-tv/src') diff --git a/tv/5pkgs/haskell/xmonad-tv/src/main.hs b/tv/5pkgs/haskell/xmonad-tv/src/main.hs index d346bfd..c921d42 100644 --- a/tv/5pkgs/haskell/xmonad-tv/src/main.hs +++ b/tv/5pkgs/haskell/xmonad-tv/src/main.hs @@ -118,13 +118,6 @@ spawnRootTerm = Nothing -spawnTermAt :: String -> X () -spawnTermAt ws = do - env <- io getEnvironment - let env' = ("XMONAD_SPAWN_WORKSPACE", ws) : env - forkFile {-pkg:rxvt_unicode-}"urxvtc" [] (Just env') - - myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ()) myKeys conf = Map.fromList $ [ ((_4 , xK_Escape ), forkFile {-pkg-}"slock" [] Nothing) @@ -133,7 +126,7 @@ myKeys conf = Map.fromList $ , ((_4 , xK_o ), forkFile {-pkg:fzmenu-}"otpmenu" [] Nothing) , ((_4 , xK_p ), forkFile {-pkg:fzmenu-}"passmenu" [] Nothing) - , ((_4 , xK_x ), chooseAction spawnTermAt) + , ((_4 , xK_x ), forkFile {-pkg:rxvt_unicode-}"urxvtc" [] Nothing) , ((_4C , xK_x ), spawnRootTerm) , ((_C , xK_Menu ), toggleWS) -- cgit v1.2.3