From 336394d8616ee094dff11634bb564c26ab012ac0 Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Sat, 24 Oct 2015 22:31:10 +0200
Subject: tv: lol display-manager

---
 tv/2configs/synaptics.nix                     |  14 -
 tv/2configs/urlwatch.nix                      |   4 +
 tv/2configs/xserver.nix                       |  41 ---
 tv/2configs/xserver/default.nix               | 126 +++++++++
 tv/2configs/xserver/xmonad-tv/Main.hs         | 277 -------------------
 tv/2configs/xserver/xmonad-tv/Util/Debunk.hs  |  16 --
 tv/2configs/xserver/xmonad-tv/Util/Font.hs    | 123 ---------
 tv/2configs/xserver/xmonad-tv/Util/Pager.hs   | 172 ------------
 tv/2configs/xserver/xmonad-tv/Util/Rhombus.hs | 370 --------------------------
 tv/2configs/xserver/xmonad-tv/Util/Submap.hs  |  31 ---
 tv/2configs/xserver/xmonad-tv/Util/XUtils.hs  |  47 ----
 tv/2configs/xserver/xmonad-tv/default.nix     |   1 -
 tv/2configs/xserver/xmonad-tv/xmonad-tv.cabal |  19 --
 tv/2configs/xserver/xmonad/Main.hs            | 277 +++++++++++++++++++
 tv/2configs/xserver/xmonad/Util/Debunk.hs     |  16 ++
 tv/2configs/xserver/xmonad/Util/Font.hs       | 123 +++++++++
 tv/2configs/xserver/xmonad/Util/Pager.hs      | 172 ++++++++++++
 tv/2configs/xserver/xmonad/Util/Rhombus.hs    | 370 ++++++++++++++++++++++++++
 tv/2configs/xserver/xmonad/Util/Submap.hs     |  31 +++
 tv/2configs/xserver/xmonad/Util/XUtils.hs     |  47 ++++
 tv/2configs/xserver/xmonad/xmonad.cabal       |  18 ++
 tv/2configs/xserver/xserver.conf.nix          |  40 +++
 22 files changed, 1224 insertions(+), 1111 deletions(-)
 delete mode 100644 tv/2configs/synaptics.nix
 delete mode 100644 tv/2configs/xserver.nix
 create mode 100644 tv/2configs/xserver/default.nix
 delete mode 100644 tv/2configs/xserver/xmonad-tv/Main.hs
 delete mode 100644 tv/2configs/xserver/xmonad-tv/Util/Debunk.hs
 delete mode 100644 tv/2configs/xserver/xmonad-tv/Util/Font.hs
 delete mode 100644 tv/2configs/xserver/xmonad-tv/Util/Pager.hs
 delete mode 100644 tv/2configs/xserver/xmonad-tv/Util/Rhombus.hs
 delete mode 100644 tv/2configs/xserver/xmonad-tv/Util/Submap.hs
 delete mode 100644 tv/2configs/xserver/xmonad-tv/Util/XUtils.hs
 delete mode 100644 tv/2configs/xserver/xmonad-tv/default.nix
 delete mode 100644 tv/2configs/xserver/xmonad-tv/xmonad-tv.cabal
 create mode 100644 tv/2configs/xserver/xmonad/Main.hs
 create mode 100644 tv/2configs/xserver/xmonad/Util/Debunk.hs
 create mode 100644 tv/2configs/xserver/xmonad/Util/Font.hs
 create mode 100644 tv/2configs/xserver/xmonad/Util/Pager.hs
 create mode 100644 tv/2configs/xserver/xmonad/Util/Rhombus.hs
 create mode 100644 tv/2configs/xserver/xmonad/Util/Submap.hs
 create mode 100644 tv/2configs/xserver/xmonad/Util/XUtils.hs
 create mode 100644 tv/2configs/xserver/xmonad/xmonad.cabal
 create mode 100644 tv/2configs/xserver/xserver.conf.nix

(limited to 'tv/2configs')

diff --git a/tv/2configs/synaptics.nix b/tv/2configs/synaptics.nix
deleted file mode 100644
index c47cb9d..0000000
--- a/tv/2configs/synaptics.nix
+++ /dev/null
@@ -1,14 +0,0 @@
-{ config, pkgs, ... }:
-
-{
-  # TODO this is host specific
-  services.xserver.synaptics = {
-    enable = true;
-    twoFingerScroll = true;
-    accelFactor = "0.035";
-    additionalOptions = ''
-      Option "FingerHigh" "60"
-      Option "FingerLow"  "60"
-    '';
-  };
-}
diff --git a/tv/2configs/urlwatch.nix b/tv/2configs/urlwatch.nix
index 373803c..8189f63 100644
--- a/tv/2configs/urlwatch.nix
+++ b/tv/2configs/urlwatch.nix
@@ -47,6 +47,10 @@
 
       # ref <stockholm/krebs/3modules>, services.openssh.knownHosts.github*
       https://help.github.com/articles/what-ip-addresses-does-github-use-that-i-should-whitelist/
+
+      # <stockholm/tv/2configs/xserver/xserver.conf.nix>
+      # is derived from `configFile` in:
+      https://raw.githubusercontent.com/NixOS/nixpkgs/master/nixos/modules/services/x11/xserver.nix
     ];
   };
 }
