1 patch for repository haskell:/srv/code/xmonad: Mon May 27 20:35:31 EDT 2013 Daniel Wagner * depend on data-default, and deprecate the monomorphic name defaultConfig New patches: [depend on data-default, and deprecate the monomorphic name defaultConfig Daniel Wagner **20130528003531 Ignore-this: 1e746731695df3b6f684d5463a3da6a4 ] { hunk ./Main.hs 40 main = do installSignalHandlers -- important to ignore SIGCHLD to avoid zombies args <- getArgs - let launch = catchIO buildLaunch >> xmonad defaultConfig + let launch = catchIO buildLaunch >> xmonad def case args of [] -> launch ("--resume":_) -> launch hunk ./XMonad/Config.hs 1 -{-# OPTIONS -fno-warn-missing-signatures #-} +{-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-} +{-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config hunk ./XMonad/Config.hs 17 -- -- DO NOT MODIFY THIS FILE! It won't work. You may configure xmonad -- by providing your own @~\/.xmonad\/xmonad.hs@ that overrides --- specific fields in 'defaultConfig'. For a starting point, you can +-- specific fields in the default config, 'def'. For a starting point, you can -- copy the @xmonad.hs@ found in the @man@ directory, or look at -- examples on the xmonad wiki. -- hunk ./XMonad/Config.hs 23 ------------------------------------------------------------------------ -module XMonad.Config (defaultConfig) where +module XMonad.Config (defaultConfig, Default(..)) where -- -- Useful imports hunk ./XMonad/Config.hs 42 import XMonad.ManageHook import qualified XMonad.StackSet as W import Data.Bits ((.|.)) +import Data.Default import Data.Monoid import qualified Data.Map as M import System.Exit hunk ./XMonad/Config.hs 255 -- you may also bind events to the mouse scroll wheel (button4 and button5) ] --- | The default set of configuration values itself -defaultConfig = XConfig +instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) where + def = XConfig { XMonad.borderWidth = borderWidth , XMonad.workspaces = workspaces , XMonad.layoutHook = layout hunk ./XMonad/Config.hs 276 , XMonad.rootMask = rootMask } +-- | The default set of configuration values itself +{-# DEPRECATED defaultConfig "Use def (from Data.Default, and re-exported by XMonad and XMonad.Config) instead." #-} +defaultConfig :: XConfig (Choose Tall (Choose (Mirror Tall) Full)) +defaultConfig = def + -- | Finally, a copy of the default bindings in simple textual tabular format. help :: String help = unlines ["The default modifier key is 'alt'. Default keybindings:", hunk ./XMonad/Core.hs 40 import Control.Applicative import Control.Monad.State import Control.Monad.Reader +import Data.Default import System.FilePath import System.IO import System.Info hunk ./XMonad/Core.hs 153 mempty = return mempty mappend = liftM2 mappend +instance Default a => Default (X a) where + def = return def + type ManageHook = Query (Endo WindowSet) newtype Query a = Query (ReaderT Window X a) deriving (Functor, Monad, MonadReader Window, MonadIO) hunk ./XMonad/Core.hs 167 mempty = return mempty mappend = liftM2 mappend +instance Default a => Default (Query a) where + def = return def + -- | Run the 'X' monad, given a chunk of 'X' monad code, and an initial state -- Return the result, and final state runX :: XConf -> XState -> X a -> IO (a, XState) hunk ./XMonad/Main.hsc 88 xinesc <- getCleanedScreenInfo dpy nbc <- do v <- initColor dpy $ normalBorderColor xmc - ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.defaultConfig + ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def return (fromMaybe nbc_ v) fbc <- do v <- initColor dpy $ focusedBorderColor xmc hunk ./XMonad/Main.hsc 92 - ~(Just fbc_) <- initColor dpy $ focusedBorderColor Default.defaultConfig + ~(Just fbc_) <- initColor dpy $ focusedBorderColor Default.def return (fromMaybe fbc_ v) hSetBuffering stdout NoBuffering hunk ./man/xmonad.hs 261 -- -- No need to modify this. -- -defaults = defaultConfig { +defaults = def { -- simple stuff terminal = myTerminal, focusFollowsMouse = myFocusFollowsMouse, hunk ./xmonad.cabal 61 else build-depends: base < 3 build-depends: X11>=1.5 && < 1.7, mtl, unix, - utf8-string >= 0.3 && < 0.4 + utf8-string >= 0.3 && < 0.4, + data-default if true ghc-options: -funbox-strict-fields -Wall } Context: [configurableEventMasks mwlochbaum@gmail.com**20130205182858 Ignore-this: 3848de0f8f5ad5995e87a2a01e7752f ] [Grab all keycodes linked to each keysym, not just one Daniel Wagner **20130118225446 Ignore-this: 1a6c001560f68f99d75d5f550e7e83 This patch is based heavily on the one contributed by svein.ove@aas.no, but updated to avoid causing a conflict and to work with the newest X11 bindings. The name of the patch (and comment below) are copied verbatim from his patch. XKeysymToKeycode only gives the first code bound to a given symbol. To handle the case where multiple keys are bound to the same symbol, XKeycodeToKeysym is used instead, searching through all possible keycodes for each sym. ] [Issue 135 use wa_border_width for floating windows (neoraider) Adam Vogt **20130115170715 Ignore-this: c8ed6ceaf9483e31771ac25d86532f6c ] [Add flags for call to ghc closing issue 240 Adam Vogt **20130101035034 Ignore-this: 42a6a8599b615884c95626f74e3ba4a The -main-is flag goes back to at least ghc 6.10, and maybe the warning that this otherwise redundant flag enables (when xmonad.hs isn't a module Main) also dates back that far. ] [TAG 0.11 actual upload Adam Vogt **20130101014128 Ignore-this: 2c2a85caeed30cd23f02a7caf229fe7d ] Patch bundle hash: 084d2f678e4e9553fa9306e8caab7202b3652fa9