Implement rofi-based layout selection in XMonad

Inspired by [1].

Manual mapping between layout names and descriptions is required due to lack in
possibilities for inspecting the layout hook function.

[1]: https://github.com/pjones/xmonadrc/blob/master/src/XMonad/Local/Layout.hs @ af6e2b3

1 files changed, 81 insertions, 49 deletions

diff --git a/gui/conf/xmonad.hs b/gui/conf/xmonad.hs
index e26ca24..eeafa62 100644
--- a/gui/conf/xmonad.hs
+++ b/gui/conf/xmonad.hs
@@ -1,21 +1,26 @@
-import XMonad
+import XMonad hiding ((|||))
 import XMonad.Util.EZConfig
-import XMonad.StackSet
+import qualified XMonad.StackSet as S
 
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Hooks.ManageHelpers
 import XMonad.Hooks.InsertPosition
 
-import XMonad.Layout.NoBorders
 import XMonad.Layout.Tabbed
 import XMonad.Layout.MultiColumns
+import XMonad.Layout.TwoPane
+import XMonad.Layout.OneBig
+
+import XMonad.Layout.NoBorders
 import XMonad.Layout.Reflect
 import XMonad.Layout.MultiToggle
 import XMonad.Layout.MultiToggle.Instances
-import XMonad.Layout.TwoPane
+import XMonad.Layout.Renamed (Rename(..), renamed)
+import XMonad.Layout.LayoutCombinators
 
 import XMonad.Util.Themes
 import XMonad.Util.NamedScratchpad
+import XMonad.Util.Dmenu (menuMapArgs)
 
 import XMonad.Actions.SpawnOn
 import XMonad.Actions.CycleWS
@@ -25,7 +30,7 @@ import XMonad.Actions.FloatKeys
 
 import Data.Maybe
 import Control.Monad (when)
-import qualified Data.Map as M
+import Data.Map (Map, fromList, member)
 
 import System.Exit
 import System.Posix.Unistd
@@ -46,22 +51,28 @@ customTabTheme = (theme xmonadTheme)
 availableLayouts = id
   . smartBorders
   . mkToggle (single NBFULL)
-  $ tabs ||| tiles ||| two
+  $ tabs ||| tiles ||| two ||| frame
   where
-    tabs  = tabbed shrinkText customTabTheme
-    tiles = mkToggle (single REFLECTX)
-          $ mkToggle (single MIRROR)
-          $ multiCol [1, 2, 0] 1 delta (1/3)
-    two   = TwoPane delta (1/2)
-    delta = 1/24
-
-windowBringerDmenuConfig = def { menuCommand  = "rofi"
-                               , menuArgs     = [ "-p", "win", "-dmenu", "-i" ] }
-
-floatRectTop    h = RationalRect (1/20) 0      (18/20) h
-floatRectBottom h = RationalRect (1/20) (1-h)  (18/20) h
-floatRectLeft   w = RationalRect 0      (1/20) w       (18/20)
-floatRectRight  w = RationalRect (1-w)  (1/20) w       (18/20)
+    tabs   = name "tabs"  $ tabbed shrinkText customTabTheme
+    tiles  = name "tiles" $ id
+                          . mkToggle (single REFLECTX)
+                          . mkToggle (single MIRROR)
+                          $ multiCol [1, 2, 0] 1 delta (1/3)
+    two    = name "two"   $ TwoPane delta (1/2)
+    frame  = name "frame" $ OneBig (2/3) (4/5)
+    delta  = 1/24
+    name n = renamed [Replace n]
+
+-- layout names for layout selection dialog
+layoutNames = fromList [ ("Tabs"                    , "tabs")
+                       , ("Multi-column tiles"      , "tiles")
+                       , ("Two columns"             , "two")
+                       , ("One large framed window" , "frame") ]
+
+floatRectTop    h = S.RationalRect (1/20) 0      (18/20) h
+floatRectBottom h = S.RationalRect (1/20) (1-h)  (18/20) h
+floatRectLeft   w = S.RationalRect 0      (1/20) w       (18/20)
+floatRectRight  w = S.RationalRect (1-w)  (1/20) w       (18/20)
 
 dropUp        = floatRectBottom $ 2/3
 dropUpLarge   = floatRectBottom $ 18/20
@@ -80,6 +91,9 @@ scratchpads host =
   , NS "messaging"     "telegram-desktop"                                      (className =? "TelegramDesktop")
        (customFloating $ hideScreenBorder host sideBarRight) ]
 
