From 1705eeae8e3c14aa188dcd073e8875aab40e888c Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 4 Nov 2021 02:17:24 -0600 Subject: Fixed huuuuge bug related to dynamicLogWithPP. dynamicLogWithPP does not support Unicode properly!! It was encoding each "Char" (32 bits in Haskell, mind you!) to a utf-8 byte instead of a codepoint. The result was a butchared faux-utf8 encoded string. This was causing xmobar to crash with unicode + my truncating code. I have now moved away from dynamicLogWithPP and am writing my own log string manually. It's better this way anyway; less hacky; more fine-grained control. --- src/Internal/Layout.hs | 25 ++++++----- src/Main.hs | 118 ++++++++++++++++++++++++++++++------------------- 2 files changed, 86 insertions(+), 57 deletions(-) (limited to 'src') diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs index 2b66f06..06ac7d6 100644 --- a/src/Internal/Layout.hs +++ b/src/Internal/Layout.hs @@ -23,18 +23,19 @@ import qualified Data.Map as M import qualified XMonad.StackSet as W myLayout = - ModifiedLayout (Zoomable False 0.05 0.05) $ - ModifiedLayout (Flippable False) $ - ModifiedLayout (HFlippable False) $ - spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ - spiral (6/7) ||| - ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) ||| - ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) ||| - Full ||| - Grid ||| - Dishes 2 (1/6) ||| - (MosaicAlt M.empty :: MosaicAlt Window) ||| - (D.Dwindle D.R D.CW 1.5 1.1) + avoidStruts $ + ModifiedLayout (Zoomable False 0.05 0.05) $ + ModifiedLayout (Flippable False) $ + ModifiedLayout (HFlippable False) $ + spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ + spiral (6/7) ||| + ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) ||| + ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) ||| + Full ||| + Grid ||| + Dishes 2 (1/6) ||| + (MosaicAlt M.empty :: MosaicAlt Window) ||| + (D.Dwindle D.R D.CW 1.5 1.1) data ModifyDescription m l a = ModifyDescription m (l a) deriving (Show, Read) diff --git a/src/Main.hs b/src/Main.hs index 6129839..9785b52 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,28 +1,44 @@ import XMonad -import Control.Exception -import XMonad.Hooks.DynamicLog + import Control.Concurrent -import XMonad.Layout.Spacing -import XMonad.Actions.WindowNavigation -import XMonad.Util.CustomKeys +import Control.Exception +import Control.Monad +import Control.Monad (when) +import Control.Monad.Writer +import Data.Ord +import Data.List (partition, isPrefixOf, sortBy) +import Data.List.Split +import Data.Maybe +import Internal.Keys +import Internal.Layout +import Internal.LayoutDraw import System.Directory import System.FilePath +import System.IO import System.Process -import Internal.Layout -import XMonad.Hooks.ManageHelpers -import XMonad.Layout.IndependentScreens import Text.Printf -import Data.List.Split +import XMonad.Actions.WindowNavigation +import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks +import XMonad.Hooks.ManageHelpers +import XMonad.Layout.IndependentScreens +import XMonad.Layout.Spacing +import XMonad.Util.CustomKeys +import XMonad.Util.NamedWindows import XMonad.Util.Run (spawnPipe) -import Control.Monad (when) -import System.IO -import Internal.Keys -import Internal.LayoutDraw -import Data.List (partition, isPrefixOf) -import Data.Maybe +import qualified XMonad.StackSet as S + +data WorkspaceState = Current | Hidden | Visible + +getWorkspaces :: (Ord i) => S.StackSet i l a sid sd -> [(WorkspaceState, i)] +getWorkspaces (S.StackSet (S.Screen cur _ _) vis hi _) = + sortBy (comparing snd) $ + mapMaybe (\(a, S.Workspace t _ s) -> fmap (const (a, t)) s) $ + map (\w -> (Hidden, w)) hi ++ + map (\(S.Screen w _ _) -> (Visible, w)) vis ++ + [(Current, cur)] main = do @@ -31,9 +47,15 @@ main = do let fp = homeDir ".xmonad" "startup" xmproc <- spawnPipe "xmobar" + hSetEncoding xmproc utf8 + + logFile <- openFile "/tmp/xmonad.log" WriteMode + + hPutStrLn logFile "·······························" + hFlush logFile config <- - applyKeys $ docks $ def + applyKeys $ def { terminal = "alacritty" , modMask = mod3Mask , borderWidth = 2 @@ -41,10 +63,10 @@ main = do , focusedBorderColor = "#ff6c00" -- , normalBorderColor = "#ffd9bf" , normalBorderColor = "#000000" - , layoutHook = avoidStruts myLayout + , layoutHook = myLayout , startupHook = do ewmhDesktopsStartup - spawn fp + spawn fp , manageHook = composeAll [ isFullscreen --> doFullFloat , className =? "Tilda" --> doFloat @@ -61,44 +83,50 @@ main = do , logHook = do (_, _, layout) <- showLayout - dynamicLogWithPP $ xmobarPP { - ppCurrent = xmobarColor "#ff8888" "red" . printf "%s" - , ppVisible = xmobarColor "#8888ff" "" . printf "%s" - , ppHidden = xmobarColor "#888888" "" . printf "%s" - , ppWsSep = " " - , ppTitle = - xmobarColor "#a0a0a0" "" . - printf "%s" - - , ppSep = xmobarColor "#404040" "" " │ " - , ppLayout = const (fromMaybe "" layout) - , ppExtras = [] - , ppOutput = hPutStrLn xmproc . reverse . trunc 80 - , ppOrder = \ss -> - let (icons, etc) = partition (" do + case t of + Current -> tell "" + Visible -> tell "" + Hidden -> tell "" + tell name + tell " " + + tell $ xmobarColor "#404040" "" "│ " + tell $ "" + tell $ title + tell $ "" } -- let toggleStructsKey XConfig {XMonad.modMask = modMask} = (modMask, xK_b) - xmonad config + xmonad (docks config) where - trunc amt str = trunc' False amt str [] - trunc' _ _ [] acc = acc - trunc' ignore amt (a:as) acc = + trunc amt str = trunc' False amt str + + trunc' :: Bool -> Int -> String -> String + trunc' _ _ [] = [] + trunc' ignore amt (a:as) = case a of - '<' -> trunc' True amt as (a : acc) - '>' -> trunc' False amt as (a : acc) + '<' -> a : trunc' True amt as + '>' -> a : trunc' False amt as _ -> if ignore - then trunc' True amt as (a : acc) + then a : trunc' True amt as else case amt of - 0 -> trunc' False 0 as acc - 4 | length as > 3 -> trunc' False 0 as ("... " ++ acc) - _ -> trunc' False (amt - 1) as (a : acc) + 0 -> trunc' False 0 as + 3 -> "..." ++ trunc' False 0 as + _ -> a : trunc' False (amt - 1) as splitOnAll arr str = splitOnAll' arr [str] splitOnAll' [] str = str -- cgit