From 94a09258ad3202cfba1bcba8cdbf99b51f5aae86 Mon Sep 17 00:00:00 2001 From: tv Date: Fri, 30 Nov 2018 09:03:52 +0100 Subject: tv xmonad: move to haskell packages --- tv/5pkgs/simple/xmonad-tv/default.nix | 262 ---------------------------------- 1 file changed, 262 deletions(-) delete mode 100644 tv/5pkgs/simple/xmonad-tv/default.nix (limited to 'tv/5pkgs/simple') diff --git a/tv/5pkgs/simple/xmonad-tv/default.nix b/tv/5pkgs/simple/xmonad-tv/default.nix deleted file mode 100644 index edfee98a..00000000 --- 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] - ''; - }; -} -- cgit v1.2.3