diff --git a/tv/2configs/xserver.nix b/tv/2configs/xserver.nix
deleted file mode 100644
index 7fc07f9..0000000
--- a/tv/2configs/xserver.nix
+++ /dev/null
@@ -1,41 +0,0 @@
-{ config, pkgs, ... }:
-
-{
-  imports = [
-    ../2configs/urxvt.nix # TODO via xserver
-  ];
-
-  services.xserver.enable = true;
-
-
-  #fonts.enableFontConfig = true;
-  #fonts.enableFontDir = true;
-  fonts.fonts = [
-    pkgs.xlibs.fontschumachermisc
-  ];
-  #services.xfs.enable = true;
-  #services.xserver.useXFS = "unix/:7100";
-
-  services.xserver.displayManager.desktopManagerHandlesLidAndPower = true;
-
-  #services.xserver.display = 11;
-  #services.xserver.tty = 11;
-  # services.xserver.layout = "us";
-  # services.xserver.xkbOptions = "eurosign:e";
-
-  #services.xserver.multitouch.enable = true;
-
-  services.xserver.windowManager.xmonad.extraPackages = hspkgs: with hspkgs; [
-    X11-xshape
-  ];
-  services.xserver.windowManager.xmonad.enable = true;
-  services.xserver.windowManager.xmonad.enableContribAndExtras = true;
-  services.xserver.windowManager.default = "xmonad";
-  services.xserver.desktopManager.default = "none";
-  services.xserver.desktopManager.xterm.enable = false;
-
-  services.xserver.displayManager.slim.enable = true;
-  #services.xserver.displayManager.auto.enable = true;
-  #services.xserver.displayManager.auto.user = "tv";
-  #services.xserver.displayManager.job.logsXsession = true;
-}
diff --git a/tv/2configs/xserver/default.nix b/tv/2configs/xserver/default.nix
new file mode 100644
index 0000000..b590fbd
--- /dev/null
+++ b/tv/2configs/xserver/default.nix
@@ -0,0 +1,126 @@
+{ config, lib, pkgs, ... }@args:
+
+with lib;
+
+let
+  # TODO krebs.build.user
+  user = config.users.users.tv;
+
+  out = {
+    services.xserver.display = 11;
+    services.xserver.tty = 11;
+
+    services.xserver.synaptics = {
+      enable = true;
+      twoFingerScroll = true;
+      accelFactor = "0.035";
+    };
+
+    fonts.fonts = [
+      pkgs.xlibs.fontschumachermisc
+    ];
+
+    systemd.services.urxvtd = {
+      wantedBy = [ "multi-user.target" ];
+      reloadIfChanged = true;
+      serviceConfig = {
+        ExecReload = need-reload "urxvtd.service";
+        ExecStart = "${pkgs.rxvt_unicode}/bin/urxvtd";
+        Restart = "always";
+        RestartSec = "2s";
+        StartLimitBurst = 0;
+        User = user.name;
+      };
+    };
+
+    environment.systemPackages = [
+      pkgs.slock
+    ];
+
+    security.setuidPrograms = [
+      "slock"
+    ];
+
+    systemd.services.display-manager = mkForce {};
+
+    services.xserver.enable = true;
+    systemd.services.xmonad = {
+      wantedBy = [ "multi-user.target" ];
+      requires = [ "xserver.service" ];
+      serviceConfig = {
+        ExecStart = "${xmonad}/bin/xmonad";
+        User = user.name;
+        WorkingDirectory = user.home;
+      };
+    };
+
+    systemd.services.xserver = {
+      after = [
+        "systemd-udev-settle.service"
+        "local-fs.target"
+        "acpid.service"
+      ];
+      reloadIfChanged = true;
+      environment = xserver-environment;
+      serviceConfig = {
+        ExecReload = need-reload "xserver.service";
+        ExecStart = "${xserver}/bin/xserver";
+      };
+    };
+  };
+
+  xmonad = let
+    pkg = pkgs.haskellPackages.callPackage src {};
+    src = pkgs.runCommand "xmonad-package" {} ''
+      ${pkgs.cabal2nix}/bin/cabal2nix ${./xmonad} > $out
+    '';
+  in pkgs.writeScriptBin "xmonad" ''
+    #! /bin/sh
+    set -efu
+    export DISPLAY; DISPLAY=:${toString config.services.xserver.display}
+    export PATH; PATH=${makeSearchPath "bin" [
+      pkgs.rxvt_unicode
+    ]}
+    settle() {(
+      # Use PATH for a clean journal
+      command=''${1##*/}
+      PATH=''${1%/*}; export PATH
+      shift
+      until "$command" "$@"; do
+        ${pkgs.coreutils}/bin/sleep 1
+      done
+    )&}
+    settle ${pkgs.xorg.xhost}/bin/xhost +LOCAL:
+    settle ${pkgs.xorg.xrdb}/bin/xrdb -merge ${import ./Xresources.nix args}
+    settle ${pkgs.xorg.xsetroot}/bin/xsetroot -solid '#1c1c1c'
+    exec ${pkg}/bin/xmonad
+  '';
+
+  xserver-environment = {
+    XKB_BINDIR = "${pkgs.xorg.xkbcomp}/bin"; # Needed for the Xkb extension.
+    XORG_DRI_DRIVER_PATH = "/run/opengl-driver/lib/dri"; # !!! Depends on the driver selected at runtime.
+    LD_LIBRARY_PATH = concatStringsSep ":" (
+      [ "${pkgs.xorg.libX11}/lib" "${pkgs.xorg.libXext}/lib" ]
+      ++ concatLists (catAttrs "libPath" config.services.xserver.drivers));
+  };
+      
+  xserver = pkgs.writeScriptBin "xserver" ''
+    #! /bin/sh
+    set -efu
+    exec ${pkgs.xorg.xorgserver}/bin/X \
+        :${toString config.services.xserver.display} \
+        vt${toString config.services.xserver.tty} \
+        -config ${import ./xserver.conf.nix args} \
+        -logfile /var/log/X.${toString config.services.xserver.display}.log \
+        -nolisten tcp \
+        -xkbdir ${pkgs.xkeyboard_config}/etc/X11/xkb \
+  '';
+
+  need-reload = s: let
+    pkg = pkgs.writeScriptBin "need-reload" ''
+      #! /bin/sh
+      echo "$*"
+    '';
+  in "${pkg}/bin/need-reload ${s}";
+
+in out
diff --git a/tv/2configs/xserver/xmonad-tv/Main.hs b/tv/2configs/xserver/xmonad-tv/Main.hs
deleted file mode 100644
index a298d72..0000000
--- a/tv/2configs/xserver/xmonad-tv/Main.hs
+++ /dev/null
@@ -1,277 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-} -- for XS
-
-
-module Main where
-
-import XMonad
-import XMonad.Prompt (defaultXPConfig)
-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 Util.Pager
-import Util.Rhombus
-import Util.Debunk
-
-
---data MyState = MyState deriving Typeable
-
-myTerm :: String
-myTerm = "urxvtc"
-
-myRootTerm :: String
-myRootTerm = "XENVIRONMENT=\"$HOME/.Xdefaults/root-urxvt\" urxvtc -e su -"
-
--- TODO execRootTerm = exec (shlex "urxvtc -e su -")
---    [ ("XENVIRONMENT", HOME ++ "/.Xdefaults/root-urxvt") ]
-
-
-myFont :: String
-myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
-
-main :: IO ()
-main = do
-    -- TODO exec (shlex "xrdb -merge" ++ [HOME ++ "/.Xresources"])
-    -- TODO exec (shlex "xsetroot -solid '#1c1c1c'")
-    --spawn "xrdb -merge \"$HOME/.Xresources\""
-    --spawn "xsetroot -solid '#1c1c1c'"
-    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 ")
-        $ defaultConfig
-            { terminal          = myTerm
-            , modMask           = mod4Mask
-            , keys              = myKeys
-            , workspaces        =
-                [ "Dashboard" -- we start here
-                , "23"
-                , "cr"
-                , "ff"
-                , "hack"
-                , "im"
-                , "mail"
-                , "zalora", "zjournal", "zskype"
-                ]
-            , layoutHook        = smartBorders $ myLayout
-            -- , handleEventHook   = myHandleEventHooks <+> handleTimerEvent
-            --, handleEventHook   = handleTimerEvent
-            , manageHook        = placeHook (smart (1,0)) <+> floatNextHook
-            , startupHook       = spawn "echo emit XMonadStartup"
-            , normalBorderColor  = "#1c1c1c"
-            , focusedBorderColor = "#f000b0"
-            }
-  where
-    myLayout =
-        (onWorkspace "im" $ reflectVert $ Mirror $ Tall 1 (3/100) (12/13))
-        (FixedColumn 1 20 80 10 ||| Full)
-
-
-spawnTermAt :: String -> X ()
---spawnTermAt _ = floatNext True >> spawn myTerm
---spawnTermAt "ff" = floatNext True >> spawn myTerm
-spawnTermAt _    = spawn myTerm
-
-
-
---jojo w = withDisplay $ \d -> liftIO $ do
---    wa <- getWindowAttributes d w
---    printToErrors (wa_width wa, wa_height wa, wa_x wa, wa_y wa)
-
-    --sh <- getWMNormalHints d w
-    --bw <- fmap (fi . wa_border_width) $ getWindowAttributes d w
-    --return $ applySizeHints bw sh
-
-
---data WindowDetails = WindowDetails
---    { wd_name :: Maybe String
---    , wd_rect :: Rectangle
---    } deriving (Show)
-
--- urxvtc
---  -title sets {,_NET_}WM_NAME but not WM_CLASS and {,_NET_}WM_ICON_NAME       res: title
---  -name sets all                                                              res: 
---mySpawn cmd = do
---    p <- xfork $ executeFile "/run/current-system/sw/bin/urxvtc" False [] Nothing
---    liftIO $ printToErrors $ (cmd, p)
-
-
-myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
-myKeys conf = Map.fromList $
-    [ ((_4C , xK_Delete ), spawn "make -C $HOME/.xmonad reload")
-    , ((_4  , xK_Escape ), spawn "/var/setuid-wrappers/slock")
-    , ((_4S , xK_c      ), kill)
-
-    , ((_4  , xK_x      ), chooseAction spawnTermAt)
-    , ((_4C , xK_x      ), spawn myRootTerm)
-    --, ((_4M , xK_x      ), spawn "xterm")
-    --, ((_4M , xK_x      ), mySpawn "xterm")
-
-    --, ((_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 . printToErrors) ["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 defaultXPConfig)
-    , ((_4  , xK_r      ), renameWorkspace defaultXPConfig)
-    , ((_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 })
-    ]
-    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
-
-
-pagerConfig :: PagerConfig
-pagerConfig = defaultPagerConfig
-    { 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 def = defaultWindowColors wsf m c u wf
-        if m == False && wf == True
-            then ("#402020", snd def)
-            else def
-
-horseConfig :: RhombusConfig
-horseConfig = defaultRhombusConfig
-    { 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 = defaultGSConfig
-    { gs_cellheight = 20
-    , gs_cellwidth = 192
-    , gs_cellpadding = 5
-    , gs_font = myFont
-    , gs_navigate = navNSearch
-    }
-
--- wsGSConfig = defaultGSConfig
---     { 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
---    navNSearchDefaultHandler (_,s,_) = do
---        transformSearchString (++ s)
---        nav
-
-
-(&) :: 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]
-
--- vim:set fdm=marker:
diff --git a/tv/2configs/xserver/xmonad-tv/Util/Debunk.hs b/tv/2configs/xserver/xmonad-tv/Util/Debunk.hs
deleted file mode 100644
index b4772e5..0000000
--- a/tv/2configs/xserver/xmonad-tv/Util/Debunk.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Util.Debunk
-    ( printToErrors
-    ) where
-
-import XMonad
-import System.FilePath ( (</>) )
-import Control.Exception ( bracket )
-import System.IO ( hPrint, stderr, openFile, hClose, IOMode( AppendMode ) )
-
-
-printToErrors x = do
-    dir <- getXMonadDir
-    let base = dir </> "xmonad"
-        err  = base ++ ".errors"
-    bracket (openFile err AppendMode) hClose $ \h -> hPrint h x
-
diff --git a/tv/2configs/xserver/xmonad-tv/Util/Font.hs b/tv/2configs/xserver/xmonad-tv/Util/Font.hs
deleted file mode 100644
index 5352cf5..0000000
--- a/tv/2configs/xserver/xmonad-tv/Util/Font.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-{-# LANGUAGE CPP #-}
-module Util.Font
-    ( printStringCentered
-    , printStringXMF'
-    ) where
-
-import XMonad
-import XMonad.Util.Font
-
-
-printStringCentered :: (Functor m, MonadIO m)
-                    => Display -> Drawable -> XMonadFont
-                    -> GC -> Rectangle -> String
-                    -> m ()
-printStringCentered d p xmf gc r s = do
-    let x = rect_x r
-        y = rect_y r
-        w = rect_width r
-        h = rect_height r
-
-    text_w <- textWidthXMF d xmf s
-    (text_ascent, _) <- textExtentsXMF xmf s
-
-    let text_x = x + round ((fi w - fi text_w) / 2)
-        text_y = y + round ((fi h + fi text_h) / 2)
-        text_h = text_ascent
-
-    printStringXMF' d p xmf gc "" "" text_x text_y s
-
-
--- from xmonad-contrib's XMonad.Util.Font, (c) 2007 Andrea Rossato and Spencer Janssen
-printStringXMF' :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
-            -> Position -> Position -> String  -> m ()
-printStringXMF' d p (Core fs) gc fc bc x y s = io $ do
-    setFont d gc $ fontFromFontStruct fs
-    --tv [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
-    --tv setForeground d gc fc'
-    --tv setBackground d gc bc'
-    drawImageString d p gc x y s
-printStringXMF' d p (Utf8 fs) gc fc bc x y s = io $ do
-    --tv [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
-    --tv setForeground d gc fc'
-    --tv setBackground d gc bc'
-    io $ wcDrawImageString d p fs gc x y s
-#ifdef XFT
-printStringXMF' dpy drw fs@(Xft font) gc fc bc x y s = do
-  let screen   = defaultScreenOfDisplay dpy
-      colormap = defaultColormapOfScreen screen
-      visual   = defaultVisualOfScreen screen
-  --tv bcolor <- stringToPixel dpy bc
-  (a,d)  <- textExtentsXMF fs s
-  gi <- io $ xftTextExtents dpy font s
-  --tv io $ setForeground dpy gc bcolor
-  io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))
-                                (y - fi a)
-                                (fi $ xglyphinfo_xOff gi)
-                                (fi $ a + d)
-  io $ withXftDraw dpy drw visual colormap $
-         \draw -> withXftColorName dpy visual colormap fc $
-                   \color -> xftDrawString draw color font x y s
-#endif
-
-
-
-
-
--- --my_printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
--- --            -> Position -> Position -> String  -> m ()
--- my_printStringXMF (Core fs) d p gc x y s = do
---     setFont d gc $ fontFromFontStruct fs
---     -- [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
---     -- setForeground d gc fc'
---     -- setBackground d gc bc'
---     drawImageString d p gc x y s
--- my_printStringXMF (Utf8 fs) d p gc x y s = do
---     -- [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
---     -- setForeground d gc fc'
---     -- setBackground d gc bc'
---     wcDrawImageString d p fs gc x y s
--- #ifdef XFT
--- my_printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do
---   let screen   = defaultScreenOfDisplay dpy
---       colormap = defaultColormapOfScreen screen
---       visual   = defaultVisualOfScreen screen
---   bcolor <- stringToPixel dpy bc
---   (a,d)  <- textExtentsXMF fs s
---   gi <- io $ xftTextExtents dpy font s
---   io $ setForeground dpy gc bcolor
---   io $ fillRectangle dpy drw gc (x - fromIntegral (xglyphinfo_x gi))
---                                 (y - fromIntegral a)
---                                 (fromIntegral $ xglyphinfo_xOff gi)
---                                 (fromIntegral $ a + d)
---   io $ withXftDraw dpy drw visual colormap $
---          \draw -> withXftColorName dpy visual colormap fc $
---                    \color -> xftDrawString draw color font x y s
--- #endif
-
-
-
--- --textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
--- my_textWidthXMF _   (Utf8 fs) s = return $ fromIntegral $ wcTextEscapement fs s
--- my_textWidthXMF _   (Core fs) s = return $ fromIntegral $ textWidth fs s
--- #ifdef XFT
--- my_TextWidthXMF dpy (Xft xftdraw) s = liftIO $ do
---     gi <- xftTextExtents dpy xftdraw s
---     return $ xglyphinfo_xOff gi
--- #endif
--- 
--- my_textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)
--- my_textExtentsXMF (Utf8 fs) s = do
---   let (_,rl)  = wcTextExtents fs s
---       ascent  = fromIntegral $ - (rect_y rl)
---       descent = fromIntegral $ rect_height rl + (fromIntegral $ rect_y rl)
---   return (ascent, descent)
--- my_textExtentsXMF (Core fs) s = do
---   let (_,a,d,_) = textExtents fs s
---   return (a,d)
--- #ifdef XFT
--- my_textExtentsXMF (Xft xftfont) _ = io $ do
---   ascent  <- fromIntegral `fmap` xftfont_ascent  xftfont
---   descent <- fromIntegral `fmap` xftfont_descent xftfont
---   return (ascent, descent)
--- #endif
diff --git a/tv/2configs/xserver/xmonad-tv/Util/Pager.hs b/tv/2configs/xserver/xmonad-tv/Util/Pager.hs
deleted file mode 100644
index b8168b5..0000000
--- a/tv/2configs/xserver/xmonad-tv/Util/Pager.hs
+++ /dev/null
@@ -1,172 +0,0 @@
-module Util.Pager
-    ( defaultPagerConfig
-    , defaultWindowColors
-    , defaultWorkspaceColors
-    , MatchMethod(..)
-    , pager
-    , PagerConfig(..)
-    ) where
-
-import Data.List ( find )
-import Data.Maybe ( catMaybes )
-import Graphics.X11
-import Util.Rhombus
-import XMonad
-import qualified XMonad.StackSet as W
-import XMonad.Hooks.UrgencyHook
-import XMonad.Util.Font ( fi, stringToPixel )
-
-
-data PagerConfig = PagerConfig
-    { pc_font               :: String
-    , pc_cellwidth          :: Dimension
-    , pc_margin             :: Dimension
-    , pc_matchmethod        :: MatchMethod
-    , pc_wrap               :: Bool
-    , pc_workspaceColors    :: Bool -> Bool -> Bool -> (String, String, String)
-    , pc_windowColors       :: Bool -> Bool -> Bool -> Bool -> Bool -> (String, String)
-    }
-
-
-defaultPagerConfig :: PagerConfig
-defaultPagerConfig = PagerConfig "xft:Sans-8" 100 0 MatchInfix True defaultWorkspaceColors defaultWindowColors
-
-
-pager :: PagerConfig -> (String -> X ()) -> [String] -> X ()
-pager pc = rhombus defaultRhombusConfig
-    { rc_font           = pc_font pc
-    , rc_cellwidth      = pc_cellwidth pc
-    , rc_margin         = pc_margin pc
-    , rc_matchmethod    = pc_matchmethod pc
-    , rc_wrap           = pc_wrap pc
-    , rc_colors         = pc_workspaceColors pc
-    , rc_paint          = pagerPaint pc
-    }
-
-
-defaultWorkspaceColors :: Bool -- workspace has focus
-                       -> Bool -- workspace name matches incremental search
-                       -> Bool -- workspace is the current one
-                       -> (String, String, String) -- workspace border, background color, and foreground color
-defaultWorkspaceColors False False False = ("#101010","#050505","#202020")
-defaultWorkspaceColors False False  True = ("#101010","#050505","#202020")
-defaultWorkspaceColors False  True False = ("#404040","#202020","#b0b0b0")
-defaultWorkspaceColors False  True  True = ("#101010","#050505","#505050")
-defaultWorkspaceColors  True     _ False = ("#808020","#404010","#f0f0b0")
-defaultWorkspaceColors  True     _  True = ("#404010","#202005","#909050")
-
-
-defaultWindowColors :: Bool -- window's workspace has focus
-                    -> Bool -- window's workspace name matches incremental search
-                    -> Bool -- window's workspace the current one
-                    -> Bool -- window is urgent
-                    -> Bool -- window has focus
-                    -> (String, String) -- window border and background color
-
-defaultWindowColors   wsf     m     c     u  True = ("#802020", snd $ defaultWindowColors wsf m c u False)
-
-defaultWindowColors False False False False     _ = ("#111111","#060606")
-defaultWindowColors False False False  True     _ = ("#802020","#401010")
-defaultWindowColors False False  True False     _ = ("#101010","#050505")
-defaultWindowColors False False  True  True     _ = ("#401010","#200505")
-defaultWindowColors False  True False False     _ = ("#202080","#101040")
-defaultWindowColors False  True False  True     _ = ("#802080","#401040")
-defaultWindowColors False  True  True False     _ = ("#101040","#100520")
-defaultWindowColors False  True  True  True     _ = ("#401040","#200520")
-
-defaultWindowColors  True False False False     _ = ("#208020","#104010")
-defaultWindowColors  True False False  True     _ = ("#808020","#404010")
-defaultWindowColors  True False  True False     _ = ("#104010","#052005")
-defaultWindowColors  True False  True  True     _ = ("#404010","#202005")
-defaultWindowColors  True  True False False     _ = ("#208080","#104040")
-defaultWindowColors  True  True False  True     _ = ("#808080","#404040")
-defaultWindowColors  True  True  True False     _ = ("#104040","#102020")
-defaultWindowColors  True  True  True  True     _ = ("#404040","#202020")
-
-
-pagerPaint ::
-  PagerConfig
-  -> RhombusConfig
-  -> Display
-  -> Drawable
-  -> GC
-  -> WorkspaceId
-  -> Rectangle
-  -> Bool
-  -> Bool
-  -> Bool
-  -> X ()
-pagerPaint pc rc d p gc t r focus match current = do
-    ss <- gets windowset
-
-    let x = rect_x r
-        y = rect_y r
-
-    urgents <- readUrgents
-    let foci = map W.focus $ catMaybes $ map W.stack $ W.workspaces ss
-
-    let color = pc_windowColors pc focus match current -- :: Bool -> (String, String)
-        (_, _, _fg_color) = pc_workspaceColors pc focus match current
-
-    fg_color <- stringToPixel d _fg_color
-
-    let r = screenRect $ W.screenDetail $ W.current ss
-    let a = fi (rect_width r) / fi (rect_height r)
-    let scale = fi (rc_cellwidth rc) / fi (rect_width r)
-
-    -- TODO whenNothing print error
-    whenJust (findWorkspace t ss) $ \ ws -> do
-        whenJust (W.stack ws) $ \ s ->
-            withDisplay $ \ d -> io $ do
-
-                let color' w = color (w `elem` urgents) (w `elem` foci)
-
-                -- TODO painting of floating windows is broken
-                mapM_ (drawMiniWindow d p gc x y color' scale) (W.down s)
-                drawMiniWindow d p gc x y color' scale (W.focus s)
-                mapM_ (drawMiniWindow d p gc x y color' scale) (W.up s)
-
-drawMiniWindow
-    :: RealFrac a
-    => Display
-    -> Drawable
-    -> GC
-    -> Position
-    -> Position
-    -> (Window -> (String, String))
-    -> a
-    -> Window
-    -> IO ()
-drawMiniWindow d p gc ox oy color s win = do
-    let scale x = round $ fi x * s
-
-    wa <- getWindowAttributes d win
-
-    let x = ox + (scale $ wa_x wa)
-        y = oy + (scale $ wa_y wa)
-        w = (scale $ wa_width wa)
-        h = (scale $ wa_height wa)
-
-    let (fg, bg) = color win
-
-    fg' <- stringToPixel d fg
-    bg' <- stringToPixel d bg
-
-    setForeground d gc bg'
-    fillRectangle d p gc (x + 1) (y + 1) (w - 2) (h - 2)
-
-    setForeground d gc fg'
-    drawLines d p gc
-        [ Point x y
-        , Point (fi w - 1) 0
-        , Point 0 (fi h - 2)
-        , Point (- fi w + 1) 0
-        , Point 0 (- fi h + 2)
-        ]
-        coordModePrevious
-
-
-
--- TODO externalize findWorkspace
-findWorkspace :: (Eq i) => i -> W.StackSet i l a sid sd -> Maybe (W.Workspace i l a)
-findWorkspace t ss = find ((==)t . W.tag) (W.workspaces ss)
diff --git a/tv/2configs/xserver/xmonad-tv/Util/Rhombus.hs b/tv/2configs/xserver/xmonad-tv/Util/Rhombus.hs
deleted file mode 100644
index 5f43cb2..0000000
--- a/tv/2configs/xserver/xmonad-tv/Util/Rhombus.hs
+++ /dev/null
@@ -1,370 +0,0 @@
-module Util.Rhombus
-    ( defaultRhombusConfig
-    , MatchMethod(..)
-    , rhombus
-    , RhombusConfig(..)
-    , RhombusState(..)
-    ) where
-
-import Control.Monad ( forM_, zipWithM_ )
-import Data.Char
-import Data.List
-import Data.Ord
-import Data.Map ( fromList )
-import Data.Maybe ( isJust, fromJust )
-import XMonad
-import XMonad.StackSet hiding ( filter )
-import XMonad.Util.Font
-import XMonad.Util.Image ( drawIcon )
-import XMonad.Util.XUtils
-
-import Util.Debunk
-import Util.Submap
-import Util.XUtils
-import Util.Font
-
-
-data MatchMethod = MatchInfix | MatchPrefix
-
-data RhombusConfig = RhombusConfig
-    { rc_font           :: String
-    , rc_cellwidth      :: Dimension
-    , rc_margin         :: Dimension
-    , rc_matchmethod    :: MatchMethod
-    , rc_wrap           :: Bool
-    , rc_colors         :: Bool -> Bool -> Bool -> (String, String, String)
-    , rc_paint          :: RhombusConfig -> Display -> Pixmap -> GC -> String -> Rectangle -> Bool -> Bool -> Bool -> X ()
-    }
-
-
--- TODO currently xft is broken
-defaultRhombusConfig = RhombusConfig "xft:Sans-8" 100 0 MatchInfix True stupidColors noPaint
-    where
-    stupidColors _ _ _ = ("red", "magenta", "yellow")
-    noPaint _ _ _ _ _ _ _ _ _ = return ()
-
-
-data RhombusState = RhombusState
-    { rs_window     :: Window
-    , rs_search     :: String
-    , rs_font       :: XMonadFont
-    , rs_focus      :: (Position, Position)
-    , rs_strings    :: [String]
-    }
-
-
-reachableCoords :: RhombusState -> [(Position, Position)]
-reachableCoords RhombusState{rs_strings=xs} = take (length xs) wave
-
-
-matchingReachableCoords :: RhombusConfig -> RhombusState -> [(Position, Position)]
-matchingReachableCoords rc rs =
-    snd $ unzip
-        $ filter (isXOf (rc_matchmethod rc) (rs_search rs) . fst)
-        $ zip (rs_strings rs) (reachableCoords rs)
-
-
-match :: MatchMethod -> String -> [String] -> Maybe String
-match m s ws = do
-    let cands = filter (isXOf m s) ws
-    if length cands == 1
-        then Just $ head cands
-        else Nothing
-
-rhombus :: RhombusConfig -> (String -> X ()) -> [String] -> X ()
-rhombus rc viewFunc as = withGrabbedKeyboard $ do
-    rs <- newRhombus rc as
-    --redraw rc rs
-    showWindow (rs_window rs)
-    rhombusMode viewFunc rc rs
-
-
-rhombusMode :: (String -> X ()) -> RhombusConfig -> RhombusState -> X ()
-rhombusMode viewFunc rc rs =
-    case match (rc_matchmethod rc) (rs_search rs) (init $ rs_strings rs) of
-        Nothing -> redraw rc rs >> submapString def keys
-        Just i -> removeRhombus rs >> viewFunc i
-    where
-    def (ch:[]) | isPrint ch =
-        incSearchPushChar ch rs >>= rhombusMode viewFunc rc
-
-    def _ =
-        failbeep >> rhombusMode viewFunc rc rs
-
-    keys = fromList $
-        [ ((0   , xK_BackSpace  ), incSearchPopChar rs >>= rhombusMode viewFunc rc)
-        , ((0   , xK_Escape     ), removeRhombus rs)
-        , ((0   , xK_Menu       ), removeRhombus rs)
-        , ((0   , xK_Left       ), goto rc (-1, 0) rs >>= rhombusMode viewFunc rc)
-        , ((0   , xK_Right      ), goto rc ( 1, 0) rs >>= rhombusMode viewFunc rc)
-        , ((0   , xK_Up         ), goto rc ( 0,-1) rs >>= rhombusMode viewFunc rc)
-        , ((0   , xK_Down       ), goto rc ( 0, 1) rs >>= rhombusMode viewFunc rc)
-        , ((0   , xK_Tab        ), gotoNextMatch rc rs >>= rhombusMode viewFunc rc)
-        , ((_S  , xK_Tab        ), gotoPrevMatch rc rs >>= rhombusMode viewFunc rc)
-        , ((0   , xK_Return     ), removeRhombus rs >> return (selectFocused rs) >>= viewFunc)
-        ]
-
-    _S = shiftMask
-
-
--- TODO make failbeep configurable
-failbeep = spawn "beep -l 100 -f 500"
-
-
-goto :: RhombusConfig -> (Position, Position) -> RhombusState -> X RhombusState
-goto RhombusConfig{rc_wrap=True}  xy rs = maybe (failbeep >> return rs) return $ wrapFocus xy rs
-goto RhombusConfig{rc_wrap=False} xy rs = maybe (failbeep >> return rs) return $ moveFocus xy rs
-
-
-moveFocus :: (Position, Position) -> RhombusState -> Maybe RhombusState
-moveFocus (dx, dy) rs@RhombusState{rs_focus=(x,y)} = do
-    let focus' = (x + dx, y + dy)
-    if elem focus' (reachableCoords rs)
-        then Just rs { rs_focus = focus' }
-        else Nothing
-
-
-wrapFocus :: (Position, Position) -> RhombusState -> Maybe RhombusState
-
-wrapFocus (0, dy) rs@RhombusState{rs_focus=focus} = do
-    let column = sortBy (comparing snd) $ filter ((==) (fst focus) . fst) (reachableCoords rs)
-    i <- elemIndex focus column
-    return rs { rs_focus = column `modIndex` (i + fromIntegral dy) }
-
-wrapFocus (dx, 0) rs@RhombusState{rs_focus=focus} = do
-    let column = sortBy (comparing fst) $ filter ((==) (snd focus) . snd) (reachableCoords rs)
-    i <- elemIndex focus column
-    return rs { rs_focus = column `modIndex` (i + fromIntegral dx) }
-
-wrapFocus _ _ = Nothing
-
-
-gotoPrevMatch :: RhombusConfig -> RhombusState -> X RhombusState
-gotoPrevMatch rc rs@RhombusState{rs_focus=focus} = do
-    case reverse (matchingReachableCoords rc rs) of
-        [] -> failbeep >> return rs
-        xs -> return rs
-            { rs_focus = maybe (head xs)
-                               (modIndex xs . (+1))
-                               (focus `elemIndex` xs)
-            }
-
-
-gotoNextMatch :: RhombusConfig -> RhombusState -> X RhombusState
-gotoNextMatch rc rs@RhombusState{rs_focus=focus} = do
-    case matchingReachableCoords rc rs of
-        [] -> failbeep >> return rs
-        xs -> return rs
-            { rs_focus = maybe (head xs)
-                               (modIndex xs . (+1))
-                               (focus `elemIndex` xs)
-            }
-
-
-selectFocused :: RhombusState -> String
-selectFocused rs =
-    -- TODO the rhombus must never "focus" something inexistent
-    fromJust $ lookup (rs_focus rs) $ zip wave (rs_strings rs)
-
-
-incSearchPushChar :: Char -> RhombusState -> X RhombusState
-incSearchPushChar c rs = return rs { rs_search = rs_search rs ++ [c] }
-
-
-incSearchPopChar :: RhombusState -> X RhombusState
-
--- only rubout if we have at least one char
-incSearchPopChar rs@RhombusState{rs_search=xs@(_:_)} =
-    return rs { rs_search = init xs }
-
-incSearchPopChar rs = return rs
-
-
-redraw :: RhombusConfig -> RhombusState -> X ()
-redraw rc rs = do
-    ss <- gets windowset
-
-    let Screen _ _ (SD (Rectangle _ _ s_width s_height)) = current ss
-
-    -- TODO this let is duplicated in newRhombus
-    let scale x = x * cell_w `div` s_width -- TODO use bw
-        cell_w  = rc_cellwidth rc
-        cell_h  = scale s_height
-
-        -- txy is the top-left corner of the first (center) cell
-        -- XXX div and (-) are not distributive
-        --     we could round $ (s_* - cell_*) / 2, though...
-        tx = fi $ s_width  `div` 2 - cell_w `div` 2
-        ty = fi $ s_height `div` 2 - cell_h `div` 2
-
-        margin = rc_margin rc
-
-        -- dxy are the outer cell dimensions (i.e. including the border)
-        dx = fi $ cell_w + 2 + margin
-        dy = fi $ cell_h + 2 + margin
-
-        paint = rc_paint rc
-        xmf   = rs_font rs
-        tags  = rs_strings rs
-        --currentTag = last tags
-
-    withDisplay $ \ d -> do
-        -- XXX we cannot use withPixmapAndGC because rc_paint is an X monad
-        p <- io $ createPixmap d (rs_window rs) s_width s_height (defaultDepthOfScreen $ defaultScreenOfDisplay d)
-        g <- io $ createGC d p
-
-        -- TODO fixme
-        color_black <- stringToPixel d "black"
-
-        forZipWithM_ tags (reachableCoords rs) $ \ tag oxy@(ox, oy) -> do
-
-            let focus   = oxy == rs_focus rs
-                match   = isXOf (rc_matchmethod rc) (rs_search rs) tag
-                current = tag == last tags
-                (_b_color, _bg_color, _fg_color) = rc_colors rc focus match current
-                --cell_x = (ox * dx) + x - fi (cell_w `div` 2)
-                --cell_y = (oy * dy) + y - fi (cell_h `div` 2)
-                cell_x = (ox * dx) + tx + 1
-                cell_y = (oy * dy) + ty + 1
-
-            b_color <- stringToPixel d _b_color
-            bg_color <- stringToPixel d _bg_color
-            fg_color <- stringToPixel d _fg_color
-
-            -- draw background
-            io $ setForeground d g bg_color
-            io $ fillRectangle d p g cell_x cell_y cell_w cell_h
-
-            -- draw border
-            io $ setForeground d g b_color
-            io $ drawLines d p g
-                    [ Point (cell_x - 1) (cell_y - 1)
-                    , Point (fi cell_w + 1) 0
-                    , Point 0 (fi cell_h + 1)
-                    , Point (-(fi cell_w + 1)) 0
-                    , Point 0 (-(fi cell_h + 1))
-                    ]
-                    coordModePrevious
-
-            -- custom draw
-            paint rc d p g tag (Rectangle cell_x cell_y cell_w cell_h) focus match current
-
-            -- paint text
-            -- TODO custom paint text?
-            -- TODO withCopyArea
-            io $ withPixmapAndGC d p s_width s_height (defaultDepthOfScreen $ defaultScreenOfDisplay d) $ \ f_pm f_gc -> do
-                withPixmapAndGC d f_pm s_width s_height 1 $ \ clip_mask clip_gc -> do
-                    setForeground d clip_gc 0
-                    setBackground d clip_gc 0
-                    fillRectangle d clip_mask clip_gc 0 0 s_width s_height
-                    setForeground d clip_gc 1
-
-                    let r = Rectangle cell_x cell_y cell_w cell_h
-
-                    printStringCentered d clip_mask xmf clip_gc r tag
-
-                    setForeground d f_gc fg_color
-                    setBackground d f_gc color_black -- TODO
-
-                    printStringCentered d f_pm xmf f_gc r tag
-
-                    setClipMask d f_gc clip_mask
-
-                    copyArea d f_pm p f_gc 0 0 s_width s_height 0 0
-
-        io $ copyArea d p (rs_window rs) g 0 0 s_width s_height 0 0
-        io $ freePixmap d p
-        io $ freeGC d g
-
-
-newRhombus :: RhombusConfig -> [String] -> X RhombusState
-newRhombus rc tags = do
-    ss <- gets windowset
-
-    let Screen _ _ (SD (Rectangle _ _ s_width s_height)) = current ss
-        (_, def_win_bg, _) = rc_colors rc False True False
-
-    -- TODO this let is duplicated in redraw
-    let scale x = x * cell_w `div` s_width -- TODO use bw
-        cell_w  = rc_cellwidth rc
-        cell_h  = scale s_height
-
-        -- TODO don't delete this let but use it instead of s_{width,height}
-        -- (xcoords, ycoords) = unzip $ take (length tags) wave -- this is reachableCoords
-        -- win_width  = (maximum xcoords - minimum xcoords) * dx
-        -- win_height = (maximum ycoords - minimum ycoords) * dy
-
-        -- txy is the top-left corner of the first (center) cell
-        -- XXX div and (-) are not distributive
-        --     we could round $ (s_* - cell_*) / 2, though...
-        tx = fi $ s_width  `div` 2 - cell_w `div` 2
-        ty = fi $ s_height `div` 2 - cell_h `div` 2
-
-        margin = rc_margin rc
-
-        -- dxy are the outer cell dimensions (i.e. including the border)
-        dx = fi $ cell_w + 2 + margin
-        dy = fi $ cell_h + 2 + margin
-
-    fn <- initXMF (rc_font rc)
-    win <- createNewWindow (Rectangle 0 0 s_width s_height) Nothing def_win_bg True
-
-    withDisplay $ \ d ->
-        io $ shapeWindow d win $ \ p g ->
-            forZipWithM_ tags wave $ \ _ (ox, oy) ->
-                fillRectangle d p g (tx + ox * dx) (ty + oy * dy) (fi cell_w + 2) (fi cell_h + 2)
-
-    return $ RhombusState win "" fn (0,0) tags
-
-
-removeRhombus :: RhombusState -> X ()
-removeRhombus (RhombusState w _ fn _ _) = do
-    deleteWindow w
-    releaseXMF fn
-
-wave :: [(Position, Position)]
-wave = zip (0:(concat $ map (\i -> [0..i]++[i-1,i-2..1] ++ [0,-1..(-i)]++[-i,-i+1..(-1)]) [1..])) (concat $ map (\i -> [0..i]++[i-1,i-2..1] ++ [0,-1..(-i)]++[-i+1,-i+2..(-1)]) [1..])
-    where
-        wave1 = 0:(concat $ map (\i -> [0..i]++[i-1,i-2..1] ++ [0,-1..(-i)]++[-i,-i+1..(-1)]) [1..])
-        wave2 = concat $ map (\i -> [0..i]++[i-1,i-2..1] ++ [0,-1..(-i)]++[-i+1,-i+2..(-1)]) [1..]
-
-commonPrefix (x:xs) (y:ys) | x == y = x:commonPrefix xs ys
-commonPrefix _ _ = []
-
-
-isXOf :: MatchMethod -> String -> String -> Bool
-isXOf MatchInfix  = isInfixOf
-isXOf MatchPrefix = isPrefixOf
-
-
-findXIndex :: (Eq a) => MatchMethod -> [a] -> [a] -> Maybe Int
-findXIndex MatchInfix  = findInfixIndex
-findXIndex MatchPrefix = findPrefixIndex
-
-
-findInfixIndex :: (Eq a) => [a] -> [a] -> Maybe Int
-findInfixIndex needle haystack
-    = (\x -> if null x then Nothing else Just (fst $ head x))
-      . dropWhile (\(_,x) -> not $ isPrefixOf needle x)
-        $ zip [0..] (tails haystack)
-
-
-findPrefixIndex :: (Eq a) => [a] -> [a] -> Maybe Int
-findPrefixIndex needle haystack =
-    if isPrefixOf needle haystack
-        then Just 0
-        else Nothing
-
-
-modIndex :: Integral i => [a] -> i -> a
-modIndex xs i = xs `genericIndex` (i `mod` genericLength xs)
-
-
-forZipWithM_ a b f = zipWithM_ f a b
-
-
-withGrabbedKeyboard f = do
-    XConf { theRoot = root, display = d } <- ask
-    catchX (io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime) >> f)
-           (return ())
-    io $ ungrabKeyboard d currentTime
diff --git a/tv/2configs/xserver/xmonad-tv/Util/Submap.hs b/tv/2configs/xserver/xmonad-tv/Util/Submap.hs
deleted file mode 100644
index b09b97c..0000000
--- a/tv/2configs/xserver/xmonad-tv/Util/Submap.hs
+++ /dev/null
@@ -1,31 +0,0 @@
--- This module is based on Jason Creighton's XMonad.Actions.Submap
-
-module Util.Submap
-    ( submapString
-    ) where
-
-import Data.Bits
-import XMonad hiding (keys)
-import qualified Data.Map as M
-import Control.Monad.Fix (fix)
-
-
--- | Like 'XMonad.Actions.Submap.submapDefault', but provides the looked up string to the default action.
-submapString :: (String -> X ()) -> M.Map (KeyMask, KeySym) (X ()) -> X ()
-submapString def keys = do
-    XConf { theRoot = root, display = d } <- ask
-
-    (m, s, str) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
-        maskEvent d keyPressMask p
-        KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
-        keysym <- keycodeToKeysym d code 0
-        if isModifierKey keysym
-            then nextkey
-            else do
-                (mbKeysym, str) <- lookupString (asKeyEvent p)
-                return (m, keysym, str)
-
-    -- Remove num lock mask and Xkb group state bits
-    m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
-
-    maybe (def str) id (M.lookup (m', s) keys)
diff --git a/tv/2configs/xserver/xmonad-tv/Util/XUtils.hs b/tv/2configs/xserver/xmonad-tv/Util/XUtils.hs
deleted file mode 100644
index de1d824..0000000
--- a/tv/2configs/xserver/xmonad-tv/Util/XUtils.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-module Util.XUtils
-    ( shapeWindow
-    , withGC
-    , withPixmap
-    , withPixmapAndGC
-    ) where
-
-import Control.Exception ( bracket )
-import Foreign.C.Types ( CInt )
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xshape
-
-
-shapeWindow :: Display -> Window -> (Pixmap -> GC -> IO ()) -> IO ()
-shapeWindow d w f = do
-    wa <- getWindowAttributes d w
-
-    let width = fromIntegral $ wa_width wa
-        height = fromIntegral $ wa_height wa
-
-    withPixmapAndGC d w width height 1 $ \ p g -> do
-
-        setForeground d g 0
-        fillRectangle d p g 0 0 width height
-
-        setForeground d g 1
-
-        f p g
-
-        xshapeCombineMask d w shapeBounding 0 0 p shapeSet
-
-
-withGC :: Display -> Drawable -> (GC -> IO ()) -> IO ()
-withGC d p =
-    bracket (createGC d p) (freeGC d)
-
-
-withPixmap :: Display -> Drawable -> Dimension -> Dimension -> CInt -> (Pixmap -> IO ()) -> IO ()
-withPixmap d p w h depth =
-    bracket (createPixmap d p w h depth) (freePixmap d)
-
-
-withPixmapAndGC :: Display -> Drawable -> Dimension -> Dimension -> CInt -> (Pixmap -> GC -> IO ()) -> IO ()
-withPixmapAndGC d w width height depth f =
-    withPixmap d w width height depth $ \ p ->
-        withGC d p $ \ g -> f p g
diff --git a/tv/2configs/xserver/xmonad-tv/default.nix b/tv/2configs/xserver/xmonad-tv/default.nix
deleted file mode 100644
index f0cb8e0..0000000
--- a/tv/2configs/xserver/xmonad-tv/default.nix
+++ /dev/null
@@ -1 +0,0 @@
-import ./xmonad-tv.nix
diff --git a/tv/2configs/xserver/xmonad-tv/xmonad-tv.cabal b/tv/2configs/xserver/xmonad-tv/xmonad-tv.cabal
deleted file mode 100644
index 72494ab..0000000
--- a/tv/2configs/xserver/xmonad-tv/xmonad-tv.cabal
+++ /dev/null
@@ -1,19 +0,0 @@
-Author: tv
-Build-Type: Simple
-Cabal-Version: >= 1.2
-License: MIT
-Name: xmonad-tv
-Version: 0
-
-Executable xmonad
-  Build-Depends:
-    base,
-    containers,
-    filepath,
-    scanner,
-    X11,
-    X11-xshape,
-    xmonad,
-    xmonad-contrib
-  GHC-Options: -Wall -O3 -threaded -rtsopts
-  Main-Is: Main.hs
diff --git a/tv/2configs/xserver/xmonad/Main.hs b/tv/2configs/xserver/xmonad/Main.hs
new file mode 100644
index 0000000..a298d72
--- /dev/null
+++ b/tv/2configs/xserver/xmonad/Main.hs
@@ -0,0 +1,277 @@
+{-# LANGUAGE DeriveDataTypeable #-} -- for XS
+
+
+module Main where
+
+import XMonad
+import XMonad.Prompt (defaultXPConfig)
+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 Util.Pager
+import Util.Rhombus
+import Util.Debunk
+
+
+--data MyState = MyState deriving Typeable
+
+myTerm :: String
+myTerm = "urxvtc"
+
+myRootTerm :: String
+myRootTerm = "XENVIRONMENT=\"$HOME/.Xdefaults/root-urxvt\" urxvtc -e su -"
+
+-- TODO execRootTerm = exec (shlex "urxvtc -e su -")
+--    [ ("XENVIRONMENT", HOME ++ "/.Xdefaults/root-urxvt") ]
+
+
+myFont :: String
+myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
+
+main :: IO ()
+main = do
+    -- TODO exec (shlex "xrdb -merge" ++ [HOME ++ "/.Xresources"])
+    -- TODO exec (shlex "xsetroot -solid '#1c1c1c'")
+    --spawn "xrdb -merge \"$HOME/.Xresources\""
+    --spawn "xsetroot -solid '#1c1c1c'"
+    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 ")
+        $ defaultConfig
+            { terminal          = myTerm
+            , modMask           = mod4Mask
+            , keys              = myKeys
+            , workspaces        =
+                [ "Dashboard" -- we start here
+                , "23"
+                , "cr"
+                , "ff"
+                , "hack"
+                , "im"
+                , "mail"
+                , "zalora", "zjournal", "zskype"
+                ]
+            , layoutHook        = smartBorders $ myLayout
+            -- , handleEventHook   = myHandleEventHooks <+> handleTimerEvent
+            --, handleEventHook   = handleTimerEvent
+            , manageHook        = placeHook (smart (1,0)) <+> floatNextHook
+            , startupHook       = spawn "echo emit XMonadStartup"
+            , normalBorderColor  = "#1c1c1c"
+            , focusedBorderColor = "#f000b0"
+            }
+  where
+    myLayout =
+        (onWorkspace "im" $ reflectVert $ Mirror $ Tall 1 (3/100) (12/13))
+        (FixedColumn 1 20 80 10 ||| Full)
+
+
+spawnTermAt :: String -> X ()
+--spawnTermAt _ = floatNext True >> spawn myTerm
+--spawnTermAt "ff" = floatNext True >> spawn myTerm
+spawnTermAt _    = spawn myTerm
+
+
+
+--jojo w = withDisplay $ \d -> liftIO $ do
+--    wa <- getWindowAttributes d w
+--    printToErrors (wa_width wa, wa_height wa, wa_x wa, wa_y wa)
+
+    --sh <- getWMNormalHints d w
+    --bw <- fmap (fi . wa_border_width) $ getWindowAttributes d w
+    --return $ applySizeHints bw sh
+
+
+--data WindowDetails = WindowDetails
+--    { wd_name :: Maybe String
+--    , wd_rect :: Rectangle
+--    } deriving (Show)
+
+-- urxvtc
+--  -title sets {,_NET_}WM_NAME but not WM_CLASS and {,_NET_}WM_ICON_NAME       res: title
+--  -name sets all                                                              res: 
+--mySpawn cmd = do
+--    p <- xfork $ executeFile "/run/current-system/sw/bin/urxvtc" False [] Nothing
+--    liftIO $ printToErrors $ (cmd, p)
+
+
+myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
+myKeys conf = Map.fromList $
+    [ ((_4C , xK_Delete ), spawn "make -C $HOME/.xmonad reload")
+    , ((_4  , xK_Escape ), spawn "/var/setuid-wrappers/slock")
+    , ((_4S , xK_c      ), kill)
+
+    , ((_4  , xK_x      ), chooseAction spawnTermAt)
+    , ((_4C , xK_x      ), spawn myRootTerm)
+    --, ((_4M , xK_x      ), spawn "xterm")
+    --, ((_4M , xK_x      ), mySpawn "xterm")
+
+    --, ((_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 . printToErrors) ["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 defaultXPConfig)
+    , ((_4  , xK_r      ), renameWorkspace defaultXPConfig)
+    , ((_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 })
+    ]
+    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
+
+
+pagerConfig :: PagerConfig
+pagerConfig = defaultPagerConfig
+    { 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 def = defaultWindowColors wsf m c u wf
+        if m == False && wf == True
+            then ("#402020", snd def)
+            else def
+
+horseConfig :: RhombusConfig
+horseConfig = defaultRhombusConfig
+    { 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 = defaultGSConfig
+    { gs_cellheight = 20
+    , gs_cellwidth = 192
+    , gs_cellpadding = 5
+    , gs_font = myFont
+    , gs_navigate = navNSearch
+    }
+
+-- wsGSConfig = defaultGSConfig
+--     { 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
+--    navNSearchDefaultHandler (_,s,_) = do
+--        transformSearchString (++ s)
+--        nav
+
+
+(&) :: 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]
+
+-- vim:set fdm=marker:
diff --git a/tv/2configs/xserver/xmonad/Util/Debunk.hs b/tv/2configs/xserver/xmonad/Util/Debunk.hs
new file mode 100644
index 0000000..b4772e5
--- /dev/null
+++ b/tv/2configs/xserver/xmonad/Util/Debunk.hs
@@ -0,0 +1,16 @@
+module Util.Debunk
+    ( printToErrors
+    ) where
+
+import XMonad
+import System.FilePath ( (</>) )
+import Control.Exception ( bracket )
+import System.IO ( hPrint, stderr, openFile, hClose, IOMode( AppendMode ) )
+
+
+printToErrors x = do
+    dir <- getXMonadDir
+    let base = dir </> "xmonad"
+        err  = base ++ ".errors"
+    bracket (openFile err AppendMode) hClose $ \h -> hPrint h x
+
diff --git a/tv/2configs/xserver/xmonad/Util/Font.hs b/tv/2configs/xserver/xmonad/Util/Font.hs
new file mode 100644
index 0000000..5352cf5
--- /dev/null
+++ b/tv/2configs/xserver/xmonad/Util/Font.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE CPP #-}
+module Util.Font
+    ( printStringCentered
+    , printStringXMF'
+    ) where
+
+import XMonad
+import XMonad.Util.Font
+
+
+printStringCentered :: (Functor m, MonadIO m)
+                    => Display -> Drawable -> XMonadFont
+                    -> GC -> Rectangle -> String
+                    -> m ()
+printStringCentered d p xmf gc r s = do
+    let x = rect_x r
+        y = rect_y r
+        w = rect_width r
+        h = rect_height r
+
+    text_w <- textWidthXMF d xmf s
+    (text_ascent, _) <- textExtentsXMF xmf s
+
+    let text_x = x + round ((fi w - fi text_w) / 2)
+        text_y = y + round ((fi h + fi text_h) / 2)
+        text_h = text_ascent
+
+    printStringXMF' d p xmf gc "" "" text_x text_y s
+
+
+-- from xmonad-contrib's XMonad.Util.Font, (c) 2007 Andrea Rossato and Spencer Janssen
+printStringXMF' :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
+            -> Position -> Position -> String  -> m ()
+printStringXMF' d p (Core fs) gc fc bc x y s = io $ do
+    setFont d gc $ fontFromFontStruct fs
+    --tv [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
+    --tv setForeground d gc fc'
+    --tv setBackground d gc bc'
+    drawImageString d p gc x y s
+printStringXMF' d p (Utf8 fs) gc fc bc x y s = io $ do
+    --tv [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
+    --tv setForeground d gc fc'
+    --tv setBackground d gc bc'
+    io $ wcDrawImageString d p fs gc x y s
+#ifdef XFT
+printStringXMF' dpy drw fs@(Xft font) gc fc bc x y s = do
+  let screen   = defaultScreenOfDisplay dpy
+      colormap = defaultColormapOfScreen screen
+      visual   = defaultVisualOfScreen screen
+  --tv bcolor <- stringToPixel dpy bc
+  (a,d)  <- textExtentsXMF fs s
+  gi <- io $ xftTextExtents dpy font s
+  --tv io $ setForeground dpy gc bcolor
+  io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))
+                                (y - fi a)
+                                (fi $ xglyphinfo_xOff gi)
+                                (fi $ a + d)
+  io $ withXftDraw dpy drw visual colormap $
+         \draw -> withXftColorName dpy visual colormap fc $
+                   \color -> xftDrawString draw color font x y s
+#endif
+
+
+
+
+
+-- --my_printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
+-- --            -> Position -> Position -> String  -> m ()
+-- my_printStringXMF (Core fs) d p gc x y s = do
+--     setFont d gc $ fontFromFontStruct fs
+--     -- [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
+--     -- setForeground d gc fc'
+--     -- setBackground d gc bc'
+--     drawImageString d p gc x y s
+-- my_printStringXMF (Utf8 fs) d p gc x y s = do
+--     -- [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
+--     -- setForeground d gc fc'
+--     -- setBackground d gc bc'
+--     wcDrawImageString d p fs gc x y s
+-- #ifdef XFT
+-- my_printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do
+--   let screen   = defaultScreenOfDisplay dpy
+--       colormap = defaultColormapOfScreen screen
+--       visual   = defaultVisualOfScreen screen
+--   bcolor <- stringToPixel dpy bc
+--   (a,d)  <- textExtentsXMF fs s
+--   gi <- io $ xftTextExtents dpy font s
+--   io $ setForeground dpy gc bcolor
+--   io $ fillRectangle dpy drw gc (x - fromIntegral (xglyphinfo_x gi))
+--                                 (y - fromIntegral a)
+--                                 (fromIntegral $ xglyphinfo_xOff gi)
+--                                 (fromIntegral $ a + d)
+--   io $ withXftDraw dpy drw visual colormap $
+--          \draw -> withXftColorName dpy visual colormap fc $
+--                    \color -> xftDrawString draw color font x y s
+-- #endif
+
+
+
+-- --textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
+-- my_textWidthXMF _   (Utf8 fs) s = return $ fromIntegral $ wcTextEscapement fs s
+-- my_textWidthXMF _   (Core fs) s = return $ fromIntegral $ textWidth fs s
+-- #ifdef XFT
+-- my_TextWidthXMF dpy (Xft xftdraw) s = liftIO $ do
+--     gi <- xftTextExtents dpy xftdraw s
+--     return $ xglyphinfo_xOff gi
+-- #endif
+-- 
+-- my_textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)
+-- my_textExtentsXMF (Utf8 fs) s = do
+--   let (_,rl)  = wcTextExtents fs s
+--       ascent  = fromIntegral $ - (rect_y rl)
+--       descent = fromIntegral $ rect_height rl + (fromIntegral $ rect_y rl)
+--   return (ascent, descent)
+-- my_textExtentsXMF (Core fs) s = do
+--   let (_,a,d,_) = textExtents fs s
+--   return (a,d)
+-- #ifdef XFT
+-- my_textExtentsXMF (Xft xftfont) _ = io $ do
+--   ascent  <- fromIntegral `fmap` xftfont_ascent  xftfont
+--   descent <- fromIntegral `fmap` xftfont_descent xftfont
+--   return (ascent, descent)
+-- #endif
diff --git a/tv/2configs/xserver/xmonad/Util/Pager.hs b/tv/2configs/xserver/xmonad/Util/Pager.hs
new file mode 100644
index 0000000..b8168b5
--- /dev/null
+++ b/tv/2configs/xserver/xmonad/Util/Pager.hs
@@ -0,0 +1,172 @@
+module Util.Pager
+    ( defa