3 patches for repository haskell:/srv/code/XMonadContrib: Mon May 27 20:10:40 EDT 2013 Daniel Wagner * minimal change needed to get xmonad-contrib to build with xmonad's data-default patch Mon May 27 20:58:25 EDT 2013 Daniel Wagner * eliminate references to defaultConfig Mon May 27 21:39:09 EDT 2013 Daniel Wagner * use Data.Default wherever possible, and deprecate the things it replaces New patches: [minimal change needed to get xmonad-contrib to build with xmonad's data-default patch Daniel Wagner **20130528001040 Ignore-this: 291e4f6cd74fc2b808062e0369665170 ] hunk ./XMonad/Layout/SubLayouts.hs 53 import XMonad.Layout.WindowNavigation(Navigate(Apply)) import XMonad.Util.Invisible(Invisible(..)) import XMonad.Util.Types(Direction2D(..)) -import XMonad +import XMonad hiding (def) import Control.Applicative((<$>),(<*)) import Control.Arrow(Arrow(second, (&&&))) import Control.Monad(MonadPlus(mplus), foldM, guard, when, join) [eliminate references to defaultConfig Daniel Wagner **20130528005825 Ignore-this: 37ae613e4b943e99c5200915b9d95e58 ] { hunk ./XMonad/Actions/BluetileCommands.hs 39 -- -- 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. hunk ./XMonad/Actions/CopyWindow.hs 90 -- > -- > 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 hunk ./XMonad/Actions/GroupNavigation.hs 76 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 hunk ./XMonad/Actions/MouseResize.hs 46 -- -- Then edit your @layoutHook@ by modifying a given layout: -- --- > myLayout = mouseResize $ windowArrange $ layoutHook defaultConfig +-- > myLayout = mouseResize $ windowArrange $ layoutHook def -- -- and then: -- hunk ./XMonad/Actions/MouseResize.hs 50 --- > main = xmonad defaultConfig { layoutHook = myLayout } +-- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- hunk ./XMonad/Actions/Navigation2D.hs 118 -- 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: -- hunk ./XMonad/Actions/Navigation2D.hs 153 -- > 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, hunk ./XMonad/Actions/Navigation2D.hs 172 -- > } -- > -- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig --- > $ defaultConfig +-- > $ def -- -- With this setup, Left/Up navigation behaves like standard -- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like hunk ./XMonad/Actions/Plane.hs 55 -- -- > import XMonad.Actions.Plane -- > --- > main = xmonad defaultConfig {keys = myKeys} +-- > main = xmonad def {keys = myKeys} -- > hunk ./XMonad/Actions/Plane.hs 57 --- > 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 -- hunk ./XMonad/Actions/Plane.hs 230 parameters :: [String] parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"] + hunk ./XMonad/Actions/SpawnOn.hs 48 -- > import XMonad.Actions.SpawnOn -- -- > main = do --- > xmonad defaultConfig { +-- > xmonad def { -- > ... hunk ./XMonad/Actions/SpawnOn.hs 50 --- > manageHook = manageSpawn <+> manageHook defaultConfig +-- > manageHook = manageSpawn <+> manageHook def -- > ... -- > } -- hunk ./XMonad/Actions/TopicSpace.hs 164 -- > 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 hunk ./XMonad/Actions/UpdateFocus.hs 32 -- following to your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.UpdateFocus --- > xmonad $ defaultConfig { +-- > xmonad $ def { -- > .. -- > startupHook = adjustEventInput -- > handleEventHook = focusOnMouseMove hunk ./XMonad/Actions/UpdateFocus.hs 61 io $ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask .|. buttonPressMask .|. pointerMotionMask + hunk ./XMonad/Actions/WindowNavigation.hs 65 -- -- > 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. hunk ./XMonad/Actions/WorkspaceCursors.hs 72 -- > 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-"] hunk ./XMonad/Config/Arossato.hs 89 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! hunk ./XMonad/Config/Arossato.hs 131 } -- 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 hunk ./XMonad/Config/Azerty.hs 41 -- > 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)))] hunk ./XMonad/Config/Bluetile.hs 201 floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l bluetileConfig = - defaultConfig + def { modMask = mod4Mask, -- logo key manageHook = bluetileManageHook, layoutHook = bluetileLayoutHook, hunk ./XMonad/Config/Desktop.hs 25 -- 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: -- hunk ./XMonad/Config/Desktop.hs 73 -- -- -- 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@. hunk ./XMonad/Config/Desktop.hs 92 -- $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. hunk ./XMonad/Config/Desktop.hs 167 -- > adjustEventInput -- -desktopConfig = ewmh defaultConfig +desktopConfig = ewmh def { startupHook = setDefaultCursor xC_left_ptr hunk ./XMonad/Config/Desktop.hs 169 - , 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) ] hunk ./XMonad/Config/Dmwit.hs 209 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", hunk ./XMonad/Config/Droundy.hs 120 ++ 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 "~" $ hunk ./XMonad/Config/Droundy.hs 132 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. hunk ./XMonad/Config/Sjanssen.hs 24 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 $ hunk ./XMonad/Config/Sjanssen.hs 31 [ ((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 hunk ./XMonad/Config/Sjanssen.hs 38 | (x, w) <- [ ("Firefox", "web") , ("Ktorrent", "7") , ("Amarokapp", "7")]] - <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn + <+> manageHook def <+> manageDocks <+> manageSpawn <+> (isFullscreen --> doFullFloat) , startupHook = mapM_ spawnOnce spawns } hunk ./XMonad/Doc/Configuring.hs 87 > > import XMonad > -> main = xmonad $ defaultConfig +> main = xmonad $ def > { borderWidth = 2 > , terminal = "urxvt" > , normalBorderColor = "#cccccc" hunk ./XMonad/Doc/Extending.hs 935 > import XMonad > -> main = xmonad $ defaultConfig { keys = myKeys } +> main = xmonad $ def { keys = myKeys } and provide an appropriate definition of @myKeys@, such as: hunk ./XMonad/Doc/Extending.hs 994 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: hunk ./XMonad/Doc/Extending.hs 999 -> 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 hunk ./XMonad/Doc/Extending.hs 1005 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: hunk ./XMonad/Doc/Extending.hs 1021 > 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) hunk ./XMonad/Doc/Extending.hs 1047 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 hunk ./XMonad/Doc/Extending.hs 1063 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 = hunk ./XMonad/Doc/Extending.hs 1084 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 hunk ./XMonad/Doc/Extending.hs 1128 > > 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)) > hunk ./XMonad/Doc/Extending.hs 1130 -> 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 hunk ./XMonad/Doc/Extending.hs 1183 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 hunk ./XMonad/Doc/Extending.hs 1207 > > mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion > -> main = xmonad $ defaultConfig { layoutHook = mylayoutHook } +> main = xmonad $ def { layoutHook = mylayoutHook } That's it! hunk ./XMonad/Doc/Extending.hs 1259 > , 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 hunk ./XMonad/Doc/Extending.hs 1321 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, hunk ./XMonad/Doc/Extending.hs 1328 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. hunk ./XMonad/Doc/Extending.hs 1390 '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. hunk ./XMonad/Hooks/CurrentWorkspaceOnTop.hs 36 -- -- > import XMonad.Hooks.CurrentWorkspaceOnTop -- > --- > main = xmonad $ defaultConfig { +-- > main = xmonad $ def { -- > ... -- > logHook = currentWorkspaceOnTop -- > ... hunk ./XMonad/Hooks/DynamicLog.hs 91 -- -- > 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 hunk ./XMonad/Hooks/DynamicLog.hs 102 -- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the -- appropriate function, for instance: -- --- > main = xmonad $ defaultConfig { +-- > main = xmonad $ def { -- > ... -- > logHook = dynamicLog -- > ... hunk ./XMonad/Hooks/DynamicLog.hs 127 -- > -- > main = do -- > h <- spawnPipe "xmobar -options -foo -bar" --- > xmonad $ defaultConfig { +-- > xmonad $ def { -- > ... -- > logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h } -- hunk ./XMonad/Hooks/DynamicLog.hs 156 -- -- > 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. hunk ./XMonad/Hooks/DynamicLog.hs 181 -- -- > main = xmonad =<< xmobar myConfig -- > --- > myConfig = defaultConfig { ... } +-- > myConfig = def { ... } -- -- This works pretty much the same as 'dzen' function above. -- hunk ./XMonad/Hooks/EwmhDesktops.hs 47 -- > 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". hunk ./XMonad/Hooks/FadeInactive.hs 43 -- > 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 hunk ./XMonad/Hooks/FadeWindows.hs 118 -- 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` hunk ./XMonad/Hooks/FloatNext.hs 56 -- -- 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: hunk ./XMonad/Hooks/InsertPosition.hs 34 -- 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. hunk ./XMonad/Hooks/ManageHelpers.hs 16 -- -- > import XMonad.Hooks.ManageHelpers -- > main = --- > xmonad defaultConfig{ +-- > xmonad def{ -- > ... -- > manageHook = composeOne [ -- > isKDETrayWindow -?> doIgnore, hunk ./XMonad/Hooks/Minimize.hs 36 -- > -- > myHandleEventHook = minimizeEventHook -- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayout --- > , handleEventHook = myHandleEventHook } +-- > main = xmonad def { layoutHook = myLayout +-- > , handleEventHook = myHandleEventHook } minimizeEventHook :: Event -> X All minimizeEventHook (ClientMessageEvent {ev_window = w, hunk ./XMonad/Hooks/Place.hs 62 -- -- 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 hunk ./XMonad/Hooks/PositionStoreHooks.hs 61 -- 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 -- > hunk ./XMonad/Hooks/PositionStoreHooks.hs 64 --- > main = xmonad defaultConfig { manageHook = myManageHook --- > , handleEventHook = myHandleEventHook --- > } +-- > main = xmonad def { manageHook = myManageHook +-- > , handleEventHook = myHandleEventHook +-- > } -- positionStoreManageHook :: Maybe Theme -> ManageHook hunk ./XMonad/Hooks/RestoreMinimized.hs 37 -- > -- > myHandleEventHook = restoreMinimizedEventHook -- > --- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook } +-- > main = xmonad def { handleEventHook = myHandleEventHook } data RestoreMinimized = RestoreMinimized deriving ( Show, Read ) hunk ./XMonad/Hooks/Script.hs 37 -- 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" -- > ... hunk ./XMonad/Hooks/ServerMode.hs 82 -- -- Then edit your @handleEventHook@ by adding the 'serverModeEventHook': -- --- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook } +-- > main = xmonad def { handleEventHook = serverModeEventHook } -- data ServerMode = ServerMode deriving ( Show, Read ) hunk ./XMonad/Hooks/ToggleHook.hs 88 -- 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). hunk ./XMonad/Hooks/ToggleHook.hs 93 -- --- > 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. hunk ./XMonad/Hooks/UrgencyHook.hs 109 -- '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. hunk ./XMonad/Hooks/UrgencyHook.hs 121 -- 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, hunk ./XMonad/Hooks/UrgencyHook.hs 262 -- | 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 } hunk ./XMonad/Hooks/WorkspaceByPos.hs 36 -- -- > import XMonad.Hooks.WorkspaceByPos -- > --- > myManageHook = workspaceByPos <+> manageHook defaultConfig +-- > myManageHook = workspaceByPos <+> manageHook def -- > hunk ./XMonad/Hooks/WorkspaceByPos.hs 38 --- > main = xmonad defaultConfig { manageHook = myManageHook } +-- > main = xmonad def { manageHook = myManageHook } workspaceByPos :: ManageHook workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask hunk ./XMonad/Hooks/WorkspaceHistory.hs 41 -- -- Then add the hook to your 'logHook': -- --- > main = xmonad $ defaultConfig +-- > main = xmonad $ def -- > { ... -- > , logHook = ... >> workspaceHistoryHook >> ... -- > , ... hunk ./XMonad/Layout/Accordion.hs 34 -- 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: -- hunk ./XMonad/Layout/BorderResize.hs 43 -- -- > 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) hunk ./XMonad/Layout/BoringWindows.hs 52 -- 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: -- hunk ./XMonad/Layout/ButtonDecoration.hs 43 -- 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 hunk ./XMonad/Layout/Circle.hs 35 -- 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: -- hunk ./XMonad/Layout/Cross.hs 32 -- 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 hunk ./XMonad/Layout/DecorationMadness.hs 108 -- -- 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: -- hunk ./XMonad/Layout/Dishes.hs 36 -- 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: -- hunk ./XMonad/Layout/DragPane.hs 44 -- 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: -- hunk ./XMonad/Layout/Drawer.hs 51 -- > 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 hunk ./XMonad/Layout/DwmStyle.hs 39 -- 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: -- hunk ./XMonad/Layout/DwmStyle.hs 53 -- -- and -- --- > myL = dwmStyle shrinkText myDWConfig (layoutHook defaultConfig) +-- > myL = dwmStyle shrinkText myDWConfig (layoutHook def) -- -- A complete xmonad.hs file for this would therefore be: -- hunk ./XMonad/Layout/DwmStyle.hs 60 -- > import XMonad -- > import XMonad.Layout.DwmStyle -- > --- > main = xmonad defaultConfig { +-- > main = xmonad def { -- > layoutHook = -- > dwmStyle shrinkText defaultTheme hunk ./XMonad/Layout/DwmStyle.hs 63 --- > (layoutHook defaultConfig) +-- > (layoutHook def) -- > } -- hunk ./XMonad/Layout/FixedColumn.hs 46 -- 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: -- hunk ./XMonad/Layout/Fullscreen.hs 56 -- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook' -- to your config, i.e. -- --- > xmonad defaultconfig { handleEventHook = fullscreenEventHook, --- > manageHook = fullscreenManageHook, --- > layoutHook = myLayouts } +-- > xmonad def { handleEventHook = fullscreenEventHook, +-- > manageHook = fullscreenManageHook, +-- > layoutHook = myLayouts } -- -- Now you can use layouts that respect fullscreen, for example the -- provided 'fullscreenFull': hunk ./XMonad/Layout/Grid.hs 34 -- 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 hunk ./XMonad/Layout/HintedGrid.hs 45 -- 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: hunk ./XMonad/Layout/HintedTile.hs 41 -- > 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 hunk ./XMonad/Layout/IM.hs 48 -- 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. hunk ./XMonad/Layout/ImageButtonDecoration.hs 53 -- 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 hunk ./XMonad/Layout/IndependentScreens.hs 48 -- -- 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. hunk ./XMonad/Layout/IndependentScreens.hs 117 -- -- > main = do -- > nScreens <- countScreens --- > xmonad $ defaultConfig { +-- > xmonad $ def { -- > ... hunk ./XMonad/Layout/IndependentScreens.hs 119 --- > workspaces = withScreens nScreens (workspaces defaultConfig), +-- > workspaces = withScreens nScreens (workspaces def), -- > ... -- > } -- hunk ./XMonad/Layout/LayoutBuilder.hs 53 -- > $ (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 hunk ./XMonad/Layout/LayoutCombinators.hs 71 -- 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: -- hunk ./XMonad/Layout/LayoutHints.hs 57 -- 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: -- hunk ./XMonad/Layout/LayoutHints.hs 77 -- -- > myHandleEventHook = hintsEventHook <+> ... -- > --- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook --- > , ... } +-- > main = xmonad def { handleEventHook = myHandleEventHook +-- > , ... } layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a layoutHints = ModifiedLayout (LayoutHints (0, 0)) hunk ./XMonad/Layout/LimitWindows.hs 50 -- > 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' hunk ./XMonad/Layout/MagicFocus.hs 44 -- modifier: -- -- > myLayout = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayout, --- > handleEventHook = promoteWarp } +-- > main = xmonad def { layoutHook = myLayout, +-- > handleEventHook = promoteWarp } -- -- For more detailed instructions on editing the layoutHook see: -- hunk ./XMonad/Layout/Magnifier.hs 47 -- 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: hunk ./XMonad/Layout/Maximize.hs 39 -- 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: -- hunk ./XMonad/Layout/Minimize.hs 44 -- 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: -- hunk ./XMonad/Layout/Mosaic.hs 52 -- 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 hunk ./XMonad/Layout/MosaicAlt.hs 48 -- 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: -- hunk ./XMonad/Layout/MouseResizableTile.hs 51 -- 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: hunk ./XMonad/Layout/MultiColumns.hs 38 -- 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: -- hunk ./XMonad/Layout/MultiColumns.hs 43 -- > 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 hunk ./XMonad/Layout/Named.hs 37 -- 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: -- hunk ./XMonad/Layout/NoFrillsDecoration.hs 40 -- 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. hunk ./XMonad/Layout/PositionStoreFloat.hs 49 -- -- > 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. hunk ./XMonad/Layout/ResizableTile.hs 37 -- 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: -- hunk ./XMonad/Layout/Roledex.hs 36 -- 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: -- hunk ./XMonad/Layout/ShowWName.hs 37 -- @~\/.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: -- hunk ./XMonad/Layout/SimpleDecoration.hs 41 -- 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: -- hunk ./XMonad/Layout/SimpleFloat.hs 42 -- 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: -- hunk ./XMonad/Layout/Simplest.hs 33 -- 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: -- hunk ./XMonad/Layout/SimplestFloat.hs 37 -- 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: -- hunk ./XMonad/Layout/Spiral.hs 40 -- 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: -- hunk ./XMonad/Layout/StackTile.hs 36 -- 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: -- hunk ./XMonad/Layout/SubLayouts.hs 126 -- -- > 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 hunk ./XMonad/Layout/TabBarDecoration.hs 39 -- -- 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: -- hunk ./XMonad/Layout/Tabbed.hs 54 -- -- 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. hunk ./XMonad/Layout/Tabbed.hs 85 -- -- > 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 hunk ./XMonad/Layout/ThreeColumns.hs 42 -- 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 hunk ./XMonad/Layout/ToggleLayouts.hs 33 -- 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: -- hunk ./XMonad/Layout/TrackFloating.hs 129 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)), > ... hunk ./XMonad/Layout/TwoPane.hs 36 -- 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: -- hunk ./XMonad/Layout/WindowArranger.hs 41 -- @~\/.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 -- hunk ./XMonad/Layout/WindowArranger.hs 46 --- > main = xmonad defaultConfig { layoutHook = windowArrangeAll myLayout } +-- > main = xmonad def { layoutHook = windowArrangeAll myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- hunk ./XMonad/Layout/WindowNavigation.hs 45 -- 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: -- hunk ./XMonad/Layout/WindowSwitcherDecoration.hs 46 -- 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 hunk ./XMonad/Layout/WindowSwitcherDecoration.hs 56 -- -- > 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 hunk ./XMonad/Layout/WindowSwitcherDecoration.hs 66 -- -- > 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 hunk ./XMonad/Layout/WorkspaceDir.hs 50 -- 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: -- hunk ./XMonad/Util/CustomKeys.hs 34 -- -- 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} = hunk ./XMonad/Util/CustomKeys.hs 56 -- > 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) ) ] } hunk ./XMonad/Util/CustomKeys.hs 61 --- | 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 hunk ./XMonad/Util/CustomKeys.hs 66 -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -customKeys = customKeysFrom defaultConfig +customKeys = customKeysFrom def -- | General variant of 'customKeys': customize key bindings of -- third-party configuration. hunk ./XMonad/Util/EZConfig.hs 10 -- -- Maintainer : Devin Mullins -- --- 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.) hunk ./XMonad/Util/EZConfig.hs 72 -- | -- 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 hunk ./XMonad/Util/EZConfig.hs 91 -- 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-", withFocused hide) -- N.B. this is an absurd thing to do hunk ./XMonad/Util/EZConfig.hs 104 -- | -- 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 = hunk ./XMonad/Util/EZConfig.hs 114 -- 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 hunk ./XMonad/Util/EZConfig.hs 685 -- > main = xmonad $ myConfig -- > -- > myKeymap = [("S-M-c", kill), ...] --- > myConfig = defaultConfig { +-- > myConfig = def { -- > ... -- > keys = \c -> mkKeymap c myKeymap -- > startupHook = return () >> checkKeymap myConfig myKeymap hunk ./XMonad/Util/NamedActions.hs 70 -- > 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"), hunk ./XMonad/Util/NamedActions.hs 194 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 hunk ./XMonad/Util/NamedActions.hs 230 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}) = hunk ./XMonad/Util/Replace.hs 43 -- > import XMonad.Util.Replace -- > main = do -- > replace --- > xmonad $ defaultConfig { .... } +-- > xmonad $ def { .... } -- -- $shortcomings hunk ./XMonad/Util/Replace.hs 64 -- > 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 hunk ./XMonad/Util/Run.hs 137 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 hunk ./XMonad/Util/Themes.hs 59 -- > -- > 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. } [use Data.Default wherever possible, and deprecate the things it replaces Daniel Wagner **20130528013909 Ignore-this: 898458b1d2868a70dfb09faf473dc7aa ] { hunk ./XMonad/Actions/DynamicWorkspaces.hs 49 -- Then add keybindings like the following: -- -- > , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace) --- > , ((modm .|. shiftMask, xK_v ), selectWorkspace defaultXPConfig) --- > , ((modm, xK_m ), withWorkspace defaultXPConfig (windows . W.shift)) --- > , ((modm .|. shiftMask, xK_m ), withWorkspace defaultXPConfig (windows . copy)) --- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_v ), selectWorkspace def) +-- > , ((modm, xK_m ), withWorkspace def (windows . W.shift)) +-- > , ((modm .|. shiftMask, xK_m ), withWorkspace def (windows . copy)) +-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def) -- -- > -- mod-[1..9] %! Switch to workspace N -- > -- mod-shift-[1..9] %! Move client to workspace N hunk ./XMonad/Actions/DynamicWorkspaces.hs 63 -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for --- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'defaultXPConfig'. +-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'. mkCompl :: [String] -> String -> IO [String] hunk ./XMonad/Actions/GridSelect.hs 30 -- * Configuration GSConfig(..), + def, defaultGSConfig, TwoDPosition, buildDefaultGSConfig, hunk ./XMonad/Actions/GridSelect.hs 171 -- -- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@: -- --- > gsconfig3 = defaultGSConfig +-- > gsconfig3 = def -- > { gs_cellheight = 30 -- > , gs_cellwidth = 100 -- > , gs_navigate = myNavigation hunk ./XMonad/Actions/GridSelect.hs 187 -- -- <> +-- | The 'Default' instance gives a basic configuration for 'gridselect', with +-- the colorizer chosen based on the type. +-- +-- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig' +-- instead of 'def' to avoid ambiguous type variables. data GSConfig a = GSConfig { gs_cellheight :: Integer, gs_cellwidth :: Integer, hunk ./XMonad/Actions/GridSelect.hs 221 let getColor = if isFg then focusedBorderColor else normalBorderColor in asks $ flip (,) "black" . getColor . config --- | A basic configuration for 'gridselect', with the colorizer chosen based on the type. --- --- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig' --- instead, to avoid ambiguous type variables. +instance HasColorizer a => Default (GSConfig a) where + def = buildDefaultGSConfig defaultColorizer + +{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-} defaultGSConfig :: HasColorizer a => GSConfig a hunk ./XMonad/Actions/GridSelect.hs 226 -defaultGSConfig = buildDefaultGSConfig defaultColorizer +defaultGSConfig = def type TwoDPosition = (Integer, Integer) hunk ./XMonad/Actions/Launcher.hs 37 To test it, modify your local .xmonad: - > import XMonad.Prompt(defaultXPConfig) + > import XMonad.Prompt(def) > import XMonad.Actions.Launcher hunk ./XMonad/Actions/Launcher.hs 40 - > ((modm .|. controlMask, xK_l), launcherPrompt defaultXPConfig $ defaultLauncherModes launcherConfig) + > ((modm .|. controlMask, xK_l), launcherPrompt def $ defaultLauncherModes launcherConfig) A LauncherConfig contains settings for the default modes, modify them accordingly. hunk ./XMonad/Actions/Launcher.hs 48 Restart xmonad. Press Ctrl + Your_Modkey + L and the first prompt should pop up. - If you used 'defaultXPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'. + If you used the default 'XPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'. -} data HoogleMode = HMode FilePath String --path to hoogle and browser hunk ./XMonad/Actions/Navigation2D.hs 37 withNavigation2DConfig , Navigation2DConfig(..) + , def , defaultNavigation2DConfig , Navigation2D , lineNavigation hunk ./XMonad/Actions/Navigation2D.hs 118 -- -- and add the configuration of the module to your main function: -- --- > main = xmonad $ withNavigation2DConfig defaultNavigation2DConfig --- > $ def +-- > main = xmonad $ withNavigation2DConfig def $ def -- -- For detailed instruction on editing the key binding see: -- hunk ./XMonad/Actions/Navigation2D.hs 150 -- example, for the Full layout, is to switch to center navigation for the Full -- layout: -- --- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] } +-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] } -- > -- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig -- > $ def hunk ./XMonad/Actions/Navigation2D.hs 167 -- on top of each other so that only the frontmost one is visible. This can be -- done as follows: -- --- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] --- > , unmappedWindowRect = [("Full", singleWindowRect)] --- > } +-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] +-- > , unmappedWindowRect = [("Full", singleWindowRect)] +-- > } -- > -- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig -- > $ def hunk ./XMonad/Actions/Navigation2D.hs 282 centerNavigation :: Navigation2D centerNavigation = N 2 doCenterNavigation --- | Stores the configuration of directional navigation +-- | Stores the configuration of directional navigation. The 'Default' instance +-- uses line navigation for the tiled layer and for navigation between screens, +-- and center navigation for the float layer. No custom navigation strategies +-- or rectangles for unmapped windows are defined for individual layouts. data Navigation2DConfig = Navigation2DConfig { defaultTiledNavigation :: Navigation2D -- ^ default navigation strategy for the tiled layer , floatNavigation :: Navigation2D -- ^ navigation strategy for the float layer hunk ./XMonad/Actions/Navigation2D.hs 311 -- So we can store the configuration in extensible state instance ExtensionClass Navigation2DConfig where - initialValue = defaultNavigation2DConfig + initialValue = def -- | Modifies the xmonad configuration to store the Navigation2D configuration withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a hunk ./XMonad/Actions/Navigation2D.hs 319 >> XS.put conf2d } --- | Default navigation configuration. It uses line navigation for the tiled --- layer and for navigation between screens, and center navigation for the float --- layer. No custom navigation strategies or rectangles for unmapped windows are --- defined for individual layouts. +{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-} defaultNavigation2DConfig :: Navigation2DConfig hunk ./XMonad/Actions/Navigation2D.hs 321 -defaultNavigation2DConfig = Navigation2DConfig { defaultTiledNavigation = lineNavigation +defaultNavigation2DConfig = def + +instance Default Navigation2DConfig where + def = Navigation2DConfig { defaultTiledNavigation = lineNavigation , floatNavigation = centerNavigation , screenNavigation = lineNavigation , layoutNavigation = [] hunk ./XMonad/Actions/Search.hs 160 > ... > -- Search commands -> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig) +> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.def) > , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) > > ... hunk ./XMonad/Actions/Search.hs 176 > ... > ] -- end of regular keybindings > -- Search commands -> ++ [("M-s " ++ k, S.promptSearch P.defaultXPConfig f) | (k,f) <- searchList ] +> ++ [("M-s " ++ k, S.promptSearch P.def f) | (k,f) <- searchList ] > ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ] > > ... hunk ./XMonad/Actions/ShowText.hs 19 module XMonad.Actions.ShowText ( -- * Usage -- $usage - defaultSTConfig + def + , defaultSTConfig , handleTimerEvent , flashText , ShowTextConfig(..) hunk ./XMonad/Actions/ShowText.hs 56 -- -- You can then use flashText in your keybindings: -- --- > ((modMask, xK_Right), flashText defaultSTConfig 1 "->" >> nextWS) +-- > ((modMask, xK_Right), flashText def 1 "->" >> nextWS) -- -- | ShowText contains the map with timers as keys and created windows as values hunk ./XMonad/Actions/ShowText.hs 76 , st_fg :: String -- ^ Foreground color } -defaultSTConfig :: ShowTextConfig -defaultSTConfig = +instance Default ShowTextConfig where + def = STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*" , st_bg = "black" , st_fg = "white" hunk ./XMonad/Actions/ShowText.hs 83 } +{-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-} +defaultSTConfig :: ShowTextConfig +defaultSTConfig = def + -- | Handles timer events that notify when a window should be removed handleTimerEvent :: Event -> X All handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do hunk ./XMonad/Actions/SpawnOn.hs 57 -- To ensure that application appears on a workspace it was launched at, add keybindings like: -- -- > , ((mod1Mask,xK_o), spawnHere "urxvt") --- > , ((mod1Mask,xK_s), shellPromptHere defaultXPConfig) +-- > , ((mod1Mask,xK_s), shellPromptHere def) -- -- The module can also be used to apply other manage hooks to the window of -- the spawned application(e.g. float or resize it). hunk ./XMonad/Actions/Submap.hs 65 -- | Like 'submap', but executes a default action if the key did not match. submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X () -submapDefault def keys = do +submapDefault defAction keys = do XConf { theRoot = root, display = d } <- ask io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime hunk ./XMonad/Actions/Submap.hs 82 io $ ungrabKeyboard d currentTime - maybe def id (M.lookup (m', s) keys) + maybe defAction id (M.lookup (m', s) keys) hunk ./XMonad/Actions/TagWindows.hs 56 -- > , ((modm, xK_d ), withTaggedP "abc" (W.shiftWin "2")) -- > , ((modm .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) -- > , ((modm .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") --- > , ((modm, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) --- > , ((modm .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) --- > , ((modm .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) --- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (W.shiftWin "2"))) --- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) --- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) +-- > , ((modm, xK_g ), tagPrompt def (\s -> withFocused (addTag s))) +-- > , ((modm .|. controlMask, xK_g ), tagDelPrompt def) +-- > , ((modm .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobal s float)) +-- > , ((modWinMask, xK_g ), tagPrompt def (\s -> withTaggedP s (W.shiftWin "2"))) +-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobalP s shiftHere)) +-- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt def (\s -> focusUpTaggedGlobal s)) -- -- NOTE: Tags are saved as space separated strings and split with -- 'unwords'. Thus if you add a tag \"a b\" the window will have hunk ./XMonad/Actions/TopicSpace.hs 25 Topic , Dir , TopicConfig(..) + , def , defaultTopicConfig , getLastFocusedTopics , setLastFocusedTopic hunk ./XMonad/Actions/TopicSpace.hs 93 -- > ] -- > -- > myTopicConfig :: TopicConfig --- > myTopicConfig = defaultTopicConfig +-- > myTopicConfig = def -- > { topicDirs = M.fromList $ -- > [ ("conf", "w/conf") -- > , ("dashboard", "Desktop") hunk ./XMonad/Actions/TopicSpace.hs 210 -- numeric keypad. } -defaultTopicConfig :: TopicConfig -defaultTopicConfig = TopicConfig { topicDirs = M.empty +instance Default TopicConfig where + def = TopicConfig { topicDirs = M.empty , topicActions = M.empty , defaultTopicAction = const (ask >>= spawn . terminal . config) , defaultTopic = "1" hunk ./XMonad/Actions/TopicSpace.hs 218 , maxTopicHistory = 10 } +{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-} +defaultTopicConfig :: TopicConfig +defaultTopicConfig = def + newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable) instance ExtensionClass PrevTopics where initialValue = PrevTopics [] hunk ./XMonad/Actions/WorkspaceNames.hs 58 -- -- Then add keybindings like the following: -- --- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def) -- -- and apply workspaceNamesPP to your DynamicLog pretty-printer: -- hunk ./XMonad/Config/Arossato.hs 39 import XMonad.Layout.SimpleFloat import XMonad.Layout.Tabbed import XMonad.Layout.WindowArranger -import XMonad.Prompt import XMonad.Prompt.Shell import XMonad.Prompt.Ssh import XMonad.Prompt.Theme hunk ./XMonad/Config/Arossato.hs 122 newManageHook = myManageHook -- xmobar - myDynLog h = dynamicLogWithPP defaultPP + myDynLog h = dynamicLogWithPP def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" , ppTitle = xmobarColor "green" "" . shorten 40 , ppVisible = wrap "(" ")" hunk ./XMonad/Config/Arossato.hs 146 [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] -- These are my personal key bindings toAdd x = - [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) - , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) - , ((modMask x , xK_F4 ), sshPrompt defaultXPConfig ) - , ((modMask x , xK_F5 ), themePrompt defaultXPConfig ) - , ((modMask x , xK_F6 ), windowPromptGoto defaultXPConfig ) - , ((modMask x , xK_F7 ), windowPromptBring defaultXPConfig ) + [ ((modMask x , xK_F12 ), xmonadPrompt def ) + , ((modMask x , xK_F3 ), shellPrompt def ) + , ((modMask x , xK_F4 ), sshPrompt def ) + , ((modMask x , xK_F5 ), themePrompt def ) + , ((modMask x , xK_F6 ), windowPromptGoto def ) + , ((modMask x , xK_F7 ), windowPromptBring def ) , ((modMask x , xK_comma ), prevWS ) , ((modMask x , xK_period), nextWS ) , ((modMask x , xK_Right ), windows W.focusDown ) hunk ./XMonad/Config/Dmwit.hs 310 allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp <- [ppFocus, ppWorkspaces]] color c = xmobarColor c "" -ppFocus s@(S s_) = whenCurrentOn s defaultPP { +ppFocus s@(S s_) = whenCurrentOn s def { ppOrder = \(_:_:windowTitle:_) -> [windowTitle], ppOutput = appendFile (pipeName "focus" s_) . (++ "\n") } hunk ./XMonad/Config/Dmwit.hs 315 -ppWorkspaces s@(S s_) = marshallPP s defaultPP { +ppWorkspaces s@(S s_) = marshallPP s def { ppCurrent = color "white", ppVisible = color "white", ppHiddenNoWindows = color dark, hunk ./XMonad/Config/Droundy.hs 19 import qualified Data.Map as M import System.Exit ( exitWith, ExitCode(ExitSuccess) ) -import XMonad.Layout.Tabbed ( tabbed, defaultTheme, +import XMonad.Layout.Tabbed ( tabbed, shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) import XMonad.Layout.Combo ( combineTwo ) import XMonad.Layout.Named ( named ) hunk ./XMonad/Config/Droundy.hs 35 import XMonad.Layout.ShowWName ( showWName ) import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) ) -import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig ) +import XMonad.Prompt ( font, height, XPConfig ) import XMonad.Prompt.Layout ( layoutPrompt ) import XMonad.Prompt.Shell ( shellPrompt ) hunk ./XMonad/Config/Droundy.hs 49 import XMonad.Hooks.EwmhDesktops ( ewmh ) myXPConfig :: XPConfig -myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*" - ,height=22} +myXPConfig = def {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*" + ,height=22} ------------------------------------------------------------------------ hunk ./XMonad/Config/Droundy.hs 140 , XMonad.keys = keys } -mytab = tabbed CustomShrink defaultTheme +mytab = tabbed CustomShrink def instance Shrinker CustomShrink where shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' hunk ./XMonad/Config/Sjanssen.hs 65 ] myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10" - myTheme = defaultTheme { fontName = myFont } - myPromptConfig = defaultXPConfig + myTheme = def { fontName = myFont } + myPromptConfig = def { position = Top , font = myFont , showCompletionOnTab = True hunk ./XMonad/Doc/Extending.hs 940 and provide an appropriate definition of @myKeys@, such as: > myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList -> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modm, xK_F3 ), shellPrompt defaultXPConfig) +> [ ((modm, xK_F12), xmonadPrompt def) +> , ((modm, xK_F3 ), shellPrompt def) > ] This particular definition also requires importing "XMonad.Prompt", hunk ./XMonad/Doc/Extending.hs 987 these: > myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList -> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modm, xK_F3 ), shellPrompt defaultXPConfig) +> [ ((modm, xK_F12), xmonadPrompt def) +> , ((modm, xK_F3 ), shellPrompt def) > ] then you can create a new key bindings map by joining the default one hunk ./XMonad/Doc/Extending.hs 1024 > main = xmonad $ def { keys = myKeys <+> keys def } > > myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList -> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modm, xK_F3 ), shellPrompt defaultXPConfig) +> [ ((modm, xK_F12), xmonadPrompt def) +> , ((modm, xK_F3 ), shellPrompt def) > ] There are much simpler ways to accomplish this, however, if you are hunk ./XMonad/Doc/Extending.hs 1100 > [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]] > -- These are my personal key bindings > toAdd XConfig{modMask = modm} = -> [ ((modm , xK_F12 ), xmonadPrompt defaultXPConfig ) -> , ((modm , xK_F3 ), shellPrompt defaultXPConfig ) +> [ ((modm , xK_F12 ), xmonadPrompt def ) +> , ((modm , xK_F3 ), shellPrompt def ) > ] ++ > -- Use modm .|. shiftMask .|. controlMask 1-9 instead > [( (m .|. modm, k), windows $ f i) hunk ./XMonad/Doc/Extending.hs 1177 Then we create the combination of layouts we need: -> mylayoutHook = Full ||| tabbed shrinkText defaultTheme ||| Accordion +> mylayoutHook = Full ||| tabbed shrinkText def ||| Accordion Now, all we need to do is change the 'XMonad.Core.layoutHook' hunk ./XMonad/Doc/Extending.hs 1191 'XMonad.Layout.NoBorders.noBorders' layout modifier, from the "XMonad.Layout.NoBorders" module (which must be imported): -> mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTheme ||| Accordion) +> mylayoutHook = noBorders (Full ||| tabbed shrinkText def ||| Accordion) If we want only the tabbed layout without borders, then we may write: hunk ./XMonad/Doc/Extending.hs 1195 -> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion +> mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion Our @~\/.xmonad\/xmonad.hs@ will now look like this: hunk ./XMonad/Doc/Extending.hs 1205 > import XMonad.Layout.Accordion > import XMonad.Layout.NoBorders > -> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion +> mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion > > main = xmonad $ def { layoutHook = mylayoutHook } hunk ./XMonad/Hooks/DynamicLog.hs 38 -- * Build your own formatter dynamicLogWithPP, dynamicLogString, - PP(..), defaultPP, + PP(..), defaultPP, def, -- * Example formatters dzenPP, xmobarPP, sjanssenPP, byorgeyPP, hunk ./XMonad/Hooks/DynamicLog.hs 129 -- > h <- spawnPipe "xmobar -options -foo -bar" -- > xmonad $ def { -- > ... --- > logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h } +-- > logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h } -- -- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of -- your pretty-printer as in the example above; by default the status hunk ./XMonad/Hooks/DynamicLog.hs 249 -- To customize the output format, see 'dynamicLogWithPP'. -- dynamicLog :: X () -dynamicLog = dynamicLogWithPP defaultPP +dynamicLog = dynamicLogWithPP def -- | Format the current status using the supplied pretty-printing format, -- and write it to stdout. hunk ./XMonad/Hooks/DynamicLog.hs 315 -- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from -- "XMonad.Util.WorkspaceCompare". For example, -- --- > defaultPP { ppCurrent = dzenColor "red" "#efebe7" --- > , ppVisible = wrap "[" "]" --- > , ppSort = getSortByXineramaRule --- > } +-- > def { ppCurrent = dzenColor "red" "#efebe7" +-- > , ppVisible = wrap "[" "]" +-- > , ppSort = getSortByXineramaRule +-- > } dynamicLogXinerama :: X () dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama hunk ./XMonad/Hooks/DynamicLog.hs 462 } -- | The default pretty printing options, as seen in 'dynamicLog'. +{-# DEPRECATED defaultPP "Use def (from Data.Default, and re-exported by XMonad.Hooks.DynamicLog) instead." #-} defaultPP :: PP hunk ./XMonad/Hooks/DynamicLog.hs 464 -defaultPP = PP { ppCurrent = wrap "[" "]" +defaultPP = def + +instance Default PP where + def = PP { ppCurrent = wrap "[" "]" , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const "" hunk ./XMonad/Hooks/DynamicLog.hs 484 -- | Settings to emulate dwm's statusbar, dzen only. dzenPP :: PP -dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad +dzenPP = def { ppCurrent = dzenColor "white" "#2b4f98" . pad , ppVisible = dzenColor "black" "#999999" . pad , ppHidden = dzenColor "black" "#cccccc" . pad , ppHiddenNoWindows = const "" hunk ./XMonad/Hooks/DynamicLog.hs 503 -- | Some nice xmobar defaults. xmobarPP :: PP -xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" +xmobarPP = def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" , ppTitle = xmobarColor "green" "" . shorten 40 , ppVisible = wrap "(" ")" , ppUrgent = xmobarColor "red" "yellow" hunk ./XMonad/Hooks/DynamicLog.hs 511 -- | The options that sjanssen likes to use with xmobar, as an -- example. Note the use of 'xmobarColor' and the record update on --- 'defaultPP'. +-- 'def'. sjanssenPP :: PP hunk ./XMonad/Hooks/DynamicLog.hs 513 -sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "black" - , ppTitle = xmobarColor "#00ee00" "" . shorten 120 - } +sjanssenPP = def { ppCurrent = xmobarColor "white" "black" + , ppTitle = xmobarColor "#00ee00" "" . shorten 120 + } -- | The options that byorgey likes to use with dzen, as another example. byorgeyPP :: PP hunk ./XMonad/Hooks/DynamicLog.hs 519 -byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces - , ppHidden = dzenColor "black" "#a8a3f7" . pad - , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad - , ppUrgent = dzenColor "red" "yellow" . pad - , ppSep = " | " - , ppWsSep = "" - , ppTitle = shorten 70 - , ppOrder = reverse - } +byorgeyPP = def { ppHiddenNoWindows = showNamedWorkspaces + , ppHidden = dzenColor "black" "#a8a3f7" . pad + , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad + , ppUrgent = dzenColor "red" "yellow" . pad + , ppSep = " | " + , ppWsSep = "" + , ppTitle = shorten 70 + , ppOrder = reverse + } where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z'] then pad wsId else "" hunk ./XMonad/Hooks/PositionStoreHooks.hs 58 -- as 'positionStoreEventHook' to your event hooks. To be accurate -- about window sizes, the module needs to know if any decoration is in effect. -- This is specified with the first argument: Supply 'Nothing' for no decoration, --- otherwise use 'Just defaultTheme' or similar to inform the module about the +-- otherwise use 'Just def' or similar to inform the module about the -- decoration theme used. -- -- > myManageHook = positionStoreManageHook Nothing <+> manageHook def hunk ./XMonad/Layout/Decoration.hs 20 ( -- * Usage: -- $usage decoration - , Theme (..), defaultTheme + , Theme (..), defaultTheme, def , Decoration , DecorationMsg (..) , DecorationStyle (..) hunk ./XMonad/Layout/Decoration.hs 89 -- Inner @[Bool]@ is a row in a icon bitmap. } deriving (Show, Read) --- | The default xmonad 'Theme'. -defaultTheme :: Theme -defaultTheme = +instance Default Theme where + def = Theme { activeColor = "#999999" , inactiveColor = "#666666" , urgentColor = "#FFFF00" hunk ./XMonad/Layout/Decoration.hs 107 , windowTitleIcons = [] } +{-# DEPRECATED defaultTheme "Use def (from Data.Default, and re-exported by XMonad.Layout.Decoration) instead." #-} +-- | The default xmonad 'Theme'. +defaultTheme :: Theme +defaultTheme = def + -- | A 'Decoration' layout modifier will handle 'SetTheme', a message -- to dynamically change the decoration 'Theme'. data DecorationMsg = SetTheme Theme deriving ( Typeable ) hunk ./XMonad/Layout/DecorationAddons.hs 71 -- | Intended to be used together with 'titleBarButtonHandler'. See above. defaultThemeWithButtons :: Theme -defaultThemeWithButtons = defaultTheme { +defaultThemeWithButtons = def { windowTitleAddons = [ (" (M)", AlignLeft) , ("_" , AlignRightOffset minimizeButtonOffset) , ("[]" , AlignRightOffset maximizeButtonOffset) hunk ./XMonad/Layout/DecorationMadness.hs 85 , floatDwmStyle , floatSimpleTabbed , floatTabbed - , defaultTheme, shrinkText + , def, defaultTheme, shrinkText ) where import XMonad hunk ./XMonad/Layout/DecorationMadness.hs 116 -- -- You can also edit the default theme: -- --- > myTheme = defaultTheme { inactiveBorderColor = "#FF0000" +-- > myTheme = def { inactiveBorderColor = "#FF0000" -- > , activeTextColor = "#00FF00" } -- -- and hunk ./XMonad/Layout/DecorationMadness.hs 143 -- -- circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window -circleSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Circle +circleSimpleDefault = decoration shrinkText def DefaultDecoration Circle -- | Similar to 'circleSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 158 -- -- circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window -circleSimpleDeco = decoration shrinkText defaultTheme (Simple True) Circle +circleSimpleDeco = decoration shrinkText def (Simple True) Circle -- | Similar to 'circleSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 175 -- circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Circle) +circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Circle) -- | Similar to 'circleSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 193 -- circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Circle) +circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Circle) -- | Similar to 'circleSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 209 -- -- circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window -circleSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Circle +circleSimpleDwmStyle = decoration shrinkText def Dwm Circle -- | Similar to 'circleSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 244 -- -- accordionSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Accordion Window -accordionSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Accordion +accordionSimpleDefault = decoration shrinkText def DefaultDecoration Accordion -- | Similar to 'accordionSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 259 -- -- accordionSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Accordion Window -accordionSimpleDeco = decoration shrinkText defaultTheme (Simple True) Accordion +accordionSimpleDeco = decoration shrinkText def (Simple True) Accordion -- | Similar to 'accordionSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 272 -- windows with the mouse, and resize\/move them with the keyboard. accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window -accordionSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Accordion) +accordionSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Accordion) -- | Similar to 'accordionSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 286 -- windows with the mouse, and resize\/move them with the keyboard. accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window -accordionSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Accordion) +accordionSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Accordion) -- | Similar to 'accordionSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 302 -- -- accordionSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Accordion Window -accordionSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Accordion +accordionSimpleDwmStyle = decoration shrinkText def Dwm Accordion -- | Similar to 'accordionSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 340 -- -- tallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Tall Window -tallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration tall +tallSimpleDefault = decoration shrinkText def DefaultDecoration tall -- | Similar to 'tallSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 355 -- -- tallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Tall Window -tallSimpleDeco = decoration shrinkText defaultTheme (Simple True) tall +tallSimpleDeco = decoration shrinkText def (Simple True) tall -- | Similar to 'tallSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 372 -- tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window -tallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange tall) +tallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange tall) -- | Similar to 'tallSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 390 -- tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window -tallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange tall) +tallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange tall) -- | Similar to 'tallSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 406 -- -- tallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Tall Window -tallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm tall +tallSimpleDwmStyle = decoration shrinkText def Dwm tall -- | Similar to 'tallSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 443 -- -- mirrorTallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (Mirror Tall) Window -mirrorTallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration mirrorTall +mirrorTallSimpleDefault = decoration shrinkText def DefaultDecoration mirrorTall -- | Similar to 'mirrorTallSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 458 -- -- mirrorTallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (Mirror Tall) Window -mirrorTallSimpleDeco = decoration shrinkText defaultTheme (Simple True) mirrorTall +mirrorTallSimpleDeco = decoration shrinkText def (Simple True) mirrorTall -- | Similar to 'mirrorTallSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 475 -- mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window -mirrorTallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange mirrorTall) +mirrorTallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange mirrorTall) -- | Similar to 'mirrorTallSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 493 -- mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window -mirrorTallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange mirrorTall) +mirrorTallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange mirrorTall) -- | Similar to 'mirrorTallSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 509 -- -- mirrorTallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) (Mirror Tall) Window -mirrorTallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm mirrorTall +mirrorTallSimpleDwmStyle = decoration shrinkText def Dwm mirrorTall -- | Similar to 'mirrorTallSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 558 -- floatSimpleDefault :: (Show a, Eq a) => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a -floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20) +floatSimpleDefault = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleDefault', but with the possibility of setting a -- custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 575 -- floatSimpleDwmStyle :: (Show a, Eq a) => ModifiedLayout (Decoration DwmStyle DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a -floatSimpleDwmStyle = decoration shrinkText defaultTheme Dwm (mouseResize $ windowArrangeAll $ SF 20) +floatSimpleDwmStyle = decoration shrinkText def Dwm (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleDwmStyle', but with the possibility of setting a -- custom shrinker and a custom theme. hunk ./XMonad/Layout/DecorationMadness.hs 592 -- floatSimpleTabbed :: (Show a, Eq a) => ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a -floatSimpleTabbed = tabBar shrinkText defaultTheme Top (mouseResize $ windowArrangeAll $ SF 20) +floatSimpleTabbed = tabBar shrinkText def Top (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleTabbed', but with the possibility of setting a -- custom shrinker and a custom theme. hunk ./XMonad/Layout/DwmStyle.hs 20 -- $usage dwmStyle , Theme (..) + , def , defaultTheme , DwmStyle (..) , shrinkText, CustomShrink(CustomShrink) hunk ./XMonad/Layout/DwmStyle.hs 40 -- Then edit your @layoutHook@ by adding the DwmStyle decoration to -- your layout: -- --- > myL = dwmStyle shrinkText defaultTheme (layoutHook def) +-- > myL = dwmStyle shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Layout/DwmStyle.hs 49 -- -- You can also edit the default configuration options. -- --- > myDWConfig = defaultTheme { inactiveBorderColor = "red" --- > , inactiveTextColor = "red"} +-- > myDWConfig = def { inactiveBorderColor = "red" +-- > , inactiveTextColor = "red"} -- -- and -- hunk ./XMonad/Layout/DwmStyle.hs 62 -- > import XMonad.Layout.DwmStyle -- > -- > main = xmonad def { --- > layoutHook = --- > dwmStyle shrinkText defaultTheme --- > (layoutHook def) --- > } +-- > layoutHook = dwmStyle shrinkText def (layoutHook def) +-- > } -- hunk ./XMonad/Layout/Groups/Examples.hs 2 {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-} +{-# LANGUAGE MultiParamTypeClasses, Rank2Types, TypeFamilies #-} ----------------------------------------------------------------------------- -- | hunk ./XMonad/Layout/Groups/Examples.hs 39 , mirrorTallTabs , fullTabs , TiledTabsConfig(..) + , def , defaultTiledTabsConfig , increaseNMasterGroups , decreaseNMasterGroups hunk ./XMonad/Layout/Groups/Examples.hs 184 -- You can use any of these three layouts by including it in your layout hook. -- You will need to provide it with a 'TiledTabsConfig' containing the size -- parameters for 'Tall' and 'Mirror' 'Tall', and the shrinker and decoration theme --- for the tabs. If you're happy with defaults, you can use 'defaultTiledTabsConfig': +-- for the tabs. If you're happy with defaults, you can use 'def': -- hunk ./XMonad/Layout/Groups/Examples.hs 186 --- > myLayout = tallTabs defaultTiledTabsConfig +-- > myLayout = tallTabs def -- -- To be able to increase\/decrease the number of master groups and shrink\/expand -- the master area, you can create key bindings for the relevant actions: hunk ./XMonad/Layout/Groups/Examples.hs 205 , tabsShrinker :: s , tabsTheme :: Theme } +instance s ~ DefaultShrinker => Default (TiledTabsConfig s) where + def = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText def + +{-# DEPRECATED defaultTiledTabsConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.Groups) instead." #-} defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker hunk ./XMonad/Layout/Groups/Examples.hs 210 -defaultTiledTabsConfig = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText defaultTheme +defaultTiledTabsConfig = def fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c hunk ./XMonad/Layout/Groups/Wmii.hs 33 -- * Useful re-exports , shrinkText + , def , defaultTheme , module XMonad.Layout.Groups.Helpers ) where hunk ./XMonad/Layout/Groups/Wmii.hs 75 -- (with a 'Shrinker' and decoration 'Theme' as -- parameters) to your layout hook, for example: -- --- > myLayout = wmii shrinkText defaultTheme +-- > myLayout = wmii shrinkText def -- -- To be able to zoom in and out of groups, change their inner layout, etc., -- create key bindings for the relevant actions: hunk ./XMonad/Layout/ImageButtonDecoration.hs 167 action defaultThemeWithImageButtons :: Theme -defaultThemeWithImageButtons = defaultTheme { +defaultThemeWithImageButtons = def { windowTitleIcons = [ (menuButton, CenterLeft 3), (closeButton, CenterRight 3), (maxiButton, CenterRight 18), hunk ./XMonad/Layout/IndependentScreens.hs 160 -- window currently focused on a given screen (even if the screen is not -- current) by doing something like this: -- --- > ppFocus s = whenCurrentOn s defaultPP +-- > ppFocus s = whenCurrentOn s def -- > { ppOrder = \(_:_:title:_) -> [title] -- > , ppOutput = appendFile ("focus" ++ show s) . (++ "\n") -- > } hunk ./XMonad/Layout/NoFrillsDecoration.hs 40 -- Then edit your @layoutHook@ by adding the NoFrillsDecoration to -- your layout: -- --- > myL = noFrillsDeco shrinkText defaultTheme (layoutHook def) +-- > myL = noFrillsDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- hunk ./XMonad/Layout/PerWorkspace.hs 28 import XMonad import qualified XMonad.StackSet as W -import XMonad.Layout.LayoutModifier - import Data.Maybe (fromMaybe) -- $usage hunk ./XMonad/Layout/PositionStoreFloat.hs 48 -- BorderResize: -- -- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc.. --- > where floatingDeco l = noFrillsDeco shrinkText defaultTheme l +-- > where floatingDeco l = noFrillsDeco shrinkText def l -- > main = xmonad def { layoutHook = myLayouts } -- -- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how hunk ./XMonad/Layout/ShowWName.hs 20 -- $usage showWName , showWName' + , def , defaultSWNConfig , SWNConfig(..) , ShowWName hunk ./XMonad/Layout/ShowWName.hs 47 -- | A layout modifier to show the workspace name when switching showWName :: l a -> ModifiedLayout ShowWName l a -showWName = ModifiedLayout (SWN True defaultSWNConfig Nothing) +showWName = ModifiedLayout (SWN True def Nothing) -- | A layout modifier to show the workspace name when switching. It -- is possible to provide a custom configuration. hunk ./XMonad/Layout/ShowWName.hs 64 , swn_fade :: Rational -- ^ Time in seconds of the name visibility } deriving (Read, Show) -defaultSWNConfig :: SWNConfig -defaultSWNConfig = +instance Default SWNConfig where + def = SWNC { swn_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*" , swn_bgcolor = "black" , swn_color = "white" hunk ./XMonad/Layout/ShowWName.hs 72 , swn_fade = 1 } +{-# DEPRECATED defaultSWNConfig "Use def (from Data.Default, and re-exported from XMonad.Layout.ShowWName) instead." #-} +defaultSWNConfig :: SWNConfig +defaultSWNConfig = def + instance LayoutModifier ShowWName a where redoLayout sn r _ wrs = doShow sn r wrs hunk ./XMonad/Layout/SimpleDecoration.hs 23 -- $usage simpleDeco , Theme (..) + , def , defaultTheme , SimpleDecoration (..) , shrinkText, CustomShrink(CustomShrink) hunk ./XMonad/Layout/SimpleDecoration.hs 42 -- Then edit your @layoutHook@ by adding the SimpleDecoration decoration to -- your layout: -- --- > myL = simpleDeco shrinkText defaultTheme (layoutHook def) +-- > myL = simpleDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Layout/SimpleDecoration.hs 51 -- -- You can also edit the default configuration options. -- --- > mySDConfig = defaultTheme { inactiveBorderColor = "red" --- > , inactiveTextColor = "red"} +-- > mySDConfig = def { inactiveBorderColor = "red" +-- > , inactiveTextColor = "red"} -- -- and -- hunk ./XMonad/Layout/SimpleDecoration.hs 56 --- > myL = dwmStyle shrinkText mySDConfig (layoutHook defaultTheme) +-- > myL = dwmStyle shrinkText mySDConfig (layoutHook def) -- | Add simple decorations to windows of a layout. simpleDeco :: (Eq a, Shrinker s) => s -> Theme hunk ./XMonad/Layout/SimpleFloat.hs 54 -- This version is decorated with the 'SimpleDecoration' style. simpleFloat :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a -simpleFloat = decoration shrinkText defaultTheme (Simple False) (mouseResize $ windowArrangeAll $ SF 20) +simpleFloat = decoration shrinkText def (Simple False) (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'simpleFloat', but with the possibility of setting a -- custom shrinker and a custom theme. hunk ./XMonad/Layout/SubLayouts.hs 48 redoLayout), ModifiedLayout(..)) import XMonad.Layout.Simplest(Simplest(..)) -import XMonad.Layout.Tabbed(defaultTheme, shrinkText, +import XMonad.Layout.Tabbed(shrinkText, TabbedDecoration, addTabs) import XMonad.Layout.WindowNavigation(Navigate(Apply)) import XMonad.Util.Invisible(Invisible(..)) hunk ./XMonad/Layout/SubLayouts.hs 62 import Data.Maybe(isNothing, fromMaybe, listToMaybe, mapMaybe) import Data.Traversable(sequenceA) +import qualified XMonad as X import qualified XMonad.Layout.BoringWindows as B import qualified XMonad.StackSet as W import qualified Data.Map as M hunk ./XMonad/Layout/SubLayouts.hs 186 -- Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed -- with: -- --- > myLayout = addTabs shrinkText defaultTheme +-- > myLayout = addTabs shrinkText def -- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle) -- > $ Tall 1 0.2 0.5 ||| Full subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a hunk ./XMonad/Layout/SubLayouts.hs 196 subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) => l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) (ModifiedLayout (Sublayout Simplest) l) a -subTabbed x = addTabs shrinkText defaultTheme $ subLayout [] Simplest x +subTabbed x = addTabs shrinkText X.def $ subLayout [] Simplest x -- | @defaultSublMap@ is an attempt to create a set of keybindings like the -- defaults ones but to be used as a 'submap' for sending messages to the hunk ./XMonad/Layout/TabBarDecoration.hs 19 ( -- * Usage -- $usage simpleTabBar, tabBar - , defaultTheme, shrinkText + , def, defaultTheme, shrinkText , TabBarDecoration (..), XPPosition (..) , module XMonad.Layout.ResizeScreen ) where hunk ./XMonad/Layout/TabBarDecoration.hs 56 -- | layout, with the default theme and the default shrinker. simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen l) a -simpleTabBar = decoration shrinkText defaultTheme (TabBar Top) . resizeVertical 20 +simpleTabBar = decoration shrinkText def (TabBar Top) . resizeVertical 20 -- | Same of 'simpleTabBar', but with the possibility of setting a -- custom shrinker, a custom theme and the position: 'Top' or hunk ./XMonad/Layout/Tabbed.hs 25 , simpleTabbedBottom, tabbedBottom, addTabsBottom , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways , Theme (..) + , def , defaultTheme , TabbedDecoration (..) , shrinkText, CustomShrink(CustomShrink) hunk ./XMonad/Layout/Tabbed.hs 51 -- -- or, if you want a specific theme for you tabbed layout: -- --- > myLayout = tabbed shrinkText defaultTheme ||| Full ||| etc.. +-- > myLayout = tabbed shrinkText def ||| Full ||| etc.. -- -- and then: -- hunk ./XMonad/Layout/Tabbed.hs 71 -- -- You can also edit the default configuration options. -- --- > myTabConfig = defaultTheme { inactiveBorderColor = "#FF0000" --- > , activeTextColor = "#00FF00"} +-- > myTabConfig = def { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} -- -- and -- hunk ./XMonad/Layout/Tabbed.hs 88 -- > import XMonad.Layout.Tabbed -- > main = xmonad def { layoutHook = simpleTabbed } simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window -simpleTabbed = tabbed shrinkText defaultTheme +simpleTabbed = tabbed shrinkText def simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window hunk ./XMonad/Layout/Tabbed.hs 91 -simpleTabbedAlways = tabbedAlways shrinkText defaultTheme +simpleTabbedAlways = tabbedAlways shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window hunk ./XMonad/Layout/Tabbed.hs 95 -simpleTabbedBottom = tabbedBottom shrinkText defaultTheme +simpleTabbedBottom = tabbedBottom shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window hunk ./XMonad/Layout/Tabbed.hs 99 -simpleTabbedBottomAlways = tabbedBottomAlways shrinkText defaultTheme +simpleTabbedBottomAlways = tabbedBottomAlways shrinkText def -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. hunk ./XMonad/Layout/WindowNavigation.hs 24 Navigate(..), Direction2D(..), MoveWindowToWindow(..), navigateColor, navigateBrightness, - noNavigateBorders, defaultWNConfig, + noNavigateBorders, defaultWNConfig, def, WNConfig, WindowNavigation, ) where hunk ./XMonad/Layout/WindowNavigation.hs 85 noNavigateBorders :: WNConfig noNavigateBorders = - defaultWNConfig {brightness = Just 0} + def {brightness = Just 0} navigateColor :: String -> WNConfig navigateColor c = hunk ./XMonad/Layout/WindowNavigation.hs 92 WNC Nothing c c c c navigateBrightness :: Double -> WNConfig -navigateBrightness f = defaultWNConfig { brightness = Just $ max 0 $ min 1 f } +navigateBrightness f = def { brightness = Just $ max 0 $ min 1 f } hunk ./XMonad/Layout/WindowNavigation.hs 94 +instance Default WNConfig where def = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" + +{-# DEPRECATED defaultWNConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.WindowNavigation) instead." #-} defaultWNConfig :: WNConfig hunk ./XMonad/Layout/WindowNavigation.hs 98 -defaultWNConfig = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" +defaultWNConfig = def data NavigationState a = NS Point [(a,Rectangle)] hunk ./XMonad/Layout/WindowNavigation.hs 105 data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show ) windowNavigation :: LayoutClass l a => l a -> ModifiedLayout WindowNavigation l a -windowNavigation = ModifiedLayout (WindowNavigation defaultWNConfig (I Nothing)) +windowNavigation = ModifiedLayout (WindowNavigation def (I Nothing)) configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing)) hunk ./XMonad/Layout/WindowSwitcherDecoration.hs 46 -- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to -- your layout: -- --- > myL = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer $ layoutHook def) +-- > myL = windowSwitcherDecoration shrinkText def (draggingVisualizer $ layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- There is also a version of the decoration that contains buttons like hunk ./XMonad/Layout/WorkspaceDir.hs 59 -- WorkspaceDir provides also a prompt. To use it you need to import -- "XMonad.Prompt" and add something like this to your key bindings: -- --- > , ((modm .|. shiftMask, xK_x ), changeDir defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_x ), changeDir def) -- -- For detailed instruction on editing the key binding see: -- hunk ./XMonad/Prompt.hs 22 mkXPrompt , mkXPromptWithReturn , mkXPromptWithModes + , def , amberXPConfig , defaultXPConfig , greenXPConfig hunk ./XMonad/Prompt.hs 234 amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig -defaultXPConfig = +instance Default XPConfig where + def = XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*" , bgColor = "grey22" , fgColor = "grey80" hunk ./XMonad/Prompt.hs 257 , searchPredicate = isPrefixOf , alwaysHighlight = False } -greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black", promptBorderWidth = 0 } -amberXPConfig = defaultXPConfig { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" } +{-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-} +defaultXPConfig = def +greenXPConfig = def { fgColor = "green", bgColor = "black", promptBorderWidth = 0 } +amberXPConfig = def { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" } initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState hunk ./XMonad/Prompt.hs 384 -- -- * a prompt type, instance of the 'XPrompt' class. -- --- * a prompt configuration ('defaultXPConfig' can be used as a --- starting point) +-- * a prompt configuration ('def' can be used as a starting point) -- -- * a completion function ('mkComplFunFromList' can be used to -- create a completions function given a list of possible completions) hunk ./XMonad/Prompt.hs 1198 -- > .. -- > ((modMask,xK_p), shellPrompt . myPrompt =<< initMatches) -- > .. --- > myPrompt ref = defaultPrompt +-- > myPrompt ref = def -- > { promptKeymap = M.union [((0,xK_Up), historyUpMatching ref) -- > ,((0,xK_Down), historyDownMatching ref)] hunk ./XMonad/Prompt.hs 1201 --- > (promptKeymap defaultPrompt) +-- > (promptKeymap def) -- > , .. } -- historyUpMatching, historyDownMatching :: HistoryMatches -> XP () hunk ./XMonad/Prompt/AppLauncher.hs 53 Then you can add the bindings to the applications. > ... -> , ((modm, xK_g), AL.launchApp defaultXPConfig "gimp" ) -> , ((modm, xK_g), AL.launchApp defaultXPConfig "evince" ) +> , ((modm, xK_g), AL.launchApp def "gimp" ) +> , ((modm, xK_g), AL.launchApp def "evince" ) > ... -} hunk ./XMonad/Prompt/AppendFile.hs 45 -- -- and adding an appropriate keybinding, for example: -- --- > , ((modm .|. controlMask, xK_n), appendFilePrompt defaultXPConfig "/home/me/NOTES") +-- > , ((modm .|. controlMask, xK_n), appendFilePrompt def "/home/me/NOTES") -- -- Additional notes can be added via regular Haskell or XMonad functions; for -- example, to preface notes with the time they were made, one could write a hunk ./XMonad/Prompt/AppendFile.hs 53 -- -- > , ((modm .|. controlMask, xK_n), do -- > spawn ("date>>"++"/home/me/NOTES") --- > appendFilePrompt defaultXPConfig "/home/me/NOTES" +-- > appendFilePrompt def "/home/me/NOTES" -- > ) -- -- (Put the spawn on the line after the prompt to append the time instead.) hunk ./XMonad/Prompt/DirExec.hs 44 -- -- 2. In your keybindings add something like: -- --- > , ("M-C-x", dirExecPrompt defaultXPConfig spawn "/home/joe/.scipts") +-- > , ("M-C-x", dirExecPrompt def spawn "/home/joe/.scipts") -- -- or -- hunk ./XMonad/Prompt/DirExec.hs 48 --- > , ("M-C-x", dirExecPromptNamed defaultXPConfig spawn +-- > , ("M-C-x", dirExecPromptNamed def spawn -- > "/home/joe/.scripts" "My Scripts: ") -- -- or add this after your default bindings: hunk ./XMonad/Prompt/DirExec.hs 54 -- -- > ++ --- > [ ("M-x " ++ key, dirExecPrompt defaultXPConfig fn "/home/joe/.scripts") +-- > [ ("M-x " ++ key, dirExecPrompt def fn "/home/joe/.scripts") -- > | (key, fn) <- [ ("x", spawn), ("M-x", runInTerm "-hold") ] -- > ] -- > ++ hunk ./XMonad/Prompt/Email.hs 39 -- -- and adding an appropriate keybinding, for example: -- --- > , ((modm .|. controlMask, xK_e), emailPrompt defaultXPConfig addresses) +-- > , ((modm .|. controlMask, xK_e), emailPrompt def addresses) -- -- where @addresses@ is a list of email addresses that should -- autocomplete, for example: hunk ./XMonad/Prompt/Layout.hs 34 -- > import XMonad.Prompt -- > import XMonad.Prompt.Layout -- --- > , ((modm .|. shiftMask, xK_m ), layoutPrompt defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_m ), layoutPrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/Man.hs 49 -- -- 2. In your keybindings add something like: -- --- > , ((modm, xK_F1), manPrompt defaultXPConfig) +-- > , ((modm, xK_F1), manPrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/RunOrRaise.hs 44 2. In your keybindings add something like: -> , ((modm .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig) +> , ((modm .|. controlMask, xK_x), runOrRaisePrompt def) For detailed instruction on editing the key binding see "XMonad.Doc.Extending#Editing_key_bindings". -} hunk ./XMonad/Prompt/Shell.hs 55 2. In your keybindings add something like: -> , ((modm .|. controlMask, xK_x), shellPrompt defaultXPConfig) +> , ((modm .|. controlMask, xK_x), shellPrompt def) For detailed instruction on editing the key binding see "XMonad.Doc.Extending#Editing_key_bindings". -} hunk ./XMonad/Prompt/Ssh.hs 44 -- -- 2. In your keybindings add something like: -- --- > , ((modm .|. controlMask, xK_s), sshPrompt defaultXPConfig) +-- > , ((modm .|. controlMask, xK_s), sshPrompt def) -- -- Keep in mind, that if you want to use the completion you have to -- disable the "HashKnownHosts" option in your ssh_config hunk ./XMonad/Prompt/Theme.hs 38 -- -- in your keybindings add: -- --- > , ((modm .|. controlMask, xK_t), themePrompt defaultXPConfig) +-- > , ((modm .|. controlMask, xK_t), themePrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/Theme.hs 52 themePrompt :: XPConfig -> X () themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' . map ppThemeInfo $ listOfThemes) changeTheme - where changeTheme t = sendMessage . SetTheme . fromMaybe defaultTheme $ M.lookup t mapOfThemes + where changeTheme t = sendMessage . SetTheme . fromMaybe def $ M.lookup t mapOfThemes mapOfThemes :: M.Map String Theme mapOfThemes = M.fromList . uncurry zip . (map ppThemeInfo &&& map theme) $ listOfThemes hunk ./XMonad/Prompt/Window.hs 47 -- -- and in the keys definition: -- --- > , ((modm .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) --- > , ((modm .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_g ), windowPromptGoto def) +-- > , ((modm .|. shiftMask, xK_b ), windowPromptBring def) -- -- The autoComplete option is a handy complement here: -- hunk ./XMonad/Prompt/Window.hs 53 -- > , ((modm .|. shiftMask, xK_g ), windowPromptGoto --- > defaultXPConfig { autoComplete = Just 500000 } ) +-- > def { autoComplete = Just 500000 } ) -- -- The \'500000\' is the number of microseconds to pause before sending you to -- your new window. This is useful so that you don't accidentally send some hunk ./XMonad/Prompt/Workspace.hs 35 -- > import XMonad.Prompt -- > import XMonad.Prompt.Workspace -- --- > , ((modm .|. shiftMask, xK_m ), workspacePrompt defaultXPConfig (windows . W.shift)) +-- > , ((modm .|. shiftMask, xK_m ), workspacePrompt def (windows . W.shift)) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/XMonad.hs 36 -- -- in your keybindings add: -- --- > , ((modm .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- > , ((modm .|. controlMask, xK_x), xmonadPrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Util/Loggers.hs 80 -- For example: -- -- > -- display load averages and a pithy quote along with xmonad status. --- > , logHook = dynamicLogWithPP $ defaultPP { +-- > , logHook = dynamicLogWithPP $ def { -- > ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ] -- > } -- > -- gives something like " 3.27 3.52 3.26 Drive defensively. Buy a tank." hunk ./XMonad/Util/Loggers.hs 196 -- use instead of \'.\' or \'$\' in hard to read formatting lines. -- For example: -- --- > myLogHook = dynamicLogWithPP defaultPP { +-- > myLogHook = dynamicLogWithPP def { -- > -- skipped -- > , ppExtras = [lLoad, lTitle, logSp 3, wrapL "[" "]" $ date "%a %d %b"] -- > , ppOrder = \(ws,l,_,xs) -> [l,ws] ++ xs hunk ./XMonad/Util/NamedScratchpad.hs 169 -- -- A simple use could be: -- --- > logHook = dynamicLogWithPP . namedScratchpadFilterOutWorkspace $ defaultPP +-- > logHook = dynamicLogWithPP . namedScratchpadFilterOutWorkspace $ def -- -- Here is another example, when using "XMonad.Layout.IndependentScreens". -- If you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write hunk ./XMonad/Util/Themes.hs 48 -- do not apply to xmonad as a whole.) -- -- If you want to use one of them with one of your decorated layouts, --- you need to substitute defaultTheme with, for instance, (theme --- smallClean). +-- you need to substitute def with, for instance, (theme smallClean). -- -- Here is an example: -- hunk ./XMonad/Util/Themes.hs 82 } newTheme :: ThemeInfo -newTheme = TI "" "" "" defaultTheme +newTheme = TI "" "" "" def ppThemeInfo :: ThemeInfo -> String ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t hunk ./XMonad/Util/Themes.hs 114 newTheme { themeName = "xmonadTheme" , themeAuthor = "David Roundy" , themeDescription = "The default xmonad theme" - , theme = defaultTheme + , theme = def } -- | Small decorations with a Ion3 remembrance, by Andrea Rossato. hunk ./XMonad/Util/Themes.hs 123 newTheme { themeName = "smallClean" , themeAuthor = "Andrea Rossato" , themeDescription = "Small decorations with a Ion3 remembrance" - , theme = defaultTheme { activeColor = "#8a999e" - , inactiveColor = "#545d75" - , activeBorderColor = "white" - , inactiveBorderColor = "grey" - , activeTextColor = "white" - , inactiveTextColor = "grey" - , decoHeight = 14 - } + , theme = def { activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , decoHeight = 14 + } } -- | Don's preferred colors - from DynamicLog...;) hunk ./XMonad/Util/Themes.hs 139 newTheme { themeName = "donaldTheme" , themeAuthor = "Andrea Rossato" , themeDescription = "Don's preferred colors - from DynamicLog...;)" - , theme = defaultTheme { activeColor = "#2b4f98" - , inactiveColor = "#cccccc" - , activeBorderColor = "#2b4f98" - , inactiveBorderColor = "#cccccc" - , activeTextColor = "white" - , inactiveTextColor = "black" - , decoHeight = 16 - } + , theme = def { activeColor = "#2b4f98" + , inactiveColor = "#cccccc" + , activeBorderColor = "#2b4f98" + , inactiveBorderColor = "#cccccc" + , activeTextColor = "white" + , inactiveTextColor = "black" + , decoHeight = 16 + } } -- | Ffrom Robert Manea's prompt theme. hunk ./XMonad/Util/Themes.hs 155 newTheme { themeName = "robertTheme" , themeAuthor = "Andrea Rossato" , themeDescription = "From Robert Manea's prompt theme" - , theme = defaultTheme { activeColor = "#aecf96" - , inactiveColor = "#111111" - , activeBorderColor = "#aecf96" - , inactiveBorderColor = "#111111" - , activeTextColor = "black" - , inactiveTextColor = "#d5d3a7" - , fontName = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859" - , decoHeight = 16 - } + , theme = def { activeColor = "#aecf96" + , inactiveColor = "#111111" + , activeBorderColor = "#aecf96" + , inactiveBorderColor = "#111111" + , activeTextColor = "black" + , inactiveTextColor = "#d5d3a7" + , fontName = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859" + , decoHeight = 16 + } } -- | deifl\'s Theme, by deifl. hunk ./XMonad/Util/Themes.hs 172 newTheme { themeName = "deiflTheme" , themeAuthor = "deifl" , themeDescription = "deifl's Theme" - , theme = defaultTheme { inactiveBorderColor = "#708090" - , activeBorderColor = "#5f9ea0" - , activeColor = "#000000" - , inactiveColor = "#333333" - , inactiveTextColor = "#888888" - , activeTextColor = "#87cefa" - , fontName = "-xos4-terminus-*-*-*-*-12-*-*-*-*-*-*-*" - , decoHeight = 15 - } + , theme = def { inactiveBorderColor = "#708090" + , activeBorderColor = "#5f9ea0" + , activeColor = "#000000" + , inactiveColor = "#333333" + , inactiveTextColor = "#888888" + , activeTextColor = "#87cefa" + , fontName = "-xos4-terminus-*-*-*-*-12-*-*-*-*-*-*-*" + , decoHeight = 15 + } } -- | oxymor00n\'s theme, by Tom Rauchenwald. hunk ./XMonad/Util/Themes.hs 189 newTheme { themeName = "oxymor00nTheme" , themeAuthor = "Tom Rauchenwald" , themeDescription = "oxymor00n's theme" - , theme = defaultTheme { inactiveBorderColor = "#000" - , activeBorderColor = "aquamarine3" - , activeColor = "aquamarine3" - , inactiveColor = "DarkSlateGray4" - , inactiveTextColor = "#222" - , activeTextColor = "#222" - -- This font can be found in the package ttf-alee - -- on debian-systems - , fontName = "-*-Bandal-*-*-*-*-12-*-*-*-*-*-*-*" - , decoHeight = 15 - , urgentColor = "#000" - , urgentTextColor = "#63b8ff" - } + , theme = def { inactiveBorderColor = "#000" + , activeBorderColor = "aquamarine3" + , activeColor = "aquamarine3" + , inactiveColor = "DarkSlateGray4" + , inactiveTextColor = "#222" + , activeTextColor = "#222" + -- This font can be found in the package ttf-alee + -- on debian-systems + , fontName = "-*-Bandal-*-*-*-*-12-*-*-*-*-*-*-*" + , decoHeight = 15 + , urgentColor = "#000" + , urgentTextColor = "#63b8ff" + } } wfarrTheme :: ThemeInfo hunk ./XMonad/Util/Themes.hs 209 newTheme { themeName = "wfarrTheme" , themeAuthor = "Will Farrington" , themeDescription = "A nice blue/black theme." - , theme = defaultTheme { activeColor = "#4c7899" - , inactiveColor = "#333333" - , activeBorderColor = "#285577" - , inactiveBorderColor = "#222222" - , activeTextColor = "#ffffff" - , inactiveTextColor = "#888888" - , fontName = "-*-fixed-medium-r-*--10-*-*-*-*-*-iso8859-1" - , decoHeight = 12 - } + , theme = def { activeColor = "#4c7899" + , inactiveColor = "#333333" + , activeBorderColor = "#285577" + , inactiveBorderColor = "#222222" + , activeTextColor = "#ffffff" + , inactiveTextColor = "#888888" + , fontName = "-*-fixed-medium-r-*--10-*-*-*-*-*-iso8859-1" + , decoHeight = 12 + } } -- | Forest colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 226 newTheme { themeName = "kavonForestTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Forest colours" - , theme = defaultTheme { activeColor = "#115422" - , activeBorderColor = "#1a8033" - , activeTextColor = "white" - , inactiveColor = "#543211" - , inactiveBorderColor = "#804c19" - , inactiveTextColor = "#ffcc33" - } + , theme = def { activeColor = "#115422" + , activeBorderColor = "#1a8033" + , activeTextColor = "white" + , inactiveColor = "#543211" + , inactiveBorderColor = "#804c19" + , inactiveTextColor = "#ffcc33" + } } -- | Lake (blue/green) colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 241 newTheme { themeName = "kavonLakeTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Lake (blue/green) colours" - , theme = defaultTheme { activeColor = "#001166" - , activeBorderColor = "#1f3999" - , activeTextColor = "white" - , inactiveColor = "#09592a" - , inactiveBorderColor = "#198044" - , inactiveTextColor = "#73e6a3" - } + , theme = def { activeColor = "#001166" + , activeBorderColor = "#1f3999" + , activeTextColor = "white" + , inactiveColor = "#09592a" + , inactiveBorderColor = "#198044" + , inactiveTextColor = "#73e6a3" + } } -- | Peacock colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 256 newTheme { themeName = "kavonPeacockTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Peacock colours" - , theme = defaultTheme { activeColor = "#190f4c" - , activeBorderColor = "#2b1980" - , activeTextColor = "white" - , inactiveColor = "#225173" - , inactiveBorderColor = "#2a638c" - , inactiveTextColor = "#8fb2cc" - } + , theme = def { activeColor = "#190f4c" + , activeBorderColor = "#2b1980" + , activeTextColor = "white" + , inactiveColor = "#225173" + , inactiveBorderColor = "#2a638c" + , inactiveTextColor = "#8fb2cc" + } } -- | Violet-Green colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 271 newTheme { themeName = "kavonVioGreenTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Violet-Green colours" - , theme = defaultTheme { activeColor = "#37174c" - , activeBorderColor = "#333399" - , activeTextColor = "white" - , inactiveColor = "#174c17" - , inactiveBorderColor = "#336633" - , inactiveTextColor = "#aaccaa" - } + , theme = def { activeColor = "#37174c" + , activeBorderColor = "#333399" + , activeTextColor = "white" + , inactiveColor = "#174c17" + , inactiveBorderColor = "#336633" + , inactiveTextColor = "#aaccaa" + } } -- | Blue colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 286 newTheme { themeName = "kavonBluesTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Blue colours" - , theme = defaultTheme { activeColor = "#000066" - , activeBorderColor = "#111199" - , activeTextColor = "white" - , inactiveColor = "#9999ee" - , inactiveBorderColor = "#6666cc" - , inactiveTextColor = "black" - } + , theme = def { activeColor = "#000066" + , activeBorderColor = "#111199" + , activeTextColor = "white" + , inactiveColor = "#9999ee" + , inactiveBorderColor = "#6666cc" + , inactiveTextColor = "black" + } } -- | Christmas colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 301 newTheme { themeName = "kavonChristmasTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Christmas (green + red) colours" - , theme = defaultTheme { activeColor = "#660000" - , activeBorderColor = "#990000" - , activeTextColor = "white" - , inactiveColor = "#006600" - , inactiveBorderColor = "#003300" - , inactiveTextColor = "#99bb99" - } + , theme = def { activeColor = "#660000" + , activeBorderColor = "#990000" + , activeTextColor = "white" + , inactiveColor = "#006600" + , inactiveBorderColor = "#003300" + , inactiveTextColor = "#99bb99" + } } -- | Autumn colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 316 newTheme { themeName = "kavonAutumnTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Autumn (brown + red) colours" - , theme = defaultTheme { activeColor = "#660000" - , activeBorderColor = "#990000" - , activeTextColor = "white" - , inactiveColor = "#542d11" - , inactiveBorderColor = "#804d1A" - , inactiveTextColor = "#ffcc33" - } + , theme = def { activeColor = "#660000" + , activeBorderColor = "#990000" + , activeTextColor = "white" + , inactiveColor = "#542d11" + , inactiveBorderColor = "#804d1A" + , inactiveTextColor = "#ffcc33" + } } -- | Fire colours, by Kathryn Andersen hunk ./XMonad/Util/Themes.hs 331 newTheme { themeName = "kavonFireTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Fire (orange + red) colours" - , theme = defaultTheme { activeColor = "#660000" - , activeBorderColor = "#990000" - , activeTextColor = "white" - , inactiveColor = "#ff8000" - , inactiveBorderColor = "#d9b162" - , inactiveTextColor = "black" - } + , theme = def { activeColor = "#660000" + , activeBorderColor = "#990000" + , activeTextColor = "white" + , inactiveColor = "#ff8000" + , inactiveBorderColor = "#d9b162" + , inactiveTextColor = "black" + } } } Context: [Generalises modWorkspace to take any layout-transforming function gopsychonauts@gmail.com**20130501151425 Ignore-this: 28c7dc1f6216bb1ebdffef5434ccbcbd modWorkspace already was capable of modifying the layout with an arbitrary layout -> layout function, but its original type restricted it such that it could only apply a single LayoutModifier; this was often inconvenient, as for example it was not possible simply to compose LayoutModifiers for use with modWorkspace. This patch also reimplements onWorkspaces in terms of modWorkspaces, since with the latter's less restrictive type this is now possible. ] [since XMonad.Config.Dmwit mentions xmobar, we should include the associated .xmobarrc file Daniel Wagner **20130503194055 Ignore-this: 2f6d7536df81eb767262b79b60eb1b86 ] [warning police Daniel Wagner **20130502012700 Ignore-this: ae7412ac77c57492a7ad6c5f8f50b9eb ] [XMonad.Config.Dmwit Daniel Wagner **20130502012132 Ignore-this: 7402161579fd2e191b60a057d955e5ea ] [minor fixes to the haddock markup in X.L.IndependentScreens Daniel Wagner **20130411193849 Ignore-this: b6a139aa43fdb39fc1b86566c0c34c7a ] [add whenCurrentOn to X.L.IndependentScreens Daniel Wagner **20130408225251 Ignore-this: ceea3d391f270abc9ed8e52ce19fb1ac ] [Allow to specify the initial gaps' states in X.L.Gaps Paul Fertser **20130222072232 Ignore-this: 31596d918d0050e36ce3f64f56205a64 ] [should bump X11 dependency, too, to make sure we have getAtomName Daniel Wagner **20130225180527 Ignore-this: 260711f27551f18cc66afeb7b4846b9f ] [getAtomName is now defined in the X11 library Daniel Wagner **20130225180323 Ignore-this: 3b9e17c234679e98752a47c37132ee4e ] [Allow to limit maximum row count in X.Prompt completion window Paul Fertser **20130221122050 Ignore-this: 923656f02996f2de2b1336275392c5f9 On a keyboard-less device (such as a smartphone), where one has to use an on-screen keyboard, the maximum completion window height must be limited to avoid overlapping the keyboard. ] [Note in U.NameActions that xmonad core can list default keys now Adam Vogt **20130217233026 Ignore-this: 937bff636fa88171932d5192fe8e290b ] [Export U.NamedActions.addDescrKeys per evaryont's request. Adam Vogt **20130217232619 Ignore-this: a694a0a3ece70b52fba6e8f688d86344 ] [Add EWMH DEMANDS_ATTENTION support to UrgencyHook. Maarten de Vries **20130212181229 Ignore-this: 5a4b314d137676758fad9ec8f85ce422 Add support for the _NET_WM_STATE_DEMANDS_ATTENTION atom by treating it the same way as the WM_HINTS urgency flag. ] [Unconditionally set _NET_WORKAREA in ManageDocks Adam Vogt **20130117180851 Ignore-this: 9f57e53fba9573d8a92cf153beb7fe7a ] [spawn command when no completion is available (if alwaysHighlight is True); changes commandToComplete in Prompt/Shell to complete the whole word instead of using getLastWord c.lopez@kmels.net**20130209190456 Ignore-this: ca7d354bb301b555b64d5e76e31d10e8 ] [order-unindexed-ws-last matthewhague@zoho.com**20120703222726 Ignore-this: 4af8162ee8b16a60e8fd62fbc915d3c0 Changes the WorkspaceCompare module's comparison by index to put workspaces without an index last (rather than first). ] [SpawnOn modification for issue 523 Adam Vogt **20130114014642 Ignore-this: 703f7dc0f800366b752f0ec1cecb52e5 This moves the function to help clean up the `Spawner' to the ManageHook rather than in functions like spawnOn. Probably it makes no difference, the reason is because there's one manageSpawn function but many different so this way there are less functions to write. ] [Update L.TrackFloating.useTransient example code Adam Vogt **20130112041239 Ignore-this: e4e31cf1db742778c1d59d52fdbeed7a Suggest useTransient goes to the right of trackFloating which is the configuration actually tested. ] [Adapt ideas of issue 306 patch to a new modifier in L.TrackFloating Adam Vogt **20130112035701 Ignore-this: d54d27b71b97144ef0660f910fd464aa ] [Make X.A.CycleWS not rely on hidden WS order Dmitri Iouchtchenko **20130109023328 Ignore-this: 8717a154b33253c5df4e9a0ada4c2c3e ] [Add X.H.WorkspaceHistory Dmitri Iouchtchenko **20130109023307 Ignore-this: c9e7ce33a944facc27481dde52c7cc80 ] [Allow removing arbitrary workspaces Dmitri Iouchtchenko **20121231214343 Ignore-this: 6fce4bd3d0c5337e5122158583138e74 ] [Remove first-hidden restriction from X.A.DynamicWorkspaces.removeWorkspace' Dmitri Iouchtchenko **20121231214148 Ignore-this: 55fb0859e9a5f476a834ecbdb774aac8 ] [Add authorspellings file for `darcs show authors'. Adam Vogt **20130101040031 Ignore-this: c3198072ebc6a71d635bec4d8e2c78fd This authorspellings file includes a couple people who've contributed to xmonad (not XMonadContrib). When people have multiple addresses, the most recent one has been picked. ] [TAG 0.11 Adam Vogt **20130101014231 Ignore-this: 57cf32412fd1ce912811cb7fafe930f5 ] Patch bundle hash: e65b00bc3cd9e305f254e625251fa4eb5e5f8528