Merge remote-tracking branch 'lass/master'

8 files changed, 200 insertions, 96 deletions

diff --git a/tv/5pkgs/haskell/xmonad-tv/default.nix b/tv/5pkgs/haskell/xmonad-tv/default.nix
index be3eca982..f42f97c2a 100644
--- a/tv/5pkgs/haskell/xmonad-tv/default.nix
+++ b/tv/5pkgs/haskell/xmonad-tv/default.nix
@@ -1,6 +1,5 @@
 { mkDerivation, aeson, base, bytestring, containers, directory
-, extra, filepath, lib, systemd, template-haskell, th-env
-, transformers, unix, X11, xmonad, xmonad-contrib
+, extra, filepath, lib, pager, unix, X11, xmonad, xmonad-contrib
 }:
 mkDerivation {
   pname = "xmonad-tv";
@@ -9,8 +8,9 @@ mkDerivation {
   isLibrary = false;
   isExecutable = true;
   executableHaskellDepends = [
-    aeson base bytestring containers directory extra filepath systemd
-    template-haskell th-env transformers unix X11 xmonad xmonad-contrib
+    aeson base bytestring containers directory extra filepath pager
+    unix X11 xmonad xmonad-contrib
   ];
   license = lib.licenses.mit;
+  mainProgram = "xmonad";
 }
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs b/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
new file mode 100644
index 000000000..bf8431446
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module XMonad.Hooks.EwmhDesktops.Extra where
+
+import Control.Monad (when)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (All)
+import Data.Tuple.Extra (both)
+import Graphics.X11.EWMH (getDesktopNames, setDesktopNames)
+import Graphics.X11.EWMH.Atom (_NET_DESKTOP_NAMES)
+import Graphics.X11.Xlib.Display.Extra (withDefaultDisplay)
+import XMonad hiding (workspaces)
+import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace, removeEmptyWorkspaceByTag)
+import XMonad.StackSet (mapWorkspace, tag, workspaces)
+import XMonad.Util.WorkspaceCompare (getSortByIndex)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified XMonad
+
+
+ewmhExtra :: XConfig a -> IO (XConfig a)
+ewmhExtra c = do
+    -- XMonad.Hooks.EwmhDesktops.setDesktopViewport uses _NET_DESKTOP_VIEWPORT
+    -- only if it exists.  This seems to be a harmless issue, but by creating
+    -- the atom here, we suppress the error message:
+    --
+    --    xmonad: X11 error: BadAtom (invalid Atom parameter),
+    --    request code=18, error code=5
+    --
+    _ <-
+      withDefaultDisplay $ \dpy -> internAtom dpy "_NET_DESKTOP_VIEWPORT" False
+
+    initialWorkspaces <-
+      Data.Maybe.fromMaybe (XMonad.workspaces def)
+        <$> withDefaultDisplay getDesktopNames
+
+    return
+      c { handleEventHook = ewmhDesktopsExtraEventHook <> handleEventHook c
+        , rootMask = rootMask c .|. propertyChangeMask
+        , XMonad.workspaces = initialWorkspaces
+        }
+
+ewmhDesktopsExtraEventHook :: Event -> X All
+ewmhDesktopsExtraEventHook = \case
+    PropertyEvent{ev_window, ev_atom} -> do
+      r <- asks theRoot
+      when (ev_window == r && ev_atom == _NET_DESKTOP_NAMES) $
+        withDisplay $ \dpy -> do
+          sort <- getSortByIndex
+
+          oldNames <- gets $ map tag . sort . workspaces . windowset
+          newNames <- fromMaybe oldNames <$> io (getDesktopNames dpy)
+
+          let
+            (renamesFrom, renamesTo) = both Set.fromList $ unzip renames
+
+            renames = go oldNames newNames where
+              go old@(headOld : tailOld) new@(headNew : tailNew) = do
+                let
+                  deleteOld = Set.member headOld deleteNameSet
+                  createNew = Set.member headNew createNameSet
+
+                if
+                  | headOld == headNew ->
+                    -- assert (not deleteOld && not createNew)
+                    go tailOld tailNew
+
+                  | deleteOld && createNew ->
+                    (headOld, headNew) :
+                    go tailOld tailNew
+
+                  | deleteOld ->
+                    go tailOld new
+
+                  | createNew ->
+                    go old tailNew
+
+                  | otherwise ->
+                    -- assert (headOld == headNew)
+                    go tailOld tailNew
+
+              go _ _ = []
+
+            oldNameSet = Set.fromList oldNames
+            newNameSet = Set.fromList newNames
+            deleteNameSet = Set.difference oldNameSet newNameSet
+            createNameSet = Set.difference newNameSet oldNameSet
+
+            deleteNames = Set.toAscList $
+                            Set.difference deleteNameSet renamesFrom
+            createNames = Set.toAscList $
+                            Set.difference createNameSet renamesTo
+
+          mapM_ addHiddenWorkspace createNames
+          mapM_ removeEmptyWorkspaceByTag deleteNames
+          when (not (null renames)) $ do
+            let
+              renameMap = Map.fromList renames
+              rename w =
+                case Map.lookup (tag w) renameMap of
+                  Just newName -> w { tag = newName }
+                  Nothing -> w
+
+            modifyWindowSet $ mapWorkspace rename
+
+          names <- gets $ map tag . sort . workspaces . windowset
+
+          when (names /= newNames) $ do
+            trace $ "setDesktopNames " <> show names
+            io (setDesktopNames names dpy)
+
+      mempty
+
+    _ ->
+      mempty
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/main.hs b/tv/5pkgs/haskell/xmonad-tv/src/main.hs
index eb61bd5cf..7256963a5 100644
--- a/tv/5pkgs/haskell/xmonad-tv/src/main.hs
+++ b/tv/5pkgs/haskell/xmonad-tv/src/main.hs
@@ -5,16 +5,15 @@ module Main (main) where
 
 import System.Exit (exitFailure)
 import XMonad.Hooks.EwmhDesktops (ewmh)
