xmonad-contrib-0.9.1: Third party extensions for xmonad

Portabilityunportable
Stabilityunstable
MaintainerAdam Vogt

XMonad.Actions.WorkspaceCursors

Contents

Description

Like XMonad.Actions.Plane for an arbitrary number of dimensions.

Synopsis

Usage

Here is an example config:

 import XMonad
 import XMonad.Actions.WorkspaceCursors
 import XMonad.Hooks.DynamicLog
 import XMonad.Util.EZConfig
 import qualified XMonad.StackSet as W

 main = do
     x <- xmobar conf
     xmonad x

 conf = additionalKeysP defaultConfig
        { layoutHook = workspaceCursors myCursors $ layoutHook defaultConfig
        , workspaces = toList myCursors } $
        [("M-"++shift++control++[k], f direction depth)
          | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"]
          , (direction,control) <- zip [W.focusUp',W.focusDown'] ["C-",""]
          , (depth,k) <- zip (reverse [1..focusDepth myCursors]) "asdf"]
        ++ moreKeybindings

 moreKeybindings = []

 myCursors = makeCursors $ map (map (\x -> [x])) [ "1234", "abc", "xyz"]
 -- myCursors = makeCursors [["wsA","wsB","wsC"],["-alpha-","-beta-","-gamma-"],["x","y"]]

focusDepth :: Cursors t -> IntSource

makeCursors :: [[String]] -> Cursors StringSource

makeCursors requires a nonempty string, and each sublist must be nonempty

toList :: Foldable t => t a -> [a]

List of elements of a structure.

workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l aSource

The state is stored in the WorkspaceCursors layout modifier. Put this as your outermost modifier, unless you want different cursors at different times (using XMonad.Layout.MultiToggle)

getFocus :: Cursors b -> bSource

Modifying the focus

modifyLayer :: (Stack (Cursors String) -> Stack (Cursors String)) -> Int -> X ()Source

modifyLayer is used to change the focus at a given depth

modifyLayer' :: (Stack (Cursors String) -> X (Stack (Cursors String))) -> Int -> X ()Source

example usages are shiftLayer and shiftModifyLayer

shiftModifyLayer :: (Stack (Cursors String) -> Stack (Cursors WorkspaceId)) -> Int -> X ()Source

shiftModifyLayer is the same as modifyLayer, but also shifts the currently focused window to the new workspace

shiftLayer :: (Stack (Cursors String) -> Stack (Cursors WorkspaceId)) -> Int -> X ()Source

shiftLayer is the same as shiftModifyLayer, but the focus remains on the current workspace.

Functions to pass to modifyLayer

noWrapUp :: Stack t -> Stack tSource

non-wrapping version of focusUp'

noWrapDown :: Stack t -> Stack tSource

non-wrapping version of focusDown'

Todo

  • Find and document how to raise the allowable length of arguments: restoring xmonad's state results in: xmonad: executeFile: resource exhausted (Argument list too long) when you specify more than about 50 workspaces. Or change it such that workspaces are created when you try to view it.
  • Function for pretty printing for DynamicLog that groups workspaces by common prefixes
  • Examples of adding workspaces to the cursors, having them appear multiple times for being able to show jumping to some n'th multiple workspace