Merge remote-tracking branch 'cd/master'
This commit is contained in:
makefu
commit
c62885a0bc
55
default.nix
55
default.nix
@ -1,19 +1,3 @@
|
||||
# Welcome to the top-level default.nix of stockholm.
|
||||
#
|
||||
# You can discover the whole thing easily using the `get` utility,
|
||||
# which can be found at http://cgit.cd.krebsco.de/get/tree/get
|
||||
# To install `get` on any Nix-enabled system, use:
|
||||
#
|
||||
# nix-env -f /path/to/stockholm -iA pkgs.get
|
||||
#
|
||||
# The "current" arguments are used to provide information about the user who's
|
||||
# evaluating this file. This information is used to determine which user
|
||||
# namespace is to be used. Of course there's nothing trying to prevent you
|
||||
# from forging this information. E.g. you could try to generate the deployment
|
||||
# script for some random user's system, targeting some random host:
|
||||
#
|
||||
# LOGNAME=tv get krebs.deploy system=nomic target=8.8.8.8
|
||||
#
|
||||
{ current-date ? abort "current-date not defined"
|
||||
, current-host-name ? abort "current-host-name not defined"
|
||||
, current-user-name ? builtins.getEnv "LOGNAME"
|
||||
@ -21,29 +5,8 @@
|
||||
}@args:
|
||||
|
||||
let stockholm = {
|
||||
# The generated scripts to deploy (or infest) systems can be found in the
|
||||
# `krebs` attribute. There's also an init script, but it's in its early
|
||||
# stages, not well integrated and mostly useless at the moment. :)
|
||||
#
|
||||
# You'll also find lib here, which is nixpkgs/lib + krebs lib, but nobody
|
||||
# is really accessing this directly, as this lib gets reexported below.
|
||||
inherit krebs;
|
||||
|
||||
# All systems of all users can be found here.
|
||||
#
|
||||
# /!\ Please note that `get users.${user-name}.${host-name}.system` is a
|
||||
# bad idea because it will produce vast amounts of output. These are the
|
||||
# actual and complete system derivations that can be installed on the
|
||||
# respective host.
|
||||
#
|
||||
# Another thing to notice here is that other user's systems might not be
|
||||
# evaluable because of missing secrets. If you _are_ able to evaluate
|
||||
# another user's system, then you probably share a similar naming scheme
|
||||
# for your secret files! :)
|
||||
inherit users;
|
||||
|
||||
# Additionally, output lib and pkgs for easy access from the shell.
|
||||
# Notice how we're evaluating just the base module to obtain pkgs.
|
||||
inherit lib;
|
||||
inherit pkgs;
|
||||
};
|
||||
@ -65,32 +28,20 @@ let stockholm = {
|
||||
|
||||
inherit (eval {}) pkgs;
|
||||
|
||||
# Path resolvers for common and individual files.
|
||||
# Example: `upath "3modules"` produces the current user's 3modules directory
|
||||
kpath = lib.nspath "krebs";
|
||||
upath = lib.nspath current-user-name;
|
||||
|
||||
# This is the base module. Its purpose is to provide modules and
|
||||
# packages, both common ones, found in krebs/ as well as the current user's,
|
||||
# found in the user's namespace.
|
||||
base-module = {
|
||||
imports = map (f: f "3modules") [ kpath upath ];
|
||||
|
||||
nixpkgs.config.packageOverrides = pkgs:
|
||||
let
|
||||
# Notice the ordering. Krebs packages can only depend on Nixpkgs,
|
||||
# whereas user packages additionally can depend on krebs packages.
|
||||
kpkgs = import (kpath "5pkgs") { inherit lib pkgs; };
|
||||
upkgs = import (upath "5pkgs") { inherit lib; pkgs = pkgs // kpkgs; };
|
||||
in
|
||||
kpkgs // upkgs;
|
||||
};
|
||||
|
||||
# The above base module is used together with a NixOS configuration to
|
||||
# produce a system. Notice how stockholm really just provides additional
|
||||
# packages and modules on top of NixOS. Some of this stuff might become
|
||||
# useful to a broader audience, at which point it should probably be merged
|
||||
# and pull-requested for inclusion into NixOS/nixpkgs.
|
||||
eval = config: import <nixpkgs/nixos/lib/eval-config.nix> {
|
||||
specialArgs = {
|
||||
inherit lib;
|
||||
@ -101,10 +52,6 @@ let stockholm = {
|
||||
];
|
||||
};
|
||||
|
||||
# Any top-level directory other than krebs/ is considered to be a user
|
||||
# namespace, configuring a bunch of systems.
|
||||
# Have a look at the definition of install in krebs/default.nix to see how
|
||||
# nix-env is using this attribute set to obtain the system to be installed.
|
||||
# TODO move user namespaces' to users/, so no exception for krebs/ is needed
|
||||
users =
|
||||
lib.mapAttrs
|
||||
@ -113,8 +60,6 @@ let stockholm = {
|
||||
(n: t: !lib.hasPrefix "." n && t == "directory" && n != "krebs")
|
||||
(builtins.readDir ./.));
|
||||
|
||||
# Given a path to a user namespace, provide an attribute of evaluated
|
||||
# system configurations, keyed by system names (AKA host names).
|
||||
eval-all-systems = path:
|
||||
lib.mapAttrs'
|
||||
(n: _: (lib.nameValuePair (lib.removeSuffix ".nix" n)
|
||||
|
||||
@ -21,6 +21,7 @@ let
|
||||
bdt_pressemitteilungen|http://bundestag.de/service/rss/Bundestag_Presse.rss|#news #bundestag
|
||||
bdt_wd|http://bundestag.de/service/rss/Bundestag_WD.rss|#news #bundestag
|
||||
bitcoinpakistan|https://bitcoinspakistan.com/feed/|#news #financial
|
||||
c|http://www.tempolimit-lichtgeschwindigkeit.de/news.xml|#news
|
||||
cancer|http://feeds.feedburner.com/ncinewsreleases?format=xml|#news
|
||||
carta|http://feeds2.feedburner.com/carta-standard-rss|#news
|
||||
catholic_news|http://feeds.feedburner.com/catholicnewsagency/dailynews|#news
|
||||
|
||||
@ -29,8 +29,7 @@ with lib;
|
||||
#../2configs/consul-client.nix
|
||||
../2configs/git.nix
|
||||
../2configs/mail-client.nix
|
||||
../2configs/xserver.nix
|
||||
../2configs/synaptics.nix # TODO w110er if xserver is enabled
|
||||
../2configs/xserver
|
||||
../2configs/test.nix
|
||||
{
|
||||
environment.systemPackages = with pkgs; [
|
||||
@ -41,12 +40,6 @@ with lib;
|
||||
hashPassword
|
||||
lentil
|
||||
parallel
|
||||
(pkgs.writeScriptBin "ff" ''
|
||||
#! ${pkgs.bash}/bin/bash
|
||||
exec sudo -u ff -i <<EOF
|
||||
exec ${pkgs.firefoxWrapper}/bin/firefox $(printf " %q" "$@")
|
||||
EOF
|
||||
'')
|
||||
(pkgs.writeScriptBin "im" ''
|
||||
#! ${pkgs.bash}/bin/bash
|
||||
export PATH=${makeSearchPath "bin" (with pkgs; [
|
||||
@ -70,6 +63,7 @@ with lib;
|
||||
bind # dig
|
||||
cac
|
||||
dic
|
||||
ff
|
||||
file
|
||||
get
|
||||
gitAndTools.qgit
|
||||
|
||||
@ -153,10 +153,9 @@ in
|
||||
}
|
||||
|
||||
{
|
||||
nixpkgs.config.packageOverrides = pkgs:
|
||||
{
|
||||
nano = pkgs.runCommand "empty" {} "mkdir -p $out";
|
||||
};
|
||||
nixpkgs.config.packageOverrides = pkgs: {
|
||||
nano = pkgs.vim;
|
||||
};
|
||||
|
||||
services.cron.enable = false;
|
||||
services.nscd.enable = false;
|
||||
|
||||
@ -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"
|
||||
'';
|
||||
};
|
||||
}
|
||||
@ -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
|
||||
];
|
||||
};
|
||||
}
|
||||
|
||||
@ -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;
|
||||
}
|
||||
215
tv/2configs/xserver/Xresources.nix
Normal file
215
tv/2configs/xserver/Xresources.nix
Normal file
@ -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
|
||||
''
|
||||
126
tv/2configs/xserver/default.nix
Normal file
126
tv/2configs/xserver/default.nix
Normal file
@ -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
|
||||
277
tv/2configs/xserver/xmonad/Main.hs
Normal file
277
tv/2configs/xserver/xmonad/Main.hs
Normal file
@ -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:
|
||||
16
tv/2configs/xserver/xmonad/Util/Debunk.hs
Normal file
16
tv/2configs/xserver/xmonad/Util/Debunk.hs
Normal file
@ -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
|
||||
|
||||
123
tv/2configs/xserver/xmonad/Util/Font.hs
Normal file
123
tv/2configs/xserver/xmonad/Util/Font.hs
Normal file
@ -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
|
||||
172
tv/2configs/xserver/xmonad/Util/Pager.hs
Normal file
172
tv/2configs/xserver/xmonad/Util/Pager.hs
Normal file
@ -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_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)
|
||||
370
tv/2configs/xserver/xmonad/Util/Rhombus.hs
Normal file
370
tv/2configs/xserver/xmonad/Util/Rhombus.hs
Normal file
@ -0,0 +1,370 @@
|
||||
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
|
||||
31
tv/2configs/xserver/xmonad/Util/Submap.hs
Normal file
31
tv/2configs/xserver/xmonad/Util/Submap.hs
Normal file
@ -0,0 +1,31 @@
|
||||
-- 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)
|
||||
47
tv/2configs/xserver/xmonad/Util/XUtils.hs
Normal file
47
tv/2configs/xserver/xmonad/Util/XUtils.hs
Normal file
@ -0,0 +1,47 @@
|
||||
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
|
||||
18
tv/2configs/xserver/xmonad/xmonad.cabal
Normal file
18
tv/2configs/xserver/xmonad/xmonad.cabal
Normal file
@ -0,0 +1,18 @@
|
||||
Author: tv
|
||||
Build-Type: Simple
|
||||
Cabal-Version: >= 1.2
|
||||
License: MIT
|
||||
Name: xmonad-tv
|
||||
Version: 0
|
||||
|
||||
Executable xmonad
|
||||
Build-Depends:
|
||||
base,
|
||||
containers,
|
||||
filepath,
|
||||
X11,
|
||||
X11-xshape,
|
||||
xmonad,
|
||||
xmonad-contrib
|
||||
GHC-Options: -Wall -O3 -threaded -rtsopts
|
||||
Main-Is: Main.hs
|
||||
40
tv/2configs/xserver/xserver.conf.nix
Normal file
40
tv/2configs/xserver/xserver.conf.nix
Normal file
@ -0,0 +1,40 @@
|
||||
{ config, lib, pkgs, ... }:
|
||||
|
||||
with lib;
|
||||
|
||||
let
|
||||
cfg = config.services.xserver;
|
||||
in
|
||||
|
||||
pkgs.stdenv.mkDerivation {
|
||||
name = "xserver.conf";
|
||||
|
||||
xfs = optionalString (cfg.useXFS != false)
|
||||
''FontPath "${toString cfg.useXFS}"'';
|
||||
|
||||
inherit (cfg) config;
|
||||
|
||||
buildCommand =
|
||||
''
|
||||
echo 'Section "Files"' >> $out
|
||||
echo $xfs >> $out
|
||||
|
||||
for i in ${toString config.fonts.fonts}; do
|
||||
if test "''${i:0:''${#NIX_STORE}}" == "$NIX_STORE"; then
|
||||
for j in $(find $i -name fonts.dir); do
|
||||
echo " FontPath \"$(dirname $j)\"" >> $out
|
||||
done
|
||||
fi
|
||||
done
|
||||
|
||||
for i in $(find ${toString cfg.modules} -type d); do
|
||||
if test $(echo $i/*.so* | wc -w) -ne 0; then
|
||||
echo " ModulePath \"$i\"" >> $out
|
||||
fi
|
||||
done
|
||||
|
||||
echo 'EndSection' >> $out
|
||||
|
||||
echo "$config" >> $out
|
||||
'';
|
||||
}
|
||||
@ -1,9 +1,6 @@
|
||||
{ pkgs, ... }:
|
||||
|
||||
let
|
||||
inherit (pkgs) callPackage;
|
||||
in
|
||||
|
||||
{
|
||||
viljetic-pages = callPackage ./viljetic-pages {};
|
||||
ff = pkgs.callPackage ./ff {};
|
||||
viljetic-pages = pkgs.callPackage ./viljetic-pages {};
|
||||
}
|
||||
|
||||
8
tv/5pkgs/ff/default.nix
Normal file
8
tv/5pkgs/ff/default.nix
Normal file
@ -0,0 +1,8 @@
|
||||
{ pkgs, ... }:
|
||||
|
||||
pkgs.writeScriptBin "ff" ''
|
||||
#! ${pkgs.bash}/bin/bash
|
||||
exec sudo -u ff -i <<EOF
|
||||
exec ${pkgs.firefoxWrapper}/bin/firefox $(printf " %q" "$@")
|
||||
EOF
|
||||
''
|
||||
Loading…
Reference in New Issue
Block a user