diff options
Diffstat (limited to 'tv/5pkgs')
-rw-r--r-- | tv/5pkgs/haskell/default.nix | 20 | ||||
-rw-r--r-- | tv/5pkgs/haskell/xmonad-tv/default.nix | 15 | ||||
-rw-r--r-- | tv/5pkgs/haskell/xmonad-tv/shell.nix | 78 | ||||
-rw-r--r-- | tv/5pkgs/haskell/xmonad-tv/src/Helpers/Path.hs | 15 | ||||
-rw-r--r-- | tv/5pkgs/haskell/xmonad-tv/src/Paths.hs | 25 | ||||
-rw-r--r-- | tv/5pkgs/haskell/xmonad-tv/src/main.hs | 206 | ||||
-rw-r--r-- | tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal | 25 | ||||
-rw-r--r-- | tv/5pkgs/simple/default.nix | 8 | ||||
-rw-r--r-- | tv/5pkgs/simple/disko.nix | 13 | ||||
-rwxr-xr-x | tv/5pkgs/simple/fzmenu/bin/otpmenu | 41 | ||||
-rwxr-xr-x | tv/5pkgs/simple/fzmenu/bin/passmenu | 41 | ||||
-rw-r--r-- | tv/5pkgs/simple/fzmenu/default.nix | 34 | ||||
-rw-r--r-- | tv/5pkgs/simple/hc.nix | 37 | ||||
-rw-r--r-- | tv/5pkgs/simple/otpmenu.nix | 15 | ||||
-rw-r--r-- | tv/5pkgs/simple/q/default.nix | 6 | ||||
-rw-r--r-- | tv/5pkgs/simple/xmonad-tv/default.nix | 295 |
16 files changed, 557 insertions, 317 deletions
diff --git a/tv/5pkgs/haskell/default.nix b/tv/5pkgs/haskell/default.nix new file mode 100644 index 000000000..fcede2f9c --- /dev/null +++ b/tv/5pkgs/haskell/default.nix @@ -0,0 +1,20 @@ +with import <stockholm/lib>; +let + overrides = self: super: + mapNixDir (path: self.callPackage path {}) [ + <stockholm/krebs/5pkgs/haskell> + ./. + ]; +in + self: super: { + haskell = super.haskell // { + packages = mapAttrs (name: value: + if hasAttr "override" value + then value.override { inherit overrides; } + else value + ) super.haskell.packages; + }; + haskellPackages = super.haskellPackages.override { + inherit overrides; + }; + } diff --git a/tv/5pkgs/haskell/xmonad-tv/default.nix b/tv/5pkgs/haskell/xmonad-tv/default.nix new file mode 100644 index 000000000..42eb13d41 --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/default.nix @@ -0,0 +1,15 @@ +{ mkDerivation, base, containers, directory, extra, stdenv, unix +, X11, xmonad, xmonad-contrib, xmonad-stockholm +}: +mkDerivation { + pname = "xmonad-tv"; + version = "1.0.0"; + src = ./src; + isLibrary = false; + isExecutable = true; + executableHaskellDepends = [ + base containers directory extra unix X11 xmonad xmonad-contrib + xmonad-stockholm + ]; + license = stdenv.lib.licenses.mit; +} diff --git a/tv/5pkgs/haskell/xmonad-tv/shell.nix b/tv/5pkgs/haskell/xmonad-tv/shell.nix new file mode 100644 index 000000000..936e69627 --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/shell.nix @@ -0,0 +1,78 @@ +{ compiler ? "default" }: let + + stockholm = import <stockholm>; + + inherit (stockholm.systems.${lib.krops.getHostName}) config pkgs; + inherit (stockholm) lib; + + haskellPackages = + if compiler == "default" + then pkgs.haskellPackages + else pkgs.haskell.packages.${compiler}; + + xmonadDrv = haskellPackages.callPackage (import ./.) {}; + +in + + lib.overrideDerivation xmonadDrv.env (oldAttrs: { + shellHook = '' + pkg_name=${lib.shell.escape (lib.baseNameOf (toString ./.))} + + WORKDIR=${toString ./src} + CACHEDIR=$HOME/tmp/$pkg_name + HISTFILE=$CACHEDIR/bash_history + + mkdir -p "$CACHEDIR" + + config_XMONAD_CACHE_DIR=${lib.shell.escape + config.systemd.services.xmonad.environment.XMONAD_CACHE_DIR + } + + xmonad=$CACHEDIR/xmonad-${lib.currentSystem} + + xmonad_build() {( + set -efu + cd "$WORKDIR" + options=$( + ${pkgs.cabal-read}/bin/ghc-options "$WORKDIR/$pkg_name.cabal" xmonad + ) + ghc $options \ + -odir "$CACHEDIR" \ + -hidir "$CACHEDIR" \ + -o "$xmonad" \ + main.hs + )} + + xmonad_restart() {( + set -efu + cd "$WORKDIR" + if systemctl is-active xmonad; then + sudo systemctl stop xmonad + cp -b "$config_XMONAD_CACHE_DIR"/xmonad.state "$CACHEDIR"/ + echo "xmonad.state: $(cat "$CACHEDIR"/xmonad.state)" + else + "$xmonad" --shutdown || : + fi + "$xmonad" & + echo xmonad pid: $! >&2 + )} + + xmonad_yield() {( + set -efu + "$xmonad" --shutdown + cp -b "$CACHEDIR"/xmonad.state "$config_XMONAD_CACHE_DIR"/ + sudo systemctl start xmonad + )} + + export PATH=${config.systemd.services.xmonad.path}:$PATH + export SHELL=/run/current-system/sw/bin/bash + + export XMONAD_CACHE_DIR="$CACHEDIR" + export XMONAD_DATA_DIR="$CACHEDIR" + export XMONAD_CONFIG_DIR=/var/empty + + unset XMONAD_STARTUP_HOOK + + cd "$WORKDIR" + ''; + }) diff --git a/tv/5pkgs/haskell/xmonad-tv/src/Helpers/Path.hs b/tv/5pkgs/haskell/xmonad-tv/src/Helpers/Path.hs new file mode 100644 index 000000000..1029d60be --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/src/Helpers/Path.hs @@ -0,0 +1,15 @@ +module Helpers.Path where + +import qualified Data.List +import qualified System.Directory +import qualified System.IO.Unsafe + + +findExecutable :: String -> FilePath +findExecutable = + System.IO.Unsafe.unsafePerformIO . find + where + find name = + maybe failure id <$> System.Directory.findExecutable name + where + failure = error (Data.List.intercalate " " [name, "not found"]) diff --git a/tv/5pkgs/haskell/xmonad-tv/src/Paths.hs b/tv/5pkgs/haskell/xmonad-tv/src/Paths.hs new file mode 100644 index 000000000..3a879b5d0 --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/src/Paths.hs @@ -0,0 +1,25 @@ +module Paths where + +import Helpers.Path + + +otpmenu :: FilePath +otpmenu = findExecutable "otpmenu" + +pactl :: FilePath +pactl = findExecutable "pactl" + +passmenu :: FilePath +passmenu = findExecutable "passmenu" + +slock :: FilePath +slock = findExecutable "slock" + +su :: FilePath +su = findExecutable "su" + +urxvtc :: FilePath +urxvtc = findExecutable "urxvtc" + +xcalib :: FilePath +xcalib = findExecutable "xcalib" diff --git a/tv/5pkgs/haskell/xmonad-tv/src/main.hs b/tv/5pkgs/haskell/xmonad-tv/src/main.hs new file mode 100644 index 000000000..b7d4e9bca --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/src/main.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE DeriveDataTypeable #-} -- for XS +{-# LANGUAGE FlexibleContexts #-} -- for xmonad' +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + + +module Main (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.CycleWS (toggleWS) +import XMonad.Layout.NoBorders ( smartBorders ) +import XMonad.Layout.ResizableTile (ResizableTall(ResizableTall)) +import XMonad.Layout.ResizableTile (MirrorResize(MirrorExpand,MirrorShrink)) +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.Hooks.Place (placeHook, smart) +import XMonad.Actions.PerWorkspaceKeys (chooseAction) + +import XMonad.Stockholm.Pager +import XMonad.Stockholm.Shutdown +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 + let width = 1366 + workspaces0 <- getWorkspaces0 + handleShutdownEvent <- newShutdownEventHandler + xmonad + $ withUrgencyHook (SpawnUrgencyHook "echo emit Urgency ") + $ def + { terminal = Paths.urxvtc + , modMask = mod4Mask + , keys = myKeys + , workspaces = workspaces0 + , layoutHook = + smartBorders $ + ResizableTall + 1 + (10 * 6 / width) + ((80 * 6 + 2 * (1+1+1))/width) [] + ||| + 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 + Paths.urxvtc + ["-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) + , ((_4S , xK_c ), kill) + + , ((_4 , xK_o ), forkFile Paths.otpmenu [] Nothing) + , ((_4 , xK_p ), forkFile Paths.passmenu [] Nothing) + + , ((_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 ), sendMessage NextLayout) + , ((_4M , xK_space ), resetLayout) + + , ((_4 , xK_m ), windows W.focusMaster) + , ((_4 , xK_j ), windows W.focusDown) + , ((_4 , xK_k ), windows W.focusUp) + + , ((_4S , xK_m ), windows W.swapMaster) + , ((_4S , xK_j ), windows W.swapDown) + , ((_4S , xK_k ), windows W.swapUp) + + , ((_4M , xK_h ), sendMessage Shrink) + , ((_4M , xK_l ), sendMessage Expand) + + , ((_4M , xK_j ), sendMessage MirrorShrink) + , ((_4M , xK_k ), sendMessage MirrorExpand) + + , ((_4 , xK_t ), withFocused $ windows . W.sink) + + , ((_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, xF86XK_AudioLowerVolume), audioLowerVolume) + , ((0, xF86XK_AudioRaiseVolume), audioRaiseVolume) + , ((0, xF86XK_AudioMute), audioMute) + + , ((_4, xK_Prior), forkFile Paths.xcalib ["-invert", "-alter"] Nothing) + ] + 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 + + pactl args = forkFile Paths.pactl args Nothing + audioLowerVolume = pactl ["--", "set-sink-volume", "@DEFAULT_SINK@", "-5%"] + audioRaiseVolume = pactl ["--", "set-sink-volume", "@DEFAULT_SINK@", "+5%"] + audioMute = pactl ["--", "set-sink-mute", "@DEFAULT_SINK@", "toggle"] + + resetLayout = setLayout $ XMonad.layoutHook conf + + +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 new file mode 100644 index 000000000..f10bc4aeb --- /dev/null +++ b/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal @@ -0,0 +1,25 @@ +name: xmonad-tv +version: 1.0.0 +license: MIT +author: tv <tv@krebsco.de> +maintainer: tv <tv@krebsco.de> +build-type: Simple +cabal-version: >=1.10 + +executable xmonad + main-is: main.hs + build-depends: + base, + containers, + directory, + extra, + unix, + X11, + xmonad, + xmonad-contrib, + xmonad-stockholm + other-modules: + Helpers.Path, + Paths + default-language: Haskell2010 + ghc-options: -O2 -Wall -threaded diff --git a/tv/5pkgs/simple/default.nix b/tv/5pkgs/simple/default.nix index 1b9d8c235..6ba4fec83 100644 --- a/tv/5pkgs/simple/default.nix +++ b/tv/5pkgs/simple/default.nix @@ -15,10 +15,4 @@ let else override; in - listToAttrs - (map - (name: nameValuePair (removeSuffix ".nix" name) - (callPackage (./. + "/${name}") {})) - (filter - (name: name != "default.nix" && !hasPrefix "." name) - (attrNames (readDir ./.)))) + mapNixDir (path: callPackage path {}) ./. diff --git a/tv/5pkgs/simple/disko.nix b/tv/5pkgs/simple/disko.nix new file mode 100644 index 000000000..de8f1df22 --- /dev/null +++ b/tv/5pkgs/simple/disko.nix @@ -0,0 +1,13 @@ +{ fetchgit }: + +let + src = fetchgit { + url = https://cgit.krebsco.de/disko; + rev = "16cd458af06d3caf687eb7d80ca3df26b71fe28c"; + sha256 = "16cd458af06d3caf687eb7d80ca3df26b71fe28c"; + }; +in + +{ + lib = import "${src}/lib"; +} diff --git a/tv/5pkgs/simple/fzmenu/bin/otpmenu b/tv/5pkgs/simple/fzmenu/bin/otpmenu new file mode 100755 index 000000000..ad8a0fda9 --- /dev/null +++ b/tv/5pkgs/simple/fzmenu/bin/otpmenu @@ -0,0 +1,41 @@ +#! /bin/sh +set -efu + +#PATH= + +case ${FZMENU_PHASE-0} in + 0) + export FZMENU_PHASE=1 + exec setsid -f urxvt -name fzmenu-urxvt -e dash "$0" + ;; + 1) + if result=$( + FZF_DEFAULT_OPTS=${FZMENU_FZF_DEFAULT_OPTS-} + if test -n "$FZF_DEFAULT_OPTS"; then + export FZF_DEFAULT_OPTS + fi + pass git ls-files '*/otp.gpg' | \ + sed ' + + s/\/otp\.gpg$// + ' | + exec fzf \ + --history=/dev/null \ + --no-sort \ + --prompt='OTP: ' \ + ) + then + export FZMENU_PHASE=2 + export FZMENU_RESULT="$result" + setsid -f "$0" + fi + ;; + 2) + pass=$(pass otp code "$FZMENU_RESULT/otp") + printf %s "$pass" | + xdotool type -f - + ;; + *) + echo "$0: error: bad phase: $FZMENU_PHASE" >&2 + exit -1 +esac diff --git a/tv/5pkgs/simple/fzmenu/bin/passmenu b/tv/5pkgs/simple/fzmenu/bin/passmenu new file mode 100755 index 000000000..00b36c3af --- /dev/null +++ b/tv/5pkgs/simple/fzmenu/bin/passmenu @@ -0,0 +1,41 @@ +#! /bin/sh +set -efu + +#PATH= + +case ${FZMENU_PHASE-0} in + 0) + export FZMENU_PHASE=1 + exec setsid -f urxvt -name fzmenu-urxvt -e dash "$0" + ;; + 1) + if result=$( + FZF_DEFAULT_OPTS=${FZMENU_FZF_DEFAULT_OPTS-} + if test -n "$FZF_DEFAULT_OPTS"; then + export FZF_DEFAULT_OPTS + fi + pass git ls-files '*/*.gpg' | \ + sed ' + /\/otp\.gpg$:/d + s/\.gpg$// + ' | + exec fzf \ + --history=/dev/null \ + --no-sort \ + --prompt='pass: ' \ + ) + then + export FZMENU_PHASE=2 + export FZMENU_RESULT="$result" + setsid -f "$0" + fi + ;; + 2) + pass=$(pass show "$FZMENU_RESULT") + printf %s "$pass" | + xdotool type -f - + ;; + *) + echo "$0: error: bad phase: $FZMENU_PHASE" >&2 + exit -1 +esac diff --git a/tv/5pkgs/simple/fzmenu/default.nix b/tv/5pkgs/simple/fzmenu/default.nix new file mode 100644 index 000000000..c49c903c6 --- /dev/null +++ b/tv/5pkgs/simple/fzmenu/default.nix @@ -0,0 +1,34 @@ +{ coreutils, dash, gnused, fzf, pass, runCommand, rxvt_unicode, stdenv, utillinux, xdotool }: + +runCommand "fzmenu" { +} /* sh */ '' + mkdir $out + + cp -r ${./bin} $out/bin + + substituteInPlace $out/bin/otpmenu \ + --replace '#! /bin/sh' '#! ${dash}/bin/dash' \ + --replace '#PATH=' PATH=${stdenv.lib.makeBinPath [ + coreutils + dash + fzf + gnused + pass + rxvt_unicode + utillinux + xdotool + ]} + + substituteInPlace $out/bin/passmenu \ + --replace '#! /bin/sh' '#! ${dash}/bin/dash' \ + --replace '#PATH=' PATH=${stdenv.lib.makeBinPath [ + coreutils + dash + fzf + gnused + pass + rxvt_unicode + utillinux + xdotool + ]} +'' diff --git a/tv/5pkgs/simple/hc.nix b/tv/5pkgs/simple/hc.nix new file mode 100644 index 000000000..4d325e16c --- /dev/null +++ b/tv/5pkgs/simple/hc.nix @@ -0,0 +1,37 @@ +{ coreutils, fetchgit, findutils, gawk, gnugrep, makeWrapper, qrencode, stdenv, texlive, utillinux, zbar }: + +stdenv.mkDerivation rec { + name = "hc-${meta.version}"; + + src = fetchgit { + url = "https://cgit.krebsco.de/hc"; + rev = "refs/tags/v${meta.version}"; + sha256 = "09349gja22p0j3xs082kp0fnaaada14bafszn4r3q7rg1id2slfb"; + }; + + nativeBuildInputs = [ makeWrapper ]; + + buildPhase = null; + + installPhase = '' + mkdir -p $out/bin + + cp $src/bin/hc $out/bin/hc + + wrapProgram $out/bin/hc \ + --prefix PATH : ${stdenv.lib.makeBinPath [ + coreutils + findutils + gawk + gnugrep + qrencode + texlive.combined.scheme-full + utillinux + zbar + ]} + ''; + + meta = { + version = "1.0.0"; + }; +} diff --git a/tv/5pkgs/simple/otpmenu.nix b/tv/5pkgs/simple/otpmenu.nix deleted file mode 100644 index b35e1601f..000000000 --- a/tv/5pkgs/simple/otpmenu.nix +++ /dev/null @@ -1,15 +0,0 @@ -{ dmenu, gnused, pass, writeDashBin, xdotool }: - -writeDashBin "otpmenu" '' - set -efu - - x=$( - ${pass}/bin/pass git ls-files '*/otp.gpg' \ - | ${gnused}/bin/sed 's:/otp\.gpg$::' \ - | ${dmenu}/bin/dmenu -f -p OTP - ) - - otp=$(${pass}/bin/pass otp code "$x/otp") - - printf %s "$otp" | ${xdotool}/bin/xdotool type -f - -'' diff --git a/tv/5pkgs/simple/q/default.nix b/tv/5pkgs/simple/q/default.nix index 655c75e1b..cbcec1bae 100644 --- a/tv/5pkgs/simple/q/default.nix +++ b/tv/5pkgs/simple/q/default.nix @@ -71,6 +71,11 @@ let '+[1m%Y-%m-%d[;30mT[;38;5;088m%H:%M[m:%S%:z' ''; + q-utcdate = '' + ${pkgs.coreutils}/bin/date -u \ + '+[1m%Y-%m-%d[;30mT[;38;5;065m%H:%M[m:%S%:z' + ''; + q-gitdir = '' if test -d .git; then #git status --porcelain @@ -295,6 +300,7 @@ pkgs.writeBashBin "q" '' set -eu export PATH=/var/empty ${q-cal} + ${q-utcdate} ${q-isodate} ${q-sgtdate} (${q-gitdir}) & diff --git a/tv/5pkgs/simple/xmonad-tv/default.nix b/tv/5pkgs/simple/xmonad-tv/default.nix deleted file mode 100644 index 1168f10c8..000000000 --- a/tv/5pkgs/simple/xmonad-tv/default.nix +++ /dev/null @@ -1,295 +0,0 @@ -{ pkgs, ... }: -pkgs.writeHaskellPackage "xmonad-tv" { - executables.xmonad = { - 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 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, withArgs, 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.Actions.CopyWindow ( copy ) -import XMonad.Layout.NoBorders ( smartBorders ) -import qualified XMonad.StackSet as W -import Data.Map (Map) -import qualified Data.Map as Map --- TODO import XMonad.Layout.WorkspaceDir -import XMonad.Hooks.UrgencyHook (SpawnUrgencyHook(..), withUrgencyHook) --- import XMonad.Layout.Tabbed ---import XMonad.Layout.MouseResizableTile -import XMonad.Layout.Reflect (reflectVert) -import XMonad.Layout.FixedColumn (FixedColumn(..)) -import XMonad.Hooks.Place (placeHook, smart) -import XMonad.Hooks.FloatNext (floatNextHook) -import XMonad.Actions.PerWorkspaceKeys (chooseAction) -import XMonad.Layout.PerWorkspace (onWorkspace) ---import XMonad.Layout.BinarySpacePartition - ---import XMonad.Actions.Submap -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 - ["--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 } - -- $ withUrgencyHook borderUrgencyHook "magenta" - -- $ withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "magenta" } urgencyConfig { suppressWhen = Never } - $ withUrgencyHook (SpawnUrgencyHook "echo emit Urgency ") - $ def - { terminal = urxvtcPath - , modMask = mod4Mask - , keys = myKeys - , workspaces = workspaces0 - , layoutHook = smartBorders $ FixedColumn 1 20 80 10 ||| Full - -- , handleEventHook = myHandleEventHooks <+> handleTimerEvent - --, handleEventHook = handleTimerEvent - , manageHook = placeHook (smart (1,0)) <+> floatNextHook - , startupHook = - whenJustM (liftIO (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 <- liftIO 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.otpmenu}/bin/otpmenu" [] Nothing) - , ((_4 , xK_p ), forkFile "${pkgs.pass}/bin/passmenu" ["--type"] 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 - } - --- wsGSConfig = def --- { gs_cellheight = 20 --- , gs_cellwidth = 64 --- , gs_cellpadding = 5 --- , gs_font = myFont --- , gs_navigate = navNSearch --- } - --- custom navNSearch ---makeGSNav :: (KeyMask, KeySym) -> TwoD a (Maybe a) ---makeGSNav esc = nav --- where --- nav = makeXEventhandler $ shadowWithKeymap keyMap navNSearchDefaultHandler --- keyMap = Map.fromList --- [ (esc , cancel) --- , ((0,xK_Escape) , cancel) --- , ((0,xK_Return) , select) --- , ((0,xK_Left) , move (-1, 0) >> nav) --- , ((0,xK_Right) , move ( 1, 0) >> nav) --- , ((0,xK_Down) , move ( 0, 1) >> nav) --- , ((0,xK_Up) , move ( 0,-1) >> nav) --- , ((0,xK_BackSpace) , transformSearchString (\s -> if (s == "") then "" else init s) >> nav) --- ] --- -- The navigation handler ignores unknown key symbols, therefore we const --- navNSearchDe |