Search code examples
linuxhaskellwindow-managersxmonadxmonad-contrib

Move window to workspace and focus that workspace (shiftAndView) on XMonad WM


I have XMonad for a while and I have been working on this for the last couple of days, and still no solution.

Let me give you an example of what I'm trying to do:
VLC is open, move it to workspace 2 while it's still focused so I don't have to take a long way and first move VLC to workspace 2 and then switch to that workspace.

I have searched a lot of forums and websites and people provided good answers but there is a difference in my case:

I'm using namedActions for my key bindings and those answers don't work for me.

I'm not sure if it's gonna help or not but here is my config file:
https://pastebin.com/UuWt9qji

import XMonad
import Data.Char
import Data.Monoid
import System.Exit
import System.IO
import XMonad.Layout.Tabbed
import XMonad.Layout.Spacing
import XMonad.Layout.NoBorders
import XMonad.Layout.Fullscreen
import XMonad.Layout.Spiral
import XMonad.Layout.ResizableTile
import XMonad.Layout.Renamed
import XMonad.Layout.BinarySpacePartition
import XMonad.Layout.ToggleLayouts
import XMonad.Layout.Reflect
import XMonad.Layout.SubLayouts
import XMonad.Layout.WindowNavigation
import XMonad.Layout.Simplest
import XMonad.Util.Run
import XMonad.Util.SpawnOnce
import XMonad.Util.NamedScratchpad
import XMonad.Util.NamedActions
import XMonad.Util.EZConfig
import XMonad.ManageHook
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import qualified XMonad.StackSet as W
import qualified Data.Map        as M
import XMonad.Actions.CycleWS
import XMonad.Util.WorkspaceCompare

-----------------------------------------------------------------------------------
myModMask       = mod4Mask
myTerminal      = "alacritty"
myBrowser       = "qutebrowser"
myBorderWidth   = 2

myLauncher      = "rofi -show drun"
myStatusBar     = "xmobar .config/xmobar/xmobarrc"
myFont          = "xft:Hack Nerd Font:regular:size=12:antialias=true:hinting=true"

myNormalColor   = "#4e5173"
myFocusColor    = "#46d9ff"

myFocusFollowsMouse :: Bool
myFocusFollowsMouse = True

myClickJustFocuses :: Bool
myClickJustFocuses = False

-----------------------------------------------------------------------------------
myScratchPads :: [NamedScratchpad]
myScratchPads  = [ NS "terminal" spawnTerm findTerm manageTerm
                 , NS "htop"     spawnHtop findHtop manageHtop
                 ]
  where
    spawnTerm  = myTerminal ++ " -t scratchpad"
    findTerm   = title =?      "scratchpad"
    manageTerm = customFloating $ W.RationalRect l t w h
              where
                h  = 0.9
                w  = 0.9
                t  = 0.95 -h
                l  = 0.95 -w
    spawnHtop  = myTerminal ++ " -t htop -e htop"
    findHtop   = title =?      "htop"
    manageHtop = customFloating $ W.RationalRect l t w h
               where
                h  = 0.9
                w  = 0.9
                t  = 0.95 -h
                l  = 0.95 -w

-----------------------------------------------------------------------------------
wsDo   = "AV"
wsBo   = "BSA"
wsCo   = "COM"
wsMo   = "DOM"
wsGo   = "DMO"
wsFo   = "FLT"

-- myWorkspaces = map show [1..9]
myWorkspaces = [wsDo, wsBo, wsCo, wsGo, wsMo, wsFo]

-----------------------------------------------------------------------------------
showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
showKeybindings x = addName "Show Keybindings" $ io $ do
  h <- spawnPipe $ "yad --text-info --fontname=\"SauceCodePro Nerd Font Mono 12\" --fore=#46d9ff --back=#282c36 --center --geometry=1200x800 --title \"XMonad keybindings\""
  hPutStr h (unlines $ showKm x)
  hClose h
  return ()

