summaryrefslogtreecommitdiffstats
path: root/tv/2configs/xserver
diff options
context:
space:
mode:
Diffstat (limited to 'tv/2configs/xserver')
-rw-r--r--tv/2configs/xserver/Xresources.nix215
-rw-r--r--tv/2configs/xserver/default.nix126
-rw-r--r--tv/2configs/xserver/xmonad/Main.hs277
-rw-r--r--tv/2configs/xserver/xmonad/Util/Debunk.hs16
-rw-r--r--tv/2configs/xserver/xmonad/Util/Font.hs123
-rw-r--r--tv/2configs/xserver/xmonad/Util/Pager.hs172
-rw-r--r--tv/2configs/xserver/xmonad/Util/Rhombus.hs370
-rw-r--r--tv/2configs/xserver/xmonad/Util/Submap.hs31
-rw-r--r--tv/2configs/xserver/xmonad/Util/XUtils.hs47
-rw-r--r--tv/2configs/xserver/xmonad/xmonad.cabal18
-rw-r--r--tv/2configs/xserver/xserver.conf.nix40
11 files changed, 1435 insertions, 0 deletions
diff --git a/tv/2configs/xserver/Xresources.nix b/tv/2configs/xserver/Xresources.nix
new file mode 100644
index 000000000..f287bf206
--- /dev/null
+++ b/tv/2configs/xserver/Xresources.nix
@@ -0,0 +1,215 @@
+{ config, lib, pkgs, ... }:
+
+with lib;
+
+pkgs.writeText "Xresources" ''
+ !URxvt*background: #050505
+
+ ! 2013-02-25 \e was reas escape before
+ ! *VT100.Translations: #override\
+ ! :<Btn4Down>: string("\e[5~")\n\
+ ! :<Btn5Down>: string("\e[6~")
+
+ ! XTerm*VT100*Translations: #override \
+ ! Shift<Key>Return: string(" &") string(0x0A) \n\
+ ! Meta<Key>Return: string(" | less") string(0x0A) \n\
+ ! ~Shift<Key>Prior: scroll-back(1,page) \n\
+ ! ~Shift<Key>Next: scroll-forw(1,page) \n\
+ ! Shift<Key>Prior: scroll-back(1) \n\
+ ! Shift<Key>Next: scroll-forw(1) \n\
+ ! <Key>Delete: string(0x1b) string("[2~")
+ ! \n\
+ ! <Key>BackSpace: string(0x7f)
+
+ ! 2013-02-2013-02-25
+ ! ! <M-c>: load bash-completion (if not already)
+ ! URxvt*VT100*Translations: #override\
+ ! Meta<KeyPress>c:\
+ ! string("\eOH# \eOF\n+compl\n\eOA\eOA\eOH\e[3~\e[3~\eOF")\
+ ! string(0x7)\n
+
+ ! do not scroll automatically on output:
+ ! XTerm*scrollTtyOutput: false
+ URxvt*cutchars: "\\`\"'&()*,;<=>?@[]^{|}‘’"
+ ! URxvt*secondaryScreen: false
+
+ ! URxvt*loginShell: true
+
+ URxvt*eightBitInput: false
+ ! *eightBitOutput: 1
+ ! URxvt*decTerminalID: 220
+ ! URxvt*utf8: 1
+ ! URxvt*locale: UTF-8
+ ! XTerm*customization: -color
+ URxvt*SaveLines: 4096
+ URxvt*font: -*-clean-*-*-*-*-*-*-*-*-*-*-iso10646-1
+ URxvt*boldFont: -*-clean-*-*-*-*-*-*-*-*-*-*-iso10646-1
+
+ ! 2013-05-23 if this does not work try
+ ! xset +fp /usr/share/fonts/local/
+ ! xset fp rehash
+ ! URxvt*font: -*-termsynu-edium-*-*-*-12-*-*-*-*-*-iso10646-1
+ ! URxvt*boldFont: -*-termsynu-bold-*-*-*-12-*-*-*-*-*-iso10646-1
+ !
+ !-misc-termsynu-medium-r-normal--12-87-100-100-c-70-iso10646-1
+
+ ! XTerm*font: -misc-fixed-medium-r-normal--13-120-75-75-c-80-iso10646-1
+ URxvt*scrollBar: false
+
+ ! XTerm*font:-nil-profont-medium-r-normal--11-110-72-72-c-60-iso8859-1
+ ! URxvt*boldFont:-nil-profont-medium-r-normal--11-110-72-72-c-60-iso8859-1
+
+ URxvt*background: #050505
+ ! URxvt*background: #041204
+
+ !URxvt.depth: 32
+ !URxvt*background: rgba:0500/0500/0500/cccc
+
+ ! URxvt*background: #080810
+ URxvt*foreground: #d0d7d0
+ ! URxvt*background: black
+ ! URxvt*foreground: white
+ ! URxvt*background: rgb:00/00/40
+ ! URxvt*foreground: rgb:a0/a0/d0
+ ! XTerm*cursorColor: rgb:00/00/60
+ URxvt*cursorColor: #f042b0
+ URxvt*cursorColor2: #f0b000
+ URxvt*cursorBlink: off
+ ! URxvt*cursorUnderline: true
+ ! URxvt*highlightColor: #232323
+ ! URxvt*highlightTextColor: #b0ffb0
+
+ URxvt*.pointerBlank: true
+ URxvt*.pointerBlankDelay: 987654321
+ URxvt*.pointerColor: #f042b0
+ URxvt*.pointerColor2: #050505
+
+ ! URxvt*fading: 50
+ ! URxvt*fadeColor: #0f0f0f
+
+ ! XTerm*colorMode: on
+ ! URxvt*dynamicColors: on
+ ! URxvt*boldColors: off
+
+ URxvt*jumpScroll: true
+
+ ! allow synthetic events for fvwm, so pass window specific keys
+ ! XTerm*allowSendEvents: true
+ URxvt*allowSendEvents: false
+
+ ! better double/tripple clicking in xterms
+ ! Format: csv, [low-]high:value
+ !
+ ! extend character class 48 due they are used in urls
+ ! (see: man xterm; /CHARACTER CLASSES)
+ ! ! % -./ @ & = ?
+ URxvt*charClass: 33:48,37:48,45-47:48,64:48,38:48,61:48,63:48
+ URxvt*cutNewline: False
+ URxvt*cutToBeginningOfLine: False
+
+ ! BLACK for indigo background
+ URxvt*color0: #232342
+
+ ! TODO: man xterm; /ACTIONS
+
+ ! *VT100*colorULMode: on
+ ! XTerm*underLine: on
+ !
+ ! URxvt*color0: black
+ ! URxvt*color1: red3
+ ! URxvt*color2: green3
+ ! URxvt*color3: yellow3
+ ! URxvt*color4: blue2
+ ! URxvt*color5: magenta3
+ ! URxvt*color6: cyan3
+ ! URxvt*color7: gray90
+ ! URxvt*color8: burlywood1
+ ! URxvt*color9: sienna1
+ ! URxvt*color10: PaleVioletRed1
+ ! URxvt*color11: LightSkyBlue
+ ! URxvt*color12: white
+ ! URxvt*color13: white
+ ! URxvt*color14: white
+ ! URxvt*color33: #f0b0f0
+
+
+ ! URxvt*color0: #000000
+ ! URxvt*color1: #c00000
+ ! URxvt*color2: #80c070
+ URxvt*color3: #c07000
+ ! URxvt*color4: #0000c0
+ URxvt*color4: #4040c0
+ ! URxvt*color5: #c000c0
+ ! URxvt*color6: #008080
+ URxvt*color7: #c0c0c0
+
+ URxvt*color8: #707070
+ URxvt*color9: #ff6060
+ URxvt*color10: #70ff70
+ URxvt*color11: #ffff70
+ URxvt*color12: #7070ff
+ URxvt*color13: #ff50ff
+ URxvt*color14: #70ffff
+ URxvt*color15: #ffffff
+
+ ! XTerm*color91: #000070
+ ! XTerm*color92: #000080
+ ! XTerm*color93: #000090
+ ! XTerm*color94: #0000a0
+ ! XTerm*color95: #0000b0
+ ! XTerm*color96: #0000c0
+ ! XTerm*color97: #0000d0
+ ! XTerm*color98: #0000e0
+ ! XTerm*color99: #0000f0
+
+ ! !! vim-create-colorscheme {{{
+ ! !! Question cterm=none
+ ! XTerm*color20: #f0b000
+ ! !! }}}
+ !
+ !
+ ! #include ".xrdb/look-zenburn.xrdb"
+ ! #include ".xrdb/xterm.xrdb"
+
+
+
+ ! URxvt.perl-ext: matcher
+ ! URxvt.urlLauncher: cr
+ ! URxvt.underlineColor: blue
+
+ ! URxvt.matcher.button: 1
+ ! URxvt.perl-ext: default,matcher
+ ! URxvt.urlLauncher: cr
+ ! URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
+ ! URxvt.underlineColor: blue
+
+ ! 2014-05-12 von lass
+ !URxvt.perl-ext-common: default,clipboard,url-select,keyboard-select
+ !URxvt.url-select.launcher: /home/tv/bin/ff -new-tab
+ !URxvt.url-select.underline: true
+ !URxvt.keysym.M-u: perl:url-select:select_next
+ !URxvt.keysym.M-Escape: perl:keyboard-select:activate
+ !URxvt.keysym.M-s: perl:keyboard-select:search
+
+
+
+
+ ! 2013-02-25 I neve use this
+ URxvt*iso14755: False
+
+ URxvt*urgentOnBell: True
+ URxvt*visualBell: True
+
+ ! ref https://github.com/muennich/urxvt-perls
+ URxvt*perl-ext: default,url-select
+ URxvt*keysym.M-u: perl:url-select:select_next
+ URxvt*url-select.launcher: ${pkgs.ff}/bin/ff -new-tab
+ URxvt*url-select.underline: true
+ URxvt*colorUL: #4682B4
+ URxvt.perl-lib: ${pkgs.urxvt_perls}/lib/urxvt/perl
+
+ root-urxvt*background: #230000
+ root-urxvt*foreground: #e0c0c0
+ root-urxvt*BorderColor: #400000
+ root-urxvt*color0: #800000
+''
diff --git a/tv/2configs/xserver/default.nix b/tv/2configs/xserver/default.nix
new file mode 100644
index 000000000..5d3372609
--- /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
+ ]}:/var/setuid-wrappers
+ 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/Main.hs b/tv/2configs/xserver/xmonad/Main.hs
new file mode 100644
index 000000000..cca2902a0
--- /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 = "urxvtc -name root-urxvt -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 000000000..b4772e582
--- /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 000000000..5352cf5ad
--- /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 000000000..b8168b5b0
--- /dev/null
+++ b/tv/2configs/xserver/xmonad/Util/Pager.hs
@@ -0,0 +1,172 @@
+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_