twin/xmonad
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad.git synced 2025-05-19 08:30:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Store user configuration in XConf

Browse Source
This commit is contained in:
Spencer Janssen 2007-11-01 07:23:08 +00:00
parent 3789f37f25
commit e50927ffc0
4 changed files with 54 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
EventLoop.hs
View File

@ -13,7 +13,7 @@
-- --
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module EventLoop ( makeMain, XMonadConfig(..) ) where module EventLoop (makeMain) where
import Data.Bits import Data.Bits
import qualified Data.Map as M import qualified Data.Map as M
@ -28,31 +28,17 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama (getScreenInfo) import Graphics.X11.Xinerama (getScreenInfo)
import XMonad hiding ( logHook, borderWidth ) import XMonad
import qualified XMonad ( logHook, borderWidth )
import StackSet (new, floating, member) import StackSet (new, floating, member)
import qualified StackSet as W import qualified StackSet as W
import Operations import Operations
import System.IO import System.IO
data XMonadConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
XMonadConfig { normalBorderColor :: !String
, focusedBorderColor :: !String
, defaultTerminal :: !String
, layoutHook :: !(l Window)
, workspaces :: ![String]
, defaultGaps :: ![(Int,Int,Int,Int)]
, keys :: !(M.Map (ButtonMask,KeySym) (X ()))
, mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
, borderWidth :: !Dimension
, logHook :: !(X ())
}
-- | -- |
-- The main entry point -- The main entry point
-- --
makeMain :: XMonadConfig -> IO () makeMain :: XConfig -> IO ()
makeMain xmc = do makeMain xmc = do
dpy <- openDisplay "" dpy <- openDisplay ""
let dflt = defaultScreen dpy let dflt = defaultScreen dpy
@ -64,7 +50,7 @@ makeMain xmc = do
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
args <- getArgs args <- getArgs
let (layout, lreads) = case xmc of XMonadConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s]) let (layout, lreads) = case xmc of XConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s])
initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
maybeRead reads' s = case reads' s of maybeRead reads' s = case reads' s of
@ -81,8 +67,7 @@ makeMain xmc = do
cf = XConf cf = XConf
{ display = dpy { display = dpy
, XMonad.logHook = logHook xmc , config = xmc
, XMonad.borderWidth = borderWidth xmc
, terminal = defaultTerminal xmc , terminal = defaultTerminal xmc
, theRoot = rootw , theRoot = rootw
, normalBorder = nbc , normalBorder = nbc
@ -259,7 +244,7 @@ scan dpy rootw = do
&& (wa_map_state wa == waIsViewable || ic) && (wa_map_state wa == waIsViewable || ic)
-- | Grab the keys back -- | Grab the keys back
grabKeys :: XMonadConfig -> X () grabKeys :: XConfig -> X ()
grabKeys xmc = do grabKeys xmc = do
XConf { display = dpy, theRoot = rootw } <- ask XConf { display = dpy, theRoot = rootw } <- ask
let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
@ -271,7 +256,7 @@ grabKeys xmc = do
when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
-- | XXX comment me -- | XXX comment me
grabButtons :: XMonadConfig -> X () grabButtons :: XConfig -> X ()
grabButtons xmc = do grabButtons xmc = do
XConf { display = dpy, theRoot = rootw } <- ask XConf { display = dpy, theRoot = rootw } <- ask
let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask

54
Main.hs
View File

@ -20,7 +20,8 @@ module Main where
-- Useful imports -- Useful imports
-- --
import Control.Monad.Reader ( asks ) import Control.Monad.Reader ( asks )
import XMonad hiding ( logHook, borderWidth ) import XMonad hiding (workspaces)
import qualified XMonad (workspaces)
import Layouts import Layouts
import Operations import Operations
import qualified StackSet as W import qualified StackSet as W
@ -29,8 +30,7 @@ import Data.Bits ((.|.))
import qualified Data.Map as M import qualified Data.Map as M
import System.Exit import System.Exit
import Graphics.X11.Xlib import Graphics.X11.Xlib
import EventLoop hiding ( workspaces ) import EventLoop
import qualified EventLoop ( workspaces )
-- % Extension-provided imports -- % Extension-provided imports
@ -230,30 +230,30 @@ mouseBindings = M.fromList $
-- % Extension-provided definitions -- % Extension-provided definitions
defaultConfig :: XMonadConfig defaultConfig :: XConfig
defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in pixels. defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixels.
, EventLoop.workspaces = workspaces , XMonad.workspaces = workspaces
, defaultGaps = [(0,0,0,0)] -- 15 for default dzen font , defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
-- | The top level layout switcher. Most users will not need to modify this binding. -- | The top level layout switcher. Most users will not need to modify this binding.
-- --
-- By default, we simply switch between the layouts listed in `layouts' -- By default, we simply switch between the layouts listed in `layouts'
-- above, but you may program your own selection behaviour here. Layout -- above, but you may program your own selection behaviour here. Layout
-- transformers, for example, would be hooked in here. -- transformers, for example, would be hooked in here.
-- --
, layoutHook = layout , layoutHook = layout
, defaultTerminal = "xterm" -- The preferred terminal program. , defaultTerminal = "xterm" -- The preferred terminal program.
, normalBorderColor = "#dddddd" -- Border color for unfocused windows. , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
, focusedBorderColor = "#ff0000" -- Border color for focused windows. , focusedBorderColor = "#ff0000" -- Border color for focused windows.
, EventLoop.keys = Main.keys , XMonad.keys = Main.keys
, EventLoop.mouseBindings = Main.mouseBindings , XMonad.mouseBindings = Main.mouseBindings
-- | Perform an arbitrary action on each internal state change or X event. -- | Perform an arbitrary action on each internal state change or X event.
-- Examples include: -- Examples include:
-- * do nothing -- * do nothing
-- * log the state to stdout -- * log the state to stdout
-- --
-- See the 'DynamicLog' extension for examples. -- See the 'DynamicLog' extension for examples.
, logHook = return () , logHook = return ()
} }
-- % The main function -- % The main function