+import XMonad.Hooks.EwmhDesktops.Extra (ewmhExtra)
 import XMonad.Hooks.RefocusLast (refocusLastLayoutHook, toggleFocus)
 
-import Control.Exception
 import Control.Monad.Extra (whenJustM)
 import qualified Data.Aeson
 import qualified Data.ByteString.Char8
 import qualified Data.List
 import qualified Data.Maybe
 import Graphics.X11.ExtraTypes.XF86
-import Text.Read (readEither)
 import XMonad
 import XMonad.Extra (isFloatingX)
 import System.IO (hPutStrLn, stderr)
@@ -23,6 +22,7 @@ import System.Posix.Process (executeFile)
 import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace
                                         , removeEmptyWorkspace)
 import XMonad.Actions.CycleWS (toggleWS)
+import XMonad.Layout.Gaps (Direction2D(U,R,D,L), gaps)
 import XMonad.Layout.NoBorders ( smartBorders )
 import XMonad.Layout.ResizableTile (ResizableTall(ResizableTall))
 import XMonad.Layout.ResizableTile (MirrorResize(MirrorExpand,MirrorShrink))
@@ -58,22 +58,27 @@ main = getArgs >>= \case
 
 readEnv :: Data.Aeson.FromJSON b => String -> IO b
 readEnv name =
-    Data.Maybe.fromJust
+    readEnv' (error $ "could not get environment variable: " <> name) name
+
+readEnv' :: Data.Aeson.FromJSON b => b -> String -> IO b
+readEnv' defaultValue name =
+    Data.Maybe.fromMaybe defaultValue
       . Data.Aeson.decodeStrict'
       . Data.ByteString.Char8.pack
-      <$> getEnv name
+      . Data.Maybe.fromMaybe mempty
+      <$> lookupEnv name
 
 mainNoArgs :: IO ()
 mainNoArgs = do
+    myScreenGaps <- readEnv' [] "XMONAD_SCREEN_GAPS" :: IO [Int]
     myScreenWidth <- readEnv "XMONAD_SCREEN_WIDTH" :: IO Dimension
     myTermFont <- getEnv "XMONAD_TERM_FONT"
     myTermFontWidth <- readEnv "XMONAD_TERM_FONT_WIDTH" :: IO Dimension
     myTermPadding <- readEnv "XMONAD_TERM_PADDING" :: IO Dimension
-    workspaces0 <- getWorkspaces0
     handleShutdownEvent <- newShutdownEventHandler
