From 37e55957fbf411b928184465acb2b1ecd5ca6852 Mon Sep 17 00:00:00 2001 From: Gregor Kleen 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') 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 = "%s %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 = "%s\\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"{icon}" # noqa: E501 + if is_silent: + text = f"{text}" + 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 {}).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 --- (). -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 --- - -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