6
Operations.hs
View File

@ -167,7 +167,7 @@ windows f = do
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
setTopFocus setTopFocus
asks logHook >>= userCode asks (logHook . config) >>= userCode
-- io performGC -- really helps, but seems to trigger GC bugs? -- io performGC -- really helps, but seems to trigger GC bugs?
-- hide every window that was potentially visible before, but is not -- hide every window that was potentially visible before, but is not
@ -211,7 +211,7 @@ setInitialProperties :: Window -> X ()
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
setWMState w iconicState setWMState w iconicState
io $ selectInput d w $ clientMask io $ selectInput d w $ clientMask
bw <- asks borderWidth bw <- asks (borderWidth . config)
io $ setWindowBorderWidth d w bw io $ setWindowBorderWidth d w bw
-- we must initially set the color of new windows, to maintain invariants -- we must initially set the color of new windows, to maintain invariants
-- required by the border setting in 'windows' -- required by the border setting in 'windows'
@ -388,7 +388,7 @@ floatLocation :: Window -> X (ScreenId, W.RationalRect)
floatLocation w = withDisplay $ \d -> do floatLocation w = withDisplay $ \d -> do
ws <- gets windowset ws <- gets windowset
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
bw <- fi `fmap` asks borderWidth bw <- fi `fmap` asks (borderWidth . config)
-- XXX horrible -- XXX horrible
let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws

20
XMonad.hs
View File

@ -16,7 +16,7 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad ( module XMonad (
X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..), X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), XConfig(..), LayoutClass(..), Layout(..),
Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..), Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),
runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX, runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
@ -46,15 +46,29 @@ data XState = XState
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows , mapped :: !(S.Set Window) -- ^ the Set of mapped windows
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
, dragging :: !(Maybe (Position -> Position -> X (), X ())) } , dragging :: !(Maybe (Position -> Position -> X (), X ())) }
data XConf = XConf data XConf = XConf
{ display :: Display -- ^ the X11 display { display :: Display -- ^ the X11 display
, logHook :: !(X ()) -- ^ the loghook function , config :: !XConfig -- ^ initial user configuration
, terminal :: !String -- ^ the user's preferred terminal , terminal :: !String -- ^ the user's preferred terminal
, theRoot :: !Window -- ^ the root window , theRoot :: !Window -- ^ the root window
, borderWidth :: !Dimension -- ^ the preferred border width
, normalBorder :: !Pixel -- ^ border color of unfocused windows , normalBorder :: !Pixel -- ^ border color of unfocused windows
, focusedBorder :: !Pixel } -- ^ border color of the focused window , focusedBorder :: !Pixel } -- ^ border color of the focused window
-- todo, better name
data XConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
XConfig { normalBorderColor :: !String
, focusedBorderColor :: !String
, defaultTerminal :: !String
, layoutHook :: !(l Window)
, workspaces :: ![String]
, defaultGaps :: ![(Int,Int,Int,Int)]
, keys :: !(M.Map (ButtonMask,KeySym) (X ()))
, mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
, borderWidth :: !Dimension
, logHook :: !(X ())
}
type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
type WindowSpace = Workspace WorkspaceId (Layout Window) Window type WindowSpace = Workspace WorkspaceId (Layout Window) Window