summaryrefslogtreecommitdiffstats
path: root/tv/5pkgs/haskell/xmonad-tv/src/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tv/5pkgs/haskell/xmonad-tv/src/main.hs')
-rw-r--r--tv/5pkgs/haskell/xmonad-tv/src/main.hs77
1 files changed, 11 insertions, 66 deletions
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/main.hs b/tv/5pkgs/haskell/xmonad-tv/src/main.hs
index 43461ab98..dd76fbf6e 100644
--- a/tv/5pkgs/haskell/xmonad-tv/src/main.hs
+++ b/tv/5pkgs/haskell/xmonad-tv/src/main.hs
@@ -4,7 +4,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
-module Main where
+module Main (main) where
import System.Exit (exitFailure)
@@ -18,7 +18,6 @@ import System.Environment (getArgs, getEnv, getEnvironment, lookupEnv)
import System.Posix.Process (executeFile)
import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace
, removeEmptyWorkspace)
-import XMonad.Actions.GridSelect
import XMonad.Actions.CycleWS (toggleWS)
import XMonad.Layout.NoBorders ( smartBorders )
import qualified XMonad.StackSet as W
@@ -31,7 +30,6 @@ import XMonad.Hooks.Place (placeHook, smart)
import XMonad.Actions.PerWorkspaceKeys (chooseAction)
import XMonad.Stockholm.Pager
-import XMonad.Stockholm.Rhombus
import XMonad.Stockholm.Shutdown
import qualified Paths
@@ -39,12 +37,14 @@ import qualified Paths
myFont :: String
myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
+
main :: IO ()
main = getArgs >>= \case
[] -> mainNoArgs
["--shutdown"] -> shutdown
args -> hPutStrLn stderr ("bad arguments: " <> show args) >> exitFailure
+
mainNoArgs :: IO ()
mainNoArgs = do
workspaces0 <- getWorkspaces0
@@ -84,6 +84,7 @@ getWorkspaces0 =
where
warn msg = hPutStrLn stderr ("getWorkspaces0: " ++ msg) >> return []
+
displaySomeException :: SomeException -> String
displaySomeException = displayException
@@ -92,6 +93,7 @@ forkFile :: FilePath -> [String] -> Maybe [(String, String)] -> X ()
forkFile path args env =
xfork (executeFile path False args env) >> return ()
+
spawnRootTerm :: X ()
spawnRootTerm =
forkFile
@@ -99,12 +101,14 @@ spawnRootTerm =
["-name", "root-urxvt", "-e", Paths.su, "-"]
Nothing
+
spawnTermAt :: String -> X ()
spawnTermAt ws = do
env <- io getEnvironment
let env' = ("XMONAD_SPAWN_WORKSPACE", ws) : env
forkFile Paths.urxvtc [] (Just env')
+
myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
myKeys conf = Map.fromList $
[ ((_4 , xK_Escape ), forkFile Paths.slock [] Nothing)
@@ -116,52 +120,25 @@ myKeys conf = Map.fromList $
, ((_4 , xK_x ), chooseAction spawnTermAt)
, ((_4C , xK_x ), spawnRootTerm)
- --, ((_4 , xK_F1 ), withFocused jojo)
- --, ((_4 , xK_F1 ), printAllGeometries)
-
, ((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_Menu ), rhombus horseConfig (io . hPutStrLn stderr) ["Correct", "Horse", "Battery", "Staple", "Stuhl", "Tisch"] )
-
- -- %! Rotate through the available layout algorithms
+
, ((_4 , xK_space ), sendMessage NextLayout)
, ((_4S , xK_space ), setLayout $ XMonad.layoutHook conf) -- reset layout
- ---- BinarySpacePartition
- --, ((_4 , xK_l), sendMessage $ ExpandTowards R)
- --, ((_4 , xK_h), sendMessage $ ExpandTowards L)
- --, ((_4 , xK_j), sendMessage $ ExpandTowards D)
- --, ((_4 , xK_k), sendMessage $ ExpandTowards U)
- --, ((_4S , xK_l), sendMessage $ ShrinkFrom R)
- --, ((_4S , xK_h), sendMessage $ ShrinkFrom L)
- --, ((_4S , xK_j), sendMessage $ ShrinkFrom D)
- --, ((_4S , xK_k), sendMessage $ ShrinkFrom U)
- --, ((_4 , xK_n), sendMessage Rotate)
- --, ((_4S , xK_n), sendMessage Swap)
-
- ---- mouseResizableTile
- --, ((_4 , xK_u), sendMessage ShrinkSlave)
- --, ((_4 , xK_i), sendMessage ExpandSlave)
-
- -- move focus up or down the window stack
- --, ((_4 , xK_m ), windows W.focusMaster)
, ((_4 , xK_j ), windows W.focusDown)
, ((_4 , xK_k ), windows W.focusUp)
- -- modifying the window order
, ((_4S , xK_m ), windows W.swapMaster)
, ((_4S , xK_j ), windows W.swapDown)
, ((_4S , xK_k ), windows W.swapUp)
- -- resizing the master/slave ratio
- , ((_4 , xK_h ), sendMessage Shrink) -- %! Shrink the master area
- , ((_4 , xK_l ), sendMessage Expand) -- %! Expand the master area
+ , ((_4 , xK_h ), sendMessage Shrink)
+ , ((_4 , xK_l ), sendMessage Expand)
- -- floating layer support
- , ((_4 , xK_t ), withFocused $ windows . W.sink) -- make tiling
+ , ((_4 , xK_t ), withFocused $ windows . W.sink) -- make tiling
- -- increase or decrease number of windows in the master area
, ((_4 , xK_comma ), sendMessage $ IncMasterN 1)
, ((_4 , xK_period ), sendMessage $ IncMasterN (-1))
@@ -170,10 +147,6 @@ myKeys conf = Map.fromList $
, ((_4 , xK_Delete ), removeEmptyWorkspace)
, ((_4 , xK_Return ), toggleWS)
- --, (0 , xK_Menu ) & \k -> (k, gridselectWorkspace wsGSConfig { gs_navigate = makeGSNav k } W.view)
- --, (_4 , xK_v ) & \k -> (k, gridselectWorkspace wsGSConfig { gs_navigate = makeGSNav k } W.view)
- --, (_4S , xK_v ) & \k -> (k, gridselectWorkspace wsGSConfig { gs_navigate = makeGSNav k } W.shift)
- --, (_4 , xK_b ) & \k -> (k, goToSelected wGSConfig { gs_navigate = makeGSNav k })
, ((noModMask, xF86XK_AudioLowerVolume), amixer ["sset", "Master", "5%-"])
, ((noModMask, xF86XK_AudioRaiseVolume), amixer ["sset", "Master", "5%+"])
, ((noModMask, xF86XK_AudioMute), amixer ["sset", "Master", "toggle"])
@@ -196,11 +169,7 @@ pagerConfig :: PagerConfig
pagerConfig = def
{ pc_font = myFont
, pc_cellwidth = 64
- --, pc_cellheight = 36 -- TODO automatically keep screen aspect
- --, pc_borderwidth = 1
- --, pc_matchcolor = "#f0b000"
, pc_matchmethod = MatchPrefix
- --, pc_colors = pagerWorkspaceColors
, pc_windowColors = windowColors
}
where
@@ -211,30 +180,6 @@ pagerConfig = def
then ("#402020", snd y)
else y
-horseConfig :: RhombusConfig
-horseConfig = def
- { rc_font = myFont
- , rc_cellwidth = 64
- --, rc_cellheight = 36 -- TODO automatically keep screen aspect
- --, rc_borderwidth = 1
- --, rc_matchcolor = "#f0b000"
- , rc_matchmethod = MatchPrefix
- --, rc_colors = pagerWorkspaceColors
- --, rc_paint = myPaint
- }
-
-wGSConfig :: GSConfig Window
-wGSConfig = def
- { gs_cellheight = 20
- , gs_cellwidth = 192
- , gs_cellpadding = 5
- , gs_font = myFont
- , gs_navigate = navNSearch
- }
-
-
-(&) :: a -> (a -> c) -> c
-(&) = flip ($)
allWorkspaceNames :: W.StackSet i l a sid sd -> X [i]
allWorkspaceNames ws =
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 00:07:58 +0000