From fe066e8e9ca5326dd146630a6d729fae51af12cf Mon Sep 17 00:00:00 2001 From: Daniel Wagner Date: Tue, 28 May 2013 02:58:25 +0200 Subject: eliminate references to defaultConfig Ignore-this: 37ae613e4b943e99c5200915b9d95e58 darcs-hash:20130528005825-76d51-89eaf6f1aeeb02086371f9c4ae2afade984f62e0.gz --- XMonad/Util/CustomKeys.hs | 8 ++++---- XMonad/Util/EZConfig.hs | 12 ++++++------ XMonad/Util/NamedActions.hs | 6 +++--- XMonad/Util/Replace.hs | 4 ++-- XMonad/Util/Run.hs | 2 +- XMonad/Util/Themes.hs | 2 +- 6 files changed, 17 insertions(+), 17 deletions(-) (limited to 'XMonad/Util') diff --git a/XMonad/Util/CustomKeys.hs b/XMonad/Util/CustomKeys.hs index e2e73ef..49c33d9 100644 --- a/XMonad/Util/CustomKeys.hs +++ b/XMonad/Util/CustomKeys.hs @@ -31,7 +31,7 @@ import qualified Data.Map as M -- -- 2. Set key bindings with 'customKeys': -- --- > main = xmonad defaultConfig { keys = customKeys delkeys inskeys } +-- > main = xmonad def { keys = customKeys delkeys inskeys } -- > where -- > delkeys :: XConfig l -> [(KeyMask, KeySym)] -- > delkeys XConfig {modMask = modm} = @@ -53,17 +53,17 @@ import qualified Data.Map as M -- > import System.Exit -- > import qualified Data.Map as M -- > --- > main = xmonad defaultConfig { +-- > main = xmonad def { -- > keys = \_ -> M.fromList [ -- > -- Let me out of here! I want my KDE back! Help! Help! -- > ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] } --- | Customize 'XMonad.Config.defaultConfig' -- delete needless +-- | Customize 'XMonad.Config.def' -- delete needless -- shortcuts and insert those you will use. customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -customKeys = customKeysFrom defaultConfig +customKeys = customKeysFrom def -- | General variant of 'customKeys': customize key bindings of -- third-party configuration. diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs index 53f893a..f24d9d6 100644 --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -7,7 +7,7 @@ -- -- 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.) @@ -69,7 +69,7 @@ import Text.ParserCombinators.ReadP -- | -- Add or override keybindings from the existing set. Example use: -- --- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > main = xmonad $ def { terminal = "urxvt" } -- > `additionalKeys` -- > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") -- > , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do @@ -88,7 +88,7 @@ additionalKeys conf keyList = -- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as -- described in the documentation for 'mkKeymap'. For example: -- --- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > main = xmonad $ def { terminal = "urxvt" } -- > `additionalKeysP` -- > [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4") -- > , ("M-", withFocused hide) -- N.B. this is an absurd thing to do @@ -101,7 +101,7 @@ additionalKeysP conf keyList = -- | -- Remove standard keybindings you're not using. Example use: -- --- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > main = xmonad $ def { terminal = "urxvt" } -- > `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]] removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a removeKeys conf keyList = @@ -111,7 +111,7 @@ removeKeys conf keyList = -- like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the -- documentation for 'mkKeymap'. For example: -- --- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > main = xmonad $ def { terminal = "urxvt" } -- > `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']] removeKeysP :: XConfig l -> [String] -> XConfig l @@ -682,7 +682,7 @@ multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $ -- > main = xmonad $ myConfig -- > -- > myKeymap = [("S-M-c", kill), ...] --- > myConfig = defaultConfig { +-- > myConfig = def { -- > ... -- > keys = \c -> mkKeymap c myKeymap -- > startupHook = return () >> checkKeymap myConfig myKeymap diff --git a/XMonad/Util/NamedActions.hs b/XMonad/Util/NamedActions.hs index 6ea4b82..7b8012c 100644 --- a/XMonad/Util/NamedActions.hs +++ b/XMonad/Util/NamedActions.hs @@ -67,7 +67,7 @@ import qualified XMonad.StackSet as W -- > import XMonad.Util.EZConfig -- > -- > main = xmonad $ addDescrKeys ((mod4Mask, xK_F1), xMessage) myKeys --- > defaultConfig { modMask = mod4Mask } +-- > def { modMask = mod4Mask } -- > -- > myKeys c = (subtitle "Custom Keys":) $ mkNamedKeymap c $ -- > [("M-x a", addName "useless message" $ spawn "xmessage foo"), @@ -191,7 +191,7 @@ smartSpace [] = [] smartSpace xs = ' ':xs _test :: String -_test = unlines $ showKm $ defaultKeysDescr XMonad.defaultConfig { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.defaultConfig } +_test = unlines $ showKm $ defaultKeysDescr XMonad.def { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.def } showKm :: [((KeyMask, KeySym), NamedAction)] -> [String] showKm keybindings = padding $ do @@ -227,7 +227,7 @@ addDescrKeys' (k,f) ks conf = keylist l = M.map getAction $ M.fromList $ ks l ^++^ [(k, shk l)] in conf { keys = keylist } --- | A version of the default keys from 'XMonad.Config.defaultConfig', but with +-- | A version of the default keys from the default configuration, but with -- 'NamedAction' instead of @X ()@ defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] defaultKeysDescr conf@(XConfig {XMonad.modMask = modm}) = diff --git a/XMonad/Util/Replace.hs b/XMonad/Util/Replace.hs index 110f701..49eda82 100644 --- a/XMonad/Util/Replace.hs +++ b/XMonad/Util/Replace.hs @@ -40,7 +40,7 @@ import Control.Monad -- > import XMonad.Util.Replace -- > main = do -- > replace --- > xmonad $ defaultConfig { .... } +-- > xmonad $ def { .... } -- -- $shortcomings @@ -61,7 +61,7 @@ import Control.Monad -- > main = do -- > args <- getArgs -- > when ("--replace" `elem` args) replace --- > xmonad $ defaultConfig { .... } +-- > xmonad $ def { .... } -- -- -- Note that your @~\/.xmonad/xmonad-$arch-$os@ binary is not run with the same diff --git a/XMonad/Util/Run.hs b/XMonad/Util/Run.hs index 796193d..bd18a6a 100644 --- a/XMonad/Util/Run.hs +++ b/XMonad/Util/Run.hs @@ -134,7 +134,7 @@ safeSpawnProg = flip safeSpawn [] unsafeSpawn :: MonadIO m => String -> m () unsafeSpawn = spawn --- | Open a terminal emulator. The terminal emulator is specified in @defaultConfig@ as xterm by default. It is then +-- | Open a terminal emulator. The terminal emulator is specified in the default configuration as xterm by default. It is then -- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn' unsafeRunInTerm, runInTerm :: String -> String -> X () unsafeRunInTerm options command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " " ++ options ++ " -e " ++ command diff --git a/XMonad/Util/Themes.hs b/XMonad/Util/Themes.hs index 576f84c..61352d6 100644 --- a/XMonad/Util/Themes.hs +++ b/XMonad/Util/Themes.hs @@ -56,7 +56,7 @@ import XMonad.Layout.Decoration -- > -- > myLayout = tabbed shrinkText (theme smallClean) -- > --- > main = xmonad defaultConfig {layoutHook = myLayout} +-- > main = xmonad def {layoutHook = myLayout} -- -- If you have a theme you would like to share, adding it to this -- module is very easy. -- cgit v1.2.3