wsKeys = map show $ [1..9] ++ [0]
notSP = (return $ ("SP" /=) . W.tag) :: X (WindowSpace -> Bool)
shiftAndView dir = findWorkspace getSortByIndex dir (WSIs notSP) 1
  >>= \t -> (windows . W.shift $ t) >> (windows . W.greedyView $ t)

myKeys confkey =let subKeys str ks = subtitle str : mkNamedKeymap confkey ks in

  subKeys "System"
  [ ("M-t"    , addName "Push window back into tiling"  $ withFocused $ windows . W.sink)
  , ("M-S-q"  , addName "Quit xmonad"                   $ io (exitWith ExitSuccess))
  , ("M-q"    , addName "Rebuild & restart XMonad"      $ spawn "xmonad --recompile; xmonad --restart")]

  ^++^ subKeys "Launchers"
  [ ("M-S-<Return>"  , addName "Launch Terminal"  $ spawn myTerminal)
  , ("M-p"           , addName "Launch Rofi"      $ spawn myLauncher)
  , ("M-b"           , addName "Launch Browser"   $ spawn myBrowser)]

  ^++^ subKeys "Layout Management"
  [ ("M-<Space>"    , addName "Switch to next layout"            $ sendMessage NextLayout)
  , ("M-S-<Space>"  , addName "Reset layouts"                    $ setLayout $ XMonad.layoutHook confkey)
  , ("M-f"          , addName "Toggle to Fullscreen"             $ sendMessage (Toggle "Full"))
  , ("M-S-b"        , addName "Toggle Struts"                    $ sendMessage ToggleStruts)
  ]

  ^++^ subKeys "Workspaces"
  [ ("M-1", addName "Switch to workspace 1"    $ (windows $ W.greedyView $ myWorkspaces !! 0))
  , ("M-2", addName "Switch to workspace 2"    $ (windows $ W.greedyView $ myWorkspaces !! 1))
  , ("M-3", addName "Switch to workspace 3"    $ (windows $ W.greedyView $ myWorkspaces !! 2))
  , ("M-4", addName "Switch to workspace 4"    $ (windows $ W.greedyView $ myWorkspaces !! 3))
  , ("M-5", addName "Switch to workspace 5"    $ (windows $ W.greedyView $ myWorkspaces !! 4))
  , ("M-6", addName "Switch to workspace 6"    $ (windows $ W.greedyView $ myWorkspaces !! 5))
  , ("M-S-1", addName "Send to workspace 1"    $ (windows $ W.shift $ myWorkspaces !! 0))
  , ("M-S-2", addName "Send to workspace 2"    $ (windows $ W.shift $ myWorkspaces !! 1))
  , ("M-S-3", addName "Send to workspace 3"    $ (windows $ W.shift $ myWorkspaces !! 2))
  , ("M-S-4", addName "Send to workspace 4"    $ (windows $ W.shift $ myWorkspaces !! 3))
  , ("M-S-5", addName "Send to workspace 5"    $ (windows $ W.shift $ myWorkspaces !! 4))
  , ("M-S-6", addName "Send to workspace 6"    $ (windows $ W.shift $ myWorkspaces !! 5))]
  
  ^++^ subKeys "Window Management"
  [ ("M-<Tab>"     , addName "Move focus to the next window"        $ windows W.focusDown)
  , ("M-j"         , addName "Move focus to the next window"        $ windows W.focusDown)
  , ("M-k"         , addName "Move focus to the previous window"    $ windows W.focusUp)
  , ("M-m"         , addName "Move focus to the master window"      $ windows W.focusMaster)
  , ("M-<Return>"  , addName "Swap focused to the master window"    $ windows W.swapMaster)
  , ("M-S-j"       , addName "Swap focused to the next window"      $ windows W.swapDown)
  , ("M-S-k"       , addName "Swap focused to the previous window"  $ windows W.swapUp)
  , ("M-t"         , addName "Push window back into tiling"         $ withFocused $ windows . W.sink)
  , ("M-,"         , addName "Increase windows in master area"      $ sendMessage (IncMasterN 1))
  , ("M-."         , addName "Decrease windows in master area"      $ sendMessage (IncMasterN (-1)))
  , ("M-c"         , addName "Close focused window"                 $ kill)]

  ^++^ subKeys "Scratchpads"
  [ ("M-s t"  , addName "Toggle scratchpad terminal"  $ namedScratchpadAction myScratchPads "terminal")
  , ("M-s h"  , addName "Toggle scratchpad htop"      $ namedScratchpadAction myScratchPads "htop")]

  ^++^ subKeys "Sublayouts"
  [ ("M-C-h",  addName "pullGroup Left"        $ sendMessage $ pullGroup L)
  , ("M-C-l",  addName "pullGroup Right"       $ sendMessage $ pullGroup R)
  , ("M-C-k",  addName "pullGroup Up"          $ sendMessage $ pullGroup U)
  , ("M-C-j",  addName "pullGroup Down"        $ sendMessage $ pullGroup D)
  , ("M-C-m",  addName "MergeAll"              $ withFocused (sendMessage . MergeAll))
  , ("M-C-u",  addName "UnMerge"               $ withFocused (sendMessage . UnMerge))
  , ("M-C-/", addName "UnMergeAll"             $  withFocused (sendMessage . UnMergeAll))
  , ("M-C-.", addName "Switch focus next tab"  $  onGroup W.focusUp')
  , ("M-C-,", addName "Switch focus prev tab"  $  onGroup W.focusDown')]

  ^++^ subKeys "Window resizing"
  [ ("M-h"  , addName "Shrink the master area"  $ sendMessage Shrink)
  , ("M-l"  , addName "Expand the master area"  $ sendMessage Expand)]

  ^++^ subKeys "Window spacing"
  [ ("C-M1-j",  addName "Decrease window spacing"  $ decWindowSpacing 5)
  , ("C-M1-k",  addName "Increase window spacing"  $ incWindowSpacing 5)]

-----Workspaces

-----------------------------------------------------------------------------------
myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList $

    [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w
                                       >> windows W.shiftMaster))

    , ((modm, button2), (\w -> focus w >> windows W.shiftMaster))

    , ((modm, button3), (\w -> focus w >> mouseResizeWindow w
                                       >> windows W.shiftMaster)) ]

-----------------------------------------------------------------------------------
myTabConfig = def { fontName            = myFont
                  , activeColor         = "#46d9ff"
                  , inactiveColor       = "#202328"
                  , activeBorderColor   = "#46d9ff"
                  , inactiveBorderColor = "#282c34"
                  , activeTextColor     = "#282c34"
                  , inactiveTextColor   = "#dfdfdf" }

tall         = renamed [Replace "tall"]
             $ windowNavigation
             $ addTabs shrinkText myTabConfig
             $ subLayout [] Simplest
             $ smartSpacing 5
             $ ResizableTall 1 (3/100) (1/2) []

binary       = renamed [Replace "binary"]
             $ reflectHoriz
             $ reflectVert
             $ smartSpacing 5
             $ emptyBSP

spirals      = renamed [Replace "spirals"]
             $ smartSpacing 5
             $ spiral (6/7)

myLayoutHook = avoidStruts
             $ smartBorders
             $ toggleLayouts Full
             $ myLayouts
  where
   myLayouts = tall
           ||| binary
           ||| spirals

-----------------------------------------------------------------------------------
myManageHook = composeAll
    [ className =? "MPlayer"        --> doFloat
    , className =? "Gimp"           --> doFloat
    , className =? "confirm"        --> doFloat
    , className =? "file_progress"  --> doFloat
    , className =? "dialog"         --> doFloat
    , className =? "download"       --> doFloat
    , className =? "error"          --> doFloat
    , className =? "notification"   --> doFloat
    , className =? "Yad"            --> doCenterFloat
    , resource  =? "desktop_window" --> doIgnore
    , resource  =? "kdesktop"       --> doIgnore
    , isFullscreen --> doFullFloat
    ] <+> namedScratchpadManageHook myScratchPads

-----------------------------------------------------------------------------------
myEventHook = mempty

-----------------------------------------------------------------------------------
myLogHook = return ()


-----------------------------------------------------------------------------------
myStartupHook :: X ()
myStartupHook = do
    spawnOnce "xsetroot -cursor_name left_ptr"
    spawnOnce "nitrogen --restore &"
    spawnOnce "picom -f"

-----------------------------------------------------------------------------------
main :: IO ()
main = do
    xmproc <- spawnPipe myStatusBar
    xmonad 
        $ addDescrKeys' ((mod4Mask, xK_F1), showKeybindings) myKeys 
        $ docks defaults

defaults = def 
     {
        terminal           = myTerminal,
        focusFollowsMouse  = myFocusFollowsMouse,
        clickJustFocuses   = myClickJustFocuses,
        borderWidth        = myBorderWidth,
        modMask            = myModMask,
        workspaces         = myWorkspaces,
        normalBorderColor  = myNormalColor,
        focusedBorderColor = myFocusColor,
        mouseBindings      = myMouseBindings,
        layoutHook         = myLayoutHook,
        manageHook         = myManageHook,
        handleEventHook    = myEventHook,
        logHook            = myLogHook,
        startupHook        = myStartupHook
    }

Solution

  • Thanks to people from Reddit this problem solved by a few lines of code. (Also @pmf answer works all right)
    Here is the solution:

    1. First(best) solution:
    ^++^ subKeys "Workspaces" (
    [ ("M-" ++ i, addName ("Switch to workspace " ++ i) (windows $ W.greedyView wsp)) | (i, wsp) <- zip (map show [1..9]) myWorkspaces]
    ++ [ ("M-S-" ++ i, addName ("Send to workspace " ++ i) (windows $ W.shift wsp)) | (i, wsp) <- zip (map show [1..9]) myWorkspaces]
    )
    
    ^++^ subKeys "Window Management" (
    [ -- other keys here ]
    ++ [ ("M-C-" ++ i, addName ("Send and switch to workspace " ++ i) (windows $ W.greedyView wsp . W.shift wsp)) | (i, wsp) <- zip (map show [1..9]) myWorkspaces]
    )
    
    1. Second solution:
    shiftAndView :: Int -> X ()
    shiftAndView n = windows $ W.greedyView (myWorkspaces !! (n - 1))
                             . W.shift      (myWorkspaces !! (n - 1))
    
    1. Third solution:
    windows $ W.greedyView (myWorkspaces !! 2) . W.shift (myWorkspaces !! 2)
    

    An explanation from RossOgilvie about how first solution works:

    We started with a list of entries

    [ ("M-1", addName "Switch to workspace 1"    $ (windows $ W.greedyView $ myWorkspaces !! 0))
    , ("M-2", addName "Switch to workspace 2"    $ (windows $ W.greedyView $ myWorkspaces !! 1))
    , etc ]
    

    So we see that each entry is mostly the same, but the number changes and the workspace changes. The idea is first make a list of the numbers and the workspaces, and then second make an entry for each of them. To make the first list we use

    zip (map show [1..9]) myWorkspaces
     = [("1", wsDo), ("2", wsBo), etc ]
    

    A list comprehension is a lot like a foreach loop in other languages

    [ g a | a <- alist ]
     = for each a in alist, apply g to a, and make a list from the results.
    

    So the final code we wrote was basically a list comprehension of the form

    [ expression for the entry depending on i and wsp | (i,wsp) <- list of numbers and workspaces ]
    

    I hope you see now why this makes the list of entries that we want.


    Thanks to RossOgilvie and slinchisl from Reddit :)