[XMonad] Add icon support/fix selection of windows

This commit is contained in:
Ivan Malison 2019-06-24 15:35:40 -07:00
parent a4c784a947
commit 0538219110
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8
2 changed files with 30 additions and 11 deletions

View File

@ -22,6 +22,7 @@ executable imalison-xmonad
, hostname>=1.0 , hostname>=1.0
, multimap>=1.2.1 , multimap>=1.2.1
, process>=1.4.3.0 , process>=1.4.3.0
, safe
, split , split
, taffybar , taffybar
, transformers>=0.5.2.0 , transformers>=0.5.2.0

View File

@ -3,6 +3,7 @@
FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-} FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}
module Main where module Main where
import Codec.Binary.UTF8.String as UTF8
import qualified Codec.Binary.UTF8.String as UTF8String (encode) import qualified Codec.Binary.UTF8.String as UTF8String (encode)
import qualified Control.Arrow as A import qualified Control.Arrow as A
import Control.Monad import Control.Monad
@ -21,9 +22,11 @@ import qualified Data.MultiMap as MM
import Data.Proxy import Data.Proxy
import Data.Tuple.Sequence (sequenceT) import Data.Tuple.Sequence (sequenceT)
import Data.Typeable import Data.Typeable
import Foreign.C.Types
import Graphics.X11.ExtraTypes.XF86 import Graphics.X11.ExtraTypes.XF86
import Network.HostName import Network.HostName
import PagerHints import PagerHints
import Safe
import System.Directory import System.Directory
import System.FilePath.Posix import System.FilePath.Posix
import System.IO.Unsafe import System.IO.Unsafe
@ -379,7 +382,7 @@ myLayoutHook =
myWindowBringerConfig = myWindowBringerConfig =
def { menuCommand = "rofi" def { menuCommand = "rofi"
, menuArgs = myDmenuArgs , menuArgs = myDmenuArgs ++ ["-format", "i"]
, windowTitler = myDecorateName , windowTitler = myDecorateName
} }
@ -401,15 +404,24 @@ desktopEntriesMap =
directoryEntriesByClassName <$> getDirectoryEntriesDefault directoryEntriesByClassName <$> getDirectoryEntriesDefault
lookupIconFromClasses classes = lookupIconFromClasses classes =
getFirst $ fold $ First . deIcon <$> (classes >>= idAndLower >>= flip MM.lookup desktopEntriesMap) getFirst $ fold $ First . deIcon <$>
(classes >>= idAndLower >>= flip MM.lookup desktopEntriesMap)
where idAndLower value = [value, map toLower value] where idAndLower value = [value, map toLower value]
xGetWindowProperty8 :: Atom -> Window -> X (Maybe [CChar])
xGetWindowProperty8 a w = withDisplay $ \dpy -> io $ getWindowProperty8 dpy a w
getEWMHClasses w = do
atom <- withDisplay $ \d -> io $ internAtom d "WM_CLASS" False
mValue <- fmap (UTF8.decode . map fromIntegral) <$> xGetWindowProperty8 atom w
pure $ filter (not . null) $ splitOn "\NUL" $ join $ maybeToList mValue
myDecorateName ws w = do myDecorateName ws w = do
name <- show <$> getName w name <- show <$> getName w
rawClass <- getClassRaw w classes <- getEWMHClasses w
classTitle <- getClass w classTitle <- getClass w
workspaceToName <- getWorkspaceNames workspaceToName <- getWorkspaceNames
let iconName = fromMaybe "" $ lookupIconFromClasses [rawClass, classTitle] let iconName = fromMaybe (map toLower $ head classes) $ lookupIconFromClasses classes
entryString = printf "%-20s%-40s %+30s in %s \0icon\x1f%s" entryString = printf "%-20s%-40s %+30s in %s \0icon\x1f%s"
classTitle (take 40 name) " " (workspaceToName (W.tag ws)) iconName classTitle (take 40 name) " " (workspaceToName (W.tag ws)) iconName
return entryString return entryString
@ -451,6 +463,14 @@ chromeTabAction doSplit action selected =
spawn $ printf command $ show tid spawn $ printf command $ show tid
return () return ()
menuIndexArgs :: MonadIO m => String -> [String] -> [(String, a)] ->
m (Maybe a)
menuIndexArgs menuCmd args selectionPairs = do
selection <- menuFunction (map fst selectionPairs)
pure $ snd <$> (readMay selection >>= atMay selectionPairs)
where
menuFunction = DM.menuArgs menuCmd args
-- This needs access to X in order to unminimize, which means that it can't be -- This needs access to X in order to unminimize, which means that it can't be
-- done with the existing window bringer interface -- done with the existing window bringer interface
myWindowAct c@WindowBringerConfig {menuCommand = cmd, menuArgs = args} myWindowAct c@WindowBringerConfig {menuCommand = cmd, menuArgs = args}
@ -464,9 +484,8 @@ myWindowAct c@WindowBringerConfig {menuCommand = cmd, menuArgs = args}
if filterVisible if filterVisible
then c {windowFilter = not . flip elem visible} then c {windowFilter = not . flip elem visible}
else c else c
ws <- windowMap' actualConfig ws <- M.toList <$> windowMap' actualConfig
let options = M.union (M.map Left ws) (M.map Right M.empty) selection <- menuIndexArgs cmd args ws
selection <- DM.menuMapArgs cmd args options
whenJust selection action whenJust selection action
doBringWindow window = doBringWindow window =
@ -476,14 +495,13 @@ myWindowAction filterVisible =
andDeactivateFull . maybeUnminimizeAfter . myWindowAct myWindowBringerConfig filterVisible andDeactivateFull . maybeUnminimizeAfter . myWindowAct myWindowBringerConfig filterVisible
myGoToWindow = myGoToWindow =
myWindowAction False $ chromeTabAction False $ windows . greedyFocusWindow myWindowAction False $ windows . greedyFocusWindow
myBringWindow = myWindowAction True $ chromeTabAction True doBringWindow myBringWindow = myWindowAction True $ doBringWindow
myReplaceWindow = myReplaceWindow =
swapMinimizeStateAfter $ swapMinimizeStateAfter $
myWindowAct myWindowBringerConfig True $ myWindowAct myWindowBringerConfig True $ (windows . swapFocusedWith)
chromeTabAction True (windows . swapFocusedWith)
-- Workspace Names for EWMH -- Workspace Names for EWMH