summaryrefslogtreecommitdiffstats
path: root/tv/5pkgs/simple
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2018-11-30 09:03:52 +0100
committertv <tv@krebsco.de>2018-11-30 09:48:36 +0100
commit94a09258ad3202cfba1bcba8cdbf99b51f5aae86 (patch)
tree7142334df0f353d8d7da5430ef6cc14d09cfcf7d /tv/5pkgs/simple
parent4319a386800c8dd535fe8b7273539d258e3c6092 (diff)
tv xmonad: move to haskell packages
Diffstat (limited to 'tv/5pkgs/simple')
-rw-r--r--tv/5pkgs/simple/xmonad-tv/default.nix262
1 files changed, 0 insertions, 262 deletions
diff --git a/tv/5pkgs/simple/xmonad-tv/default.nix b/tv/5pkgs/simple/xmonad-tv/default.nix
deleted file mode 100644
index edfee98a0..000000000
--- a/tv/5pkgs/simple/xmonad-tv/default.nix
+++ /dev/null
@@ -1,262 +0,0 @@
-{ pkgs, ... }:
-pkgs.writeHaskellPackage "xmonad-tv" {
- executables."xmonad-${builtins.currentSystem}" = {
- extra-depends = [
- "containers"
- "extra"
- "unix"
- "X11"
- "xmonad"
- "xmonad-contrib"
- "xmonad-stockholm"
- ];
- text = /* haskell */ ''
-{-# LANGUAGE DeriveDataTypeable #-} -- for XS
-{-# LANGUAGE FlexibleContexts #-} -- for xmonad'
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-
-module Main where
-
-import System.Exit (exitFailure)
-
-import Control.Exception
-import Control.Monad.Extra (whenJustM)
-import Graphics.X11.ExtraTypes.XF86
-import Text.Read (readEither)
-import XMonad
-import System.IO (hPutStrLn, stderr)
-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
-import Data.Map (Map)
-import qualified Data.Map as Map
-import XMonad.Hooks.UrgencyHook (SpawnUrgencyHook(..), withUrgencyHook)
-import XMonad.Hooks.ManageHelpers (doCenterFloat)
-import XMonad.Layout.FixedColumn (FixedColumn(..))
-import XMonad.Hooks.Place (placeHook, smart)
-import XMonad.Actions.PerWorkspaceKeys (chooseAction)
-
-import XMonad.Stockholm.Pager
-import XMonad.Stockholm.Rhombus
-import XMonad.Stockholm.Shutdown
-
-
-amixerPath :: FilePath
-amixerPath = "${pkgs.alsaUtils}/bin/amixer"
-
-urxvtcPath :: FilePath
-urxvtcPath = "${pkgs.rxvt_unicode}/bin/urxvtc"
-
-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
- handleShutdownEvent <- newShutdownEventHandler
- xmonad
- $ withUrgencyHook (SpawnUrgencyHook "echo emit Urgency ")
- $ def
- { terminal = urxvtcPath
- , modMask = mod4Mask
- , keys = myKeys
- , workspaces = workspaces0
- , layoutHook = smartBorders $ FixedColumn 1 20 80 10 ||| Full
- , manageHook =
- composeAll
- [ appName =? "fzmenu-urxvt" --> doCenterFloat
- , appName =? "pinentry" --> doCenterFloat
- , placeHook (smart (1,0))
- ]
- , startupHook =
- whenJustM (io (lookupEnv "XMONAD_STARTUP_HOOK"))
- (\path -> forkFile path [] Nothing)
- , normalBorderColor = "#1c1c1c"
- , focusedBorderColor = "#f000b0"
- , handleEventHook = handleShutdownEvent
- }
-
-
-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 = hPutStrLn stderr ("getWorkspaces0: " ++ msg) >> return []
-
-displaySomeException :: SomeException -> String
-displaySomeException = displayException
-
-
-forkFile :: FilePath -> [String] -> Maybe [(String, String)] -> X ()
-forkFile path args env =
- xfork (executeFile path False args env) >> return ()
-
-spawnRootTerm :: X ()
-spawnRootTerm =
- forkFile
- urxvtcPath
- ["-name", "root-urxvt", "-e", "/run/wrappers/bin/su", "-"]
- Nothing
-
-spawnTermAt :: String -> X ()
-spawnTermAt ws = do
- env <- io getEnvironment
- let env' = ("XMONAD_SPAWN_WORKSPACE", ws) : env
- forkFile urxvtcPath [] (Just env')
-
-myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
-myKeys conf = Map.fromList $
- [ ((_4 , xK_Escape ), forkFile "/run/wrappers/bin/slock" [] Nothing)
- , ((_4S , xK_c ), kill)
-
- , ((_4 , xK_o ), forkFile "${pkgs.fzmenu}/bin/otpmenu" [] Nothing)
- , ((_4 , xK_p ), forkFile "${pkgs.fzmenu}/bin/passmenu" [] Nothing)
-
- , ((_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 (liftIO . 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
-
- -- floating layer support
- , ((_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))
-
- , ((_4 , xK_a ), addWorkspacePrompt def)
- , ((_4 , xK_r ), renameWorkspace def)
- , ((_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"])
- ]
- where
- _4 = mod4Mask
- _C = controlMask
- _S = shiftMask
- _M = mod1Mask
- _4C = _4 .|. _C
- _4S = _4 .|. _S
- _4M = _4 .|. _M
- _4CM = _4 .|. _C .|. _M
- _4SM = _4 .|. _S .|. _M
-
- amixer args = forkFile amixerPath args Nothing
-
-
-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
- 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
-
-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 =
- return $ map W.tag (W.hidden ws) ++ [W.tag $ W.workspace $ W.current ws]
- '';
- };
-}