eliminate references to defaultConfig

This commit is contained in:
Daniel Wagner 2013-05-28 00:58:25 +00:00
parent 0287b2861c
commit daa2731d3d
98 changed files with 182 additions and 181 deletions

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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:
--

View File

@ -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

View File

@ -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
--

View File

@ -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
-- > ...
-- > }
--

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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-"]

View File

@ -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

View File

@ -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)))]

View File

@ -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,

View File

@ -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) ]

View File

@ -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",

View File

@ -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.

View File

@ -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
}

View File

@ -84,7 +84,7 @@ some colours:
>
> import XMonad
>
> main = xmonad $ defaultConfig
> main = xmonad $ def
> { borderWidth = 2
> , terminal = "urxvt"
> , normalBorderColor = "#cccccc"

View File

@ -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.

View File

@ -33,7 +33,7 @@ import qualified Data.Map as M
--
-- > import XMonad.Hooks.CurrentWorkspaceOnTop
-- >
-- > main = xmonad $ defaultConfig {
-- > main = xmonad $ def {
-- > ...
-- > logHook = currentWorkspaceOnTop
-- > ...

View File

@ -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.
--

View File

@ -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".

View File

@ -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>

View File

@ -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`

View File

@ -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:

View File

@ -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.

View File

@ -13,7 +13,7 @@
--
-- > import XMonad.Hooks.ManageHelpers
-- > main =
-- > xmonad defaultConfig{
-- > xmonad def{
-- > ...
-- > manageHook = composeOne [
-- > isKDETrayWindow -?> doIgnore,

View File

@ -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

View File

@ -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

View File

@ -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
-- > }
--

View File

@ -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 )

View File

@ -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"
-- > ...

View File

@ -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 )

View File

@ -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.

View File

@ -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 }

View File

@ -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

View File

@ -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 >> ...
-- > , ...

View File

@ -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:
--

View File

@ -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)

View File

@ -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:
--

View File

@ -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

View File

@ -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:
--

View File

@ -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

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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

View File

@ -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)
-- > }
--

View File

@ -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:
--

View File

@ -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 }
--

View File

@ -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

View File

@ -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:

View File

@ -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

View File

@ -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.

View File

@ -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

View File

@ -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),
-- > ...
-- > }
--

View File

@ -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

View File

@ -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:
--

View File

@ -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

View File

@ -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'

View File

@ -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:

View File

@ -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:

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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

View File

@ -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:
--

View File

@ -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:

View File

@ -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

View File

@ -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:
--

View File

@ -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.

View File

@ -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.

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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

View File

@ -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:
--

View File

@ -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

View File

@ -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

View File

@ -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:
--

View File

@ -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)),
> ...

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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:
--

View File

@ -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

View File

@ -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:
--

View File

@ -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.

View File

@ -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

View File

@ -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}) =

View File

@ -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

View File

@ -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

View File

@ -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.