+windowBringerDmenuConfig = def { menuCommand  = "rofi"
+                               , menuArgs     = [ "-p", "win", "-dmenu", "-i" ] }
+
 hostSpecificKeybindings host = case host of
   "asterix" -> [ ("M-i b" , showNotification "Battery"
                                              "`acpi | cut -c 10-`")
@@ -100,12 +114,12 @@ commonKeybindings host =
   , ("M-S-<Return>"  , spawn "nvim-qt")
   , ("<Print>"       , spawn "xfce4-screenshooter")
 -- window management
-  , ("M-q"           , windows $ shift "NSP")
+  , ("M-q"           , windows $ S.shift "NSP")
   , ("M-S-q"         , kill)
-  , ("M-j"           , windows focusDown)
-  , ("M-k"           , windows focusUp)
-  , ("M-S-j"         , windows swapDown)
-  , ("M-S-k"         , windows swapUp)
+  , ("M-j"           , windows S.focusDown)
+  , ("M-k"           , windows S.focusUp)
+  , ("M-S-j"         , windows S.swapDown)
+  , ("M-S-k"         , windows S.swapUp)
   , ("M-h"           , sendMessage Shrink)
   , ("M-l"           , sendMessage Expand)
   , ("M-<Backspace>" , nextMatch History (return True))
@@ -118,8 +132,8 @@ commonKeybindings host =
   , ("M-m"           , namedScratchpadAction (scratchpads host) "messaging") ] ++
 -- workspace selection
   [ (p ++ [k]        , windows $ f i) | (i, k) <- zip Main.workspaces ['1' .. '9']
-                                      , (p, f) <- [ ("M-"   , greedyView)
-                                                  , ("M-S-" , shift) ] ] ++
+                                      , (p, f) <- [ ("M-"   , S.greedyView)
+                                                  , ("M-S-" , S.shift) ] ] ++
   [ ("M-s p"         , toggleWS' ["NSP"])
 -- workspace movement
   , ("M-s j"         , moveTo  Next nonEmptyWS)
@@ -127,15 +141,16 @@ commonKeybindings host =
   , ("M-S-s j"       , shiftTo Next nonEmptyWS >> moveTo Next nonEmptyWS)
   , ("M-S-s k"       , shiftTo Prev nonEmptyWS >> moveTo Prev nonEmptyWS)
 -- workspace layout management
+  , ("M-v"           , layoutMenu)
   , ("M-s l"         , sendMessage NextLayout)
   , ("M-s +"         , sendMessage $ IncMasterN   1)
   , ("M-s -"         , sendMessage $ IncMasterN (-1))
-  , ("M-s m"         , sendMessage $ XMonad.Layout.MultiToggle.Toggle REFLECTX)
-  , ("M-s r"         , sendMessage $ XMonad.Layout.MultiToggle.Toggle MIRROR)
-  , ("M-s f"         , sendMessage $ XMonad.Layout.MultiToggle.Toggle NBFULL)
+  , ("M-s m"         , sendMessage $ Toggle REFLECTX)
+  , ("M-s r"         , sendMessage $ Toggle MIRROR)
+  , ("M-s f"         , sendMessage $ Toggle NBFULL)
 -- floating placement
-  , ("M-w t"         , withFocused $ windows . sink)
-  , ("M-w f"         , withFocused $ placeFloating host $ RationalRect 0 0 1 1)
+  , ("M-w t"         , withFocused $ windows . S.sink)
+  , ("M-w f"         , withFocused $ placeFloating host $ S.RationalRect 0 0 1 1)
   , ("M-w j"         , withFocused $ placeFloating host dropUp)
   , ("M-w S-j"       , withFocused $ placeFloating host dropUpLarge)
   , ("M-w k"         , withFocused $ placeFloating host dropDown)
@@ -152,9 +167,9 @@ commonKeybindings host =
 
 customKeybindings host = concatMap ($ host) [commonKeybindings, hostSpecificKeybindings]
 
-customMousebindings (XConfig {XMonad.modMask = modMask}) = M.fromList
-  [ ((modMask .|. shiftMask, button1), \w -> XMonad.focus w >> mouseMoveWindow w)
-  , ((modMask .|. shiftMask, button3), \w -> XMonad.focus w >> mouseResizeWindow w) ]
+customMousebindings (XConfig {XMonad.modMask = modMask}) = fromList
+  [ ((modMask .|. shiftMask, button1), \w -> focus w >> mouseMoveWindow w)
+  , ((modMask .|. shiftMask, button3), \w -> focus w >> mouseResizeWindow w) ]
 
 customEventHook = do
   handleEventHook def
@@ -191,28 +206,42 @@ main = do
     [ ((noModMask, xK_Menu) , namedScratchpadAction (scratchpads host) "terminal") ]
 
 nonEmptyWS = WSIs $ return (\w -> nonNSP w && nonEmpty w)
-  where nonNSP (Workspace tag _ _) = tag /= "NSP"
-        nonEmpty = isJust . stack
+  where nonNSP (S.Workspace tag _ _) = tag /= "NSP"
+        nonEmpty = isJust . S.stack
 
-placeFloating :: String -> RationalRect -> Window -> X ()
-placeFloating host rect = windows . (flip XMonad.StackSet.float $ (hideScreenBorder host rect))
+showNotification title text = spawn ("notify-send \"" ++ title ++ "\" \"" ++ text ++ "\"")
+
+-- layout selection dialog
+layoutMenu :: X ()
+layoutMenu = (askUserForLayout layoutNames) >>= setLayoutByName
+  where
+    setLayoutByName :: (Maybe String) -> X ()
+    setLayoutByName value = case value of
+      Just name -> sendMessage (JumpToLayout name)
+      Nothing   -> return ()
+    askUserForLayout :: Map String String -> X (Maybe String)
+    askUserForLayout = menuMapArgs "rofi" [ "-p", "layout", "-dmenu", "-i" ]
 
-windowSize w = do
-  r <- withDisplay $ (\d -> io $ getWindowAttributes d w)
-  return (fromIntegral $ wa_width r, fromIntegral $ wa_height r)
 
-withCurrentScreen     f = withWindowSet     $ \ws -> f (current ws)
-withCurrentScreenRect f = withCurrentScreen $ \s  -> f (screenRect (screenDetail s))
+-------------------------------------------------------------------------------
+-- utilities for customizing borders of floating windows
+
+withCurrentScreen     f = withWindowSet     $ \ws -> f (S.current ws)
+withCurrentScreenRect f = withCurrentScreen $ \s  -> f (screenRect (S.screenDetail s))
 
 screenResolution = withCurrentScreenRect $ \r -> return (rect_width r, rect_height r)
 
+windowSize w = do
+  r <- withDisplay $ (\d -> io $ getWindowAttributes d w)
+  return (fromIntegral $ wa_width r, fromIntegral $ wa_height r)
+
 isNotFullscreen :: Query Bool
 isNotFullscreen = ask >>= (\w -> liftX $ do (ww, wh) <- windowSize w
                                             (sw, sh) <- screenResolution
                                             return $ not (ww == sw && wh == sh))
 
 isFloat :: Query Bool
-isFloat = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ (M.member w (floating ws)))
+isFloat = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ (member w (S.floating ws)))
 
 customizeBorderWhen :: Query Bool -> String -> Dimension -> X ()
 customizeBorderWhen q color width = withFocused $ \w -> runQuery q w >>= flip when (setWindowBorder' color width w)
@@ -224,9 +253,14 @@ setWindowBorder' color width window = do
   io $ setWindowBorder      d window pixel
   io $ setWindowBorderWidth d window width
 
+-------------------------------------------------------------------------------
 -- ugly hack to hide window border at screen boundary
-hideScreenBorder :: String -> RationalRect -> RationalRect
-hideScreenBorder host (RationalRect x0 y0 w h) = RationalRect (x0-(bw/sw)) (y0-(bw/sh)) (w+((2*bw)/sw)) (h+((2*bw+1)/sh))
+
+placeFloating :: String -> S.RationalRect -> Window -> X ()
+placeFloating host rect = windows . (flip S.float $ (hideScreenBorder host rect))
+
+hideScreenBorder :: String -> S.RationalRect -> S.RationalRect
+hideScreenBorder host (S.RationalRect x0 y0 w h) = S.RationalRect (x0-(bw/sw)) (y0-(bw/sh)) (w+((2*bw)/sw)) (h+((2*bw+1)/sh))
   where bw = 6
         sw = screenWidthOn  host
         sh = screenHeightOn host
@@ -237,5 +271,3 @@ screenWidthOn  host = case host of
 screenHeightOn host = case host of
   "obelix"  -> 1200
   "asterix" -> 768
-
-showNotification title text = spawn ("notify-send \"" ++ title ++ "\" \"" ++ text ++ "\"")