From 6769de07f7e06ddf6eea728bd7072ebfe6eff017 Mon Sep 17 00:00:00 2001 From: Daniel Wagner Date: Tue, 28 May 2013 03:39:09 +0200 Subject: use Data.Default wherever possible, and deprecate the things it replaces Ignore-this: 898458b1d2868a70dfb09faf473dc7aa darcs-hash:20130528013909-76d51-863278165b6f149c47b08b31b34e85ddcab19f1f.gz --- XMonad/Actions/DynamicWorkspaces.hs | 10 +- XMonad/Actions/GridSelect.hs | 18 ++- XMonad/Actions/Launcher.hs | 6 +- XMonad/Actions/Navigation2D.hs | 29 ++-- XMonad/Actions/Search.hs | 4 +- XMonad/Actions/ShowText.hs | 13 +- XMonad/Actions/SpawnOn.hs | 2 +- XMonad/Actions/Submap.hs | 4 +- XMonad/Actions/TagWindows.hs | 12 +- XMonad/Actions/TopicSpace.hs | 11 +- XMonad/Actions/WorkspaceNames.hs | 2 +- XMonad/Config/Arossato.hs | 15 +- XMonad/Config/Dmwit.hs | 4 +- XMonad/Config/Droundy.hs | 10 +- XMonad/Config/Sjanssen.hs | 4 +- XMonad/Doc/Extending.hs | 24 ++-- XMonad/Hooks/DynamicLog.hs | 50 ++++--- XMonad/Hooks/PositionStoreHooks.hs | 2 +- XMonad/Layout/Decoration.hs | 12 +- XMonad/Layout/DecorationAddons.hs | 2 +- XMonad/Layout/DecorationMadness.hs | 50 +++---- XMonad/Layout/DwmStyle.hs | 13 +- XMonad/Layout/Groups/Examples.hs | 13 +- XMonad/Layout/Groups/Wmii.hs | 3 +- XMonad/Layout/ImageButtonDecoration.hs | 2 +- XMonad/Layout/IndependentScreens.hs | 2 +- XMonad/Layout/NoFrillsDecoration.hs | 2 +- XMonad/Layout/PerWorkspace.hs | 2 - XMonad/Layout/PositionStoreFloat.hs | 2 +- XMonad/Layout/ShowWName.hs | 11 +- XMonad/Layout/SimpleDecoration.hs | 9 +- XMonad/Layout/SimpleFloat.hs | 2 +- XMonad/Layout/SubLayouts.hs | 7 +- XMonad/Layout/TabBarDecoration.hs | 4 +- XMonad/Layout/Tabbed.hs | 15 +- XMonad/Layout/WindowNavigation.hs | 13 +- XMonad/Layout/WindowSwitcherDecoration.hs | 2 +- XMonad/Layout/WorkspaceDir.hs | 2 +- XMonad/Prompt.hs | 17 ++- XMonad/Prompt/AppLauncher.hs | 4 +- XMonad/Prompt/AppendFile.hs | 4 +- XMonad/Prompt/DirExec.hs | 6 +- XMonad/Prompt/Email.hs | 2 +- XMonad/Prompt/Layout.hs | 2 +- XMonad/Prompt/Man.hs | 2 +- XMonad/Prompt/RunOrRaise.hs | 2 +- XMonad/Prompt/Shell.hs | 2 +- XMonad/Prompt/Ssh.hs | 2 +- XMonad/Prompt/Theme.hs | 4 +- XMonad/Prompt/Window.hs | 6 +- XMonad/Prompt/Workspace.hs | 2 +- XMonad/Prompt/XMonad.hs | 2 +- XMonad/Util/Loggers.hs | 4 +- XMonad/Util/NamedScratchpad.hs | 2 +- XMonad/Util/Themes.hs | 231 +++++++++++++++--------------- 55 files changed, 362 insertions(+), 320 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs index c7c0d5b..fc73542 100644 --- a/XMonad/Actions/DynamicWorkspaces.hs +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -46,10 +46,10 @@ import Control.Monad (when) -- 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 @@ -60,7 +60,7 @@ import Control.Monad (when) -- -- 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] diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index e7ba0b7..1543644 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -27,6 +27,7 @@ module XMonad.Actions.GridSelect ( -- * Configuration GSConfig(..), + def, defaultGSConfig, TwoDPosition, buildDefaultGSConfig, @@ -167,7 +168,7 @@ import Data.Word (Word8) -- -- 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 @@ -183,6 +184,11 @@ import Data.Word (Word8) -- -- <> +-- | 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, @@ -212,12 +218,12 @@ instance HasColorizer a where 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 -defaultGSConfig = buildDefaultGSConfig defaultColorizer +defaultGSConfig = def type TwoDPosition = (Integer, Integer) diff --git a/XMonad/Actions/Launcher.hs b/XMonad/Actions/Launcher.hs index 9056bf4..025fb34 100644 --- a/XMonad/Actions/Launcher.hs +++ b/XMonad/Actions/Launcher.hs @@ -34,10 +34,10 @@ import XMonad.Util.Run To test it, modify your local .xmonad: - > import XMonad.Prompt(defaultXPConfig) + > import XMonad.Prompt(def) > import XMonad.Actions.Launcher - > ((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. @@ -45,7 +45,7 @@ import XMonad.Util.Run 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 diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs index 379180d..dda42ff 100644 --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -34,6 +34,7 @@ module XMonad.Actions.Navigation2D ( -- * Usage withNavigation2DConfig , Navigation2DConfig(..) + , def , defaultNavigation2DConfig , Navigation2D , lineNavigation @@ -114,8 +115,7 @@ import XMonad.Util.Types -- -- 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: -- @@ -147,7 +147,7 @@ import XMonad.Util.Types -- 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 @@ -164,9 +164,9 @@ import XMonad.Util.Types -- 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 @@ -279,7 +279,10 @@ lineNavigation = N 1 doLineNavigation 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 @@ -305,7 +308,7 @@ type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -- 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 @@ -313,12 +316,12 @@ withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf >> 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 -defaultNavigation2DConfig = Navigation2DConfig { defaultTiledNavigation = lineNavigation +defaultNavigation2DConfig = def + +instance Default Navigation2DConfig where + def = Navigation2DConfig { defaultTiledNavigation = lineNavigation , floatNavigation = centerNavigation , screenNavigation = lineNavigation , layoutNavigation = [] diff --git a/XMonad/Actions/Search.hs b/XMonad/Actions/Search.hs index cb15898..ab55ba4 100644 --- a/XMonad/Actions/Search.hs +++ b/XMonad/Actions/Search.hs @@ -157,7 +157,7 @@ Then add the following to your key bindings: > ... > -- 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) > > ... @@ -173,7 +173,7 @@ Or in combination with XMonad.Util.EZConfig: > ... > ] -- 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 ] > > ... diff --git a/XMonad/Actions/ShowText.hs b/XMonad/Actions/ShowText.hs index e0a64cb..77d7244 100644 --- a/XMonad/Actions/ShowText.hs +++ b/XMonad/Actions/ShowText.hs @@ -16,7 +16,8 @@ module XMonad.Actions.ShowText ( -- * Usage -- $usage - defaultSTConfig + def + , defaultSTConfig , handleTimerEvent , flashText , ShowTextConfig(..) @@ -52,7 +53,7 @@ import qualified XMonad.Util.ExtensibleState as ES -- -- 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 @@ -72,13 +73,17 @@ data ShowTextConfig = , 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" } +{-# 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 diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs index df37c9d..d266492 100644 --- a/XMonad/Actions/SpawnOn.hs +++ b/XMonad/Actions/SpawnOn.hs @@ -54,7 +54,7 @@ import qualified XMonad.Util.ExtensibleState as XS -- 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). diff --git a/XMonad/Actions/Submap.hs b/XMonad/Actions/Submap.hs index 17ab676..3a49d88 100644 --- a/XMonad/Actions/Submap.hs +++ b/XMonad/Actions/Submap.hs @@ -62,7 +62,7 @@ submap keys = submapDefault (return ()) keys -- | 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 @@ -79,4 +79,4 @@ submapDefault def keys = do io $ ungrabKeyboard d currentTime - maybe def id (M.lookup (m', s) keys) + maybe defAction id (M.lookup (m', s) keys) diff --git a/XMonad/Actions/TagWindows.hs b/XMonad/Actions/TagWindows.hs index 86c2e9e..ac88045 100644 --- a/XMonad/Actions/TagWindows.hs +++ b/XMonad/Actions/TagWindows.hs @@ -53,12 +53,12 @@ econst = const . return -- > , ((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 diff --git a/XMonad/Actions/TopicSpace.hs b/XMonad/Actions/TopicSpace.hs index cf4fb0d..4bef3c3 100644 --- a/XMonad/Actions/TopicSpace.hs +++ b/XMonad/Actions/TopicSpace.hs @@ -22,6 +22,7 @@ module XMonad.Actions.TopicSpace Topic , Dir , TopicConfig(..) + , def , defaultTopicConfig , getLastFocusedTopics , setLastFocusedTopic @@ -89,7 +90,7 @@ import qualified XMonad.Util.ExtensibleState as XS -- > ] -- > -- > myTopicConfig :: TopicConfig --- > myTopicConfig = defaultTopicConfig +-- > myTopicConfig = def -- > { topicDirs = M.fromList $ -- > [ ("conf", "w/conf") -- > , ("dashboard", "Desktop") @@ -206,14 +207,18 @@ data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir -- 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" , 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 [] diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs index 30d3d01..368e6e1 100644 --- a/XMonad/Actions/WorkspaceNames.hs +++ b/XMonad/Actions/WorkspaceNames.hs @@ -55,7 +55,7 @@ import Data.Maybe (fromMaybe) -- -- 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: -- diff --git a/XMonad/Config/Arossato.hs b/XMonad/Config/Arossato.hs index 319e2a1..09d0b18 100644 --- a/XMonad/Config/Arossato.hs +++ b/XMonad/Config/Arossato.hs @@ -36,7 +36,6 @@ import XMonad.Layout.NoBorders 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 @@ -120,7 +119,7 @@ arossatoConfig = do newManageHook = myManageHook -- xmobar - myDynLog h = dynamicLogWithPP defaultPP + myDynLog h = dynamicLogWithPP def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" , ppTitle = xmobarColor "green" "" . shorten 40 , ppVisible = wrap "(" ")" @@ -144,12 +143,12 @@ arossatoConfig = do [(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 ) diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs index 08c0b04..2bf22ec 100644 --- a/XMonad/Config/Dmwit.hs +++ b/XMonad/Config/Dmwit.hs @@ -307,12 +307,12 @@ xmobarCommand (S s) = unwords ["xmobar", 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") } -ppWorkspaces s@(S s_) = marshallPP s defaultPP { +ppWorkspaces s@(S s_) = marshallPP s def { ppCurrent = color "white", ppVisible = color "white", ppHiddenNoWindows = color dark, diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index 8fe7f2d..a26dbae 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -16,7 +16,7 @@ import qualified XMonad.StackSet as W 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 ) @@ -32,7 +32,7 @@ import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) ) 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 ) @@ -46,8 +46,8 @@ import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) 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} ------------------------------------------------------------------------ @@ -137,7 +137,7 @@ config = ewmh def , 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' diff --git a/XMonad/Config/Sjanssen.hs b/XMonad/Config/Sjanssen.hs index cc9c536..1f2d66e 100644 --- a/XMonad/Config/Sjanssen.hs +++ b/XMonad/Config/Sjanssen.hs @@ -62,8 +62,8 @@ sjanssenConfig = ] 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 diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index f766962..432be26 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -937,8 +937,8 @@ example, you could write: 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", @@ -984,8 +984,8 @@ For instance, if you have defined some additional key bindings like 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 @@ -1021,8 +1021,8 @@ All together, your @~\/.xmonad\/xmonad.hs@ would now look like this: > 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 @@ -1097,8 +1097,8 @@ for removing and adding. Here is an example from > [(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) @@ -1174,7 +1174,7 @@ Suppose we want a list with the 'XMonad.Layout.Full', 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' @@ -1188,11 +1188,11 @@ example, suppose we want to use the '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: -> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion +> mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion Our @~\/.xmonad\/xmonad.hs@ will now look like this: @@ -1202,7 +1202,7 @@ Our @~\/.xmonad\/xmonad.hs@ will now look like this: > 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 } diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index 3bdf5f1..6b454db 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -35,7 +35,7 @@ module XMonad.Hooks.DynamicLog ( -- * Build your own formatter dynamicLogWithPP, dynamicLogString, - PP(..), defaultPP, + PP(..), defaultPP, def, -- * Example formatters dzenPP, xmobarPP, sjanssenPP, byorgeyPP, @@ -126,7 +126,7 @@ import XMonad.Hooks.ManageDocks -- > 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 @@ -246,7 +246,7 @@ toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b ) -- 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. @@ -312,10 +312,10 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $ -- 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 @@ -459,8 +459,12 @@ data PP = PP { ppCurrent :: WorkspaceId -> String } -- | 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 -defaultPP = PP { ppCurrent = wrap "[" "]" +defaultPP = def + +instance Default PP where + def = PP { ppCurrent = wrap "[" "]" , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const "" @@ -477,7 +481,7 @@ defaultPP = PP { ppCurrent = wrap "[" "]" -- | 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 "" @@ -496,7 +500,7 @@ dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad -- | 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" @@ -504,23 +508,23 @@ xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" -- | 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 -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 -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 "" diff --git a/XMonad/Hooks/PositionStoreHooks.hs b/XMonad/Hooks/PositionStoreHooks.hs index 0818b1c..17ef59b 100644 --- a/XMonad/Hooks/PositionStoreHooks.hs +++ b/XMonad/Hooks/PositionStoreHooks.hs @@ -55,7 +55,7 @@ import qualified Data.Set as S -- 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 diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index ec09575..3cada5b 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -17,7 +17,7 @@ module XMonad.Layout.Decoration ( -- * Usage: -- $usage decoration - , Theme (..), defaultTheme + , Theme (..), defaultTheme, def , Decoration , DecorationMsg (..) , DecorationStyle (..) @@ -86,9 +86,8 @@ data Theme = -- 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" @@ -105,6 +104,11 @@ defaultTheme = , 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 ) diff --git a/XMonad/Layout/DecorationAddons.hs b/XMonad/Layout/DecorationAddons.hs index 6d751ec..0f4a799 100644 --- a/XMonad/Layout/DecorationAddons.hs +++ b/XMonad/Layout/DecorationAddons.hs @@ -68,7 +68,7 @@ titleBarButtonHandler mainw distFromLeft distFromRight = do -- | Intended to be used together with 'titleBarButtonHandler'. See above. defaultThemeWithButtons :: Theme -defaultThemeWithButtons = defaultTheme { +defaultThemeWithButtons = def { windowTitleAddons = [ (" (M)", AlignLeft) , ("_" , AlignRightOffset minimizeButtonOffset) , ("[]" , AlignRightOffset maximizeButtonOffset) diff --git a/XMonad/Layout/DecorationMadness.hs b/XMonad/Layout/DecorationMadness.hs index c463636..ec5a88d 100644 --- a/XMonad/Layout/DecorationMadness.hs +++ b/XMonad/Layout/DecorationMadness.hs @@ -82,7 +82,7 @@ module XMonad.Layout.DecorationMadness , floatDwmStyle , floatSimpleTabbed , floatTabbed - , defaultTheme, shrinkText + , def, defaultTheme, shrinkText ) where import XMonad @@ -113,7 +113,7 @@ import XMonad.Layout.SimpleFloat -- -- You can also edit the default theme: -- --- > myTheme = defaultTheme { inactiveBorderColor = "#FF0000" +-- > myTheme = def { inactiveBorderColor = "#FF0000" -- > , activeTextColor = "#00FF00" } -- -- and @@ -140,7 +140,7 @@ import XMonad.Layout.SimpleFloat -- -- 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. @@ -155,7 +155,7 @@ circleDefault s t = decoration s t DefaultDecoration Circle -- -- 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. @@ -172,7 +172,7 @@ circleDeco s t = decoration s t (Simple True) Circle -- 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. @@ -190,7 +190,7 @@ circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ win -- 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. @@ -206,7 +206,7 @@ circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArra -- -- 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. @@ -241,7 +241,7 @@ circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle) -- -- 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. @@ -256,7 +256,7 @@ accordionDefault s t = decoration s t DefaultDecoration Accordion -- -- 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. @@ -269,7 +269,7 @@ accordionDeco s t = decoration s t (Simple True) Accordion -- 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. @@ -283,7 +283,7 @@ accordionDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ -- 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. @@ -299,7 +299,7 @@ accordionDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowA -- -- 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. @@ -337,7 +337,7 @@ tall = Tall 1 (3/100) (1/2) -- -- 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. @@ -352,7 +352,7 @@ tallDefault s t = decoration s t DefaultDecoration tall -- -- 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. @@ -369,7 +369,7 @@ tallDeco s t = decoration s t (Simple True) tall -- 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. @@ -387,7 +387,7 @@ tallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windo -- 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. @@ -403,7 +403,7 @@ tallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrang -- -- 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. @@ -440,7 +440,7 @@ mirrorTall = Mirror tall -- -- 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. @@ -455,7 +455,7 @@ mirrorTallDefault s t = decoration s t DefaultDecoration mirrorTall -- -- 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. @@ -472,7 +472,7 @@ mirrorTallDeco s t = decoration s t (Simple True) mirrorTall -- 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. @@ -490,7 +490,7 @@ mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ -- 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. @@ -506,7 +506,7 @@ mirrorTallDecoResizable s t = decoration s t (Simple True) (mouseResize $ window -- -- 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. @@ -555,7 +555,7 @@ floatSimple = simpleFloat' -- 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. @@ -572,7 +572,7 @@ floatDefault s t = decoration s t DefaultDecoration (mouseResize $ windowArrange -- 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. @@ -589,7 +589,7 @@ floatDwmStyle s t = decoration s t Dwm (mouseResize $ windowArrangeAll $ SF (dec -- 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. diff --git a/XMonad/Layout/DwmStyle.hs b/XMonad/Layout/DwmStyle.hs index 6bba823..a854d1b 100644 --- a/XMonad/Layout/DwmStyle.hs +++ b/XMonad/Layout/DwmStyle.hs @@ -17,6 +17,7 @@ module XMonad.Layout.DwmStyle -- $usage dwmStyle , Theme (..) + , def , defaultTheme , DwmStyle (..) , shrinkText, CustomShrink(CustomShrink) @@ -36,7 +37,7 @@ import XMonad.Layout.Decoration -- 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: @@ -45,8 +46,8 @@ import XMonad.Layout.Decoration -- -- You can also edit the default configuration options. -- --- > myDWConfig = defaultTheme { inactiveBorderColor = "red" --- > , inactiveTextColor = "red"} +-- > myDWConfig = def { inactiveBorderColor = "red" +-- > , inactiveTextColor = "red"} -- -- and -- @@ -58,10 +59,8 @@ import XMonad.Layout.Decoration -- > import XMonad.Layout.DwmStyle -- > -- > main = xmonad def { --- > layoutHook = --- > dwmStyle shrinkText defaultTheme --- > (layoutHook def) --- > } +-- > layoutHook = dwmStyle shrinkText def (layoutHook def) +-- > } -- diff --git a/XMonad/Layout/Groups/Examples.hs b/XMonad/Layout/Groups/Examples.hs index 9407c9b..937d58f 100644 --- a/XMonad/Layout/Groups/Examples.hs +++ b/XMonad/Layout/Groups/Examples.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-} +{-# LANGUAGE MultiParamTypeClasses, Rank2Types, TypeFamilies #-} ----------------------------------------------------------------------------- -- | @@ -36,6 +36,7 @@ module XMonad.Layout.Groups.Examples ( -- * Usage , mirrorTallTabs , fullTabs , TiledTabsConfig(..) + , def , defaultTiledTabsConfig , increaseNMasterGroups , decreaseNMasterGroups @@ -180,9 +181,9 @@ toggleWindowFull = sendMessage ZoomFullToggle -- 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': -- --- > 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: @@ -201,8 +202,12 @@ data TiledTabsConfig s = TTC { vNMaster :: Int , 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 -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 diff --git a/XMonad/Layout/Groups/Wmii.hs b/XMonad/Layout/Groups/Wmii.hs index da45149..fc0b59f 100644 --- a/XMonad/Layout/Groups/Wmii.hs +++ b/XMonad/Layout/Groups/Wmii.hs @@ -30,6 +30,7 @@ module XMonad.Layout.Groups.Wmii ( -- * Usage -- * Useful re-exports , shrinkText + , def , defaultTheme , module XMonad.Layout.Groups.Helpers ) where @@ -71,7 +72,7 @@ import XMonad.Layout.Simplest -- (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: diff --git a/XMonad/Layout/ImageButtonDecoration.hs b/XMonad/Layout/ImageButtonDecoration.hs index 1737964..25a352a 100644 --- a/XMonad/Layout/ImageButtonDecoration.hs +++ b/XMonad/Layout/ImageButtonDecoration.hs @@ -164,7 +164,7 @@ imageTitleBarButtonHandler mainw distFromLeft distFromRight = do action defaultThemeWithImageButtons :: Theme -defaultThemeWithImageButtons = defaultTheme { +defaultThemeWithImageButtons = def { windowTitleIcons = [ (menuButton, CenterLeft 3), (closeButton, CenterRight 3), (maxiButton, CenterRight 18), diff --git a/XMonad/Layout/IndependentScreens.hs b/XMonad/Layout/IndependentScreens.hs index 37be05b..b222e43 100644 --- a/XMonad/Layout/IndependentScreens.hs +++ b/XMonad/Layout/IndependentScreens.hs @@ -157,7 +157,7 @@ marshallPP s pp = pp { -- 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") -- > } diff --git a/XMonad/Layout/NoFrillsDecoration.hs b/XMonad/Layout/NoFrillsDecoration.hs index 722c13c..44de169 100644 --- a/XMonad/Layout/NoFrillsDecoration.hs +++ b/XMonad/Layout/NoFrillsDecoration.hs @@ -37,7 +37,7 @@ import XMonad.Layout.SimpleDecoration -- 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 } -- diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs index 4108138..1013fe2 100644 --- a/XMonad/Layout/PerWorkspace.hs +++ b/XMonad/Layout/PerWorkspace.hs @@ -25,8 +25,6 @@ module XMonad.Layout.PerWorkspace import XMonad import qualified XMonad.StackSet as W -import XMonad.Layout.LayoutModifier - import Data.Maybe (fromMaybe) -- $usage diff --git a/XMonad/Layout/PositionStoreFloat.hs b/XMonad/Layout/PositionStoreFloat.hs index d793178..b9a415b 100644 --- a/XMonad/Layout/PositionStoreFloat.hs +++ b/XMonad/Layout/PositionStoreFloat.hs @@ -45,7 +45,7 @@ import Data.List(nub) -- 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 diff --git a/XMonad/Layout/ShowWName.hs b/XMonad/Layout/ShowWName.hs index 827dc59..39572e3 100644 --- a/XMonad/Layout/ShowWName.hs +++ b/XMonad/Layout/ShowWName.hs @@ -17,6 +17,7 @@ module XMonad.Layout.ShowWName -- $usage showWName , showWName' + , def , defaultSWNConfig , SWNConfig(..) , ShowWName @@ -43,7 +44,7 @@ import XMonad.Util.XUtils -- | 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. @@ -60,14 +61,18 @@ data SWNConfig = , 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" , 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 diff --git a/XMonad/Layout/SimpleDecoration.hs b/XMonad/Layout/SimpleDecoration.hs index 2006b21..052750a 100644 --- a/XMonad/Layout/SimpleDecoration.hs +++ b/XMonad/Layout/SimpleDecoration.hs @@ -20,6 +20,7 @@ module XMonad.Layout.SimpleDecoration -- $usage simpleDeco , Theme (..) + , def , defaultTheme , SimpleDecoration (..) , shrinkText, CustomShrink(CustomShrink) @@ -38,7 +39,7 @@ import XMonad.Layout.Decoration -- 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: @@ -47,12 +48,12 @@ import XMonad.Layout.Decoration -- -- You can also edit the default configuration options. -- --- > mySDConfig = defaultTheme { inactiveBorderColor = "red" --- > , inactiveTextColor = "red"} +-- > mySDConfig = def { inactiveBorderColor = "red" +-- > , inactiveTextColor = "red"} -- -- and -- --- > 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 diff --git a/XMonad/Layout/SimpleFloat.hs b/XMonad/Layout/SimpleFloat.hs index f12840e..824abfc 100644 --- a/XMonad/Layout/SimpleFloat.hs +++ b/XMonad/Layout/SimpleFloat.hs @@ -51,7 +51,7 @@ import XMonad.Layout.WindowArranger -- 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. diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs index 73cea67..58a7edc 100644 --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -45,7 +45,7 @@ import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout, 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(..)) @@ -59,6 +59,7 @@ import Data.List(nubBy, (\\), find) 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 @@ -182,7 +183,7 @@ import Data.Map(Map) -- 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 @@ -192,7 +193,7 @@ subLayout nextLayout sl x = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) 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 diff --git a/XMonad/Layout/TabBarDecoration.hs b/XMonad/Layout/TabBarDecoration.hs index 3a61996..4ac808e 100644 --- a/XMonad/Layout/TabBarDecoration.hs +++ b/XMonad/Layout/TabBarDecoration.hs @@ -16,7 +16,7 @@ module XMonad.Layout.TabBarDecoration ( -- * Usage -- $usage simpleTabBar, tabBar - , defaultTheme, shrinkText + , def, defaultTheme, shrinkText , TabBarDecoration (..), XPPosition (..) , module XMonad.Layout.ResizeScreen ) where @@ -53,7 +53,7 @@ import XMonad.Prompt ( XPPosition (..) ) -- | 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 diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs index c140984..da314da 100644 --- a/XMonad/Layout/Tabbed.hs +++ b/XMonad/Layout/Tabbed.hs @@ -22,6 +22,7 @@ module XMonad.Layout.Tabbed , simpleTabbedBottom, tabbedBottom, addTabsBottom , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways , Theme (..) + , def , defaultTheme , TabbedDecoration (..) , shrinkText, CustomShrink(CustomShrink) @@ -47,7 +48,7 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) ) -- -- 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: -- @@ -67,8 +68,8 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) ) -- -- You can also edit the default configuration options. -- --- > myTabConfig = defaultTheme { inactiveBorderColor = "#FF0000" --- > , activeTextColor = "#00FF00"} +-- > myTabConfig = def { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} -- -- and -- @@ -84,18 +85,18 @@ import XMonad.Layout.Simplest ( Simplest(Simplest) ) -- > 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 -simpleTabbedAlways = tabbedAlways shrinkText defaultTheme +simpleTabbedAlways = tabbedAlways shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window -simpleTabbedBottom = tabbedBottom shrinkText defaultTheme +simpleTabbedBottom = tabbedBottom shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window -simpleTabbedBottomAlways = tabbedBottomAlways shrinkText defaultTheme +simpleTabbedBottomAlways = tabbedBottomAlways shrinkText def -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. diff --git a/XMonad/Layout/WindowNavigation.hs b/XMonad/Layout/WindowNavigation.hs index ebfa553..84e3aed 100644 --- a/XMonad/Layout/WindowNavigation.hs +++ b/XMonad/Layout/WindowNavigation.hs @@ -21,7 +21,7 @@ module XMonad.Layout.WindowNavigation ( Navigate(..), Direction2D(..), MoveWindowToWindow(..), navigateColor, navigateBrightness, - noNavigateBorders, defaultWNConfig, + noNavigateBorders, defaultWNConfig, def, WNConfig, WindowNavigation, ) where @@ -82,24 +82,27 @@ data WNConfig = noNavigateBorders :: WNConfig noNavigateBorders = - defaultWNConfig {brightness = Just 0} + def {brightness = Just 0} navigateColor :: String -> WNConfig navigateColor c = 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 } +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 -defaultWNConfig = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" +defaultWNConfig = def data NavigationState a = NS Point [(a,Rectangle)] 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)) diff --git a/XMonad/Layout/WindowSwitcherDecoration.hs b/XMonad/Layout/WindowSwitcherDecoration.hs index 07cb022..4a93c01 100644 --- a/XMonad/Layout/WindowSwitcherDecoration.hs +++ b/XMonad/Layout/WindowSwitcherDecoration.hs @@ -43,7 +43,7 @@ import Foreign.C.Types(CInt) -- 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 diff --git a/XMonad/Layout/WorkspaceDir.hs b/XMonad/Layout/WorkspaceDir.hs index ae39d4b..58ac5f5 100644 --- a/XMonad/Layout/WorkspaceDir.hs +++ b/XMonad/Layout/WorkspaceDir.hs @@ -56,7 +56,7 @@ import XMonad.StackSet ( tag, currentTag ) -- 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: -- diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index e9613db..0a032c4 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -19,6 +19,7 @@ module XMonad.Prompt mkXPrompt , mkXPromptWithReturn , mkXPromptWithModes + , def , amberXPConfig , defaultXPConfig , greenXPConfig @@ -230,7 +231,8 @@ data XPPosition = Top amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig -defaultXPConfig = +instance Default XPConfig where + def = XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*" , bgColor = "grey22" , fgColor = "grey80" @@ -252,8 +254,10 @@ defaultXPConfig = , 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 @@ -377,8 +381,7 @@ mkXPromptWithReturn t conf compl action = do -- -- * 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) @@ -1192,10 +1195,10 @@ historyNextMatching hm@(HistoryMatches ref) next = do -- > .. -- > ((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)] --- > (promptKeymap defaultPrompt) +-- > (promptKeymap def) -- > , .. } -- historyUpMatching, historyDownMatching :: HistoryMatches -> XP () diff --git a/XMonad/Prompt/AppLauncher.hs b/XMonad/Prompt/AppLauncher.hs index 167c798..ebcf035 100644 --- a/XMonad/Prompt/AppLauncher.hs +++ b/XMonad/Prompt/AppLauncher.hs @@ -50,8 +50,8 @@ configuration and the AppLauncher module itself. 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" ) > ... -} diff --git a/XMonad/Prompt/AppendFile.hs b/XMonad/Prompt/AppendFile.hs index 17d4763..4a0ce3f 100644 --- a/XMonad/Prompt/AppendFile.hs +++ b/XMonad/Prompt/AppendFile.hs @@ -42,7 +42,7 @@ import Control.Exception.Extensible (bracket) -- -- 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 @@ -50,7 +50,7 @@ import Control.Exception.Extensible (bracket) -- -- > , ((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.) diff --git a/XMonad/Prompt/DirExec.hs b/XMonad/Prompt/DirExec.hs index ef37a9a..4919049 100644 --- a/XMonad/Prompt/DirExec.hs +++ b/XMonad/Prompt/DirExec.hs @@ -41,17 +41,17 @@ econst = const . return -- -- 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 -- --- > , ("M-C-x", dirExecPromptNamed defaultXPConfig spawn +-- > , ("M-C-x", dirExecPromptNamed def spawn -- > "/home/joe/.scripts" "My Scripts: ") -- -- or add this after your default bindings: -- -- > ++ --- > [ ("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") ] -- > ] -- > ++ diff --git a/XMonad/Prompt/Email.hs b/XMonad/Prompt/Email.hs index a0eb72e..7a746df 100644 --- a/XMonad/Prompt/Email.hs +++ b/XMonad/Prompt/Email.hs @@ -36,7 +36,7 @@ import XMonad.Prompt.Input -- -- 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: diff --git a/XMonad/Prompt/Layout.hs b/XMonad/Prompt/Layout.hs index d9c59e1..76aa938 100644 --- a/XMonad/Prompt/Layout.hs +++ b/XMonad/Prompt/Layout.hs @@ -31,7 +31,7 @@ import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) ) -- > 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". diff --git a/XMonad/Prompt/Man.hs b/XMonad/Prompt/Man.hs index c5bd8d5..6cdaa66 100644 --- a/XMonad/Prompt/Man.hs +++ b/XMonad/Prompt/Man.hs @@ -46,7 +46,7 @@ import Data.Maybe -- -- 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". diff --git a/XMonad/Prompt/RunOrRaise.hs b/XMonad/Prompt/RunOrRaise.hs index ce93de9..31ed027 100644 --- a/XMonad/Prompt/RunOrRaise.hs +++ b/XMonad/Prompt/RunOrRaise.hs @@ -41,7 +41,7 @@ econst = const . return 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". -} diff --git a/XMonad/Prompt/Shell.hs b/XMonad/Prompt/Shell.hs index 93308bc..5c8f687 100644 --- a/XMonad/Prompt/Shell.hs +++ b/XMonad/Prompt/Shell.hs @@ -52,7 +52,7 @@ econst = const . return 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". -} diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs index e9e7ec8..aa1b9fd 100644 --- a/XMonad/Prompt/Ssh.hs +++ b/XMonad/Prompt/Ssh.hs @@ -41,7 +41,7 @@ econst = const . return -- -- 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 diff --git a/XMonad/Prompt/Theme.hs b/XMonad/Prompt/Theme.hs index d34dd87..1349bd1 100644 --- a/XMonad/Prompt/Theme.hs +++ b/XMonad/Prompt/Theme.hs @@ -35,7 +35,7 @@ import XMonad.Util.Themes -- -- 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". @@ -49,7 +49,7 @@ instance XPrompt ThemePrompt where 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 diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs index a6aa53f..974e986 100644 --- a/XMonad/Prompt/Window.hs +++ b/XMonad/Prompt/Window.hs @@ -44,13 +44,13 @@ import XMonad.Actions.WindowBringer -- -- 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: -- -- > , ((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 diff --git a/XMonad/Prompt/Workspace.hs b/XMonad/Prompt/Workspace.hs index 749ca9d..b324762 100644 --- a/XMonad/Prompt/Workspace.hs +++ b/XMonad/Prompt/Workspace.hs @@ -32,7 +32,7 @@ import XMonad.Util.WorkspaceCompare ( getSortByIndex ) -- > 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". diff --git a/XMonad/Prompt/XMonad.hs b/XMonad/Prompt/XMonad.hs index 86f5369..ce075be 100644 --- a/XMonad/Prompt/XMonad.hs +++ b/XMonad/Prompt/XMonad.hs @@ -33,7 +33,7 @@ import Data.Maybe (fromMaybe) -- -- 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". diff --git a/XMonad/Util/Loggers.hs b/XMonad/Util/Loggers.hs index 36f91d9..c613d69 100644 --- a/XMonad/Util/Loggers.hs +++ b/XMonad/Util/Loggers.hs @@ -77,7 +77,7 @@ econst = const . return -- 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." @@ -193,7 +193,7 @@ logCurrent = withWindowSet $ return . Just . W.currentTag -- 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 diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs index c3e0452..07af0a8 100644 --- a/XMonad/Util/NamedScratchpad.hs +++ b/XMonad/Util/NamedScratchpad.hs @@ -166,7 +166,7 @@ namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scr -- -- 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 diff --git a/XMonad/Util/Themes.hs b/XMonad/Util/Themes.hs index 61352d6..f753a50 100644 --- a/XMonad/Util/Themes.hs +++ b/XMonad/Util/Themes.hs @@ -45,8 +45,7 @@ import XMonad.Layout.Decoration -- 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: -- @@ -80,7 +79,7 @@ data ThemeInfo = } newTheme :: ThemeInfo -newTheme = TI "" "" "" defaultTheme +newTheme = TI "" "" "" def ppThemeInfo :: ThemeInfo -> String ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t @@ -112,7 +111,7 @@ xmonadTheme = newTheme { themeName = "xmonadTheme" , themeAuthor = "David Roundy" , themeDescription = "The default xmonad theme" - , theme = defaultTheme + , theme = def } -- | Small decorations with a Ion3 remembrance, by Andrea Rossato. @@ -121,14 +120,14 @@ smallClean = 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...;) @@ -137,14 +136,14 @@ donaldTheme = 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. @@ -153,15 +152,15 @@ robertTheme = 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. @@ -170,15 +169,15 @@ deiflTheme = 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. @@ -187,19 +186,19 @@ oxymor00nTheme = 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 @@ -207,15 +206,15 @@ wfarrTheme = 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 @@ -224,13 +223,13 @@ kavonForestTheme = 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 @@ -239,13 +238,13 @@ kavonLakeTheme = 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 @@ -254,13 +253,13 @@ kavonPeacockTheme = 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 @@ -269,13 +268,13 @@ kavonVioGreenTheme = 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 @@ -284,13 +283,13 @@ kavonBluesTheme = 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 @@ -299,13 +298,13 @@ kavonChristmasTheme = 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 @@ -314,13 +313,13 @@ kavonAutumnTheme = 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 @@ -329,12 +328,12 @@ kavonFireTheme = 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" + } } -- cgit v1.2.3