From 37e55957fbf411b928184465acb2b1ecd5ca6852 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 17 Jan 2025 22:20:56 +0100
Subject: mako
---
accounts/gkleen@sif/default.nix | 15 -
accounts/gkleen@sif/dunst-settings.nix | 45 -
accounts/gkleen@sif/dunstrc.d/00-urgency_low.conf | 4 -
.../gkleen@sif/dunstrc.d/01-urgency_normal.conf | 4 -
.../gkleen@sif/dunstrc.d/02-urgency_critical.conf | 4 -
accounts/gkleen@sif/dunstrc.d/10-brightness.conf | 5 -
.../gkleen@sif/dunstrc.d/10-pulseaudio-ctl.conf | 5 -
accounts/gkleen@sif/dunstrc.d/20-element.conf | 3 -
accounts/gkleen@sif/dunstrc.d/20-kitty.conf | 3 -
accounts/gkleen@sif/dunstrc.d/20-mail.conf | 3 -
accounts/gkleen@sif/dunstrc.d/20-zulip.conf | 3 -
accounts/gkleen@sif/niri/default.nix | 29 +-
accounts/gkleen@sif/niri/mako.nix | 28 +
accounts/gkleen@sif/niri/waybar.nix | 58 +-
accounts/gkleen@sif/systemd.nix | 9 -
accounts/gkleen@sif/taffybar/default.nix | 2 -
.../gkleen@sif/taffybar/gkleen-sif-taffybar.cabal | 32 -
.../taffybar/src/System/Taffybar/Widget/Clock.hs | 111 ---
.../src/System/Taffybar/Widget/TooltipBattery.hs | 101 ---
accounts/gkleen@sif/taffybar/src/taffybar.hs | 89 --
accounts/gkleen@sif/taffybar/taffybar.css | 146 ----
accounts/gkleen@sif/xmonad/.gitignore | 4 -
accounts/gkleen@sif/xmonad/default.nix | 7 -
accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs | 127 ---
.../gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs | 94 ---
.../gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs | 105 ---
.../gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs | 246 ------
accounts/gkleen@sif/xmonad/package.yaml | 31 -
accounts/gkleen@sif/xmonad/stack.nix | 17 -
accounts/gkleen@sif/xmonad/stack.yaml | 10 -
accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix | 21 -
accounts/gkleen@sif/xmonad/xmonad.hs | 939 ---------------------
32 files changed, 99 insertions(+), 2201 deletions(-)
delete mode 100644 accounts/gkleen@sif/dunst-settings.nix
delete mode 100644 accounts/gkleen@sif/dunstrc.d/00-urgency_low.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/01-urgency_normal.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/02-urgency_critical.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/10-brightness.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/10-pulseaudio-ctl.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/20-element.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/20-kitty.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/20-mail.conf
delete mode 100644 accounts/gkleen@sif/dunstrc.d/20-zulip.conf
create mode 100644 accounts/gkleen@sif/niri/mako.nix
delete mode 100644 accounts/gkleen@sif/taffybar/default.nix
delete mode 100644 accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal
delete mode 100644 accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs
delete mode 100644 accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs
delete mode 100644 accounts/gkleen@sif/taffybar/src/taffybar.hs
delete mode 100644 accounts/gkleen@sif/taffybar/taffybar.css
delete mode 100644 accounts/gkleen@sif/xmonad/.gitignore
delete mode 100644 accounts/gkleen@sif/xmonad/default.nix
delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs
delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs
delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs
delete mode 100644 accounts/gkleen@sif/xmonad/package.yaml
delete mode 100644 accounts/gkleen@sif/xmonad/stack.nix
delete mode 100644 accounts/gkleen@sif/xmonad/stack.yaml
delete mode 100644 accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix
delete mode 100644 accounts/gkleen@sif/xmonad/xmonad.hs
(limited to 'accounts/gkleen@sif')
diff --git a/accounts/gkleen@sif/default.nix b/accounts/gkleen@sif/default.nix
index bcfd1224..7d5a9c25 100644
--- a/accounts/gkleen@sif/default.nix
+++ b/accounts/gkleen@sif/default.nix
@@ -285,14 +285,6 @@ in {
};
services = {
- dunst = {
- settings = import ./dunst-settings.nix inputs;
- iconTheme = {
- package = pkgs.paper-icon-theme;
- name = "Paper";
- };
- enable = true;
- };
emacs = {
enable = true;
socketActivation.enable = true;
@@ -468,13 +460,6 @@ in {
};
xdg.configFile = {
- "dunst/dunstrc.d" = {
- source = ./dunstrc.d;
- recursive = true;
- onChange = ''
- ${pkgs.systemd}/bin/systemctl --user try-restart dunst
- '';
- };
"wireplumber" = {
source = ./wireplumber;
recursive = true;
diff --git a/accounts/gkleen@sif/dunst-settings.nix b/accounts/gkleen@sif/dunst-settings.nix
deleted file mode 100644
index 72687aea..00000000
--- a/accounts/gkleen@sif/dunst-settings.nix
+++ /dev/null
@@ -1,45 +0,0 @@
-{ pkgs, ... }:
-{
- global = {
- font = "Fira Sans 12";
- markup = "full";
- format = "<i>%s</i> %p\\n%b";
- alignment = "left";
- # geometry = "1216x10-32+64";
- width = 500;
- height = 100;
- offset = "4x4";
- origin = "top-right";
- shrink = true;
- monitor = 0;
- follow = "none";
- padding = 6;
- horizontal_padding = 6;
- separator_height = 1;
- separator_color = "frame";
- idle_threshold = 0;
-
- transparency = 10;
-
- frame_width = 1;
- frame_color = "#999999";
-
- word_wrap = true;
- show_age_threshold = 15;
- show_indicators = false;
- icon_position = "right";
- min_icon_size = 25;
- max_icon_size = 25;
- sort = false;
- sticky_history = false;
-
- dmenu = "fuzzel --dmenu";
- browser = "${pkgs.xdg-utils}/bin/xdg-open";
- };
- # shortcuts = {
- # close = "ctrl+space";
- # close_all = "ctrl+shift+space";
- # history = "ctrl+comma";
- # context = "ctrl+period";
- # };
-}
diff --git a/accounts/gkleen@sif/dunstrc.d/00-urgency_low.conf b/accounts/gkleen@sif/dunstrc.d/00-urgency_low.conf
deleted file mode 100644
index 98c94b64..00000000
--- a/accounts/gkleen@sif/dunstrc.d/00-urgency_low.conf
+++ /dev/null
@@ -1,4 +0,0 @@
-[urgency_low]
-background="#000000aa"
-foreground="#999999"
-timeout=5
\ No newline at end of file
diff --git a/accounts/gkleen@sif/dunstrc.d/01-urgency_normal.conf b/accounts/gkleen@sif/dunstrc.d/01-urgency_normal.conf
deleted file mode 100644
index f8fa8e2d..00000000
--- a/accounts/gkleen@sif/dunstrc.d/01-urgency_normal.conf
+++ /dev/null
@@ -1,4 +0,0 @@
-[urgency_normal]
-background="#000000aa"
-foreground="#ffffff"
-timeout=15
\ No newline at end of file
diff --git a/accounts/gkleen@sif/dunstrc.d/02-urgency_critical.conf b/accounts/gkleen@sif/dunstrc.d/02-urgency_critical.conf
deleted file mode 100644
index a08bf4b1..00000000
--- a/accounts/gkleen@sif/dunstrc.d/02-urgency_critical.conf
+++ /dev/null
@@ -1,4 +0,0 @@
-[urgency_critical]
-background="#900000aa"
-foreground="#ffffff"
-timeout=0
diff --git a/accounts/gkleen@sif/dunstrc.d/10-brightness.conf b/accounts/gkleen@sif/dunstrc.d/10-brightness.conf
deleted file mode 100644
index c54595ab..00000000
--- a/accounts/gkleen@sif/dunstrc.d/10-brightness.conf
+++ /dev/null
@@ -1,5 +0,0 @@
-[brightness]
-appname="brightness"
-set_stack_tag="brightness"
-set_transient=yes
-history_ignore=yes
diff --git a/accounts/gkleen@sif/dunstrc.d/10-pulseaudio-ctl.conf b/accounts/gkleen@sif/dunstrc.d/10-pulseaudio-ctl.conf
deleted file mode 100644
index 074f4535..00000000
--- a/accounts/gkleen@sif/dunstrc.d/10-pulseaudio-ctl.conf
+++ /dev/null
@@ -1,5 +0,0 @@
-[pulseaudio-ctl]
-body="Current is *"
-history_ignore=yes
-set_stack_tag="volume"
-summary="Volume *"
diff --git a/accounts/gkleen@sif/dunstrc.d/20-element.conf b/accounts/gkleen@sif/dunstrc.d/20-element.conf
deleted file mode 100644
index 5ff6031e..00000000
--- a/accounts/gkleen@sif/dunstrc.d/20-element.conf
+++ /dev/null
@@ -1,3 +0,0 @@
-[element-im]
-appname=Element
-timeout=0
\ No newline at end of file
diff --git a/accounts/gkleen@sif/dunstrc.d/20-kitty.conf b/accounts/gkleen@sif/dunstrc.d/20-kitty.conf
deleted file mode 100644
index b27ee27e..00000000
--- a/accounts/gkleen@sif/dunstrc.d/20-kitty.conf
+++ /dev/null
@@ -1,3 +0,0 @@
-[kitty]
-appname=kitty
-urgency=low
diff --git a/accounts/gkleen@sif/dunstrc.d/20-mail.conf b/accounts/gkleen@sif/dunstrc.d/20-mail.conf
deleted file mode 100644
index cb568e01..00000000
--- a/accounts/gkleen@sif/dunstrc.d/20-mail.conf
+++ /dev/null
@@ -1,3 +0,0 @@
-[element]
-appname="notmuch"
-timeout=0
\ No newline at end of file
diff --git a/accounts/gkleen@sif/dunstrc.d/20-zulip.conf b/accounts/gkleen@sif/dunstrc.d/20-zulip.conf
deleted file mode 100644
index d7fbd32c..00000000
--- a/accounts/gkleen@sif/dunstrc.d/20-zulip.conf
+++ /dev/null
@@ -1,3 +0,0 @@
-[zulip]
-appname="Zulip"
-timeout=0
\ No newline at end of file
diff --git a/accounts/gkleen@sif/niri/default.nix b/accounts/gkleen@sif/niri/default.nix
index 841c972a..cc6c85c3 100644
--- a/accounts/gkleen@sif/niri/default.nix
+++ b/accounts/gkleen@sif/niri/default.nix
@@ -4,7 +4,7 @@ let
terminal = lib.getExe config.programs.kitty.package;
lightctl = lib.getExe' config.services.avizo.package "lightctl";
volumectl = lib.getExe' config.services.avizo.package "volumectl";
- dunstctl = lib.getExe' config.services.dunst.package "dunstctl";
+ makoctl = lib.getExe' config.services.mako.package "makoctl";
loginctl = lib.getExe' hostConfig.systemd.package "loginctl";
systemctl = lib.getExe' hostConfig.systemd.package "systemctl";
@@ -121,6 +121,7 @@ let
in {
imports = [
./waybar.nix
+ ./mako.nix
];
config = {
@@ -244,13 +245,13 @@ in {
};
window-rules = [
- {
- geometry-corner-radius =
- let
- allCorners = r: { bottom-left = r; bottom-right = r; top-left = r; top-right = r; };
- in allCorners 4.;
- clip-to-geometry = true;
- }
+ # {
+ # geometry-corner-radius =
+ # let
+ # allCorners = r: { bottom-left = r; bottom-right = r; top-left = r; top-right = r; };
+ # in allCorners 4.;
+ # clip-to-geometry = true;
+ # }
{
matches = [ { app-id = "^com\.saivert\.pwvucontrol$"; } ];
open-on-workspace = "pwctl";
@@ -264,7 +265,7 @@ in {
excludes = [
{ title = "^Unlock Database.*"; }
{ title = "^Access Request.*"; }
- { title = "^Passkey credentials.*"; }
+ { title = ".*Passkey credentials$"; }
];
open-on-workspace = "kpxc";
open-focused = false;
@@ -273,7 +274,7 @@ in {
matches = [
{ app-id = "^org\.keepassxc\.KeePassXC$"; title = "^Unlock Database.*"; }
{ app-id = "^org\.keepassxc\.KeePassXC$"; title = "^Access Request.*"; }
- { app-id = "^org\.keepassxc\.KeePassXC$"; title = "^Passkey credentials.*"; }
+ { app-id = "^org\.keepassxc\.KeePassXC$"; title = ".*Passkey credentials$"; }
];
open-focused = true;
}
@@ -519,10 +520,10 @@ in {
allow-when-locked = true;
};
- "Mod+Semicolon".action = spawn dunstctl "close";
- "Mod+Shift+Semicolon".action = spawn dunstctl "close-all";
- "Mod+Period".action = spawn dunstctl "context";
- "Mod+Comma".action = spawn dunstctl "history-pop";
+ "Mod+Semicolon".action = spawn makoctl "dismiss";
+ "Mod+Shift+Semicolon".action = spawn makoctl "dismiss" "--all";
+ "Mod+Period".action = spawn makoctl (lib.getExe config.programs.fuzzel.package) "--dmenu";
+ "Mod+Comma".action = spawn makoctl "restore";
"Mod+Control+A".action = focus-or-spawn-action-app_id "com.saivert.pwvucontrol" "pwctl" "pwvucontrol";
"Mod+Control+P".action = focus-or-spawn-action-app_id "org.keepassxc.KeePassXC" "kpxc" "keepassxc";
diff --git a/accounts/gkleen@sif/niri/mako.nix b/accounts/gkleen@sif/niri/mako.nix
new file mode 100644
index 00000000..7e31f7e1
--- /dev/null
+++ b/accounts/gkleen@sif/niri/mako.nix
@@ -0,0 +1,28 @@
+{ config, lib, ... }:
+{
+ config = {
+ services.mako = {
+ enable = true;
+ font = "Fira Sans 10";
+ format = "<i>%s</i>\\n%b";
+ margin = "2";
+ maxVisible = -1;
+ backgroundColor = "#000000dd";
+ progressColor = "source #223544ff";
+ width = 384;
+ extraConfig = ''
+ outer-margin=1
+ max-history=100
+
+ [urgency=low]
+ text-color=#999999ff
+
+ [urgency=critical]
+ background-color=#900000dd
+
+ [mode=silent]
+ invisible=1
+ '';
+ };
+ };
+}
diff --git a/accounts/gkleen@sif/niri/waybar.nix b/accounts/gkleen@sif/niri/waybar.nix
index ff48ba83..26e76a1d 100644
--- a/accounts/gkleen@sif/niri/waybar.nix
+++ b/accounts/gkleen@sif/niri/waybar.nix
@@ -25,8 +25,58 @@
modules-right = [ # "custom/worktime" "custom/worktime-today"
"custom/weather"
"custom/keymap"
- "privacy" "tray" "wireplumber" "backlight" "battery" "idle_inhibitor" "clock" ];
+ "privacy" "tray" "wireplumber" "backlight" "battery" "idle_inhibitor" "custom/mako" "clock" ];
+ "custom/mako" = {
+ format = "{}";
+ return-type = "json";
+ exec = pkgs.writers.writePython3 "mako-silent" { libraries = [ pkgs.python3Packages.dbus-next ]; } ''
+ from dbus_next.aio import MessageBus
+
+ import asyncio
+
+ import json
+
+
+ loop = asyncio.new_event_loop()
+ asyncio.set_event_loop(loop)
+
+
+ async def main():
+ bus = await MessageBus().connect()
+ # the introspection xml would normally be included in your project, but
+ # this is convenient for development
+ introspection = await bus.introspect('org.freedesktop.Notifications', '/fr/emersion/Mako') # noqa: E501
+
+ obj = bus.get_proxy_object('org.freedesktop.Notifications', '/fr/emersion/Mako', introspection) # noqa: E501
+ mako = obj.get_interface('fr.emersion.Mako')
+ properties = obj.get_interface('org.freedesktop.DBus.Properties')
+
+ async def print_mode():
+ modes = await mako.get_modes()
+ is_silent = "silent" in modes
+ icon = "󰂛" if is_silent else "󰂚"
+ text = f"<span font=\"Symbols Nerd Font Mono\" size=\"90%\">{icon}</span>" # noqa: E501
+ if is_silent:
+ text = f"<span color=\"#ffffff\">{text}</span>"
+ print(json.dumps({'text': text}, separators=(',', ':')), flush=True) # noqa: E501
+
+ async def on_properties_changed(interface_name, changed_properties, invalidated_properties): # noqa: E501
+ if "Modes" not in invalidated_properties:
+ return
+
+ await print_mode()
+
+ properties.on_properties_changed(on_properties_changed)
+ await print_mode()
+
+ await loop.create_future()
+
+
+ loop.run_until_complete(main())
+ '';
+ on-click = "makoctl mode -t silent";
+ };
"custom/weather" = {
format = "{}";
tooltip = true;
@@ -240,11 +290,15 @@
#tray {
margin: 0;
}
- #battery, #idle_inhibitor, #backlight, #wireplumber {
+ #battery, #idle_inhibitor, #backlight, #wireplumber, #custom-mako {
color: @grey;
margin: 0 5px 0 2px;
}
#idle_inhibitor {
+ margin-right: 4px;
+ margin-left: 6px;
+ }
+ #custom-mako {
margin-right: 2px;
margin-left: 3px;
}
diff --git a/accounts/gkleen@sif/systemd.nix b/accounts/gkleen@sif/systemd.nix
index 119d8cc3..cefcf4ea 100644
--- a/accounts/gkleen@sif/systemd.nix
+++ b/accounts/gkleen@sif/systemd.nix
@@ -126,15 +126,6 @@ in {
After = ["graphical-session-pre.target"];
};
};
- dunst = {
- Service = {
- ExecStart = lib.mkForce "${cfg.services.dunst.package}/bin/dunst";
- Restart = "always";
- };
- Install = {
- WantedBy = ["graphical-session.target"];
- };
- };
keepassxc = {
Service = {
Type = "dbus";
diff --git a/accounts/gkleen@sif/taffybar/default.nix b/accounts/gkleen@sif/taffybar/default.nix
deleted file mode 100644
index 98366d8f..00000000
--- a/accounts/gkleen@sif/taffybar/default.nix
+++ /dev/null
@@ -1,2 +0,0 @@
-{ haskellPackages ? (import <nixpkgs> {}).haskellPackages }:
-haskellPackages.callCabal2nix "gkleen-sif-taffybar" ./. {}
diff --git a/accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal b/accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal
deleted file mode 100644
index e32cb473..00000000
--- a/accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal
+++ /dev/null
@@ -1,32 +0,0 @@
-name: gkleen-sif-taffybar
-version: 0.0.0
-build-type: Simple
-cabal-version: >=1.10
-
-data-files: taffybar.css
-
-executable taffybar
- hs-source-dirs: src
- main-is: taffybar.hs
- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall
- build-depends: base
- , containers
- , directory
- , filepath
- , gtk3
- , taffybar
- , X11>=1.8
- , transformers
- , gi-gtk
- , time, time-locale-compat
- , text
- , HStringTemplate
- , gtk-sni-tray
- , hslogger
- other-modules: Paths_gkleen_sif_taffybar
- , System.Taffybar.Widget.Clock
- , System.Taffybar.Widget.TooltipBattery
- default-language: Haskell2010
- default-extensions: ScopedTypeVariables
- , LambdaCase
- , NamedFieldPuns
\ No newline at end of file
diff --git a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs
deleted file mode 100644
index e8dc480f..00000000
--- a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module System.Taffybar.Widget.Clock
- ( textClockNew
- , textClockNewWith
- , defaultClockConfig
- , ClockConfig(..)
- , ClockUpdateStrategy(..)
- ) where
-
-import Control.Monad.IO.Class
-import Data.Maybe
-import qualified Data.Text as T
-import qualified Data.Time.Clock as Clock
-import Data.Time.Format
-import Data.Time.LocalTime
-import qualified Data.Time.Locale.Compat as L
-import GI.Gtk
-import System.Taffybar.Widget.Generic.PollingLabel
-
-type ClockFormat = L.TimeLocale -> ZonedTime -> T.Text
-
--- | Create the widget. I recommend passing @Nothing@ for the TimeLocale
--- parameter. The format string can include Pango markup
--- (<http://developer.gnome.org/pango/stable/PangoMarkupFormat.html>).
-textClockNew ::
- MonadIO m => Maybe L.TimeLocale -> ClockFormat -> Double -> m GI.Gtk.Widget
-textClockNew userLocale format interval =
- textClockNewWith cfg
- where
- cfg = defaultClockConfig { clockTimeLocale = userLocale
- , clockFormat = format
- , clockUpdateStrategy = ConstantInterval interval
- }
-
-data ClockUpdateStrategy
- = ConstantInterval Double
- | RoundedTargetInterval Int Double
- deriving (Eq, Ord, Show)
-
-data ClockConfig = ClockConfig
- { clockTimeZone :: Maybe TimeZone
- , clockTimeLocale :: Maybe L.TimeLocale
- , clockFormat :: ClockFormat
- , clockUpdateStrategy :: ClockUpdateStrategy
- }
-
--- | A clock configuration that defaults to the current locale
-defaultClockConfig :: ClockConfig
-defaultClockConfig = ClockConfig
- { clockTimeZone = Nothing
- , clockTimeLocale = Nothing
- , clockFormat = \locale zonedTime -> T.pack $ formatTime locale "%a %b %_d %r" zonedTime
- , clockUpdateStrategy = RoundedTargetInterval 5 0.0
- }
-
-systemGetTZ :: IO TimeZone
-systemGetTZ = getCurrentTimeZone
-
--- | A configurable text-based clock widget. It currently allows for
--- a configurable time zone through the 'ClockConfig'.
---
--- See also 'textClockNew'.
-textClockNewWith :: MonadIO m => ClockConfig -> m Widget
-textClockNewWith ClockConfig
- { clockTimeZone = userZone
- , clockTimeLocale = userLocale
- , clockFormat = format
- , clockUpdateStrategy = updateStrategy
- } = liftIO $ do
- let getTZ = maybe systemGetTZ return userZone
- locale = fromMaybe L.defaultTimeLocale userLocale
-
- let getUserZonedTime =
- utcToZonedTime <$> getTZ <*> Clock.getCurrentTime
-
- doTimeFormat = format locale
-
- getRoundedTimeAndNextTarget = do
- zonedTime <- getUserZonedTime
- return $ case updateStrategy of
- ConstantInterval interval ->
- (doTimeFormat zonedTime, Nothing, interval)
- RoundedTargetInterval roundSeconds offset ->
- let roundSecondsDiffTime = fromIntegral roundSeconds
- addTheRound = addLocalTime roundSecondsDiffTime
- localTime = zonedTimeToLocalTime zonedTime
- ourLocalTimeOfDay = localTimeOfDay localTime
- seconds = round $ todSec ourLocalTimeOfDay
- secondsFactor = seconds `div` roundSeconds
- displaySeconds = secondsFactor * roundSeconds
- baseLocalTimeOfDay =
- ourLocalTimeOfDay { todSec = fromIntegral displaySeconds }
- ourLocalTime =
- localTime { localTimeOfDay = baseLocalTimeOfDay }
- roundedLocalTime =
- if seconds `mod` roundSeconds > roundSeconds `div` 2
- then addTheRound ourLocalTime
- else ourLocalTime
- roundedZonedTime =
- zonedTime { zonedTimeToLocalTime = roundedLocalTime }
- nextTarget = addTheRound ourLocalTime
- amountToWait = realToFrac $ diffLocalTime nextTarget localTime
- in (doTimeFormat roundedZonedTime, Nothing, amountToWait - offset)
-
- label <- pollingLabelWithVariableDelay getRoundedTimeAndNextTarget
- ebox <- eventBoxNew
- containerAdd ebox label
- eventBoxSetVisibleWindow ebox False
- widgetShowAll ebox
- toWidget ebox
-
diff --git a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs
deleted file mode 100644
index 9dc52774..00000000
--- a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module System.Taffybar.Widget.TooltipBattery ( batteryIconTooltipNew ) where
-
-import Control.Applicative
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Reader
-import Data.Int (Int64)
-import qualified Data.Text as T
-import GI.Gtk
-import Prelude
-import StatusNotifier.Tray (scalePixbufToSize)
-import System.Taffybar.Context
-import System.Taffybar.Information.Battery
-import System.Taffybar.Util
-import System.Taffybar.Widget.Generic.AutoSizeImage
-import System.Taffybar.Widget.Generic.ChannelWidget
-import Text.Printf
-import Text.StringTemplate
-import Data.Function ((&))
-
--- | Just the battery info that will be used for display (this makes combining
--- several easier).
-data BatteryWidgetInfo = BWI
- { seconds :: Maybe Int64
- , percent :: Double
- , status :: String
- , rate :: Maybe Double
- } deriving (Eq, Show)
-
--- | Format a duration expressed as seconds to hours and minutes
-formatDuration :: Int64 -> String
-formatDuration secs = let minutes, hours, minutes' :: Int64
- minutes = secs `div` 60
- (hours, minutes') = minutes `divMod` 60
- in printf "%02d:%02d" hours minutes'
-
-getBatteryWidgetInfo :: BatteryInfo -> BatteryWidgetInfo
-getBatteryWidgetInfo info =
- let battPctNum :: Double
- battPctNum = batteryPercentage info
- battTime :: Maybe Int64
- battTime =
- case batteryState info of
- BatteryStateCharging -> Just $ batteryTimeToFull info
- BatteryStateDischarging -> Just $ batteryTimeToEmpty info
- _ -> Nothing
- battStatus :: String
- battStatus =
- case batteryState info of
- BatteryStateCharging -> "↑"
- BatteryStateDischarging -> "↓"
- BatteryStateEmpty -> "⤓"
- BatteryStateFullyCharged -> "⤒"
- _ -> "?"
- battRate :: Maybe Double
- battRate | rawRate < 0.1 = Nothing
- | otherwise = Just rawRate
- where rawRate = batteryEnergyRate info
- in BWI{ seconds = battTime, percent = battPctNum, status = battStatus, rate = battRate }
-
--- | Given (maybe summarized) battery info and format: provides the string to display
-formatBattInfo :: BatteryWidgetInfo -> String -> T.Text
-formatBattInfo info fmt =
- let tpl = newSTMP fmt
- tpl' = tpl
- & setManyAttrib [ ("percentage", printf "%.0f" $ percent info)
- , ("status", status info)
- ]
- & setManyAttrib [ ("time", formatDuration <$> seconds info)
- , ("rate", printf "%.0f" <$> rate info)
- ]
- in render tpl'
-
-themeLoadFlags :: [IconLookupFlags]
-themeLoadFlags = [IconLookupFlagsGenericFallback, IconLookupFlagsUseBuiltin]
-
-batteryIconTooltipNew :: String -> TaffyIO Widget
-batteryIconTooltipNew format = do
- DisplayBatteryChanVar (chan, _) <- setupDisplayBatteryChanVar ["IconName", "State", "Percentage", "TimeToFull", "TimeToEmpty", "EnergyRate"]
- ctx <- ask
- liftIO $ do
- image <- imageNew
- styleCtx <- widgetGetStyleContext =<< toWidget image
- defaultTheme <- iconThemeGetDefault
- let getCurrentBatteryIconNameStringTooltip = do
- info <- runReaderT getDisplayBatteryInfo ctx
- let iconNameString = T.pack $ batteryIconName info
- tooltip = formatBattInfo (getBatteryWidgetInfo info) format
- return (iconNameString, tooltip)
- extractPixbuf info =
- fst <$> iconInfoLoadSymbolicForContext info styleCtx
- setIconForSize size = do
- (name, tooltip) <- getCurrentBatteryIconNameStringTooltip
- widgetSetTooltipMarkup image $ Just tooltip
- iconThemeLookupIcon defaultTheme name size themeLoadFlags >>=
- traverse extractPixbuf >>=
- traverse (scalePixbufToSize size OrientationHorizontal)
- updateImage <- autoSizeImage image setIconForSize OrientationHorizontal
- toWidget =<< channelWidgetNew image chan (const $ postGUIASync updateImage)
diff --git a/accounts/gkleen@sif/taffybar/src/taffybar.hs b/accounts/gkleen@sif/taffybar/src/taffybar.hs
deleted file mode 100644
index 67ee942d..00000000
--- a/accounts/gkleen@sif/taffybar/src/taffybar.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main where
-
-import System.Taffybar (startTaffybar)
-import System.Taffybar.Context (TaffybarConfig(..))
-import System.Taffybar.Hooks
-import System.Taffybar.SimpleConfig hiding (SimpleTaffyConfig(cssPaths))
-import System.Taffybar.Widget
-import qualified System.Taffybar.Widget.Clock as MyClock
-import System.Taffybar.Widget.TooltipBattery
-
-import Data.Time.Format
-import Data.Time.LocalTime
-import Data.Time.Calendar.WeekDate
-
-import qualified Data.Text as T
-
-import Control.Exception (SomeException, try)
-import Control.Monad.Trans.Reader (mapReaderT)
-
-import Paths_gkleen_sif_taffybar
-
-import System.Log.Logger
-
-
-main :: IO ()
-main = do
- logger <- getLogger "System.Taffybar"
- saveGlobalLogger $ setLevel INFO logger
-
- myCssPath <- getDataFileName "taffybar.css"
- startTaffybar taffybarConfig{ cssPaths = pure myCssPath }
-
-
-taffybarConfig :: TaffybarConfig
-taffybarConfig =
- let myWorkspacesConfig =
- defaultWorkspacesConfig
- { maxIcons = Just 0
- , widgetGap = 7
- , showWorkspaceFn = \case
- -- Workspace{ workspaceState = Empty } -> False
- Workspace{ workspaceName } | workspaceName == "NSP" -> False
- _other -> True
- , getWindowIconPixbuf = \i d -> either (\(_ :: SomeException) -> Nothing) id <$> mapReaderT try (defaultGetWindowIconPixbuf i d)
- , urgentWorkspaceState = True
- }
- workspaces = workspacesNew myWorkspacesConfig
- clock = MyClock.textClockNewWith MyClock.defaultClockConfig
- { MyClock.clockUpdateStrategy = MyClock.RoundedTargetInterval 1 0.0
- , MyClock.clockFormat = \tl zt@ZonedTime{ zonedTimeToLocalTime = LocalTime{ localDay } }
- -> let date = formatTime tl "%Y-%m-%d" localDay
- weekdate = "W" <> show2 woy <> "-" <> show dow
- where (_, woy, dow) = toWeekDate localDay
- show2 :: Int -> String
- show2 x = replicate (2 - length s) '0' ++ s
- where s = show x
- time = formatTime tl "%H:%M:%S%Ez" zt
- in T.intercalate " " $ map T.pack [weekdate, date, time]
- }
- layout = layoutNew defaultLayoutConfig
- windowsW = windowsNew defaultWindowsConfig
- { getMenuLabel = truncatedGetMenuLabel 80
- , getActiveLabel = truncatedGetActiveLabel 80
- }
- worktime = commandRunnerNew 60 "worktime" [] "worktime"
- worktimeToday = commandRunnerNew 60 "worktime" ["today"] "worktime today"
- -- See https://github.com/taffybar/gtk-sni-tray#statusnotifierwatcher
- -- for a better way to set up the sni tray
- -- tray = sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt
- tray = sniTrayNew
- myConfig = defaultSimpleTaffyConfig
- { startWidgets =
- workspaces : map (>>= buildContentsBox) [ layout, windowsW ]
- , endWidgets = map (>>= buildContentsBox) $ reverse
- -- , mpris2New
- [ worktime, worktimeToday
- , clock
- , tray
- , batteryIconTooltipNew "$status$ $percentage$%$if(time)$$if(rate)$ ($rate$W $time$)$else$ ($time$)$endif$$elseif(rate)$ ($rate$W)$endif$"
- ]
- , barPosition = Top
- , barPadding = 2
- , barHeight = ExactSize 28
- , widgetSpacing = 10
- }
- in withBatteryRefresh $ withLogServer $
- withToggleServer $ toTaffyConfig myConfig
diff --git a/accounts/gkleen@sif/taffybar/taffybar.css b/accounts/gkleen@sif/taffybar/taffybar.css
deleted file mode 100644
index 7a297465..00000000
--- a/accounts/gkleen@sif/taffybar/taffybar.css
+++ /dev/null
@@ -1,146 +0,0 @@
-@define-color transparent rgba(0.0, 0.0, 0.0, 0.0);
-@define-color white #808080;
-@define-color gray #202020;
-@define-color green #008000;
-@define-color yellow #808000;
-@define-color blue #000080;
-@define-color red #800000;
-@define-color black #000000;
-/* @define-color taffy-blue #0c7cd5; */
-@define-color taffy-blue @blue;
-
-@define-color active-window-color @white;
-@define-color urgent-window-color @taffy-blue;
-@define-color font-color @white;
-@define-color menu-background-color @black;
-@define-color menu-font-color @white;
-
-/* Top level styling */
-
-.taffy-window * {
- /*
- This removes any existing styling from UI elements. Taffybar will not
- cohere with your gtk theme.
- */
- all: unset;
-
- font-family: "Fira Sans", sans-serif;
- font-size: 21px;
- color: @font-color;
-}
-
-.taffy-box {
- /* border-radius: 10px; */
- background-color: @black;
-}
-
-.inner-pad {
- /* padding-bottom: 5px; */
- /* padding-top: 5px; */
- padding-left: 2px;
- padding-right: 2px;
-}
-
-.contents {
- /* padding-bottom: 4px; */
- /* padding-top: 4px; */
- padding-right: 2px;
- padding-left: 2px;
- transition: background-color .5s;
- border-radius: 5px;
-}
-
-/* Workspaces styling */
-
-.workspace-label {
- padding-right: 3px;
- padding-left: 2px;
- font-size: 21px;
-}
-
-.workspace-label.active {
- color: @green;
-}
-.workspace-label.visible {
- color: @yellow;
-}
-.workspace-label.empty {
- color: @gray;
-}
-.workspace-label.urgent {
- color: @red;
-}
-
-.active .contents {
- background-color: rgba(0.0, 0.0, 0.0, 0.5);
-}
-
-.visible .contents {
- background-color: rgba(0.0, 0.0, 0.0, 0.2);
-}
-
-.window-icon-container {
- transition: opacity .5s, box-shadow .5s;
- opacity: 1;
-}
-
-/* This gives space for the box-shadow (they look like underlines) that follow.
- This will actually affect all widgets, (not just the workspace icons), but
- that is what we want since we want the icons to look the same. */
-.auto-size-image, .sni-tray {
- padding-top: 3px;
- padding-bottom: 3px;
-}
-
-.window-icon-container.active {
- box-shadow: inset 0 -3px @white;
-}
-
-.window-icon-container.urgent {
- box-shadow: inset 0 -3px @urgent-window-color;
-}
-
-.window-icon-container.inactive .window-icon {
- padding: 0px;
-}
-
-.window-icon-container.minimized .window-icon {
- opacity: .3;
-}
-
-.window-icon {
- opacity: 1;
- transition: opacity .5s;
-}
-
-/* Button styling */
-
-button {
- background-color: @transparent;
- border-width: 0px;
- border-radius: 0px;
-}
-
-button:checked, button:hover .Contents:hover {
- box-shadow: inset 0 -3px @taffy-blue;
-}
-
-/* Menu styling */
-
-/* The ".taffy-window" prefixed selectors are needed because if they aren't present,
- the top level .Taffybar selector takes precedence */
-.taffy-window menuitem *, menuitem * {
- color: @menu-font-color;
-}
-
-.taffy-window menuitem, menuitem {
- background-color: @menu-background-color;
-}
-
-.taffy-window menuitem:hover, menuitem:hover {
- background-color: @taffy-blue;
-}
-
-.taffy-window menuitem:hover > label, menuitem:hover > label {
- color: @white;
-}
diff --git a/accounts/gkleen@sif/xmonad/.gitignore b/accounts/gkleen@sif/xmonad/.gitignore
deleted file mode 100644
index c11891cd..00000000
--- a/accounts/gkleen@sif/xmonad/.gitignore
+++ /dev/null
@@ -1,4 +0,0 @@
-**/#*#
-**/.stack-work/
-/stack.yaml.lock
-/*.cabal
diff --git a/accounts/gkleen@sif/xmonad/default.nix b/accounts/gkleen@sif/xmonad/default.nix
deleted file mode 100644
index 8790c12f..00000000
--- a/accounts/gkleen@sif/xmonad/default.nix
+++ /dev/null
@@ -1,7 +0,0 @@
-argumentPackages@{ ... }:
-
-let
- # defaultPackages = (import ./stackage.nix {});
- # haskellPackages = defaultPackages // argumentPackages;
- haskellPackages = argumentPackages;
-in haskellPackages.callPackage ./xmonad-yggdrasil.nix {}
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
deleted file mode 100644
index e6accdcc..00000000
--- a/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE DeriveGeneric, OverloadedLists, OverloadedStrings, ViewPatterns, ExistentialQuantification, MultiWayIf #-}
-
-module XMonad.Mpv
- ( MpvCommand(..), MpvResponse(..), MpvException(..)
- , mpv
- , mpvDir
- , mpvAll, mpvOne
- , mpvResponse
- ) where
-
-import Data.Aeson
-
-import Data.Monoid
-
-import Network.Socket hiding (recv)
-import Network.Socket.ByteString
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as CBS
-import qualified Data.ByteString.Lazy as LBS
-
-import GHC.Generics (Generic)
-import Data.Typeable (Typeable)
-import Data.String (IsString(..))
-
-import Control.Exception
-
-import System.IO.Temp (getCanonicalTemporaryDirectory)
-
-import Control.Monad
-import Control.Exception (bracket)
-import Control.Monad.IO.Class (MonadIO(..))
-
-import System.FilePath
-import System.Directory (getDirectoryContents)
-
-import Data.List
-import Data.Either
-import Data.Maybe
-
-import Debug.Trace
-
-
-data MpvCommand
- = forall a. ToJSON a => MpvSetProperty String a
- | MpvGetProperty String
-data MpvResponse
- = MpvError String
- | MpvSuccess (Maybe Value)
- deriving (Read, Show, Generic, Eq)
-data MpvException = MpvException String
- | MpvNoValue
- | MpvNoParse String
- deriving (Generic, Typeable, Read, Show)
-instance Exception MpvException
-
-
-instance ToJSON MpvCommand where
- toJSON (MpvSetProperty name val) = Array ["set_property", fromString name, toJSON val]
- toJSON (MpvGetProperty name) = Array ["get_property", fromString name]
-
-instance FromJSON MpvResponse where
- parseJSON = withObject "response object" $ \obj -> do
- mval <- obj .:? "data"
- err <- obj .: "error"
-
- let ret
- | err == "success" = MpvSuccess mval
- | otherwise = MpvError err
-
- return ret
-
-mpvSocket :: FilePath -> (Socket -> IO a) -> IO a
-mpvSocket sockPath = withSocketsDo . bracket mkSock close
- where
- mkSock = do
- sock <- socket AF_UNIX Stream defaultProtocol
- connect sock $ SockAddrUnix (traceId sockPath)
- return sock
-
-mpvResponse :: FromJSON v => MpvResponse -> IO v
-mpvResponse (MpvError str) = throwIO $ MpvException str
-mpvResponse (MpvSuccess Nothing) = throwIO MpvNoValue
-mpvResponse (MpvSuccess (Just v)) = case fromJSON v of
- Success v' -> return v'
- Error str -> throwIO $ MpvNoParse str
-
-mpv :: FilePath -> MpvCommand -> IO MpvResponse
-mpv sockPath cmd = mpvSocket sockPath $ \sock -> do
- let message = (`BS.append` "\n") . LBS.toStrict . encode $ Object [("command", toJSON cmd)]
- traceIO $ show message
- sendAll sock message
- let recvAll = do
- prefix <- recv sock 4096
- if
- | (prefix', rest) <- CBS.break (== '\n') prefix
- , not (BS.null rest) -> return prefix'
- | BS.null prefix -> return prefix
- | otherwise -> BS.append prefix <$> recvAll
- response <- recvAll
- traceIO $ show response
- either (ioError . userError) return . traceShowId $ eitherDecodeStrict' response
-
-mpvDir :: Exception e => FilePath -> (FilePath -> [(FilePath, Either e MpvResponse)] -> Maybe MpvCommand) -> IO [(FilePath, Either e MpvResponse)]
-mpvDir dir step = do
- socks <- filter (".sock" `isSuffixOf`) <$> getDirectoryContents dir
- go [] socks
- where
- go acc [] = return acc
- go acc (sock:socks)
- | Just cmd <- step sock acc = do
- res <- try $ mpv (dir </> sock) cmd
- go ((sock, res) : acc) socks
- | otherwise =
- go acc socks
-
-mpvAll :: FilePath -> MpvCommand -> IO [MpvResponse]
-mpvAll dir cmd = do
- results <- map snd <$> (mpvDir dir (\_ _ -> Just cmd) :: IO [(FilePath, Either SomeException MpvResponse)])
- mapM (either throwIO return) results
-
-mpvOne :: FilePath -> MpvCommand -> IO (Maybe MpvResponse)
-mpvOne dir cmd = listToMaybe . snd . partitionEithers . map snd <$> (mpvDir dir step :: IO [(FilePath, Either SomeException MpvResponse)])
- where
- step _ results
- | any (isRight . snd) results = Nothing
- | otherwise = Just cmd
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs
deleted file mode 100644
index 1caefae5..00000000
--- a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs
+++ /dev/null
@@ -1,94 +0,0 @@
-module XMonad.Prompt.MyPass
- (
- -- * Usages
- -- $usages
- mkPassPrompt
- ) where
-
-import Control.Monad (liftM)
-import XMonad.Core
-import XMonad.Prompt ( XPrompt
- , showXPrompt
- , commandToComplete
- , nextCompletion
- , getNextCompletion
- , XPConfig
- , mkXPrompt
- , searchPredicate)
-import System.Directory (getHomeDirectory)
-import System.FilePath (takeExtension, dropExtension, combine)
-import System.Posix.Env (getEnv)
-import XMonad.Util.Run (runProcessWithInput)
-
--- $usages
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
---
--- > import XMonad.Prompt.Pass
---
--- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt':
---
--- > , ((modMask x , xK_p) , passPrompt xpconfig)
--- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig)
--- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig)
---
--- For detailed instructions on:
---
--- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
---
--- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/>
---
-
-type Predicate = String -> String -> Bool
-
-getPassCompl :: [String] -> Predicate -> String -> IO [String]
-getPassCompl compls p s
- | length s <= minL
- , all ((> minL) . length) compls = return []
- | otherwise = do return $ filter (p s) compls
- where
- minL = 3
-
-type PromptLabel = String
-
-data Pass = Pass PromptLabel
-
-instance XPrompt Pass where
- showXPrompt (Pass prompt) = prompt ++ ": "
- commandToComplete _ c = c
- nextCompletion _ = getNextCompletion
-
--- | Default password store folder in $HOME/.password-store
---
-passwordStoreFolderDefault :: String -> String
-passwordStoreFolderDefault home = combine home ".password-store"
-
--- | Compute the password store's location.
--- Use the PASSWORD_STORE_DIR environment variable to set the password store.
--- If empty, return the password store located in user's home.
---
-passwordStoreFolder :: IO String
-passwordStoreFolder =
- getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir
- where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory
- computePasswordStoreDir (Just storeDir) = return storeDir
-
--- | A pass prompt factory
---
-mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X ()
-mkPassPrompt promptLabel passwordFunction xpconfig = do
- passwords <- io (passwordStoreFolder >>= getPasswords)
- mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction
-
--- | Retrieve the list of passwords from the password storage 'passwordStoreDir
-getPasswords :: FilePath -> IO [String]
-getPasswords passwordStoreDir = do
- files <- runProcessWithInput "find" [
- passwordStoreDir,
- "-type", "f",
- "-name", "*.gpg",
- "-printf", "%P\n"] []
- return $ map removeGpgExtension $ lines files
-
-removeGpgExtension :: String -> String
-removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file
- | otherwise = file
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs
deleted file mode 100644
index c268f87d..00000000
--- a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs
+++ /dev/null
@@ -1,105 +0,0 @@
-module XMonad.Prompt.MyShell
- ( Shell (..)
- , shellPrompt
- , prompt
- , safePrompt
- , unsafePrompt
- , getCommands
- , getShellCompl
- , split
- ) where
-
-import Codec.Binary.UTF8.String (encodeString)
-import Control.Exception as E
-import Control.Monad (forM)
-import Data.List (isPrefixOf)
-import System.Directory (doesDirectoryExist, getDirectoryContents)
-import System.Environment (getEnv)
-import System.Posix.Files (getFileStatus, isDirectory)
-
-import XMonad hiding (config)
-import XMonad.Prompt
-import XMonad.Util.Run
-
-econst :: Monad m => a -> IOException -> m a
-econst = const . return
-
-data Shell = Shell String
-
-instance XPrompt Shell where
- showXPrompt (Shell q) = q
- completionToCommand _ = escape
-
-shellPrompt :: String -> XPConfig -> X ()
-shellPrompt q c = do
- cmds <- io getCommands
- mkXPrompt (Shell q) c (getShellCompl cmds) spawn
-
-{- $spawns
- See safe and unsafeSpawn in "XMonad.Util.Run".
- prompt is an alias for safePrompt;
- safePrompt and unsafePrompt work on the same principles, but will use
- XPrompt to interactively query the user for input; the appearance is
- set by passing an XPConfig as the second argument. The first argument
- is the program to be run with the interactive input.
- You would use these like this:
-
- > , ((modm, xK_b), safePrompt "firefox" greenXPConfig)
- > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig)
-
- Note that you want to use safePrompt for Firefox input, as Firefox
- wants URLs, and unsafePrompt for the XTerm example because this allows
- you to easily start a terminal executing an arbitrary command, like
- 'top'. -}
-
-prompt, unsafePrompt, safePrompt :: String -> FilePath -> XPConfig -> X ()
-prompt = unsafePrompt
-safePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run
- where run = safeSpawn c . return
-unsafePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run
- where run a = unsafeSpawn $ c ++ " " ++ a
-
-getShellCompl :: [String] -> String -> IO [String]
-getShellCompl cmds s | s == "" || last s == ' ' = return []
- | otherwise = do
- f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- "
- ++ s ++ "\n")
- files <- case f of
- [x] -> do fs <- getFileStatus (encodeString x)
- if isDirectory fs then return [x ++ "/"]
- else return [x]
- _ -> return f
- return . uniqSort $ files ++ commandCompletionFunction cmds s
-
-commandCompletionFunction :: [String] -> String -> [String]
-commandCompletionFunction cmds str | '/' `elem` str = []
- | otherwise = filter (isPrefixOf str) cmds
-
-getCommands :: IO [String]
-getCommands = do
- p <- getEnv "PATH" `E.catch` econst []
- let ds = filter (/= "") $ split ':' p
- es <- forM ds $ \d -> do
- exists <- doesDirectoryExist d
- if exists
- then getDirectoryContents d
- else return []
- return . uniqSort . filter ((/= '.') . head) . concat $ es
-
-split :: Eq a => a -> [a] -> [[a]]
-split _ [] = []
-split e l =
- f : split e (rest ls)
- where
- (f,ls) = span (/=e) l
- rest s | s == [] = []
- | otherwise = tail s
-
-escape :: String -> String
-escape [] = ""
-escape (x:xs)
- | isSpecialChar x = '\\' : x : escape xs
- | otherwise = x : escape xs
-
-isSpecialChar :: Char -> Bool
-isSpecialChar = flip elem " &\\@\"'#?$*()[]{};"
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs
deleted file mode 100644
index 998c533e..00000000
--- a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs
+++ /dev/null
@@ -1,246 +0,0 @@
-module XMonad.Prompt.MySsh
- ( -- * Usage
- -- $usage
- sshPrompt,
- Ssh,
- Override (..),
- mkOverride,
- Conn (..),
- moshCmd,
- moshCmd',
- sshCmd,
- inTmux,
- withEnv
- ) where
-
-import XMonad
-import XMonad.Util.Run
-import XMonad.Prompt
-
-import System.Directory
-import System.Environment
-import qualified Control.Exception as E
-
-import Control.Monad
-import Data.Maybe
-
-import Text.Parsec.String
-import Text.Parsec
-import Data.Char (isSpace)
-
-econst :: Monad m => a -> E.IOException -> m a
-econst = const . return
-
--- $usage
--- 1. In your @~\/.xmonad\/xmonad.hs@:
---
--- > import XMonad.Prompt
--- > import XMonad.Prompt.Ssh
---
--- 2. In your keybindings add something like:
---
--- > , ((modm .|. controlMask, xK_s), sshPrompt defaultXPConfig)
---
--- Keep in mind, that if you want to use the completion you have to
--- disable the "HashKnownHosts" option in your ssh_config
---
--- For detailed instruction on editing the key binding see
--- "XMonad.Doc.Extending#Editing_key_bindings".
-
-data Override = Override
- { oUser :: Maybe String
- , oHost :: String
- , oPort :: Maybe Int
- , oCommand :: Conn -> String
- }
-
-mkOverride = Override { oUser = Nothing, oHost = "", oPort = Nothing, oCommand = sshCmd }
-sshCmd c = concat
- [ "ssh -t "
- , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else ""
- , cHost c
- , if isJust $ cPort c then " -p " ++ (show $ fromJust $ cPort c) else ""
- , " -- "
- , cCommand c
- ]
-moshCmd c = concat
- [ "mosh "
- , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else ""
- , cHost c
- , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else ""
- , " -- "
- , cCommand c
- ]
-moshCmd' p c = concat
- [ "mosh "
- , "--server=" ++ p ++ " "
- , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else ""
- , cHost c
- , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else ""
- , " -- "
- , cCommand c
- ]
-inTmux Nothing c
- | null $ cCommand c = c { cCommand = "tmux new-session" }
- | otherwise = c { cCommand = "tmux new-session \"" ++ (cCommand c) ++ "\"" }
-inTmux (Just h) c
- | null $ cCommand c = c { cCommand = "tmux new-session -As " <> h }
- | otherwise = c { cCommand = "tmux new-session \"" ++ (cCommand c) ++ "\"" }
-withEnv :: [(String, String)] -> Conn -> Conn
-withEnv envs c = c { cCommand = "env" ++ (concat $ map (\(n, v) -> ' ' : (n ++ "=" ++ v)) envs) ++ " " ++ (cCommand c) }
-
-data Conn = Conn
- { cUser :: Maybe String
- , cHost :: String
- , cPort :: Maybe Int
- , cCommand :: String
- } deriving (Eq, Show, Read)
-
-data Ssh = Ssh
-
-instance XPrompt Ssh where
- showXPrompt Ssh = "SSH to: "
- commandToComplete _ c = c
- nextCompletion _ = getNextCompletion
-
-toConn :: String -> Maybe Conn
-toConn = toConn' . parse connParser "(unknown)"
-toConn' :: Either ParseError Conn -> Maybe Conn
-toConn' (Left _) = Nothing
-toConn' (Right a) = Just a
-
-connParser :: Parser Conn
-connParser = do
- spaces
- user' <- optionMaybe $ try $ do
- str <- many1 $ satisfy (\c -> (not $ isSpace c) && (c /= '@'))
- char '@'
- return str
- host' <- many1 $ satisfy (not . isSpace)
- port' <- optionMaybe $ try $ do
- space
- string "-p"
- spaces
- int <- many1 digit
- (space >> return ()) <|> eof
- return $ (read int :: Int)
- spaces
- command' <- many anyChar
- eof
- return $ Conn
- { cHost = host'
- , cUser = user'
- , cPort = port'
- , cCommand = command'
- }
-
-sshPrompt :: [Override] -> XPConfig -> X ()
-sshPrompt o c = do
- sc <- io sshComplList
- mkXPrompt Ssh c (mkComplFunFromList c sc) $ ssh o
-
-ssh :: [Override] -> String -> X ()
-ssh overrides str = do
- let cmd = applyOverrides overrides str
- liftIO $ putStr "SSH Command: "
- liftIO $ putStrLn cmd
- runInTerm "" cmd
-
-applyOverrides :: [Override] -> String -> String
-applyOverrides [] str = "ssh " ++ str
-applyOverrides (o:os) str = case (applyOverride o str) of
- Just str -> str
- Nothing -> applyOverrides os str
-
-applyOverride :: Override -> String -> Maybe String
-applyOverride o str = let
- conn = toConn str
- in
- if isNothing conn then Nothing else
- case (fromJust conn) `matches` o of
- True -> Just $ (oCommand o) (fromJust conn)
- False -> Nothing
-
-matches :: Conn -> Override -> Bool
-a `matches` b = and
- [ justBool (cUser a) (oUser b) (==)
- , (cHost a) == (oHost b)
- , justBool (cPort a) (oPort b) (==)
- ]
-
-justBool :: Eq a => Maybe a -> Maybe a -> (a -> a -> Bool) -> Bool
-justBool Nothing _ _ = True
-justBool _ Nothing _ = True
-justBool (Just a) (Just b) match = a `match` b
-
-sshComplList :: IO [String]
-sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal
-
-sshComplListLocal :: IO [String]
-sshComplListLocal = do
- h <- getEnv "HOME"
- s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts"
- s2 <- sshComplListConf $ h ++ "/.ssh/config"
- return $ s1 ++ s2
-
-sshComplListGlobal :: IO [String]
-sshComplListGlobal = do
- env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent"
- fs <- mapM fileExists [ env
- , "/usr/local/etc/ssh/ssh_known_hosts"
- , "/usr/local/etc/ssh_known_hosts"
- , "/etc/ssh/ssh_known_hosts"
- , "/etc/ssh_known_hosts"
- ]
- case catMaybes fs of
- [] -> return []
- (f:_) -> sshComplListFile' f
-
-sshComplListFile :: String -> IO [String]
-sshComplListFile kh = do
- f <- doesFileExist kh
- if f then sshComplListFile' kh
- else return []
-
-sshComplListFile' :: String -> IO [String]
-sshComplListFile' kh = do
- l <- readFile kh
- return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words)
- $ filter nonComment
- $ lines l
-
-sshComplListConf :: String -> IO [String]
-sshComplListConf kh = do
- f <- doesFileExist kh
- if f then sshComplListConf' kh
- else return []
-
-sshComplListConf' :: String -> IO [String]
-sshComplListConf' kh = do
- l <- readFile kh
- return $ map (!!1)
- $ filter isHost
- $ map words
- $ lines l
- where
- isHost ws = take 1 ws == ["Host"] && length ws > 1
-
-fileExists :: String -> IO (Maybe String)
-fileExists kh = do
- f <- doesFileExist kh
- if f then return $ Just kh
- else return Nothing
-
-nonComment :: String -> Bool
-nonComment [] = False
-nonComment ('#':_) = False
-nonComment ('|':_) = False -- hashed, undecodeable
-nonComment _ = True
-
-getWithPort :: String -> String
-getWithPort ('[':str) = host ++ " -p " ++ port
- where (host,p) = break (==']') str
- port = case p of
- ']':':':x -> x
- _ -> "22"
-getWithPort str = str
diff --git a/accounts/gkleen@sif/xmonad/package.yaml b/accounts/gkleen@sif/xmonad/package.yaml
deleted file mode 100644
index f65137af..00000000
--- a/accounts/gkleen@sif/xmonad/package.yaml
+++ /dev/null
@@ -1,31 +0,0 @@
-name: xmonad-yggdrasil
-
-executables:
- xmonad:
- dependencies:
- - base
- - xmonad
- - xmonad-contrib
- - aeson
- - bytestring
- - text
- - temporary
- - filepath
- - directory
- - network
- - unix
- - utf8-string
- - parsec
- - process
- - mtl
- - X11
- - transformers
- - containers
- - hostname
- - libnotify
- - taffybar
-
- main: xmonad.hs
- source-dirs:
- - .
- - lib
diff --git a/accounts/gkleen@sif/xmonad/stack.nix b/accounts/gkleen@sif/xmonad/stack.nix
deleted file mode 100644
index 17a49e04..00000000
--- a/accounts/gkleen@sif/xmonad/stack.nix
+++ /dev/null
@@ -1,17 +0,0 @@
-{ ghc, nixpkgs ? import ./nixpkgs.nix {} }:
-
-let
- haskellPackages = import ./stackage.nix { inherit nixpkgs; };
- inherit (nixpkgs {}) pkgs;
-in pkgs.haskell.lib.buildStackProject {
- inherit ghc;
- inherit (haskellPackages) stack;
- name = "stackenv";
- buildInputs = (with pkgs;
- [ xorg.libX11 xorg.libXrandr xorg.libXinerama xorg.libXScrnSaver xorg.libXext xorg.libXft
- cairo
- glib
- ]) ++ (with haskellPackages;
- [
- ]);
-}
diff --git a/accounts/gkleen@sif/xmonad/stack.yaml b/accounts/gkleen@sif/xmonad/stack.yaml
deleted file mode 100644
index b8ed1147..00000000
--- a/accounts/gkleen@sif/xmonad/stack.yaml
+++ /dev/null
@@ -1,10 +0,0 @@
-nix:
- enable: true
- shell-file: stack.nix
-
-resolver: lts-13.21
-
-packages:
- - .
-
-extra-deps: []
diff --git a/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix b/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix
deleted file mode 100644
index 7c853619..00000000
--- a/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix
+++ /dev/null
@@ -1,21 +0,0 @@
-{ mkDerivation, aeson, base, bytestring, containers, directory
-, filepath, hostname, hpack, mtl, network, parsec, process, lib
-, temporary, transformers, unix, utf8-string, X11, xmonad
-, xmonad-contrib, libnotify, taffybar
-}:
-mkDerivation {
- pname = "xmonad-yggdrasil";
- version = "0.0.0";
- src = ./.;
- isLibrary = false;
- isExecutable = true;
- libraryToolDepends = [ hpack ];
- executableHaskellDepends = [
- aeson base bytestring containers directory filepath hostname mtl
- network parsec process temporary transformers unix utf8-string X11
- xmonad xmonad-contrib libnotify taffybar
- ];
- preConfigure = "hpack";
- license = "unknown";
- hydraPlatforms = lib.platforms.none;
-}
diff --git a/accounts/gkleen@sif/xmonad/xmonad.hs b/accounts/gkleen@sif/xmonad/xmonad.hs
deleted file mode 100644
index a44d3bb7..00000000
--- a/accounts/gkleen@sif/xmonad/xmonad.hs
+++ /dev/null
@@ -1,939 +0,0 @@
-{-# LANGUAGE TupleSections, ViewPatterns, OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiWayIf, NumDecimals #-}
-
-import XMonad
-import XMonad.Hooks.DynamicLog
-import XMonad.Hooks.ManageDocks
-import XMonad.Util.Run hiding (proc)
-import XMonad.Util.Loggers
-import XMonad.Util.EZConfig(additionalKeys)
-import System.IO
-import System.IO.Error
-import System.Environment
-import Data.Map (Map)
-import qualified Data.Map as Map
-import qualified XMonad.StackSet as W
-import System.Exit
-import Control.Monad.State (get)
--- import XMonad.Layout.Spiral
-import Data.Ratio
-import Data.List
-import Data.Char
-import Data.Maybe (fromMaybe, listToMaybe, maybeToList, catMaybes, isJust)
-import XMonad.Layout.Tabbed
-import XMonad.Prompt
-import XMonad.Prompt.Input
-import XMonad.Util.Scratchpad
-import XMonad.Util.NamedScratchpad
-import XMonad.Util.Ungrab
-import Control.Monad (sequence, liftM, liftM2, join, void)
-import XMonad.Util.WorkspaceCompare
-import XMonad.Layout.NoBorders
-import XMonad.Layout.PerWorkspace
-import XMonad.Layout.SimplestFloat
-import XMonad.Layout.Renamed
-import XMonad.Layout.Reflect
-import XMonad.Layout.OnHost
-import XMonad.Layout.Combo
-import XMonad.Layout.ComboP
-import XMonad.Layout.Column
-import XMonad.Layout.TwoPane
-import XMonad.Layout.IfMax
-import XMonad.Layout.LayoutBuilder
-import XMonad.Layout.WindowNavigation
-import XMonad.Layout.Dwindle
-import XMonad.Layout.TrackFloating
-import System.Process
-import System.Directory (removeFile)
-import System.Posix.Files
-import System.FilePath ((</>))
-import Control.Concurrent
-import System.Posix.Process (getProcessID)
-import System.IO.Error
-import System.IO
-import XMonad.Hooks.ManageHelpers hiding (CW)
-import XMonad.Hooks.UrgencyHook as U
-import XMonad.Hooks.EwmhDesktops
-import XMonad.StackSet (RationalRect (..))
-import Control.Monad (when, filterM, (<=<))
-import Graphics.X11.ExtraTypes.XF86
-import XMonad.Util.Cursor
-import XMonad.Actions.Warp
-import XMonad.Actions.FloatKeys
-import XMonad.Util.SpawnOnce
-import System.Directory
-import System.FilePath
-import XMonad.Actions.CopyWindow
-import XMonad.Hooks.ServerMode
-import XMonad.Actions.Commands
-import XMonad.Actions.CycleWS
-import XMonad.Actions.RotSlaves
-import XMonad.Actions.UpdatePointer
-import XMonad.Prompt.Window
-import Data.IORef
-import Data.Monoid
-import Data.String
-import qualified XMonad.Actions.PhysicalScreens as P
-
-import XMonad.Layout.IM
-
-import System.Taffybar.Support.PagerHints (pagerHints)
-
-import XMonad.Prompt.MyShell
-import XMonad.Prompt.MyPass
-import XMonad.Prompt.MySsh
-
-import XMonad.Mpv
-
-import Network.HostName
-
-import Control.Applicative ((<$>))
-
-import Libnotify as Notify hiding (appName)
-import qualified Libnotify as Notify (appName)
-import Libnotify (Notification)
--- import System.Information.Battery
-
-import Data.Int (Int32)
-
-import System.Posix.Process
-import System.Posix.Signals
-import System.Posix.IO as Posix
-import Control.Exception
-
-import System.IO.Unsafe
-
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Maybe
-
-import Data.Fixed (Micro)
-
-import qualified Data.Text as Text
-import Data.Ord (comparing)
-import Debug.Trace
-
-instance MonadIO m => IsString (m ()) where
- fromString = spawn
-
-type KeyMap = Map (ButtonMask, KeySym) (X ())
-
-data Host = Host
- { hName :: HostName
- , hManageHook :: ManageHook
- , hWsp :: Integer -> WorkspaceId
- , hCoWsp :: String -> Maybe WorkspaceId
- , hKeysMod :: XConfig Layout -> (KeyMap -> KeyMap)
- , hScreens :: [P.PhysicalScreen]
- , hKbLayouts :: [(String, Maybe String)]
- , hCmds :: X [(String, X ())]
- , hKeyUpKeys :: XConfig Layout -> KeyMap
- }
-
-defaultHost = Host { hName = "unkown"
- , hManageHook = composeOne [manageScratchTerm]
- , hWsp = show
- , hCoWsp = const Nothing
- , hKeysMod = const id
- , hScreens = [0,1..]
- , hKbLayouts = [ ("us", Just "dvp")
- , ("us", Nothing)
- , ("de", Nothing)
- ]
- , hCmds = return []
- , hKeyUpKeys = const Map.empty
- }
-
-browser :: String
-browser = "env MOZ_USE_XINPUT2=1 firefox"
-
-gray, darkGray, red, green :: String
-gray = "#808080"
-darkGray = "#202020"
-red = "#800000"
-green = "#008000"
-
-hostFromName :: HostName -> Host
-hostFromName h@("vali") = defaultHost { hName = h
- , hManageHook = composeOne $ catMaybes [ Just manageScratchTerm
- , assign "web" $ className =? ".dwb-wrapped"
- , assign "web" $ className =? "Chromium"
- , assign "work" $ className =? "Emacs"
- , assign "media" $ className =? "mpv"
- ]
- , hWsp = hWsp
- , hCoWsp = hCoWsp
- , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_d, ["chromium", "chromium $(xclip -o)"])
- , (xK_e, ["emacsclient -c"])
- ])
- `Map.union`
- ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), scratchpadSpawnActionCustom $ (XMonad.terminal conf) ++ " -name scratchpad -title scratchpad -e tmux new-session -D -s scratch")
- ] )
- , hScreens = hScreens defaultHost
- }
- where
- workspaceNames = Map.fromList [ (2, "web")
- , (3, "work")
- , (10, "media")
- ]
- hWsp = wspFromMap workspaceNames
- hCoWsp = coWspFromMap workspaceNames
- assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp
-hostFromName h
- | h `elem` ["hel", "sif"] = defaultHost { hName = h
- , hManageHook = namedScratchpadManageHook scratchpads <+> composeOne (catMaybes
- [ assign "mpv" $ className =? "mpv"
- , assign "mpv" $ stringProperty "WM_WINDOW_ROLE" =? "presentation"
- , assign "read" $ stringProperty "WM_WINDOW_ROLE" =? "presenter"
- , assign "mpv" $ className =? "factorio"
- , assign "mpv" $ resource =? "twitch"
- , assign "web" $ className =? "chromium-browser"
- , assign "web" $ className =? "Google-chrome"
- , assign "work" $ (appName =? "Devtools" <&&> className =? "firefox")
- , assign "work" $ className =? "Postman"
- , assign "web" $ (appName =? "Navigator" <&&> className =? "firefox")
- , assign "comm" $ (className =? "Emacs" <&&> title =? "Mail")
- , assign "comm" $ className =? "Zulip"
- , assign "comm" $ className =? "Element"
- , assign "comm" $ className =? "Rocket.Chat"
- , assign "comm" $ className =? "Discord"
- , assign "comm" $ className =? "Rainbow"
- , assign "media" $ resource =? "media"
- , assign "monitor" $ className =? "Grafana"
- , assign "monitor" $ className =? "Virt-viewer"
- , assign "monitor" $ resource =? "htop"
- , assign "monitor" $ resource =? "monitor"
- , assign "monitor" $ className =? "xfreerdp"
- , assign "monitor" $ className =? "org.remmina.Remmina"
- , Just $ resource =? "htop" -?> centerFloat
- , Just $ (className =? "Scp-dbus-service.py") -?> centerFloat
- , Just $ resource =? "log" -?> centerFloat
- , assign "work" $ className =? "Alacritty"
- , Just $ (appName =? "Edit with Emacs FRAME") -?> centerFloat
- , assign' ["work", "uni"] $ (className =? "Emacs" <&&> appName /=? "Edit with Emacs FRAME")
- , assign' ["work", "uni"] $ className =? "jetbrains-idea-ce"
- , assign "read" $ className =? "llpp"
- , assign "read" $ className =? "Evince"
- , assign "read" $ className =? "Zathura"
- , assign "read" $ className =? "MuPDF"
- , assign "read" $ className =? "Xournal"
- , assign "read" $ appName =? "libreoffice"
- , assign "read" $ appName =? "com-trollworks-gcs-app-GCS"
- , assign "read" $ appName =? "Tux.py"
- , assign "read" $ className =? "Gnucash"
- , assign "comm" $ className =? "Skype"
- , assign "comm" $ className =? "Daily"
- , assign "comm" $ className =? "Pidgin"
- , assign "comm" $ className =? "Thunderbird"
- , assign "comm" $ className =? "Slack"
- , Just $ (resource =? "xvkbd") -?> doRectFloat $ RationalRect (1 % 8) (3 % 8) (6 % 8) (4 % 8)
- , Just $ (stringProperty "_NET_WM_WINDOW_TYPE" =? "_NET_WM_WINDOW_TYPE_DIALOG") -?> doFloat
- , Just $ (className =? "Dunst") -?> doFloat
- , Just $ (className =? "Xmessage") -?> doCenterFloat
- , Just $ (className =? "Nm-openconnect-auth-dialog") -?> centerFloat
- , Just $ (className =? "Pinentry") -?> doCenterFloat
- , Just $ (className =? "pinentry") -?> doCenterFloat
- , Just $ (stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooseDialog") -?> centerFloatSmall
- , Just $ (className =? "Nvidia-settings") -?> doCenterFloat
- , Just $ fmap ("Minetest" `isInfixOf`) title -?> doIgnore
- , Just $ fmap ("Automachef" `isInfixOf`) title -?> doIgnore
- , assign "call" $ className =? "zoom"
- ])
- , hWsp = hWsp
- , hCoWsp = hCoWsp
- , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_e, ["emacsclient -c"])
- , (xK_d, [fromString browser, "google-chrome" {- , "notmuch-links" -}])
- , (xK_c, [ inputPrompt xPConfigMonospace "dc" ?+ dc ])
- , (xK_g, ["pidgin"])
- , (xK_s, ["skype"])
- -- , (xK_p, [mkPassPrompt "Type password" pwType xPConfig, mkPassPrompt "Show password" pwShow xPConfig, mkPassPrompt "Copy password" pwClip xPConfig])
- , (xK_w, ["sudo rewacom"])
- , (xK_y, [ "tmux new-window -dt media /var/media/link.hs $(xclip -o)"
- , "tmux new-window -dt media /var/media/download.hs $(xclip -o)"
- , "tmux new-window -dt media /var/media/download.hs $(xclip -o -selection clipboard)"
- ])
- , (xK_l, [ "tmux new-window -dt media mpv $(xclip -o)"
- , "tmux new-window -dt media mpv $(xclip -o -selection clipboard)"
- , "alacritty --class media -e tmuxp load /var/media"
- ])
- {- , (xK_m, [ "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch)'"
- , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch-mua-new-mail)'"
- , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e \"(browse-url-mail \"$(xclip -o)\")\""
- ]) -}
- , (xK_Return, ["keynav start,windowzoom", "keynav start"])
- , (xK_t, [inputPrompt xPConfigMonospace "fuzzytime timer" ?+ fuzzytime, fuzzytime "unset", work_fuzzytime])
- , (xK_a, [inputPrompt xPConfigMonospace "adjmix" ?+ adjmix])
- , (xK_s, [ inputPromptWithCompl xPConfigMonospace "start synergy" synergyCompl ?+ synergyStart
- , inputPromptWithCompl xPConfigMonospace "stop synergy" synergyCompl ?+ synergyStop
- ])
- , (xK_h, [ "alacritty --class htop -e htop"
- , "alacritty --class log -e journalctl -xef"
- ])
- , (xK_x, [ "autorandr -c"
- , "autorandr -fl def"
- ])
- , (xK_z, [ "zulip -- --force-device-scale-factor=2"
- ])
- ])
- `Map.union`
- ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), namedScratchpadAction scratchpads "term")
- , ((XMonad.modMask conf .|. controlMask, xK_a), namedScratchpadAction scratchpads "pavucontrol")
- , ((XMonad.modMask conf .|. controlMask, xK_o), namedScratchpadAction scratchpads "easyeffects")
- , ((XMonad.modMask conf .|. controlMask .|. shiftMask, xK_o), namedScratchpadAction scratchpads "helvum")
- , ((XMonad.modMask conf .|. controlMask, xK_w), namedScratchpadAction scratchpads "alarms")
- , ((XMonad.modMask conf .|. controlMask, xK_b), namedScratchpadAction scratchpads "blueman")
- , ((XMonad.modMask conf .|. controlMask, xK_p), namedScratchpadAction scratchpads "keepassxc")
- , ((XMonad.modMask conf .|. controlMask, xK_t), namedScratchpadAction scratchpads "toggl")
- , ((XMonad.modMask conf .|. controlMask, xK_e), namedScratchpadAction scratchpads "emacs")
- , ((XMonad.modMask conf .|. controlMask, xK_m), namedScratchpadAction scratchpads "calendar")
- , ((XMonad.modMask conf .|. controlMask, xK_f), namedScratchpadAction scratchpads "music")
- , ((XMonad.modMask conf .|. mod1Mask, xK_Up), rotate U)
- , ((XMonad.modMask conf .|. mod1Mask, xK_Down), rotate D)
- , ((XMonad.modMask conf .|. mod1Mask, xK_Left), rotate L)
- , ((XMonad.modMask conf .|. mod1Mask, xK_Right), rotate R)
- , ((controlMask, xK_space ), "dunstctl close" )
- , ((controlMask .|. shiftMask, xK_space ), "dunstctl close-all" )
- , ((controlMask, xK_period), "dunstctl context" )
- , ((controlMask, xK_comma ), "dunstctl history-pop")
- -- , ((XMonad.modMask conf .|. shiftMask, xK_a), startMute "hel")
- ] )
- , hKeyUpKeys = \conf -> Map.fromList [ -- ((XMonad.modMask conf .|. shiftMask, xK_a), stopMute "hel")
- ]
- , hScreens = hScreens defaultHost
- , hCmds = return [ ("prev-workspace", prevWS)
- , ("next-workspace", nextWS)
- , ("prev-window", rotAllDown)
- , ("next-window", rotAllUp)
- , ("banish", banishScreen LowerRight)
- , ("update-gpg-tty", safeSpawn "gpg-connect-agent" ["UPDATESTARTUPTTY", "/bye"])
- , ("rescreen", rescreen)
- , ("repanel", do
- spawn "nm-applet"
- spawn "blueman-applet"
- spawn "pasystray"
- spawn "kdeconnect-indicator"
- spawn "dunst -print"
- spawn "udiskie"
- spawn "autocutsel -s PRIMARY"
- spawn "autocutsel -s CLIPBOARD"
- )
- , ("pause", mediaMpv $ MpvSetProperty "pause" True)
- , ("unpause", mediaMpv $ MpvSetProperty "pause" False)
- , ("exit", io $ exitWith ExitSuccess)
- ]
- }
- where
- withGdkScale act = void . xfork $ setEnv "GDK_SCALE" "2" >> act
- workspaceNames = Map.fromList [ (1, "comm")
- , (2, "web")
- , (3, "work")
- , (4, "read")
- , (5, "monitor")
- , (6, "uni")
- , (8, "call")
- , (9, "media")
- , (10, "mpv")
- ]
- scratchpads = [ NS "term" "alacritty --class scratchpad --title scratchpad -e tmux new-session -AD -s scratch" (resource =? "scratchpad") centerFloat
- , NS "pavucontrol" "pavucontrol" (resource =? "pavucontrol") centerFloat
- , NS "helvum" "helvum" (resource =? "helvum") centerFloat
- , NS "easyeffects" "easyeffects" (resource =? "easyeffects") centerFloat
- , NS "alarms" "alarm-clock-applet" (className =? "Alarm-clock-applet" <&&> title =? "Alarms") centerFloat
- , NS "blueman" "blueman-manager" (className =? ".blueman-manager-wrapped") centerFloat
- , NS "keepassxc" "keepassxc" (className =? "KeePassXC") centerFloat
- , NS "toggl" "toggldesktop" (className =? "Toggl Desktop") centerFloat
- , NS "calendar" "minetime -- --force-device-scale-factor=1.6" (className =? "MineTime") centerFloat
- , NS "emacs" "emacsclient -c -F \"'(title . \\\"Scratchpad\\\")\"" (className =? "Emacs" <&&> title =? "Scratchpad") centerFloat
- , NS "music" "ytmdesktop" (className =? "youtube-music-desktop-app") centerFloat
- ]
- centerFloat = customFloating $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8)
- centerFloatSmall = customFloating $ RationalRect (1 % 4) (1 % 4) (1 % 2) (1 % 2)
- hWsp = wspFromMap workspaceNames
- hCoWsp = coWspFromMap workspaceNames
- assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp
- assign' :: [String] -> Query Bool -> Maybe MaybeManageHook
- assign' wsps test = do
- wsIds <- mapM hCoWsp wsps
- return $ test -?> go wsIds
- where
- go :: [WorkspaceId] -> ManageHook
- go wsps = do
- visWsps <- liftX $ (\wset -> W.tag . W.workspace <$> W.current wset : W.visible wset) <$> gets windowset
- case (filter (`elem` visWsps) wsps, wsps) of
- (wsp : _, _) -> doShift wsp
- (_, wsp : _) -> doShift wsp
- ([], []) -> return mempty
- rotate rot = do
- safeSpawn "xrandr" ["--output", "eDP-1", "--rotate", xrandrDir]
- mapM_ rotTouch touchscreens
- where
- xrandrDir = case rot of
- U -> "normal"
- L -> "left"
- R -> "right"
- D -> "inverted"
- matrix = case rot of
- U -> [ [ 1, 0, 0]
- , [ 0, 1, 0]
- , [ 0, 0, 1]
- ]
- L -> [ [ 0, -1, 1]
- , [ 1, 0, 0]
- , [ 0, 0, 1]
- ]
- R -> [ [ 0, 1, 0]
- , [-1, 0, 1]
- , [ 0, 0, 1]
- ]
- D -> [ [-1, 0, 1]
- , [ 0, -1, 1]
- , [ 0, 0, 1]
- ]
- touchscreens = [ "Wacom Co.,Ltd. Pen and multitouch sensor Finger touch"
- , "Wacom Co.,Ltd. Pen and multitouch sensor Pen stylus"
- , "Wacom Co.,Ltd. Pen and multitouch sensor Pen eraser"
- ]
- rotTouch screen = do
- safeSpawn "xinput" $ ["set-prop", screen, "Coordinate Transformation Matrix"] ++ map (\n -> show n ++ ",") (concat matrix)
- safeSpawn "xinput" ["map-to-output", screen, "eDP-1"]
- withPw f label = io . void . forkProcess $ do
- uninstallSignalHandlers
- void $ createSession
- (dropWhileEnd isSpace -> pw) <- readCreateProcess (proc "pass" ["show", label]) ""
- void $ f pw
- pwType :: String -> X ()
- pwType = withPw $ readCreateProcess (proc "xdotool" ["type", "--clearmodifiers", "--file", "-"])
- pwClip label = safeSpawn "pass" ["show", "--clip", label]
- pwShow :: String -> X ()
- pwShow = withPw $ \pw -> do
- xmessage <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE")
- readCreateProcess (proc xmessage ["-file", "-"]) pw
- fuzzytime str = safeSpawn "fuzzytime" $ "timer" : words str
- work_fuzzytime = io . void . forkProcess $ do
- readCreateProcess (proc "worktime" []) "" >>= safeSpawn "fuzzytime" . ("timer" : ) . pure
- adjmix str = safeSpawn "adjmix" $ words str
- dc expr = void . xfork $ do
- result <- readProcess "dc" [] $ expr ++ "f"
- let
- (first : rest) = filter (not . null) $ lines result
- notification = Notify.summary first <> Notify.body (unlines rest) <> Notify.timeout Infinite <> Notify.urgency Normal <> Notify.appName "dc"
- void $ Notify.display notification
- synergyCompl = mkComplFunFromList' xPConfigMonospace ["mathw86"]
- synergyStart host = safeSpawn "systemctl" ["--user", "start", "synergy-rtunnel@" ++ host ++ ".service"]
- synergyStop host = safeSpawn "systemctl" ["--user", "stop", "synergy-rtunnel@" ++ host ++ ".service"]
-
-hostFromName _ = defaultHost
-
--- muteRef :: IORef (Maybe (String, Notification))
--- {-# NOINLINE muteRef #-}
--- muteRef = unsafePerformIO $ newIORef Nothing
-
--- startMute, stopMute :: String -> X ()
--- startMute sink = liftIO $ do
--- muted <- isJust <$> readIORef muteRef
--- when (not muted) $ do
--- let
--- notification = Notify.summary "Muted" <> Notify.timeout Infinite <> Notify.urgency Normal
--- level = "0.0dB"
--- -- level <- runProcessWithInput "ssh" ["bragi", "cat", "/dev/shm/mix/" ++ sink ++ "/level"] ""
--- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", "0"]
--- hPutStrLn stderr "Mute"
--- writeIORef muteRef . Just . (level, ) =<< Notify.display notification
--- stopMute sink = liftIO $ do
--- let
--- unmute (Just (level, notification)) = do
--- hPutStrLn stderr "Unmute"
--- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", level]
--- Notify.close notification
--- unmute Nothing = return ()
--- muted <- isJust <$> readIORef muteRef
--- when muted . join . atomicModifyIORef muteRef $ (Nothing, ) . unmute
-
-wspFromMap workspaceNames = \i -> case Map.lookup i workspaceNames of
- Just str -> show i ++ " " ++ str
- Nothing -> show i
-
-coWspFromMap workspaceNames = \str -> case filter ((== str) . snd) $ Map.toList workspaceNames of
- [] -> Nothing
- [(i, _)] -> Just $ wspFromMap workspaceNames i
- _ -> Nothing
-
-spawnModifiers = [0, controlMask, shiftMask .|. controlMask]
-spawnBindings :: XConfig layout -> (KeySym, [X ()]) -> [((KeyMask, KeySym), X ())]
-spawnBindings conf (k, cmds) = zipWith (\m cmd -> ((modm .|. mod1Mask .|. m, k), cmd)) spawnModifiers cmds
- where
- modm = XMonad.modMask conf
-
-manageScratchTerm = (resource =? "scratchpad" <||> resource =? "keysetup") -?> doRectFloat $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8)
-
-tabbedLayout t = renamed [Replace "Tabbed"] $ reflectHoriz $ t CustomShrink $ tabbedTheme
-tabbedLayoutHoriz t = renamed [Replace "Tabbed Horiz"] $ reflectVert $ t CustomShrink $ tabbedTheme
-tabbedTheme = def
- { activeColor = "black"
- , inactiveColor = "black"
- , urgentColor = "black"
- , activeBorderColor = gray
- , inactiveBorderColor = darkGray
- , urgentBorderColor = red
- , activeTextColor = gray
- , inactiveTextColor = gray
- , urgentTextColor = gray
- , decoHeight = 32
- , fontName = "xft:Fira Sans:pixelsize=21"
- }
-
-main :: IO ()
-main = do
- arguments <- either (const []) id <$> tryIOError getArgs
- case arguments of
- ["--command", s] -> do
- d <- openDisplay ""
- rw <- rootWindow d $ defaultScreen d
- a <- internAtom d "XMONAD_COMMAND" False
- m <- internAtom d s False
- allocaXEvent $ \e -> do
- setEventType e clientMessage
- setClientMessageEvent e rw a 32 m currentTime
- sendEvent d rw False structureNotifyMask e
- sync d False
- _ -> do
- -- batteryMon <- xfork $ monitorBattery Nothing Nothing
- hostname <- getHostName
- let
- host = hostFromName hostname
- setEnv "HOST" hostname
- let myConfig = withHostUrgency . ewmhFullscreen . ewmh . pagerHints $ docks def
- { manageHook = hManageHook host
- , terminal = "alacritty"
- , layoutHook = smartBorders . avoidStruts $ windowNavigation layout'
- , logHook = do
- dynamicLogString xmobarPP' >>= writeProps
- updatePointer (99 % 100, 98 % 100) (0, 0)
- , modMask = mod4Mask
- , keys = \conf -> hKeysMod host conf $ myKeys' conf host
- , workspaces = take (length numKeys) $ map wsp [1..]
- , startupHook = setDefaultCursor xC_left_ptr
- , normalBorderColor = darkGray
- , focusedBorderColor = gray
- , handleEventHook = serverModeEventHookCmd' (hCmds host) <+> keyUpEventHook
- }
- writeProps str = do
- let encodeCChar = map $ fromIntegral . fromEnum
- atoms = [ "_XMONAD_WORKSPACES"
- , "_XMONAD_LAYOUT"
- , "_XMONAD_TITLE"
- ]
- (flip mapM_) (zip atoms (lines str)) $ \(atom', content) -> do
- ustring <- getAtom "UTF8_STRING"
- atom <- getAtom atom'
- withDisplay $ \dpy -> io $ do
- root <- rootWindow dpy $ defaultScreen dpy
- changeProperty8 dpy root atom ustring propModeReplace $ encodeCChar content
- sync dpy True
- wsp = hWsp host
- -- We can´t define per-host layout modifiers because we lack dependent types
- layout' = onHost "skadhi" ( onWorkspace (wsp 1) (Full ||| withIM (1%5) (Title "Buddy List") tabbedLayout') $
- onWorkspace (wsp 10) Full $
- onWorkspace (wsp 2) (Full ||| tabbedLayout') $
- onWorkspace (wsp 5) tabbedLayout' $
- onWorkspace (wsp 8) (withIM (1%5) (Title "Friends") tabbedLayout') $
- defaultLayouts
- ) $
- onHost "vali" ( onWorkspace (wsp 2) (Full ||| tabbedLayout' ||| combineTwo (TwoPane 0.01 0.57) Full tabbedLayout') $
- onWorkspace (wsp 3) workLayouts $
- defaultLayouts
- ) $
- onHost "hel" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $
- onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
- onWorkspace (wsp 3) workLayouts $
- onWorkspace (wsp 6) workLayouts $
- onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $
- onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
- onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $
- defaultLayouts
- ) $
- onHost "sif" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $
- onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
- onWorkspace (wsp 3) workLayouts $
- onWorkspace (wsp 6) workLayouts $
- onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $
- onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
- onWorkspace (wsp 8) tabbedLayout''' $
- onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $
- defaultLayouts
- ) $
- defaultLayouts
- -- tabbedLayout''' = renamed [Replace "Tabbed'"] $ IfMax 1 (noBorders Full) (tabbedLayout tabbedBottomAlways)
- tabbedLayout''' = tabbedLayout tabbedBottom
- tabbedLayout' = tabbedLayout tabbedBottomAlways
- tabbedLayoutHoriz' = tabbedLayoutHoriz tabbedLeftAlways
- defaultLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW 1 (5 % 100) ||| tabbedLayout' ||| Full
- -- workLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW (2 % 1) (5 % 100) ||| tabbedLayout' ||| Full
- workLayouts = tabbedLayout' ||| (renamed [Replace "Combined"] $ combineTwoP (TwoPane (1 % 100) (1891 % 2560)) tabbedLayout''' (Column 1.6) (ClassName "Postman" `Or` ClassName "Emacs" `Or` ClassName "jetbrains-idea-ce" `Or` (Resource "Devtools" `And` ClassName "Firefox"))) ||| Full ||| Dwindle R CW 1 (5 % 100)
- sqrtTwo = approxRational (sqrt 2) (1 / 2560)
- xmobarPP' = xmobarPP { ppTitle = shorten 80
- , ppSort = (liftM2 (.)) getSortByIndex $ return scratchpadFilterOutWorkspace
- , ppUrgent = wrap "(" ")" . xmobarColor "#800000" ""
- , ppHiddenNoWindows = xmobarColor "#202020" "" . wrap "(" ")"
- , ppVisible = wrap "(" ")" . xmobarColor "#808000" ""
- , ppCurrent = wrap "(" ")" . xmobarColor "#008000" ""
- , ppHidden = wrap "(" ")"
- , ppWsSep = " "
- , ppSep = "\n"
- }
- withHostUrgency = case hostname of
- "sif" -> withUrgencyHookC urgencyHook' $ def { suppressWhen = U.Never, remindWhen = Every 2 }
- _ -> id
- urgencyHook' window = do
- let blinkLight = (lightHigh >> threadDelay 0.5e6) `finally` lightLow
- where
- lightHigh =
- writeFile "/sys/class/leds/input0::capslock/brightness" =<< readFile "/sys/class/leds/input0::capslock/max_brightness"
- lightLow = writeFile "/sys/class/leds/input0::capslock/brightness" "0"
- runQuery ((resource =? "comm" <||> resource =? "Pidgin" <||> className =? "Gajim" <||> className =? "Skype" <||> className =? "Thunderbird") --> void (xfork blinkLight)) window
- urgencyHook (BorderUrgencyHook { urgencyBorderColor = red }) window
- shutdown :: SomeException -> IO a
- shutdown e = do
- let pids = [ -- batteryMon
- ]
- mapM_ (signalProcess sigTERM) pids
- mapM_ (getProcessStatus False False) pids
- throw e
- keyUpEventHook :: Event -> X All
- keyUpEventHook event = handle event >> return (All True)
- where
- handle (KeyEvent { ev_event_type = t, ev_state = m, ev_keycode = code })
- | t == keyRelease = withDisplay $ \dpy -> do
- s <- io $ keycodeToKeysym dpy code 0
- mClean <- cleanMask m
- ks <- asks $ hKeyUpKeys host . config
- userCodeDef () $ whenJust (Map.lookup (mClean, s) ks) id
- | otherwise = return ()
- handle _ = return ()
- handle shutdown $ launch myConfig =<< getDirectories
-
-secs :: Int -> Int
-secs = (* 1000000)
-
--- monitorBattery :: Maybe BatteryContext -> Maybe Notification -> IO ()
--- monitorBattery Nothing n = do
--- ctx <- batteryContextNew
--- case ctx of
--- Nothing -> threadDelay (secs 10) >> monitorBattery Nothing n
--- Just _ -> monitorBattery ctx n
--- monitorBattery ctx@(Just ctx') n = do
--- batInfo <- getBatteryInfo ctx'
--- case batInfo of
--- Nothing -> threadDelay (secs 1) >> monitorBattery ctx n
--- Just batInfo -> do
--- let n'
--- | batteryState batInfo == BatteryStateDischarging
--- , timeLeft <= 1200
--- , timeLeft > 0 = Just $ summary "Discharging" <> hint "value" percentage <> urgency u <> body (duz timeLeft ++ "left")
--- | otherwise = Nothing
--- u
--- | timeLeft <= 600 = Critical
--- | timeLeft <= 1800 = Normal
--- | otherwise = Low
--- timeLeft = batteryTimeToEmpty batInfo
--- percentage :: Int32
--- percentage = round $ batteryPercentage batInfo
--- ts = [("s", 60), ("m", 60), ("h", 24), ("d", 365), ("y", 1)]
--- duz ms = ss
--- where (ss, _) = foldl (\(ss, x) (s, y) -> ((if rem x y > 0 then show (rem x y) ++ s ++ " " else "") ++ ss , quot x y)) ("", ms) ts
--- case n' of
--- Just n' -> Notify.display (maybe mempty reuse n <> Notify.appName "monitorBattery" <> n') >>= (\n -> threadDelay (secs 2) >> monitorBattery ctx (Just n))
--- Nothing -> threadDelay (secs 30) >> monitorBattery ctx n
-
-disableTouchpad, disableTrackpoint, enableTrackpoint, enableTouchpad :: X ()
-enableTouchpad = safeSpawn "xinput" ["enable", "SynPS/2 Synaptics TouchPad"]
-disableTouchpad = safeSpawn "xinput" ["disable", "SynPS/2 Synaptics TouchPad"]
-enableTrackpoint = safeSpawn "xinput" ["enable", "TPPS/2 IBM TrackPoint"]
-disableTrackpoint = safeSpawn "xinput" ["disable", "TPPS/2 IBM TrackPoint"]
-
-isDisabled :: String -> X Bool
-isDisabled str = do
- out <- runProcessWithInput "xinput" ["list", str] ""
- return $ "disabled" `isInfixOf` out
-
-
-spawnKeychain :: X ()
-spawnKeychain = do
- home <- liftIO getHomeDirectory
- let keys = (map ((home </>) . (".ssh/" ++)) ["id", "id-rsa"]) ++ ["6B13AA67"]
- liftIO (maybe (return ()) (setEnv "SSH_ASKPASS") =<< findAskpass)
- safeSpawn "keychain" . (["--agents", "gpg,ssh"] ++)=<< liftIO (filterM doesFileExist keys)
- where
- findAskpass = filter `liftM` readFile "/etc/zshrc"
- filter = listToMaybe . catMaybes . map (stripPrefix "export SSH_ASKPASS=") . lines
-
-assimilateKeychain :: X ()
-assimilateKeychain = liftIO $ assimilateKeychain' >> return ()
-assimilateKeychain' = tryIOError $ do
- -- pid <- getProcessID
- -- tmpDir <- lookupEnv "TMPDIR"
- -- let tmpDir' = fromMaybe "/tmp" tmpDir
- -- tmpFile = tmpDir' </> "xmonad-keychain" ++ (show pid) ++ ".env"
- env <- runProcessWithInput "sh" ["-c", "eval $(keychain --eval --noask --agents gpg,ssh); env"] "" -- > " ++ tmpFile] ""
- -- env <- readFile tmpFile
- let envVars = Map.fromList $ map (\(k, v) -> (k, tail' v)) $ map (span (/= '=')) $ envLines
- envVars' = Map.filterWithKey (\k _ -> k `elem` transfer) envVars
- transfer = ["SSH_AUTH_SOCK", "SSH_AGENT_PID", "GPG_AGENT_INFO"]
- envLines = filter (elem '=') $ lines env :: [String]
- sequence $ map (\(k, c) -> setEnv k c) $ Map.toList envVars'
- -- removeFile tmpFile
- where
- tail' [] = []
- tail' (x:xs) = xs
-
-
-numKeys = [xK_parenleft, xK_parenright, xK_braceright, xK_plus, xK_braceleft, xK_bracketright, xK_bracketleft, xK_exclam, xK_equal, xK_asterisk]
-
-instance Shrinker CustomShrink where
- shrinkIt _ "" = [""]
- shrinkIt s cs
- | length cs >= 4 = cs : shrinkIt s ((reverse . drop 4 . reverse $ cs) ++ "...")
- | otherwise = cs : shrinkIt s (init cs)
-
-xPConfig, xPConfigMonospace :: XPConfig
-xPConfig = def
- { font = "xft:Fira Sans:pixelsize=21"
- , height = 32
- , bgColor = "black"
- , fgColor = gray
- , fgHLight = green
- , bgHLight = "black"
- , borderColor = gray
- , searchPredicate = (\needle haystack -> all (`isInfixOf` map toLower haystack) . map (map toLower) $ words needle)
- , position = Top
- }
-xPConfigMonospace = xPConfig { font = "xft:Fira Code:pixelsize=21" }
-
-sshOverrides host = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux host} )
- [ "odin"
- , "ymir"
- , "surtr"
- , "vidhar"
- , "srv02.uniworx.de"
- ]
- ++
- map (\h -> mkOverride { oHost = h, oCommand = moshCmd' "/run/current-system/sw/bin/mosh-server" . withEnv [("TERM", "xterm")] . inTmux host} )
- [ "bragi", "bragi.asgard.yggdrasil"
- ]
- ++
- map (\h -> mkOverride { oHost = h, oCommand = sshCmd . inTmux host } )
- [ "uni2work-dev1", "srv01.uniworx.de"
- ]
- ++
- map (\h -> mkOverride { oHost = h, oCommand = sshCmd . withEnv [("TERM", "xterm")] . inTmux host } )
- [ "remote.cip.ifi.lmu.de"
- , "uniworx3", "uniworx4", "uniworx5", "uniworxdb2"
- , "testworx"
- ]
-
-backlight :: (Rational -> Rational) -> X ()
-backlight f = void . xfork . liftIO $ do
- [ _device
- , _class
- , read . Text.unpack -> currentBright
- , _currentPercentage
- , read . Text.unpack -> maximumBright
- ] <- Text.splitOn "," . Text.pack <$> readProcess "brightnessctl" ["-m"] ""
- let current = currentBright % maximumBright
- new' = f current * fromIntegral maximumBright
- new :: Integer
- new | floor new' < 0 = 0
- | ceiling new' > maximumBright = maximumBright
- | new' >= maximumBright % 2 = ceiling new'
- | otherwise = floor new'
- callProcess "brightnessctl" ["-m", "s", show new]
-
-cycleThrough :: [Rational] -> (Rational -> Rational)
-cycleThrough opts current = fromMaybe currentOpt $ listToMaybe next'
- where currentOpt = minimumBy (comparing $ abs . subtract current) opts
- (_, _ : next') = break (== currentOpt) opts
-
-cycleKbLayout :: [(String, Maybe String)] -> X ()
-cycleKbLayout [] = return ()
-cycleKbLayout layouts = liftIO $ do
- next <- (getNext . extract) `liftM` runProcessWithInput "setxkbmap" ["-query"] ""
- let
- args = case next of
- (l, Just v) -> [l, v]
- (l, Nothing) -> [l]
- safeSpawn "setxkbmap" args
- where
- extract :: String -> Maybe (String, Maybe String)
- extract str = listToMaybe $ do
- ["layout:", l] <- str'
- [(l, Just v) | ["variant:", v] <- str'] ++ pure (l, Nothing)
- where
- str' = map words $ lines str
- getNext :: Maybe (String, Maybe String) -> (String, Maybe String)
- getNext = maybe (head layouts) getNext'
- getNext' x = case elemIndex x layouts of
- Nothing -> getNext Nothing
- Just i -> layouts !! ((i + 1) `mod` length layouts)
-
-mpvAll' :: MpvCommand -> IO [MpvResponse]
-mpvAll' = mpvAll "/var/media/.mpv-ipc"
-
-mpvOne' :: MpvCommand -> IO (Maybe MpvResponse)
-mpvOne' = mpvOne "/var/media/.mpv-ipc"
-
-mediaMpv :: MpvCommand -> X ()
-mediaMpv cmd = void . xfork $ print =<< mpvAll' cmd
-
-mediaMpvTogglePause :: X ()
-mediaMpvTogglePause = void . xfork $ do
- paused <- mapM mpvResponse <=< mpvAll' $ MpvGetProperty "pause"
- if
- | and paused -> print <=< mpvAll' $ MpvSetProperty "pause" False
- | otherwise -> print <=< mpvOne' $ MpvSetProperty "pause" True
-
-myKeys' conf host = Map.fromList $
- -- launch a terminal
- [ ((modm, xK_Return), spawn $ (XMonad.terminal conf) ++ " -e tmux")
- , ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)
-
- -- launch dmenu
- --, ((modm, xK_d ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
- , ((modm, xK_d ), shellPrompt "Run: " xPConfigMonospace)
- , ((modm .|. shiftMask, xK_d ), prompt "Run in Terminal: " ("alacritty" ++ " -e") xPConfigMonospace)
- , ((modm, xK_at ), sshPrompt (sshOverrides . Just $ hName host) xPConfigMonospace)
-
- -- close focused window
- , ((modm .|. shiftMask, xK_q ), kill)
- , ((modm .|. controlMask .|. shiftMask, xK_q ), spawn "xkill")
-
- -- Rotate through the available layout algorithms
- , ((modm, xK_space ), sendMessage NextLayout)
-
- -- Reset the layouts on the current workspace to default
- , ((modm .|. controlMask, xK_r ), (setLayout $ XMonad.layoutHook conf) >> refresh)
-
- -- Resize viewed windows to the correct size
- , ((modm, xK_r ), refresh)
-
- -- Move focus to the next window
- , ((modm, xK_t ), windows W.focusDown)
-
- -- Move focus to the previous window
- , ((modm, xK_n ), windows W.focusUp )
-
- -- Move focus to the master window
- , ((modm, xK_m ), windows W.focusMaster )
-
- -- Swap the focused window and the master window
- , ((modm .|. shiftMask, xK_m ), windows W.swapMaster)
-
- -- Swap the focused window with the next window
- , ((modm .|. shiftMask, xK_t ), windows W.swapDown )
-
- -- Swap the focused window with the previous window
- , ((modm .|. shiftMask, xK_n ), windows W.swapUp )
-
- -- Swap the focused window with the previous window
- , ((modm .|. shiftMask .|. controlMask, xK_m), sendMessage SwapWindow)
-
- , ((modm, xK_Right), sendMessage $ Go R)
- , ((modm, xK_Left ), sendMessage $ Go L)
- , ((modm, xK_Up ), sendMessage $ Go U)
- , ((modm, xK_Down ), sendMessage $ Go D)
- , ((modm .|. shiftMask , xK_Right), sendMessage $ Move R)
- , ((modm .|. shiftMask , xK_Left ), sendMessage $ Move L)
- , ((modm .|. shiftMask , xK_Up ), sendMessage $ Move U)
- , ((modm .|. shiftMask , xK_Down ), sendMessage $ Move D)
- -- , ((modm .|. controlMask, xK_Right), withFocused $ keysMoveWindow (10, 0))
- -- , ((modm .|. controlMask, xK_Left ), withFocused $ keysMoveWindow (-10, 0))
- -- , ((modm .|. controlMask, xK_Up ), withFocused $ keysMoveWindow (0, -10))
- -- , ((modm .|. controlMask, xK_Down ), withFocused $ keysMoveWindow (0, 10))
- -- Shrink the master area
- , ((modm, xK_h ), sendMessage Shrink)
-
- -- Expand the master area
- , ((modm, xK_s ), sendMessage Expand)
-
- -- Push window back into tiling
- , ((modm .|. shiftMask, xK_space ), withFocused $ windows . W.sink)
- , ((modm, xK_BackSpace), focusUrgent)
- , ((modm .|. shiftMask, xK_BackSpace), clearUrgents)
-
- -- Increment the number of windows in the master area
- , ((modm , xK_comma ), sendMessage (IncMasterN 1))
-
- -- Deincrement the number of windows in the master area
- , ((modm , xK_period), sendMessage (IncMasterN (-1)))
-
- , ((0, xF86XK_AudioRaiseVolume), safeSpawn "pamixer" ["-i", "2"])
- , ((0, xF86XK_AudioLowerVolume), safeSpawn "pamixer" ["-d", "2"])
- , ((0, xF86XK_AudioMute), safeSpawn "pamixer" ["-t"])
- , ((0, xF86XK_AudioPause), mediaMpv $ MpvSetProperty "pause" False)
- , ((0, {-xF86XK_AudioMicMute-} 269025202), safeSpawn "pulseaudio-ctl" ["mute-input"])
- , ((0, xF86XK_AudioPlay), mediaMpvTogglePause)
- , ((0, xK_Print), do
- home <- liftIO getHomeDirectory
- unGrab
- safeSpawn "scrot" ["-s", "-F", home </> "screenshots" </> "%Y-%m-%dT%H:%M:%S.png", "-e", "xclip -selection clipboard -t image/png -i $f"]
- )
- , ((modm .|. mod1Mask, xK_space), mediaMpvTogglePause)
-
- -- , ((0, xF86XK_MonBrightnessDown), backlight . cycleThrough $ reverse brCycle)
- -- , ((0, xF86XK_MonBrightnessUp ), backlight $ cycleThrough brCycle)
- , ((modm .|. shiftMask , xK_b), backlight . cycleThrough $ reverse brCycle)
- , ((modm .|. shiftMask .|. controlMask, xK_b), backlight $ cycleThrough brCycle)
-
- , ((modm , xK_Escape), cycleKbLayout (hKbLayouts host))
- , ((modm .|. controlMask, xK_Escape), safeSpawn "setxkbmap" $ fst (head $ hKbLayouts host) : maybeToList (snd . head $ hKbLayouts host))
-
- -- Toggle the status bar gap
- -- Use this binding with avoidStruts from Hooks.ManageDocks.
- -- See also the statusBar function from Hooks.DynamicLog.
- --
- , ((modm , xK_b ), sendMessage ToggleStruts)
-
- , ((modm .|. shiftMask, xK_p ), safeSpawn "playerctl" ["-a", "pause"])
-
- -- Quit xmonad
- , ((modm .|. shiftMask, xK_e ), io (exitWith ExitSuccess))
-
- -- Restart xmonad
- -- , ((modm .|. shiftMask .|. controlMask, xK_r ), void . xfork $ recompile False >>= flip when (safeSpawn "xmonad" ["--restart"]))
- , ((modm .|. shiftMask, xK_r ), void . liftIO $ executeFile "xmonad" True [] Nothing)
- , ((modm .|. shiftMask, xK_l ), void . xfork $ do
- sessId <- getEnv "XDG_SESSION_ID"
- safeSpawn "loginctl" ["lock-session", sessId]
- )
- , ((modm .|. shiftMask, xK_s ), safeSpawn "systemctl" ["suspend"])
- , ((modm .|. shiftMask, xK_h ), inputPromptWithCompl xPConfigMonospace "systemctl" powerActCompl ?+ powerAct)
- , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible
- , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back
- , ((modm .|. shiftMask, xK_g ), windowPrompt xPConfig Goto wsWindows)
- , ((modm , xK_g ), windowPrompt xPConfig Bring allWindows)
- ]
- ++
-
- --
- -- mod-[1..9], Switch to workspace N
- --
- -- mod-[1..9], Switch to workspace N
- -- mod-shift-[1..9], Move client to workspace N
- --
- [((m .|. modm, k), windows $ f i)
- | (i, k) <- zip (XMonad.workspaces conf) $ numKeys
- , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]
- ]
- ++
- [((m .|. modm .|. controlMask, k), void . runMaybeT $
- MaybeT (P.getScreen def i) >>= MaybeT . screenWorkspace >>= lift . windows . f
- )
- | (i, k) <- zip (hScreens host) [xK_g, xK_c, xK_r, xK_l]
- , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]
- ]
- where
- modm = XMonad.modMask conf
-
- brCycle = [0, 1 % 500, 1 % 250, 1 % 100, 1 % 10, 1 % 4, 1 % 2, 3 % 4, 1]
-
- powerActWords = ["poweroff", "reboot", "hibernate", "suspend"]
- powerActCompl = mkComplFunFromList' xPConfigMonospace powerActWords
- powerAct act | act `elem` powerActWords = safeSpawn "systemctl" $ pure act
- | otherwise = return ()
--
cgit v1.2.3