diff options
-rw-r--r-- | default.nix | 36 | ||||
-rw-r--r-- | krebs/4lib/default.nix | 9 | ||||
-rw-r--r-- | krebs/4lib/git.nix | 42 | ||||
-rw-r--r-- | krebs/5pkgs/git-hooks/default.nix | 168 | ||||
-rw-r--r-- | krebs/5pkgs/haskell-overrides/xmonad-stockholm.nix | 16 | ||||
-rw-r--r-- | tv/1systems/mkdir.nix | 1 | ||||
-rw-r--r-- | tv/1systems/xu.nix | 1 | ||||
-rw-r--r-- | tv/2configs/default.nix | 14 | ||||
-rw-r--r-- | tv/2configs/git.nix | 22 | ||||
-rw-r--r-- | tv/2configs/vim.nix | 4 | ||||
-rw-r--r-- | tv/4lib/default.nix | 11 | ||||
-rw-r--r-- | tv/4lib/git.nix | 202 | ||||
-rw-r--r-- | tv/4lib/modules.nix | 21 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/Main.hs | 6 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/Util/Font.hs | 123 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/Util/Pager.hs | 172 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/Util/Rhombus.hs | 369 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/Util/Shutdown.hs | 53 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/Util/Submap.hs | 31 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/Util/XUtils.hs | 47 | ||||
-rw-r--r-- | tv/5pkgs/xmonad-tv/xmonad.cabal | 6 |
21 files changed, 285 insertions, 1069 deletions
diff --git a/default.nix b/default.nix index c001b8c1..1637aa46 100644 --- a/default.nix +++ b/default.nix @@ -13,40 +13,36 @@ let stockholm = { krebs = import ./krebs (args // { inherit lib stockholm; }); - lib = - let - lib = import <nixpkgs/lib>; - klib = import ./krebs/4lib { inherit lib; }; - #ulib = import (./. + "/${current-user-name}/4lib") { lib = lib // klib; }; - ulib = {}; # TODO - in - builtins // lib // klib // ulib // rec { - # TODO move this stuff + lib = let + nlib = import <nixpkgs/lib>; + klib = import (slib.kpath "4lib") { lib = nlib; }; + slib = rec { stockholm-path = ./.; nspath = ns: p: stockholm-path + "/${ns}/${p}"; + kpath = nspath "krebs"; + upath = nspath current-user-name; }; + ulib = let p = slib.upath "4lib"; in + nlib.optionalAttrs (klib.dir.has-default-nix p) + (import p { lib = nlib // klib; }); + in nlib // klib // slib // ulib // builtins; inherit (eval {}) pkgs; - kpath = lib.nspath "krebs"; - upath = lib.nspath current-user-name; - base-module = { config, ... }: { imports = builtins.filter lib.dir.has-default-nix (lib.concatLists [ - (map (f: f "2configs") [ upath ]) - (map (f: f "3modules") [ kpath upath ]) + (map (f: f "2configs") [ lib.upath ]) + (map (f: f "3modules") [ lib.kpath lib.upath ]) ]); krebs.current.enable = true; krebs.current.host = config.krebs.hosts.${current-host-name}; krebs.current.user = config.krebs.users.${current-user-name}; - nixpkgs.config.packageOverrides = pkgs: - let - kpkgs = import (kpath "5pkgs") { inherit lib pkgs; }; - upkgs = import (upath "5pkgs") { inherit lib; pkgs = pkgs // kpkgs; }; - in - kpkgs // upkgs; + nixpkgs.config.packageOverrides = pkgs: let + kpkgs = import (lib.kpath "5pkgs") { inherit lib pkgs; }; + upkgs = import (lib.upath "5pkgs") { inherit lib; pkgs = pkgs // kpkgs; }; + in kpkgs // upkgs; }; eval = config: import <nixpkgs/nixos/lib/eval-config.nix> { diff --git a/krebs/4lib/default.nix b/krebs/4lib/default.nix index f907fe87..1cabeae2 100644 --- a/krebs/4lib/default.nix +++ b/krebs/4lib/default.nix @@ -3,7 +3,7 @@ with builtins; with lib; -rec { +let out = rec { eq = x: y: x == y; @@ -17,6 +17,7 @@ rec { dir.has-default-nix = path: pathExists (path + "/default.nix"); dns = import ./dns.nix { inherit lib; }; + git = import ./git.nix { lib = lib // out; }; listset = import ./listset.nix { inherit lib; }; shell = import ./shell.nix { inherit lib; }; tree = import ./tree.nix { inherit lib; }; @@ -30,4 +31,8 @@ rec { subdirsOf = path: mapAttrs (name: _: path + "/${name}") (filterAttrs (_: eq "directory") (readDir path)); -} + + mapAttrValues = f: mapAttrs (_: f); + setAttr = name: value: set: set // { ${name} = value; }; + +}; in out diff --git a/krebs/4lib/git.nix b/krebs/4lib/git.nix new file mode 100644 index 00000000..d50ba201 --- /dev/null +++ b/krebs/4lib/git.nix @@ -0,0 +1,42 @@ +{ lib, ... }: + +let + inherit (lib) addNames escapeShellArg makeSearchPath optionalString; + + commands = addNames { + git-receive-pack = {}; + git-upload-pack = {}; + }; + + receive-modes = addNames { + fast-forward = {}; + non-fast-forward = {}; + create = {}; + delete = {}; + merge = {}; # TODO implement in git.nix + }; + + permissions = { + fetch = { + allow-commands = [ + commands.git-upload-pack + ]; + }; + + push = ref: extra-modes: { + allow-commands = [ + commands.git-receive-pack + commands.git-upload-pack + ]; + allow-receive-ref = ref; + allow-receive-modes = [ receive-modes.fast-forward ] ++ extra-modes; + }; + }; + + refs = { + master = "refs/heads/master"; + all-heads = "refs/heads/*"; + }; + +in +commands // receive-modes // permissions // refs diff --git a/krebs/5pkgs/git-hooks/default.nix b/krebs/5pkgs/git-hooks/default.nix new file mode 100644 index 00000000..5697c31b --- /dev/null +++ b/krebs/5pkgs/git-hooks/default.nix @@ -0,0 +1,168 @@ +{ lib, pkgs, ... }: + +with lib; + +let + out = { + inherit irc-announce; + }; + + # TODO irc-announce should return a derivation + irc-announce = { nick, channel, server, port ? 6667, verbose ? false }: '' + #! /bin/sh + set -euf + + export PATH=${makeSearchPath "bin" (with pkgs; [ + coreutils + git + gnused + ])} + + green() { printf '\x0303,99%s\x0F' "$1"; } + red() { printf '\x0304,99%s\x0F' "$1"; } + orange() { printf '\x0307,99%s\x0F' "$1"; } + pink() { printf '\x0313,99%s\x0F' "$1"; } + gray() { printf '\x0314,99%s\x0F' "$1"; } + + unset message + add_message() { + message="''${message+$message + }$*" + } + + nick=${escapeShellArg nick} + channel=${escapeShellArg channel} + server=${escapeShellArg server} + port=${toString port} + + host=$nick + cgit_endpoint=http://cgit.$host + + empty=0000000000000000000000000000000000000000 + + while read oldrev newrev ref; do + + if [ $oldrev = $empty ]; then + receive_mode=create + elif [ $newrev = $empty ]; then + receive_mode=delete + elif [ "$(git merge-base $oldrev $newrev)" = $oldrev ]; then + receive_mode=fast-forward + else + receive_mode=non-fast-forward + fi + + h=$(echo $ref | sed 's:^refs/heads/::') + + # empty_tree=$(git hash-object -t tree /dev/null) + empty_tree=4b825dc6 + + id=$(echo $newrev | cut -b-7) + id2=$(echo $oldrev | cut -b-7) + if [ $newrev = $empty ]; then id=$empty_tree; fi + if [ $oldrev = $empty ]; then id2=$empty_tree; fi + + case $receive_mode in + create) + link="$cgit_endpoint/$GIT_SSH_REPO/?h=$h" + ;; + delete) + link="$cgit_endpoint/$GIT_SSH_REPO/ ($h)" + ;; + fast-forward|non-fast-forward) + link="$cgit_endpoint/$GIT_SSH_REPO/diff/?h=$h&id=$id&id2=$id2" + ;; + esac + + #$host $GIT_SSH_REPO $ref $link + add_message $(pink push) $link $(gray "($receive_mode)") + + ${optionalString verbose '' + add_message "$( + git log \ + --format="$(orange %h) %s $(gray '(%ar)')" \ + --reverse \ + $id2..$id + + git diff --stat $id2..$id \ + | sed '$!s/\(+*\)\(-*\)$/'$(green '\1')$(red '\2')'/' + )" + ''} + + done + + if test -n "''${message-}"; then + exec ${irc-announce-script} \ + "$server" \ + "$port" \ + "$nick" \ + "$channel" \ + "$message" + fi + ''; + + irc-announce-script = pkgs.writeScript "irc-announce-script" '' + #! /bin/sh + set -euf + + export PATH=${makeSearchPath "bin" (with pkgs; [ + coreutils + gawk + gnused + netcat + nettools + ])} + + IRC_SERVER=$1 + IRC_PORT=$2 + IRC_NICK=$3$$ + IRC_CHANNEL=$4 + message=$5 + + export IRC_CHANNEL # for privmsg_cat + + # echo2 and cat2 are used output to both, stdout and stderr + # This is used to see what we send to the irc server. (debug output) + echo2() { echo "$*"; echo "$*" >&2; } + cat2() { tee /dev/stderr; } + + # privmsg_cat transforms stdin to a privmsg + privmsg_cat() { awk '{ print "PRIVMSG "ENVIRON["IRC_CHANNEL"]" :"$0 }'; } + + # ircin is used to feed the output of netcat back to the "irc client" + # so we can implement expect-like behavior with sed^_^ + # XXX mkselfdestructingtmpfifo would be nice instead of this cruft + tmpdir="$(mktemp -d irc-announce_XXXXXXXX)" + cd "$tmpdir" + mkfifo ircin + trap " + rm ircin + cd '$OLDPWD' + rmdir '$tmpdir' + trap - EXIT INT QUIT + " EXIT INT QUIT + + { + echo2 "USER $LOGNAME 0 * :$LOGNAME@$(hostname)" + echo2 "NICK $IRC_NICK" + + # wait for MODE message + sed -n '/^:[^ ]* MODE /q' + + echo2 "JOIN $IRC_CHANNEL" + + printf '%s' "$message" \ + | privmsg_cat \ + | cat2 + + echo2 "PART $IRC_CHANNEL" + + # wait for PART confirmation + sed -n '/:'"$IRC_NICK"'![^ ]* PART /q' + + echo2 'QUIT :Gone to have lunch' + } < ircin \ + | nc "$IRC_SERVER" "$IRC_PORT" | tee -a ircin + ''; + +in out diff --git a/krebs/5pkgs/haskell-overrides/xmonad-stockholm.nix b/krebs/5pkgs/haskell-overrides/xmonad-stockholm.nix new file mode 100644 index 00000000..5c6f068e --- /dev/null +++ b/krebs/5pkgs/haskell-overrides/xmonad-stockholm.nix @@ -0,0 +1,16 @@ +{ mkDerivation, base, containers, fetchgit, stdenv, X11, X11-xshape +, xmonad, xmonad-contrib +}: +mkDerivation { + pname = "xmonad-stockholm"; + version = "1.0.0"; + src = fetchgit { + url = "http://cgit.cd/xmonad-stockholm"; + sha256 = "35dda5d16acc90af94ae2fae10ab5cc2d5b450c3f1ff2e7f515ac53877269abf"; + rev = "2dbefe42fc5cfe9093465bf3e22ba8f82feeef6e"; + }; + libraryHaskellDepends = [ + base containers X11 X11-xshape xmonad xmonad-contrib + ]; + license = stdenv.lib.licenses.mit; +} diff --git a/tv/1systems/mkdir.nix b/tv/1systems/mkdir.nix index 6ae4f80e..9d8a0bcf 100644 --- a/tv/1systems/mkdir.nix +++ b/tv/1systems/mkdir.nix @@ -17,7 +17,6 @@ in { krebs.build.host = config.krebs.hosts.mkdir; - krebs.build.target = "root@${primary-addr4}"; imports = [ diff --git a/tv/1systems/xu.nix b/tv/1systems/xu.nix index 1a9dddb5..94656ab6 100644 --- a/tv/1systems/xu.nix +++ b/tv/1systems/xu.nix @@ -212,7 +212,6 @@ with lib; security.setuidPrograms = [ "sendmail" # for cron - #"slock" ]; services.printing.enable = true; diff --git a/tv/2configs/default.nix b/tv/2configs/default.nix index 6ed1c65f..3400c13b 100644 --- a/tv/2configs/default.nix +++ b/tv/2configs/default.nix @@ -88,6 +88,12 @@ with lib; ls = "ls -h --color=auto --group-directories-first"; dmesg = "dmesg -L --reltime"; view = "vim -R"; + + reload = "systemctl reload"; + restart = "systemctl restart"; + start = "systemctl start"; + status = "systemctl status"; + stop = "systemctl stop"; }; environment.variables = { @@ -167,5 +173,13 @@ with lib; "sendmail" # for sudo ]; } + { + systemd.tmpfiles.rules = let + forUsers = flip map users; + isUser = { group, ... }: hasSuffix "users" group; + users = filter isUser (mapAttrsToList (_: id) config.users.users); + in forUsers (u: "d /run/xdg/${u.name} 0700 ${u.name} ${u.group} -"); + environment.variables.XDG_RUNTIME_DIR = "/run/xdg/$LOGNAME"; + } ]; } diff --git a/tv/2configs/git.nix b/tv/2configs/git.nix index 2520da17..4387be36 100644 --- a/tv/2configs/git.nix +++ b/tv/2configs/git.nix @@ -1,6 +1,7 @@ { config, lib, pkgs, ... }: -with import ../4lib { inherit lib pkgs; }; +with lib; + let out = { @@ -20,26 +21,22 @@ let rules = concatMap make-rules (attrValues repos); public-repos = mapAttrs make-public-repo ({ + } // mapAttrValues (setAttr "section" "1. Miscellaneous") { cac = { desc = "CloudAtCost command line interface"; }; - cgserver = {}; - crude-mail-setup = {}; - dot-xmonad = {}; get = {}; hack = {}; load-env = {}; make-snapshot = {}; much = {}; - nixos-infest = {}; nixpkgs = {}; - painload = {}; push = {}; regfish = {}; stockholm = { desc = "take all the computers hostage, they'll love you!"; }; - } // mapAttrs (_: repo: repo // { section = "Haskell libraries"; }) { + } // mapAttrValues (setAttr "section" "2. Haskell libraries") { blessings = {}; mime = {}; quipper = {}; @@ -47,6 +44,13 @@ let wai-middleware-time = {}; web-routes-wai-custom = {}; xintmap = {}; + xmonad-stockholm = {}; + } // mapAttrValues (setAttr "section" "3. Museum") { + cgserver = {}; + crude-mail-setup = {}; + dot-xmonad = {}; + nixos-infest = {}; + painload = {}; }); restricted-repos = mapAttrs make-restricted-repo ( @@ -63,7 +67,7 @@ let inherit name desc section; public = true; hooks = { - post-receive = git.irc-announce { + post-receive = pkgs.git-hooks.irc-announce { # TODO make nick = config.krebs.build.host.name the default nick = config.krebs.build.host.name; channel = "#retiolum"; @@ -82,7 +86,7 @@ let with git // config.krebs.users; repo: singleton { - user = tv; + user = [ tv tv_xu ]; repo = [ repo ]; perm = push "refs/*" [ non-fast-forward create delete merge ]; } ++ diff --git a/tv/2configs/vim.nix b/tv/2configs/vim.nix index 04b1480c..0822fb5b 100644 --- a/tv/2configs/vim.nix +++ b/tv/2configs/vim.nix @@ -64,6 +64,10 @@ let \ | hi TrailingSpace ctermbg=88 \ | hi Normal ctermfg=White + au BufRead,BufNewFile *.hs so ${pkgs.writeText "hs.vim" '' + syn region String start=+\[[^|]*|+ end=+|]+ + ''} + au BufRead,BufNewFile *.nix so ${pkgs.writeText "nix.vim" '' setf nix set isk=@,48-57,_,192-255,-,' diff --git a/tv/4lib/default.nix b/tv/4lib/default.nix deleted file mode 100644 index c099eb73..00000000 --- a/tv/4lib/default.nix +++ /dev/null @@ -1,11 +0,0 @@ -{ lib, pkgs, ... }: - -lib // rec { - - git = import ./git.nix { - inherit lib pkgs; - }; - - # TODO deprecate shell-escape for lass - shell-escape = lib.shell.escape; -} diff --git a/tv/4lib/git.nix b/tv/4lib/git.nix deleted file mode 100644 index d8827115..00000000 --- a/tv/4lib/git.nix +++ /dev/null @@ -1,202 +0,0 @@ -{ lib, pkgs, ... }: - -let - inherit (lib) addNames escapeShellArg makeSearchPath optionalString; - - commands = addNames { - git-receive-pack = {}; - git-upload-pack = {}; - }; - - receive-modes = addNames { - fast-forward = {}; - non-fast-forward = {}; - create = {}; - delete = {}; - merge = {}; # TODO implement in git.nix - }; - - permissions = { - fetch = { - allow-commands = [ - commands.git-upload-pack - ]; - }; - - push = ref: extra-modes: { - allow-commands = [ - commands.git-receive-pack - commands.git-upload-pack - ]; - allow-receive-ref = ref; - allow-receive-modes = [ receive-modes.fast-forward ] ++ extra-modes; - }; - }; - - refs = { - master = "refs/heads/master"; - all-heads = "refs/heads/*"; - }; - - irc-announce-script = pkgs.writeScript "irc-announce-script" '' - #! /bin/sh - set -euf - - export PATH=${makeSearchPath "bin" (with pkgs; [ - coreutils - gawk - gnused - netcat - nettools - ])} - - IRC_SERVER=$1 - IRC_PORT=$2 - IRC_NICK=$3$$ - IRC_CHANNEL=$4 - message=$5 - - export IRC_CHANNEL # for privmsg_cat - - # echo2 and cat2 are used output to both, stdout and stderr - # This is used to see what we send to the irc server. (debug output) - echo2() { echo "$*"; echo "$*" >&2; } - cat2() { tee /dev/stderr; } - - # privmsg_cat transforms stdin to a privmsg - privmsg_cat() { awk '{ print "PRIVMSG "ENVIRON["IRC_CHANNEL"]" :"$0 }'; } - - # ircin is used to feed the output of netcat back to the "irc client" - # so we can implement expect-like behavior with sed^_^ - # XXX mkselfdestructingtmpfifo would be nice instead of this cruft - tmpdir="$(mktemp -d irc-announce_XXXXXXXX)" - cd "$tmpdir" - mkfifo ircin - trap " - rm ircin - cd '$OLDPWD' - rmdir '$tmpdir' - trap - EXIT INT QUIT - " EXIT INT QUIT - - { - echo2 "USER $LOGNAME 0 * :$LOGNAME@$(hostname)" - echo2 "NICK $IRC_NICK" - - # wait for MODE message - sed -n '/^:[^ ]* MODE /q' - - echo2 "JOIN $IRC_CHANNEL" - - printf '%s' "$message" \ - | privmsg_cat \ - | cat2 - - echo2 "PART $IRC_CHANNEL" - - # wait for PART confirmation - sed -n '/:'"$IRC_NICK"'![^ ]* PART /q' - - echo2 'QUIT :Gone to have lunch' - } < ircin \ - | nc "$IRC_SERVER" "$IRC_PORT" | tee -a ircin - ''; - - hooks = { - # TODO make this a package? - irc-announce = { nick, channel, server, port ? 6667, verbose ? false }: '' - #! /bin/sh - set -euf - - export PATH=${makeSearchPath "bin" (with pkgs; [ - coreutils - git - gnused - ])} - - green() { printf '\x0303,99%s\x0F' "$1"; } - red() { printf '\x0304,99%s\x0F' "$1"; } - orange() { printf '\x0307,99%s\x0F' "$1"; } - pink() { printf '\x0313,99%s\x0F' "$1"; } - gray() { printf '\x0314,99%s\x0F' "$1"; } - - unset message - add_message() { - message="''${message+$message - }$*" - } - - nick=${escapeShellArg nick} - channel=${escapeShellArg channel} - server=${escapeShellArg server} - port=${toString port} - - host=$nick - cgit_endpoint=http://cgit.$host - - empty=0000000000000000000000000000000000000000 - - while read oldrev newrev ref; do - - if [ $oldrev = $empty ]; then - receive_mode=create - elif [ $newrev = $empty ]; then - receive_mode=delete - elif [ "$(git merge-base $oldrev $newrev)" = $oldrev ]; then - receive_mode=fast-forward - else - receive_mode=non-fast-forward - fi - - h=$(echo $ref | sed 's:^refs/heads/::') - - # empty_tree=$(git hash-object -t tree /dev/null) - empty_tree=4b825dc6 - - id=$(echo $newrev | cut -b-7) - id2=$(echo $oldrev | cut -b-7) - if [ $newrev = $empty ]; then id=$empty_tree; fi - if [ $oldrev = $empty ]; then id2=$empty_tree; fi - - case $receive_mode in - create) - link="$cgit_endpoint/$GIT_SSH_REPO/?h=$h" - ;; - delete) - link="$cgit_endpoint/$GIT_SSH_REPO/ ($h)" - ;; - fast-forward|non-fast-forward) - link="$cgit_endpoint/$GIT_SSH_REPO/diff/?h=$h&id=$id&id2=$id2" - ;; - esac - - #$host $GIT_SSH_REPO $ref $link - add_message $(pink push) $link $(gray "($receive_mode)") - - ${optionalString verbose '' - add_message "$( - git log \ - --format="$(orange %h) %s $(gray '(%ar)')" \ - --reverse \ - $id2..$id - - git diff --stat $id2..$id \ - | sed '$!s/\(+*\)\(-*\)$/'$(green '\1')$(red '\2')'/' - )" - ''} - - done - - if test -n "''${message-}"; then - exec ${irc-announce-script} \ - "$server" \ - "$port" \ - "$nick" \ - "$channel" \ - "$message" - fi - ''; - }; - -in -commands // receive-modes // permissions // refs // hooks diff --git a/tv/4lib/modules.nix b/tv/4lib/modules.nix deleted file mode 100644 index 248e638e..00000000 --- a/tv/4lib/modules.nix +++ /dev/null @@ -1,21 +0,0 @@ -let - pkgs = import <nixpkgs> {}; - inherit (pkgs.lib) concatMap hasAttr; -in rec { - - no-touch-args = { - config = throw "no-touch-args: can't touch config!"; - lib = throw "no-touch-args: can't touch lib!"; - pkgs = throw "no-touch-args: can't touch pkgs!"; - }; - - # list-imports : path -> [path] - # Return a module's transitive list of imports. - # XXX duplicates won't get eliminated from the result. - list-imports = path: - let module = import path no-touch-args; - imports = if hasAttr "imports" module - then concatMap list-imports module.imports - else []; - in [path] ++ imports; -} diff --git a/tv/5pkgs/xmonad-tv/Main.hs b/tv/5pkgs/xmonad-tv/Main.hs index 2cc48efa..2258b34a 100644 --- a/tv/5pkgs/xmonad-tv/Main.hs +++ b/tv/5pkgs/xmonad-tv/Main.hs @@ -35,9 +35,9 @@ import XMonad.Layout.PerWorkspace (onWorkspace) --import XMonad.Layout.BinarySpacePartition --import XMonad.Actions.Submap -import Util.Pager -import Util.Rhombus -import Util.Shutdown +import XMonad.Stockholm.Pager +import XMonad.Stockholm.Rhombus +import XMonad.Stockholm.Shutdown myTerm :: String diff --git a/tv/5pkgs/xmonad-tv/Util/Font.hs b/tv/5pkgs/xmonad-tv/Util/Font.hs deleted file mode 100644 index 5352cf5a..00000000 --- a/tv/5pkgs/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/5pkgs/xmonad-tv/Util/Pager.hs b/tv/5pkgs/xmonad-tv/Util/Pager.hs deleted file mode 100644 index b8168b5b..00000000 --- a/tv/5pkgs/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, Str |