-    let
-      config =
-        ewmh
+    config <-
+      ewmhExtra
+        $ ewmh
         $ withUrgencyHookC
             BorderUrgencyHook
               { urgencyBorderColor = "#ff0000"
@@ -86,9 +91,9 @@ mainNoArgs = do
             { terminal          = {-pkg:alacritty-tv-}"alacritty"
             , modMask           = mod4Mask
             , keys              = myKeys myTermFont
-            , workspaces        = workspaces0
             , layoutHook =
                 refocusLastLayoutHook $
+                gaps (zip [U,R,D,L] myScreenGaps) $
                 smartBorders $
                   ResizableTall
                     1
@@ -117,23 +122,6 @@ mainNoArgs = do
     launch config directories
 
 
-getWorkspaces0 :: IO [String]
-getWorkspaces0 =
-    try (getEnv "XMONAD_WORKSPACES0_FILE") >>= \case
-      Left e -> warn (displaySomeException e)
-      Right p -> try (readFile p) >>= \case
-        Left e -> warn (displaySomeException e)
-        Right x -> case readEither x of
-          Left e -> warn e
-          Right y -> return y
-  where
-    warn msg = hPutStrLn stderr ("getWorkspaces0: " ++ msg) >> return []
-
-
-displaySomeException :: SomeException -> String
-displaySomeException = displayException
-
-
 forkFile :: FilePath -> [String] -> Maybe [(String, String)] -> X ()
 forkFile path args env =
     xfork (executeFile path True args env) >> return ()
@@ -198,7 +186,7 @@ myKeys font conf = Map.fromList $
 
     , ((_4, xK_Prior), forkFile {-pkg-}"xcalib" ["-invert", "-alter"] Nothing)
 
-    , ((0, xK_Print), forkFile {-pkg-}"flameshot" [] Nothing)
+    , ((0, xK_Print), forkFile {-pkg:flameshot-once-tv-}"flameshot-once" [] Nothing)
 
     , ((_C, xF86XK_Forward), forkFile {-pkg:xdpytools-}"xdpychvt" ["next"] Nothing)
     , ((_C, xF86XK_Back), forkFile {-pkg:xdpytools-}"xdpychvt" ["prev"] Nothing)
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal b/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal
index 62faf2f00..f211627bf 100644
--- a/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal
+++ b/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal
@@ -9,20 +9,21 @@ cabal-version: >=1.10
 executable xmonad
   main-is: main.hs
   build-depends:
-    aeson,
-    base,
-    bytestring,
-    containers,
-    directory,
-    extra,
-    filepath,
-    template-haskell,
-    th-env,
-    unix,
-    X11,
-    xmonad,
-    xmonad-contrib
+      base
+    , X11
+    , aeson
+    , bytestring
+    , containers
+    , directory
+    , extra
+    , filepath
+    , pager
+    , unix
+    , xmonad
+    , xmonad-contrib
   other-modules:
     Shutdown
+    XMonad.Extra
+    XMonad.Hooks.EwmhDesktops.Extra
   default-language: Haskell2010
-  ghc-options: -O2 -Wall -threaded
+  ghc-options: -O2 -Wall
diff --git a/tv/5pkgs/override/flameshot/default.nix b/tv/5pkgs/override/flameshot/default.nix
deleted file mode 100644
index 10154cc44..000000000
--- a/tv/5pkgs/override/flameshot/default.nix
+++ /dev/null
@@ -1,15 +0,0 @@
-self: super:
-
-super.flameshot.overrideAttrs (old: rec {
-  name = "flameshot-${version}";
-  version = "0.10.2";
-  src = self.fetchFromGitHub {
-    owner = "flameshot-org";
-    repo = "flameshot";
-    rev = "v${version}";
-    sha256 = "sha256-rZUiaS32C77tFJmEkw/9MGbVTVscb6LOCyWaWO5FyR4=";
-  };
-  patches = old.patches or [] ++ [
-    ./flameshot_imgur_0.10.2.patch
-  ];
-})
diff --git a/tv/5pkgs/override/flameshot/flameshot_imgur_0.10.2.patch b/tv/5pkgs/override/flameshot/flameshot_imgur_0.10.2.patch
deleted file mode 100644
index c4c0bf38a..000000000
--- a/tv/5pkgs/override/flameshot/flameshot_imgur_0.10.2.patch
+++ /dev/null
@@ -1,35 +0,0 @@
---- a/src/tools/imgur/imguruploader.cpp
-+++ b/src/tools/imgur/imguruploader.cpp
-@@ -31,6 +31,7 @@
- #include <QTimer>
- #include <QUrlQuery>
- #include <QVBoxLayout>
-+#include <stdlib.h>
- 
- ImgurUploader::ImgurUploader(const QPixmap& capture, QWidget* parent)
-   : QWidget(parent)
-@@ -79,8 +80,11 @@ void ImgurUploader::handleReply(QNetworkReply* reply)
-         m_imageURL.setUrl(data[QStringLiteral("link")].toString());
- 
-         auto deleteToken = data[QStringLiteral("deletehash")].toString();
-+        char *deleteImageURLPattern = secure_getenv("IMGUR_DELETE_URL");
-+        if (deleteImageURLPattern == NULL)
-+            deleteImageURLPattern = "https://imgur.com/delete/%1";
-         m_deleteImageURL.setUrl(
--          QStringLiteral("https://imgur.com/delete/%1").arg(deleteToken));
-+          QString::fromUtf8(deleteImageURLPattern).arg(deleteToken));
- 
-         // save history
-         QString imageName = m_imageURL.toString();
-@@ -133,7 +137,10 @@ void ImgurUploader::upload()
-     QString description = FileNameHandler().parsedPattern();
-     urlQuery.addQueryItem(QStringLiteral("description"), description);
- 
--    QUrl url(QStringLiteral("https://api.imgur.com/3/image"));
-+    char *createImageURLPattern = secure_getenv("IMGUR_CREATE_URL");
-+    if (createImageURLPattern == NULL)
-+        createImageURLPattern = "https://api.imgur.com/3/image";
-+    QUrl url(QString::fromUtf8(createImageURLPattern));
-     url.setQuery(urlQuery);
-     QNetworkRequest request(url);
-     request.setHeader(QNetworkRequest::ContentTypeHeader,
diff --git a/tv/5pkgs/simple/flameshot-once-tv.nix b/tv/5pkgs/simple/flameshot-once-tv.nix
new file mode 100644
index 000000000..e3a9f9a4f
--- /dev/null
+++ b/tv/5pkgs/simple/flameshot-once-tv.nix
@@ -0,0 +1,48 @@
+{ pkgs }:
+
+pkgs.flameshot-once.override {
+  name = "flameshot-once-tv";
+  config.imgur.enable = true;
+  config.imgur.createUrl = "http://ni.r/image";
+  config.imgur.deleteUrl = "http://ni.r/image/delete/%1";
+  config.imgur.xdg-open.browser = "/etc/profiles/per-user/tv/bin/cr";
+  config.settings.General = {
+    autoCloseIdleDaemon = true;
+    buttons = [
+      "TYPE_ARROW"
+      "TYPE_CIRCLE"
+      "TYPE_CIRCLECOUNT"
+      "TYPE_COPY"
+      "TYPE_DRAWER"
+      "TYPE_IMAGEUPLOADER"
+      "TYPE_MARKER"
+      "TYPE_MOVESELECTION"
+      "TYPE_PENCIL"
+      "TYPE_PIXELATE"
+      "TYPE_RECTANGLE"
+      "TYPE_SAVE"
+      "TYPE_SELECTION"
+      "TYPE_TEXT"
+    ];
+    checkForUpdates = false;
+    contrastOpacity = 220;
+    copyPathAfterSave = true;
+    disabledTrayIcon = true;
+    drawColor = "#E4002B";
+    drawThickness = 8;
+    filenamePattern = "%FT%T%z_flameshot";
+    fontFamily = "iosevka tv 2";
+    savePath = "/tmp";
+    savePathFixed = true;
+    showDesktopNotification = false;
+    showHelp = false;
+    showSidePanelButton = false;
+    showStartupLaunchMessage = false;
+    squareMagnifier = true;
+    uploadWithoutConfirmation = true;
+  };
+  config.settings.Shortcuts = {
+    TYPE_COPY = "Return";
+    TYPE_TOGGLE_PANEL = "`";
+  };
+}
diff --git a/tv/5pkgs/simple/q/default.nix b/tv/5pkgs/simple/q/default.nix
index 809e37e59..1aea80b26 100644
--- a/tv/5pkgs/simple/q/default.nix
+++ b/tv/5pkgs/simple/q/default.nix
@@ -25,7 +25,7 @@ let
     fi |
     ${pkgs.gnused}/bin/sed -r '
       # dim week numbers
-      s/((^ *|  )[ 1-5][0-9](   *)?)(([ 1-3][0-9])*)/\1\4/g
+      s/((^|  )[ 1-5][0-9])(( ..| \[7m..\[27m){7})/\1\3/g
       # dim month and day names
       s/^ *[A-Z].*/&/
       # highlight current date