mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
eliminate references to defaultConfig
This commit is contained in:
parent
0287b2861c
commit
daa2731d3d
@ -36,7 +36,7 @@ import System.Exit
|
||||
--
|
||||
-- Then edit your @handleEventHook@:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook' bluetileCommands }
|
||||
-- > main = xmonad def { handleEventHook = serverModeEventHook' bluetileCommands }
|
||||
--
|
||||
-- See the documentation of "XMonad.Hooks.ServerMode" for details on
|
||||
-- how to actually invoke the commands from external programs.
|
||||
|
@ -87,7 +87,7 @@ import qualified XMonad.StackSet as W
|
||||
-- >
|
||||
-- > main = do
|
||||
-- > h <- spawnPipe "xmobar"
|
||||
-- > xmonad defaultConfig { logHook = sampleLogHook h }
|
||||
-- > xmonad def { logHook = sampleLogHook h }
|
||||
|
||||
-- | Copy the focused window to a workspace.
|
||||
copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||
|
@ -73,7 +73,7 @@ Finally, you can define keybindings to jump to the most recent window
|
||||
matching a certain Boolean query. To do this, you need to add
|
||||
'historyHook' to your logHook:
|
||||
|
||||
> main = xmonad $ defaultConfig { logHook = historyHook }
|
||||
> main = xmonad $ def { logHook = historyHook }
|
||||
|
||||
Then the following keybindings, for example, allow you to return to
|
||||
the most recent xterm or emacs window or to simply to the most recent
|
||||
|
@ -43,11 +43,11 @@ import XMonad.Util.XUtils
|
||||
--
|
||||
-- Then edit your @layoutHook@ by modifying a given layout:
|
||||
--
|
||||
-- > myLayout = mouseResize $ windowArrange $ layoutHook defaultConfig
|
||||
-- > myLayout = mouseResize $ windowArrange $ layoutHook def
|
||||
--
|
||||
-- and then:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -115,7 +115,7 @@ import XMonad.Util.Types
|
||||
-- and add the configuration of the module to your main function:
|
||||
--
|
||||
-- > main = xmonad $ withNavigation2DConfig defaultNavigation2DConfig
|
||||
-- > $ defaultConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- For detailed instruction on editing the key binding see:
|
||||
--
|
||||
@ -150,7 +150,7 @@ import XMonad.Util.Types
|
||||
-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] }
|
||||
-- >
|
||||
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
|
||||
-- > $ defaultConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- The navigation between windows is based on their screen rectangles, which are
|
||||
-- available /and meaningful/ only for mapped windows. Thus, as already said,
|
||||
@ -169,7 +169,7 @@ import XMonad.Util.Types
|
||||
-- > }
|
||||
-- >
|
||||
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
|
||||
-- > $ defaultConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- With this setup, Left/Up navigation behaves like standard
|
||||
-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like
|
||||
|
@ -52,9 +52,9 @@ import XMonad.Util.Run
|
||||
--
|
||||
-- > import XMonad.Actions.Plane
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig {keys = myKeys}
|
||||
-- > main = xmonad def {keys = myKeys}
|
||||
-- >
|
||||
-- > myKeys conf = union (keys defaultConfig conf) $ myNewKeys conf
|
||||
-- > myKeys conf = union (keys def conf) $ myNewKeys conf
|
||||
-- >
|
||||
-- > myNewkeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
|
||||
--
|
||||
|
@ -45,9 +45,9 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
-- > import XMonad.Actions.SpawnOn
|
||||
--
|
||||
-- > main = do
|
||||
-- > xmonad defaultConfig {
|
||||
-- > xmonad def {
|
||||
-- > ...
|
||||
-- > manageHook = manageSpawn <+> manageHook defaultConfig
|
||||
-- > manageHook = manageSpawn <+> manageHook def
|
||||
-- > ...
|
||||
-- > }
|
||||
--
|
||||
|
@ -161,7 +161,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
-- > myConfig = do
|
||||
-- > checkTopicConfig myTopics myTopicConfig
|
||||
-- > myLogHook <- makeMyLogHook
|
||||
-- > return $ defaultConfig
|
||||
-- > return $ def
|
||||
-- > { borderWidth = 1 -- Width of the window border in pixels.
|
||||
-- > , workspaces = myTopics
|
||||
-- > , layoutHook = myModifiers myLayout
|
||||
|
@ -29,7 +29,7 @@ import Data.Monoid
|
||||
-- following to your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Actions.UpdateFocus
|
||||
-- > xmonad $ defaultConfig {
|
||||
-- > xmonad $ def {
|
||||
-- > ..
|
||||
-- > startupHook = adjustEventInput
|
||||
-- > handleEventHook = focusOnMouseMove
|
||||
|
@ -62,7 +62,7 @@ import qualified Data.Set as S
|
||||
--
|
||||
-- > main = do
|
||||
-- > config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
|
||||
-- > $ defaultConfig { ... }
|
||||
-- > $ def { ... }
|
||||
-- > xmonad config
|
||||
--
|
||||
-- Here, we pass in the keys for navigation in counter-clockwise order from up.
|
||||
|
@ -69,8 +69,8 @@ import Data.Traversable(sequenceA)
|
||||
-- > x <- xmobar conf
|
||||
-- > xmonad x
|
||||
-- >
|
||||
-- > conf = additionalKeysP defaultConfig
|
||||
-- > { layoutHook = workspaceCursors myCursors $ layoutHook defaultConfig
|
||||
-- > conf = additionalKeysP def
|
||||
-- > { layoutHook = workspaceCursors myCursors $ layoutHook def
|
||||
-- > , workspaces = toList myCursors } $
|
||||
-- > [("M-"++shift++control++[k], f direction depth)
|
||||
-- > | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"]
|
||||
|
@ -86,7 +86,7 @@ import XMonad.Util.Themes
|
||||
|
||||
arossatoConfig = do
|
||||
xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed!
|
||||
return $ defaultConfig
|
||||
return $ def
|
||||
{ workspaces = ["home","var","dev","mail","web","doc"] ++
|
||||
map show [7 .. 9 :: Int]
|
||||
, logHook = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
|
||||
@ -128,7 +128,7 @@ arossatoConfig = do
|
||||
}
|
||||
|
||||
-- key bindings stuff
|
||||
defKeys = keys defaultConfig
|
||||
defKeys = keys def
|
||||
delKeys x = foldr M.delete (defKeys x) (toRemove x)
|
||||
newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x)
|
||||
-- remove some of the default key bindings
|
||||
|
@ -38,7 +38,7 @@ import qualified Data.Map as M
|
||||
-- > import qualified Data.Map as M
|
||||
-- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c }
|
||||
|
||||
azertyConfig = defaultConfig { keys = azertyKeys <+> keys defaultConfig }
|
||||
azertyConfig = def { keys = azertyKeys <+> keys def }
|
||||
|
||||
azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
|
||||
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
||||
|
@ -198,7 +198,7 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
|
||||
floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
|
||||
|
||||
bluetileConfig =
|
||||
defaultConfig
|
||||
def
|
||||
{ modMask = mod4Mask, -- logo key
|
||||
manageHook = bluetileManageHook,
|
||||
layoutHook = bluetileLayoutHook,
|
||||
|
@ -22,7 +22,8 @@ module XMonad.Config.Desktop (
|
||||
-- the DE via a subset of the Extended Window Manager Hints (EWMH)
|
||||
-- specification. Extra xmonad settings unique to specific DE's are
|
||||
-- added by overriding or modifying @desktopConfig@ fields in the
|
||||
-- same way that @defaultConfig@ is customized in @~\/.xmonad/xmonad.hs@.
|
||||
-- same way that the default configuration is customized in
|
||||
-- @~\/.xmonad/xmonad.hs@.
|
||||
--
|
||||
-- For more information about EWMH see:
|
||||
--
|
||||
@ -69,7 +70,7 @@ import qualified Data.Map as M
|
||||
-- <http://haskell.org/haskellwiki/Xmonad>
|
||||
--
|
||||
-- To configure xmonad for use with a DE or with DE tools like panels
|
||||
-- and pagers, in place of @defaultConfig@ in your @~\/.xmonad/xmonad.hs@,
|
||||
-- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@,
|
||||
-- use @desktopConfig@ or one of the other desktop configs from the
|
||||
-- @XMonad.Config@ namespace. The following setup and customization examples
|
||||
-- work the same way for the other desktop configs as for @desktopConfig@.
|
||||
@ -88,7 +89,7 @@ import qualified Data.Map as M
|
||||
|
||||
-- $customizing
|
||||
-- To customize a desktop config, modify its fields as is illustrated with
|
||||
-- @defaultConfig@ in "XMonad.Doc.Extending#Extending xmonad".
|
||||
-- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad".
|
||||
|
||||
-- $layouts
|
||||
-- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.
|
||||
@ -163,11 +164,11 @@ import qualified Data.Map as M
|
||||
-- > adjustEventInput
|
||||
--
|
||||
|
||||
desktopConfig = ewmh defaultConfig
|
||||
desktopConfig = ewmh def
|
||||
{ startupHook = setDefaultCursor xC_left_ptr
|
||||
, layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks
|
||||
, keys = desktopKeys <+> keys defaultConfig }
|
||||
, layoutHook = desktopLayoutModifiers $ layoutHook def
|
||||
, manageHook = manageHook def <+> manageDocks
|
||||
, keys = desktopKeys <+> keys def }
|
||||
|
||||
desktopKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
[ ((modm, xK_b), sendMessage ToggleStruts) ]
|
||||
|
@ -206,7 +206,7 @@ instance PPrint ScreenId
|
||||
instance (Show a, Show b) => PPrint (Map a b)
|
||||
-- }}}
|
||||
-- main {{{
|
||||
dmwitConfig nScreens = defaultConfig {
|
||||
dmwitConfig nScreens = def {
|
||||
borderWidth = 2,
|
||||
workspaces = withScreens nScreens (map show [1..5]),
|
||||
terminal = "urxvt",
|
||||
|
@ -117,7 +117,7 @@ keys x = M.fromList $
|
||||
++
|
||||
zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
|
||||
|
||||
config = ewmh defaultConfig
|
||||
config = ewmh def
|
||||
{ borderWidth = 1 -- Width of the window border in pixels.
|
||||
, XMonad.workspaces = ["mutt","iceweasel"]
|
||||
, layoutHook = showWName $ workspaceDir "~" $
|
||||
@ -129,7 +129,7 @@ config = ewmh defaultConfig
|
||||
named "widescreen" ((mytab *||* mytab)
|
||||
****//* combineTwo Square mytab mytab) -- |||
|
||||
--mosaic 0.25 0.5
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling
|
||||
, manageHook = manageHook def <+> manageDocks -- add panel-handling
|
||||
, terminal = "xterm" -- The preferred terminal program.
|
||||
, normalBorderColor = "#222222" -- Border color for unfocused windows.
|
||||
, focusedBorderColor = "#00ff00" -- Border color for focused windows.
|
||||
|
@ -21,21 +21,21 @@ import XMonad.Layout.TwoPane
|
||||
import qualified Data.Map as M
|
||||
|
||||
sjanssenConfig =
|
||||
ewmh $ defaultConfig
|
||||
ewmh $ def
|
||||
{ terminal = "exec urxvt"
|
||||
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
|
||||
, mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
|
||||
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
|
||||
, ((modm, button2), (\w -> focus w >> windows W.swapMaster))
|
||||
, ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
|
||||
, keys = \c -> mykeys c `M.union` keys defaultConfig c
|
||||
, keys = \c -> mykeys c `M.union` keys def c
|
||||
, logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
|
||||
, layoutHook = modifiers layouts
|
||||
, manageHook = composeAll [className =? x --> doShift w
|
||||
| (x, w) <- [ ("Firefox", "web")
|
||||
, ("Ktorrent", "7")
|
||||
, ("Amarokapp", "7")]]
|
||||
<+> manageHook defaultConfig <+> manageDocks <+> manageSpawn
|
||||
<+> manageHook def <+> manageDocks <+> manageSpawn
|
||||
<+> (isFullscreen --> doFullFloat)
|
||||
, startupHook = mapM_ spawnOnce spawns
|
||||
}
|
||||
|
@ -84,7 +84,7 @@ some colours:
|
||||
>
|
||||
> import XMonad
|
||||
>
|
||||
> main = xmonad $ defaultConfig
|
||||
> main = xmonad $ def
|
||||
> { borderWidth = 2
|
||||
> , terminal = "urxvt"
|
||||
> , normalBorderColor = "#cccccc"
|
||||
|
@ -932,7 +932,7 @@ example, you could write:
|
||||
|
||||
> import XMonad
|
||||
>
|
||||
> main = xmonad $ defaultConfig { keys = myKeys }
|
||||
> main = xmonad $ def { keys = myKeys }
|
||||
|
||||
and provide an appropriate definition of @myKeys@, such as:
|
||||
|
||||
@ -991,18 +991,18 @@ these:
|
||||
then you can create a new key bindings map by joining the default one
|
||||
with yours:
|
||||
|
||||
> newKeys x = myKeys x `M.union` keys defaultConfig x
|
||||
> newKeys x = myKeys x `M.union` keys def x
|
||||
|
||||
Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field
|
||||
of the configuration:
|
||||
|
||||
> main = xmonad $ defaultConfig { keys = newKeys }
|
||||
> main = xmonad $ def { keys = newKeys }
|
||||
|
||||
Alternatively, the '<+>' operator can be used which in this usage does exactly
|
||||
the same as the explicit usage of 'M.union' and propagation of the config
|
||||
argument, thanks to appropriate instances in "Data.Monoid".
|
||||
|
||||
> main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig }
|
||||
> main = xmonad $ def { keys = myKeys <+> keys def }
|
||||
|
||||
All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
|
||||
|
||||
@ -1018,7 +1018,7 @@ All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
|
||||
> import XMonad.Prompt.XMonad
|
||||
>
|
||||
> main :: IO ()
|
||||
> main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig }
|
||||
> main = xmonad $ def { keys = myKeys <+> keys def }
|
||||
>
|
||||
> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
|
||||
> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
|
||||
@ -1044,7 +1044,7 @@ For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@
|
||||
to define @newKeys@ as a 'Data.Map.difference' between the default
|
||||
map and the map of the key bindings you want to remove. Like so:
|
||||
|
||||
> newKeys x = keys defaultConfig x `M.difference` keysToRemove x
|
||||
> newKeys x = keys def x `M.difference` keysToRemove x
|
||||
>
|
||||
> keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||
> keysToRemove x = M.fromList
|
||||
@ -1060,7 +1060,7 @@ It is also possible to simply define a list of keys we want to unbind
|
||||
and then use 'Data.Map.delete' to remove them. In that case we would
|
||||
write something like:
|
||||
|
||||
> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x)
|
||||
> newKeys x = foldr M.delete (keys def x) (keysToRemove x)
|
||||
>
|
||||
> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]
|
||||
> keysToRemove x =
|
||||
@ -1081,7 +1081,7 @@ Adding and removing key bindings requires simply combining the steps
|
||||
for removing and adding. Here is an example from
|
||||
"XMonad.Config.Arossato":
|
||||
|
||||
> defKeys = keys defaultConfig
|
||||
> defKeys = keys def
|
||||
> delKeys x = foldr M.delete (defKeys x) (toRemove x)
|
||||
> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x)
|
||||
> -- remove some of the default key bindings
|
||||
@ -1125,9 +1125,9 @@ the window you click on like so:
|
||||
>
|
||||
> myMouse x = [ (0, button4), (\w -> focus w >> kill) ]
|
||||
>
|
||||
> newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x))
|
||||
> newMouse x = M.union (mouseBindings def x) (M.fromList (myMouse x))
|
||||
>
|
||||
> main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... }
|
||||
> main = xmonad $ def { ..., mouseBindings = newMouse, ... }
|
||||
|
||||
Overriding or deleting mouse bindings works similarly. You can also
|
||||
configure mouse bindings much more easily using the
|
||||
@ -1180,7 +1180,7 @@ Then we create the combination of layouts we need:
|
||||
Now, all we need to do is change the 'XMonad.Core.layoutHook'
|
||||
field of the 'XMonad.Core.XConfig' record, like so:
|
||||
|
||||
> main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
|
||||
> main = xmonad $ def { layoutHook = mylayoutHook }
|
||||
|
||||
Thanks to the new combinator, we can apply a layout modifier to a
|
||||
whole combination of layouts, instead of applying it to each one. For
|
||||
@ -1204,7 +1204,7 @@ Our @~\/.xmonad\/xmonad.hs@ will now look like this:
|
||||
>
|
||||
> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion
|
||||
>
|
||||
> main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
|
||||
> main = xmonad $ def { layoutHook = mylayoutHook }
|
||||
|
||||
That's it!
|
||||
|
||||
@ -1256,7 +1256,7 @@ This is another example of 'XMonad.Config.manageHook', taken from
|
||||
> , resource =? "win" --> doF (W.shift "doc") -- xpdf
|
||||
> , resource =? "firefox-bin" --> doF (W.shift "web")
|
||||
> ]
|
||||
> newManageHook = myManageHook <+> manageHook defaultConfig
|
||||
> newManageHook = myManageHook <+> manageHook def
|
||||
|
||||
|
||||
Again we use 'XMonad.ManageHook.composeAll' to compose a list of
|
||||
@ -1318,14 +1318,14 @@ Then we create our own 'XMonad.Config.manageHook':
|
||||
We can now use the 'XMonad.ManageHook.<+>' combinator to add our
|
||||
'XMonad.Config.manageHook' to the default one:
|
||||
|
||||
> newManageHook = myManageHook <+> manageHook defaultConfig
|
||||
> newManageHook = myManageHook <+> manageHook def
|
||||
|
||||
(Of course, if we wanted to completely replace the default
|
||||
'XMonad.Config.manageHook', this step would not be necessary.) Now,
|
||||
all we need to do is change the 'XMonad.Core.manageHook' field of the
|
||||
'XMonad.Core.XConfig' record, like so:
|
||||
|
||||
> main = xmonad defaultConfig { ..., manageHook = newManageHook, ... }
|
||||
> main = xmonad def { ..., manageHook = newManageHook, ... }
|
||||
|
||||
And we are done.
|
||||
|
||||
@ -1387,7 +1387,7 @@ Then you just need to update the 'XMonad.Core.logHook' field of the
|
||||
'XMonad.Core.XConfig' record with one of the provided functions. For
|
||||
example:
|
||||
|
||||
> main = xmonad defaultConfig { logHook = dynamicLog }
|
||||
> main = xmonad def { logHook = dynamicLog }
|
||||
|
||||
More interesting configurations are also possible; see the
|
||||
"XMonad.Hooks.DynamicLog" module for more possibilities.
|
||||
|
@ -33,7 +33,7 @@ import qualified Data.Map as M
|
||||
--
|
||||
-- > import XMonad.Hooks.CurrentWorkspaceOnTop
|
||||
-- >
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > main = xmonad $ def {
|
||||
-- > ...
|
||||
-- > logHook = currentWorkspaceOnTop
|
||||
-- > ...
|
||||
|
@ -88,7 +88,7 @@ import XMonad.Hooks.ManageDocks
|
||||
--
|
||||
-- > main = xmonad =<< xmobar myConfig
|
||||
-- >
|
||||
-- > myConfig = defaultConfig { ... }
|
||||
-- > myConfig = def { ... }
|
||||
--
|
||||
-- There is also 'statusBar' if you'd like to use another status bar, or would
|
||||
-- like to use different formatting options. The 'xmobar', 'dzen', and
|
||||
@ -99,7 +99,7 @@ import XMonad.Hooks.ManageDocks
|
||||
-- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the
|
||||
-- appropriate function, for instance:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > main = xmonad $ def {
|
||||
-- > ...
|
||||
-- > logHook = dynamicLog
|
||||
-- > ...
|
||||
@ -124,7 +124,7 @@ import XMonad.Hooks.ManageDocks
|
||||
-- >
|
||||
-- > main = do
|
||||
-- > h <- spawnPipe "xmobar -options -foo -bar"
|
||||
-- > xmonad $ defaultConfig {
|
||||
-- > xmonad $ def {
|
||||
-- > ...
|
||||
-- > logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h }
|
||||
--
|
||||
@ -153,7 +153,7 @@ import XMonad.Hooks.ManageDocks
|
||||
--
|
||||
-- > main = xmonad =<< dzen myConfig
|
||||
-- >
|
||||
-- > myConfig = defaultConfig { ... }
|
||||
-- > myConfig = def { ... }
|
||||
--
|
||||
-- The intent is that the above config file should provide a nice
|
||||
-- status bar with minimal effort.
|
||||
@ -178,7 +178,7 @@ dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
|
||||
--
|
||||
-- > main = xmonad =<< xmobar myConfig
|
||||
-- >
|
||||
-- > myConfig = defaultConfig { ... }
|
||||
-- > myConfig = def { ... }
|
||||
--
|
||||
-- This works pretty much the same as 'dzen' function above.
|
||||
--
|
||||
|
@ -44,8 +44,8 @@ import XMonad.Util.WindowProperties (getProp32)
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Hooks.EwmhDesktops
|
||||
-- >
|
||||
-- > main = xmonad $ ewmh defaultConfig{ handleEventHook =
|
||||
-- > handleEventHook defaultConfig <+> fullscreenEventHook }
|
||||
-- > main = xmonad $ ewmh def{ handleEventHook =
|
||||
-- > handleEventHook def <+> fullscreenEventHook }
|
||||
--
|
||||
-- You may also be interested in 'avoidStruts' from "XMonad.Hooks.ManageDocks".
|
||||
|
||||
|
@ -40,7 +40,7 @@ import Control.Monad
|
||||
-- > myLogHook = fadeInactiveLogHook fadeAmount
|
||||
-- > where fadeAmount = 0.8
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { logHook = myLogHook }
|
||||
-- > main = xmonad def { logHook = myLogHook }
|
||||
--
|
||||
-- fadeAmount can be any rational between 0 and 1.
|
||||
-- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
|
||||
|
@ -115,7 +115,7 @@ import Graphics.X11.Xlib.Extras (Event(..))
|
||||
-- a tight loop trying to fade the popup in). I find it useful to
|
||||
-- have a key binding to restart the compositing manager; for example,
|
||||
--
|
||||
-- main = xmonad $ defaultConfig {
|
||||
-- main = xmonad $ def {
|
||||
-- {- ... -}
|
||||
-- }
|
||||
-- `additionalKeysP`
|
||||
|
@ -53,7 +53,7 @@ hookName = "__float"
|
||||
--
|
||||
-- and adding 'floatNextHook' to your 'ManageHook':
|
||||
--
|
||||
-- > myManageHook = floatNextHook <+> manageHook defaultConfig
|
||||
-- > myManageHook = floatNextHook <+> manageHook def
|
||||
--
|
||||
-- The 'floatNext' and 'toggleFloatNext' functions can be used in key
|
||||
-- bindings to float the next spawned window:
|
||||
|
@ -31,7 +31,7 @@ import Data.Monoid(Endo(Endo))
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Hooks.InsertPosition
|
||||
-- > xmonad defaultConfig { manageHook = insertPosition Master Newer <+> myManageHook }
|
||||
-- > xmonad def { manageHook = insertPosition Master Newer <+> myManageHook }
|
||||
--
|
||||
-- You should you put the manageHooks that use 'doShift' to take effect
|
||||
-- /before/ 'insertPosition', so that the window order will be consistent.
|
||||
|
@ -13,7 +13,7 @@
|
||||
--
|
||||
-- > import XMonad.Hooks.ManageHelpers
|
||||
-- > main =
|
||||
-- > xmonad defaultConfig{
|
||||
-- > xmonad def{
|
||||
-- > ...
|
||||
-- > manageHook = composeOne [
|
||||
-- > isKDETrayWindow -?> doIgnore,
|
||||
|
@ -33,7 +33,7 @@ import XMonad.Layout.Minimize
|
||||
-- >
|
||||
-- > myHandleEventHook = minimizeEventHook
|
||||
-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout
|
||||
-- > main = xmonad def { layoutHook = myLayout
|
||||
-- > , handleEventHook = myHandleEventHook }
|
||||
|
||||
minimizeEventHook :: Event -> X All
|
||||
|
@ -59,8 +59,8 @@ import Control.Monad.Trans (lift)
|
||||
--
|
||||
-- and adding 'placeHook' to your 'manageHook', for example:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart
|
||||
-- > <+> manageHook defaultConfig }
|
||||
-- > main = xmonad $ def { manageHook = placeHook simpleSmart
|
||||
-- > <+> manageHook def }
|
||||
--
|
||||
-- Note that 'placeHook' should be applied after most other hooks, especially hooks
|
||||
-- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from
|
||||
|
@ -58,10 +58,10 @@ import qualified Data.Set as S
|
||||
-- otherwise use 'Just defaultTheme' or similar to inform the module about the
|
||||
-- decoration theme used.
|
||||
--
|
||||
-- > myManageHook = positionStoreManageHook Nothing <+> manageHook defaultConfig
|
||||
-- > myManageHook = positionStoreManageHook Nothing <+> manageHook def
|
||||
-- > myHandleEventHook = positionStoreEventHook
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { manageHook = myManageHook
|
||||
-- > main = xmonad def { manageHook = myManageHook
|
||||
-- > , handleEventHook = myHandleEventHook
|
||||
-- > }
|
||||
--
|
||||
|
@ -34,7 +34,7 @@ import XMonad.Layout.Minimize
|
||||
-- >
|
||||
-- > myHandleEventHook = restoreMinimizedEventHook
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook }
|
||||
-- > main = xmonad def { handleEventHook = myHandleEventHook }
|
||||
|
||||
data RestoreMinimized = RestoreMinimized deriving ( Show, Read )
|
||||
|
||||
|
@ -34,7 +34,7 @@ import XMonad
|
||||
-- For example, if you wanted to run the hook "startup" in your script every
|
||||
-- time your startup hook ran, you could modify your xmonad config as such:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > main = xmonad $ def {
|
||||
-- > ...
|
||||
-- > startupHook = execScriptHook "startup"
|
||||
-- > ...
|
||||
|
@ -79,7 +79,7 @@ import XMonad.Actions.Commands
|
||||
--
|
||||
-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
|
||||
--
|
||||
-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
|
||||
-- > main = xmonad def { handleEventHook = serverModeEventHook }
|
||||
--
|
||||
|
||||
data ServerMode = ServerMode deriving ( Show, Read )
|
||||
|
@ -85,12 +85,12 @@ modify' n f = XS.modify (HookState . setter . hooks)
|
||||
-- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the
|
||||
-- name of the hook and @hook@ is the hook to execute based on the state.
|
||||
--
|
||||
-- > myManageHook = toggleHook "float" doFloat <+> manageHook defaultConfig
|
||||
-- > myManageHook = toggleHook "float" doFloat <+> manageHook def
|
||||
--
|
||||
-- Additionally, toggleHook' is provided to toggle between two hooks (rather
|
||||
-- than on/off).
|
||||
--
|
||||
-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook defaultConfig
|
||||
-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def
|
||||
--
|
||||
-- The 'hookNext' and 'toggleHookNext' functions can be used in key
|
||||
-- bindings to set whether the hook is applied or not.
|
||||
|
@ -106,7 +106,7 @@ import Foreign.C.Types (CLong)
|
||||
-- 'withUrgencyHook'. For example:
|
||||
--
|
||||
-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
|
||||
-- > $ defaultConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- This will pop up a dzen bar for five seconds telling you you've got an
|
||||
-- urgent window.
|
||||
@ -118,7 +118,7 @@ import Foreign.C.Types (CLong)
|
||||
-- extra popup, install NoUrgencyHook, as so:
|
||||
--
|
||||
-- > main = xmonad $ withUrgencyHook NoUrgencyHook
|
||||
-- > $ defaultConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent
|
||||
-- windows. If you're using the 'dzen' or 'dzenPP' functions from that module,
|
||||
@ -259,7 +259,7 @@ minutes secs = secs * 60
|
||||
|
||||
-- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.
|
||||
-- Use a variation of this in your config just as you use a variation of
|
||||
-- defaultConfig for your xmonad definition.
|
||||
-- 'def' for your xmonad definition.
|
||||
urgencyConfig :: UrgencyConfig
|
||||
urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }
|
||||
|
||||
|
@ -33,9 +33,9 @@ import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
|
||||
--
|
||||
-- > import XMonad.Hooks.WorkspaceByPos
|
||||
-- >
|
||||
-- > myManageHook = workspaceByPos <+> manageHook defaultConfig
|
||||
-- > myManageHook = workspaceByPos <+> manageHook def
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { manageHook = myManageHook }
|
||||
-- > main = xmonad def { manageHook = myManageHook }
|
||||
|
||||
workspaceByPos :: ManageHook
|
||||
workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask
|
||||
|
@ -38,7 +38,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
--
|
||||
-- Then add the hook to your 'logHook':
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig
|
||||
-- > main = xmonad $ def
|
||||
-- > { ...
|
||||
-- > , logHook = ... >> workspaceHistoryHook >> ...
|
||||
-- > , ...
|
||||
|
@ -31,7 +31,7 @@ import Data.Ratio
|
||||
-- Then edit your @layoutHook@ by adding the Accordion layout:
|
||||
--
|
||||
-- > myLayout = Accordion ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -40,7 +40,7 @@ import qualified Data.Map as M
|
||||
--
|
||||
-- > import XMonad.Layout.BorderResize
|
||||
-- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
|
||||
type BorderBlueprint = (Rectangle, Glyph, BorderType)
|
||||
|
@ -49,7 +49,7 @@ import qualified XMonad.StackSet as W
|
||||
-- Then edit your @layoutHook@ by adding the layout modifier:
|
||||
--
|
||||
-- > myLayout = boringWindows (Full ||| etc..)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- Then to your keybindings, add:
|
||||
--
|
||||
|
@ -40,8 +40,8 @@ import XMonad.Layout.DecorationAddons
|
||||
-- Then edit your @layoutHook@ by adding the ButtonDecoration to
|
||||
-- your layout:
|
||||
--
|
||||
-- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
|
||||
buttonDeco :: (Eq a, Shrinker s) => s -> Theme
|
||||
|
@ -32,7 +32,7 @@ import XMonad.StackSet (integrate, peek)
|
||||
-- Then edit your @layoutHook@ by adding the Circle layout:
|
||||
--
|
||||
-- > myLayout = Circle ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -29,7 +29,7 @@ import Control.Monad( msum )
|
||||
-- Then edit your @layoutHook@ by adding one of the Cross layouts:
|
||||
--
|
||||
-- > myLayout = simpleCross ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
|
||||
-- apply a factor to a Rectangle Dimension
|
||||
|
@ -105,7 +105,7 @@ import XMonad.Layout.SimpleFloat
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the layout you want:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = someMadLayout }
|
||||
-- > main = xmonad def { layoutHook = someMadLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -33,7 +33,7 @@ import Control.Monad (ap)
|
||||
-- Then edit your @layoutHook@ by adding the Dishes layout:
|
||||
--
|
||||
-- > myLayout = Dishes 2 (1/6) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -41,7 +41,7 @@ import XMonad.Util.XUtils
|
||||
-- Then edit your @layoutHook@ by adding the DragPane layout:
|
||||
--
|
||||
-- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -48,7 +48,7 @@ import XMonad.Layout.Reflect
|
||||
-- > where
|
||||
-- > drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat")
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- This will place the Rhythmbox and Xchat windows in at the top of the screen
|
||||
-- only when using the 'Tall' layout. See "XMonad.Util.WindowProperties" for
|
||||
|
@ -36,8 +36,8 @@ import XMonad.Layout.Decoration
|
||||
-- Then edit your @layoutHook@ by adding the DwmStyle decoration to
|
||||
-- your layout:
|
||||
--
|
||||
-- > myL = dwmStyle shrinkText defaultTheme (layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = dwmStyle shrinkText defaultTheme (layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
@ -50,17 +50,17 @@ import XMonad.Layout.Decoration
|
||||
--
|
||||
-- and
|
||||
--
|
||||
-- > myL = dwmStyle shrinkText myDWConfig (layoutHook defaultConfig)
|
||||
-- > myL = dwmStyle shrinkText myDWConfig (layoutHook def)
|
||||
--
|
||||
-- A complete xmonad.hs file for this would therefore be:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Layout.DwmStyle
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig {
|
||||
-- > main = xmonad def {
|
||||
-- > layoutHook =
|
||||
-- > dwmStyle shrinkText defaultTheme
|
||||
-- > (layoutHook defaultConfig)
|
||||
-- > (layoutHook def)
|
||||
-- > }
|
||||
--
|
||||
|
||||
|
@ -43,7 +43,7 @@ import XMonad.StackSet as W
|
||||
-- Then edit your @layoutHook@ by adding the FixedColumn layout:
|
||||
--
|
||||
-- > myLayout = FixedColumn 1 20 80 10 ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -53,7 +53,7 @@ import Control.Arrow (second)
|
||||
-- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook'
|
||||
-- to your config, i.e.
|
||||
--
|
||||
-- > xmonad defaultconfig { handleEventHook = fullscreenEventHook,
|
||||
-- > xmonad def { handleEventHook = fullscreenEventHook,
|
||||
-- > manageHook = fullscreenManageHook,
|
||||
-- > layoutHook = myLayouts }
|
||||
--
|
||||
|
@ -31,7 +31,7 @@ import XMonad.StackSet
|
||||
-- Then edit your @layoutHook@ by adding the Grid layout:
|
||||
--
|
||||
-- > myLayout = Grid ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- You can also specify an aspect ratio for Grid to strive for with the
|
||||
-- GridRatio constructor. For example, if you want Grid to try to make a grid
|
||||
|
@ -42,7 +42,7 @@ infixr 9 .
|
||||
-- Then edit your @layoutHook@ by adding the 'Grid' layout:
|
||||
--
|
||||
-- > myLayout = Grid False ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- You can also specify an aspect ratio for Grid to strive for with the
|
||||
-- GridRatio constructor:
|
||||
|
@ -38,7 +38,7 @@ import Control.Monad
|
||||
-- > nmaster = 1
|
||||
-- > ratio = 1/2
|
||||
-- > delta = 3/100
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- Because both Xmonad and Xmonad.Layout.HintedTile define Tall,
|
||||
-- you need to disambiguate Tall. If you are replacing the
|
||||
|
@ -45,7 +45,7 @@ import XMonad.Util.WindowProperties
|
||||
-- to consider is Tabbed layout).
|
||||
--
|
||||
-- > myLayout = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- Here @1%7@ is the part of the screen which your roster will occupy,
|
||||
-- @ClassName \"Tkabber\"@ tells xmonad which window is actually your roster.
|
||||
|
@ -50,8 +50,8 @@ import XMonad.Layout.Maximize
|
||||
-- Then edit your @layoutHook@ by adding the ImageButtonDecoration to
|
||||
-- your layout:
|
||||
--
|
||||
-- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
|
||||
-- The buttons' dimension and placements
|
||||
|
@ -45,7 +45,7 @@ import XMonad.Hooks.DynamicLog
|
||||
--
|
||||
-- You can define your workspaces by calling @withScreens@:
|
||||
--
|
||||
-- > myConfig = defaultConfig { workspaces = withScreens 2 ["web", "email", "irc"] }
|
||||
-- > myConfig = def { workspaces = withScreens 2 ["web", "email", "irc"] }
|
||||
--
|
||||
-- This will create \"physical\" workspaces with distinct internal names for
|
||||
-- each (screen, virtual workspace) pair.
|
||||
@ -114,9 +114,9 @@ onCurrentScreen f vws = screen . current >>= f . flip marshall vws
|
||||
--
|
||||
-- > main = do
|
||||
-- > nScreens <- countScreens
|
||||
-- > xmonad $ defaultConfig {
|
||||
-- > xmonad $ def {
|
||||
-- > ...
|
||||
-- > workspaces = withScreens nScreens (workspaces defaultConfig),
|
||||
-- > workspaces = withScreens nScreens (workspaces def),
|
||||
-- > ...
|
||||
-- > }
|
||||
--
|
||||
|
@ -50,7 +50,7 @@ import Data.Maybe (isJust)
|
||||
-- > $ (layoutN 1 (absBox (-200) 0 0 0) Nothing $ simpleTabbed)
|
||||
-- > $ (layoutAll (absBox 0 0 (-512-200) 0) $ simpleTabbed)
|
||||
-- > ) ||| Full ||| etc...
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- This will produce a layout similar to DragPane, but with the possibility to have multiple windows in the left half
|
||||
-- and tabs that show the available windows. It will also produce a layout similar to ThreeColMid and a special layout
|
||||
|
@ -68,7 +68,7 @@ import XMonad.Layout.DragPane
|
||||
-- example:
|
||||
--
|
||||
-- > myLayout = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the @layoutHook@ see:
|
||||
--
|
||||
|
@ -54,7 +54,7 @@ import qualified Data.Set as Set
|
||||
-- to some layout:
|
||||
--
|
||||
-- > myLayout = layoutHints (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- Or, to center the adapted window in its available area:
|
||||
--
|
||||
@ -74,7 +74,7 @@ import qualified Data.Set as Set
|
||||
--
|
||||
-- > myHandleEventHook = hintsEventHook <+> ...
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook
|
||||
-- > main = xmonad def { handleEventHook = myHandleEventHook
|
||||
-- > , ... }
|
||||
|
||||
layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a
|
||||
|
@ -47,7 +47,7 @@ import Data.Maybe(fromJust)
|
||||
-- > import XMonad.Layout.LimitWindows
|
||||
--
|
||||
-- > myLayout = limitWindows 6 $ Tall 1 0.03 0.5 ||| Full ||| RandomOtherLayout...
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- You may also be interested in dynamically changing the number dynamically,
|
||||
-- by binding keys to the 'increaseLimit', 'decreaseLimit', or 'setLimit'
|
||||
|
@ -41,7 +41,7 @@ import qualified Data.Map as M
|
||||
-- modifier:
|
||||
--
|
||||
-- > myLayout = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout,
|
||||
-- > main = xmonad def { layoutHook = myLayout,
|
||||
-- > handleEventHook = promoteWarp }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
|
@ -44,7 +44,7 @@ import XMonad.Util.XUtils
|
||||
-- to some layout:
|
||||
--
|
||||
-- > myLayout = magnifier (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- By default magnifier increases the focused window's size by 1.5.
|
||||
-- You can also use:
|
||||
|
@ -36,7 +36,7 @@ import Data.List ( partition )
|
||||
-- Then edit your @layoutHook@ by adding the Maximize layout modifier:
|
||||
--
|
||||
-- > myLayout = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -41,7 +41,7 @@ import Foreign.C.Types (CLong)
|
||||
-- Then edit your @layoutHook@ by adding the Minimize layout modifier:
|
||||
--
|
||||
-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -49,7 +49,7 @@ import Data.Monoid(Monoid,mempty, mappend)
|
||||
-- Then edit your @layoutHook@ by adding the Mosaic layout:
|
||||
--
|
||||
-- > myLayout = mosaic 2 [3,2] ||| Full ||| etc..
|
||||
-- > main = xmonad $ defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad $ def { layoutHook = myLayout }
|
||||
--
|
||||
-- Unfortunately, infinite lists break serialization, so don't use them. And if
|
||||
-- the list is too short, it is extended with @++ repeat 1@, which covers the
|
||||
|
@ -45,7 +45,7 @@ import Data.Ratio
|
||||
-- Then edit your @layoutHook@ by adding the MosaicAlt layout:
|
||||
--
|
||||
-- > myLayout = MosaicAlt M.empty ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -48,7 +48,7 @@ import Control.Applicative((<$>))
|
||||
-- will not work correctly here because of the use of the mouse.)
|
||||
--
|
||||
-- > myLayout = mouseResizableTile ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
|
@ -35,12 +35,12 @@ import Control.Monad
|
||||
-- Then edit your @layoutHook@ by adding the multiCol layout:
|
||||
--
|
||||
-- > myLayouts = multiCol [1] 4 0.01 0.5 ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
-- > main = xmonad def { layoutHook = myLayouts }
|
||||
--
|
||||
-- Or alternatively:
|
||||
--
|
||||
-- > myLayouts = Mirror (multiCol [1] 2 0.01 (-0.25)) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
-- > main = xmonad def { layoutHook = myLayouts }
|
||||
--
|
||||
-- The maximum number of windows in a column can be controlled using the
|
||||
-- IncMasterN messages and the column containing the focused window will be
|
||||
|
@ -34,7 +34,7 @@ import XMonad.Layout.Renamed
|
||||
-- to some layout:
|
||||
--
|
||||
-- > myLayout = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -37,8 +37,8 @@ import XMonad.Layout.SimpleDecoration
|
||||
-- Then edit your @layoutHook@ by adding the NoFrillsDecoration to
|
||||
-- your layout:
|
||||
--
|
||||
-- > myL = noFrillsDeco shrinkText defaultTheme (layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = noFrillsDeco shrinkText defaultTheme (layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
|
||||
-- | Add very simple decorations to windows of a layout.
|
||||
|
@ -46,7 +46,7 @@ import Data.List(nub)
|
||||
--
|
||||
-- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc..
|
||||
-- > where floatingDeco l = noFrillsDeco shrinkText defaultTheme l
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
|
||||
-- > main = xmonad def { layoutHook = myLayouts }
|
||||
--
|
||||
-- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how
|
||||
-- to add the support hooks.
|
||||
|
@ -34,7 +34,7 @@ import Data.List ((\\))
|
||||
-- Then edit your @layoutHook@ by adding the ResizableTile layout:
|
||||
--
|
||||
-- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -33,7 +33,7 @@ import Data.Ratio
|
||||
-- Then edit your @layoutHook@ by adding the Roledex layout:
|
||||
--
|
||||
-- > myLayout = Roledex ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -34,8 +34,8 @@ import XMonad.Util.XUtils
|
||||
-- @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Layout.ShowWName
|
||||
-- > myLayout = layoutHook defaultConfig
|
||||
-- > main = xmonad defaultConfig { layoutHook = showWName myLayout }
|
||||
-- > myLayout = layoutHook def
|
||||
-- > main = xmonad def { layoutHook = showWName myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -38,8 +38,8 @@ import XMonad.Layout.Decoration
|
||||
-- Then edit your @layoutHook@ by adding the SimpleDecoration decoration to
|
||||
-- your layout:
|
||||
--
|
||||
-- > myL = simpleDeco shrinkText defaultTheme (layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = simpleDeco shrinkText defaultTheme (layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -39,7 +39,7 @@ import XMonad.Layout.WindowArranger
|
||||
-- Then edit your @layoutHook@ by adding the SimpleFloat layout:
|
||||
--
|
||||
-- > myLayout = simpleFloat ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -30,7 +30,7 @@ import qualified XMonad.StackSet as S
|
||||
-- Then edit your @layoutHook@ by adding the Simplest layout:
|
||||
--
|
||||
-- > myLayout = Simplest ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -34,7 +34,7 @@ import XMonad.Util.XUtils (fi)
|
||||
-- Then edit your @layoutHook@ by adding the SimplestFloat layout:
|
||||
--
|
||||
-- > myLayout = simplestFloat ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -37,7 +37,7 @@ import XMonad.StackSet ( integrate )
|
||||
-- Then edit your @layoutHook@ by adding the Spiral layout:
|
||||
--
|
||||
-- > myLayout = spiral (6/7) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -33,7 +33,7 @@ import Control.Monad
|
||||
-- Then edit your @layoutHook@ by adding the StackTile layout:
|
||||
--
|
||||
-- > myLayout = StackTile 1 (3/100) (1/2) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -123,7 +123,7 @@ import Data.Map(Map)
|
||||
--
|
||||
-- > myLayout = windowNavigation $ subTabbed $ boringWindows $
|
||||
-- > Tall 1 (3/100) (1/2) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- "XMonad.Layout.WindowNavigation" is used to specify which windows to merge,
|
||||
-- and it is not integrated into the modifier because it can be configured, and
|
||||
|
@ -36,7 +36,7 @@ import XMonad.Prompt ( XPPosition (..) )
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the layout you want:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = simpleTabBar $ layoutHook defaultConfig}
|
||||
-- > main = xmonad def { layoutHook = simpleTabBar $ layoutHook def}
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -51,7 +51,7 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) )
|
||||
--
|
||||
-- and then:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- This layout has hardcoded behaviour for mouse clicks on tab decorations:
|
||||
-- Left click on the tab switches focus to that window.
|
||||
@ -82,7 +82,7 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) )
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Layout.Tabbed
|
||||
-- > main = xmonad defaultConfig { layoutHook = simpleTabbed }
|
||||
-- > main = xmonad def { layoutHook = simpleTabbed }
|
||||
simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
|
||||
simpleTabbed = tabbed shrinkText defaultTheme
|
||||
|
||||
|
@ -39,7 +39,7 @@ import Control.Monad
|
||||
-- Then edit your @layoutHook@ by adding the ThreeCol layout:
|
||||
--
|
||||
-- > myLayout = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 1 (3/100) (1/2) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- The first argument specifies how many windows initially appear in the main
|
||||
-- window. The second argument argument specifies the amount to resize while
|
||||
|
@ -30,7 +30,7 @@ import XMonad.StackSet (Workspace (..))
|
||||
-- Then edit your @layoutHook@ by adding the ToggleLayouts layout:
|
||||
--
|
||||
-- > myLayout = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -126,7 +126,7 @@ focusWin st@(W.Stack f u d) w
|
||||
|
||||
Apply to your layout in a config like:
|
||||
|
||||
> main = xmonad (defaultConfig{
|
||||
> main = xmonad (def{
|
||||
> layoutHook = trackFloating (useTransientFor
|
||||
> (noBorders Full ||| Tall 1 0.3 0.5)),
|
||||
> ...
|
||||
|
@ -33,7 +33,7 @@ import XMonad.StackSet ( focus, up, down)
|
||||
-- Then edit your @layoutHook@ by adding the TwoPane layout:
|
||||
--
|
||||
-- > myLayout = TwoPane (3/100) (1/2) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -38,12 +38,12 @@ import Data.List
|
||||
-- @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Layout.WindowArranger
|
||||
-- > myLayout = layoutHook defaultConfig
|
||||
-- > main = xmonad defaultConfig { layoutHook = windowArrange myLayout }
|
||||
-- > myLayout = layoutHook def
|
||||
-- > main = xmonad def { layoutHook = windowArrange myLayout }
|
||||
--
|
||||
-- or
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = windowArrangeAll myLayout }
|
||||
-- > main = xmonad def { layoutHook = windowArrangeAll myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -42,7 +42,7 @@ import XMonad.Util.XUtils
|
||||
-- to some layout:
|
||||
--
|
||||
-- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -43,8 +43,8 @@ import Foreign.C.Types(CInt)
|
||||
-- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to
|
||||
-- your layout:
|
||||
--
|
||||
-- > myL = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer $ layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer $ layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
-- There is also a version of the decoration that contains buttons like
|
||||
-- "XMonad.Layout.ButtonDecoration". To use that version, you will need to
|
||||
@ -53,8 +53,8 @@ import Foreign.C.Types(CInt)
|
||||
--
|
||||
-- > import XMonad.Layout.DecorationAddons
|
||||
-- >
|
||||
-- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
-- Additionaly, there is a version of the decoration that contains image buttons like
|
||||
-- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to
|
||||
@ -63,8 +63,8 @@ import Foreign.C.Types(CInt)
|
||||
--
|
||||
-- > import XMonad.Layout.ImageButtonDecoration
|
||||
-- >
|
||||
-- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
|
||||
windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme
|
||||
|
@ -47,7 +47,7 @@ import XMonad.StackSet ( tag, currentTag )
|
||||
-- to some layout:
|
||||
--
|
||||
-- > myLayout = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@ -31,7 +31,7 @@ import qualified Data.Map as M
|
||||
--
|
||||
-- 2. Set key bindings with 'customKeys':
|
||||
--
|
||||
-- > main = xmonad defaultConfig { keys = customKeys delkeys inskeys }
|
||||
-- > main = xmonad def { keys = customKeys delkeys inskeys }
|
||||
-- > where
|
||||
-- > delkeys :: XConfig l -> [(KeyMask, KeySym)]
|
||||
-- > delkeys XConfig {modMask = modm} =
|
||||
@ -53,17 +53,17 @@ import qualified Data.Map as M
|
||||
-- > import System.Exit
|
||||
-- > import qualified Data.Map as M
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig {
|
||||
-- > main = xmonad def {
|
||||
-- > keys = \_ -> M.fromList [
|
||||
-- > -- Let me out of here! I want my KDE back! Help! Help!
|
||||
-- > ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] }
|
||||
|
||||
-- | Customize 'XMonad.Config.defaultConfig' -- delete needless
|
||||
-- | Customize 'XMonad.Config.def' -- delete needless
|
||||
-- shortcuts and insert those you will use.
|
||||
customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete
|
||||
-> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert
|
||||
-> XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||
customKeys = customKeysFrom defaultConfig
|
||||
customKeys = customKeysFrom def
|
||||
|
||||
-- | General variant of 'customKeys': customize key bindings of
|
||||
-- third-party configuration.
|
||||
|
@ -7,7 +7,7 @@
|
||||
--
|
||||
-- Maintainer : Devin Mullins <me@twifkak.com>
|
||||
--
|
||||
-- Useful helper functions for amending the defaultConfig, and for
|
||||
-- Useful helper functions for amending the default configuration, and for
|
||||
-- parsing keybindings specified in a special (emacs-like) format.
|
||||
--
|
||||
-- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.)
|
||||
@ -69,7 +69,7 @@ import Text.ParserCombinators.ReadP
|
||||
-- |
|
||||
-- Add or override keybindings from the existing set. Example use:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
|
||||
-- > main = xmonad $ def { terminal = "urxvt" }
|
||||
-- > `additionalKeys`
|
||||
-- > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4")
|
||||
-- > , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do
|
||||
@ -88,7 +88,7 @@ additionalKeys conf keyList =
|
||||
-- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as
|
||||
-- described in the documentation for 'mkKeymap'. For example:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
|
||||
-- > main = xmonad $ def { terminal = "urxvt" }
|
||||
-- > `additionalKeysP`
|
||||
-- > [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4")
|
||||
-- > , ("M-<Backspace>", withFocused hide) -- N.B. this is an absurd thing to do
|
||||
@ -101,7 +101,7 @@ additionalKeysP conf keyList =
|
||||
-- |
|
||||
-- Remove standard keybindings you're not using. Example use:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
|
||||
-- > main = xmonad $ def { terminal = "urxvt" }
|
||||
-- > `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]]
|
||||
removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a
|
||||
removeKeys conf keyList =
|
||||
@ -111,7 +111,7 @@ removeKeys conf keyList =
|
||||
-- like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the
|
||||
-- documentation for 'mkKeymap'. For example:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
|
||||
-- > main = xmonad $ def { terminal = "urxvt" }
|
||||
-- > `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']]
|
||||
|
||||
removeKeysP :: XConfig l -> [String] -> XConfig l
|
||||
@ -682,7 +682,7 @@ multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $
|
||||
-- > main = xmonad $ myConfig
|
||||
-- >
|
||||
-- > myKeymap = [("S-M-c", kill), ...]
|
||||
-- > myConfig = defaultConfig {
|
||||
-- > myConfig = def {
|
||||
-- > ...
|
||||
-- > keys = \c -> mkKeymap c myKeymap
|
||||
-- > startupHook = return () >> checkKeymap myConfig myKeymap
|
||||
|
@ -67,7 +67,7 @@ import qualified XMonad.StackSet as W
|
||||
-- > import XMonad.Util.EZConfig
|
||||
-- >
|
||||
-- > main = xmonad $ addDescrKeys ((mod4Mask, xK_F1), xMessage) myKeys
|
||||
-- > defaultConfig { modMask = mod4Mask }
|
||||
-- > def { modMask = mod4Mask }
|
||||
-- >
|
||||
-- > myKeys c = (subtitle "Custom Keys":) $ mkNamedKeymap c $
|
||||
-- > [("M-x a", addName "useless message" $ spawn "xmessage foo"),
|
||||
@ -191,7 +191,7 @@ smartSpace [] = []
|
||||
smartSpace xs = ' ':xs
|
||||
|
||||
_test :: String
|
||||
_test = unlines $ showKm $ defaultKeysDescr XMonad.defaultConfig { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.defaultConfig }
|
||||
_test = unlines $ showKm $ defaultKeysDescr XMonad.def { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.def }
|
||||
|
||||
showKm :: [((KeyMask, KeySym), NamedAction)] -> [String]
|
||||
showKm keybindings = padding $ do
|
||||
@ -227,7 +227,7 @@ addDescrKeys' (k,f) ks conf =
|
||||
keylist l = M.map getAction $ M.fromList $ ks l ^++^ [(k, shk l)]
|
||||
in conf { keys = keylist }
|
||||
|
||||
-- | A version of the default keys from 'XMonad.Config.defaultConfig', but with
|
||||
-- | A version of the default keys from the default configuration, but with
|
||||
-- 'NamedAction' instead of @X ()@
|
||||
defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
|
||||
defaultKeysDescr conf@(XConfig {XMonad.modMask = modm}) =
|
||||
|
@ -40,7 +40,7 @@ import Control.Monad
|
||||
-- > import XMonad.Util.Replace
|
||||
-- > main = do
|
||||
-- > replace
|
||||
-- > xmonad $ defaultConfig { .... }
|
||||
-- > xmonad $ def { .... }
|
||||
--
|
||||
|
||||
-- $shortcomings
|
||||
@ -61,7 +61,7 @@ import Control.Monad
|
||||
-- > main = do
|
||||
-- > args <- getArgs
|
||||
-- > when ("--replace" `elem` args) replace
|
||||
-- > xmonad $ defaultConfig { .... }
|
||||
-- > xmonad $ def { .... }
|
||||
--
|
||||
--
|
||||
-- Note that your @~\/.xmonad/xmonad-$arch-$os@ binary is not run with the same
|
||||
|
@ -134,7 +134,7 @@ safeSpawnProg = flip safeSpawn []
|
||||
unsafeSpawn :: MonadIO m => String -> m ()
|
||||
unsafeSpawn = spawn
|
||||
|
||||
-- | Open a terminal emulator. The terminal emulator is specified in @defaultConfig@ as xterm by default. It is then
|
||||
-- | Open a terminal emulator. The terminal emulator is specified in the default configuration as xterm by default. It is then
|
||||
-- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn'
|
||||
unsafeRunInTerm, runInTerm :: String -> String -> X ()
|
||||
unsafeRunInTerm options command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " " ++ options ++ " -e " ++ command
|
||||
|
@ -56,7 +56,7 @@ import XMonad.Layout.Decoration
|
||||
-- >
|
||||
-- > myLayout = tabbed shrinkText (theme smallClean)
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig {layoutHook = myLayout}
|
||||
-- > main = xmonad def {layoutHook = myLayout}
|
||||
--
|
||||
-- If you have a theme you would like to share, adding it to this
|
||||
-- module is very easy.
|
||||
|
Loading…
x
Reference in New Issue
Block a user