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

cleaner version of main/config inversion.

Browse Source
This commit is contained in:
David Roundy 2007-10-29 18:48:23 +00:00
parent d679ceb234
commit 48ccbc7fb2
5 changed files with 82 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
EventLoop.hs
View File

@ -12,7 +12,7 @@
--
-----------------------------------------------------------------------------
module EventLoop ( makeMain ) where
module EventLoop ( makeMain, XMonadConfig(..) ) where
import Data.Bits
import qualified Data.Map as M
@ -27,32 +27,42 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama (getScreenInfo)
import XMonad
import XMonad hiding ( logHook, borderWidth )
import qualified XMonad ( logHook, borderWidth )
import StackSet (new, floating, member)
import qualified StackSet as W
import Operations
import System.IO
data XMonadConfig l = 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
--
makeMain :: String -> String -> Layout Window -> [String] -> [(Int,Int,Int,Int)]
-> M.Map (ButtonMask,KeySym) (X ()) -> M.Map (ButtonMask, Button) (Window -> X ())
-> Dimension -> X () -> IO ()
makeMain normalBorderColor focusedBorderColor layoutHook workspaces
defaultGaps keys mouseBindings borderWidth logHook = do
makeMain :: LayoutClass l Window => XMonadConfig l -> IO ()
makeMain xmc = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
xinesc <- getScreenInfo dpy
nbc <- initColor dpy normalBorderColor
fbc <- initColor dpy focusedBorderColor
nbc <- initColor dpy $ normalBorderColor xmc
fbc <- initColor dpy $ focusedBorderColor xmc
hSetBuffering stdout NoBuffering
args <- getArgs
let initialWinset = new layoutHook workspaces $ zipWith SD xinesc gaps
let initialWinset = new (Layout $ layoutHook xmc) (workspaces xmc) $ zipWith SD xinesc gaps
maybeRead s = case reads s of
[(x, "")] -> Just x
@ -61,13 +71,16 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
winset = fromMaybe initialWinset $ do
("--resume" : s : _) <- return args
ws <- maybeRead s
return . W.ensureTags layoutHook workspaces
$ W.mapLayout (fromMaybe layoutHook . maybeRead) ws
return . W.ensureTags (Layout $ layoutHook xmc) (workspaces xmc)
$ W.mapLayout (fromMaybe (Layout $ layoutHook xmc) . maybeRead) ws
gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0)
cf = XConf
{ display = dpy
, XMonad.logHook = logHook xmc
, XMonad.borderWidth = borderWidth xmc
, terminal = defaultTerminal xmc
, theRoot = rootw
, normalBorder = nbc
, focusedBorder = fbc }
@ -87,8 +100,8 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
allocaXEvent $ \e ->
runX cf st $ do
grabKeys keys
grabButtons mouseBindings
grabKeys xmc
grabButtons xmc
io $ sync dpy False
@ -124,7 +137,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
| t == keyPress = withDisplay $ \dpy -> do
s <- io $ keycodeToKeysym dpy code 0
userCode $ whenJust (M.lookup (cleanMask m,s) keys) id
userCode $ whenJust (M.lookup (cleanMask m,s) (keys xmc)) id
-- manage a new window
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
@ -148,7 +161,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
-- set keyboard mapping
handle e@(MappingNotifyEvent {}) = do
io $ refreshKeyboardMapping e
when (ev_request e == mappingKeyboard) (grabKeys keys)
when (ev_request e == mappingKeyboard) (grabKeys xmc)
-- handle button release, which may finish dragging.
handle e@(ButtonEvent {ev_event_type = t})
@ -172,7 +185,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
-- If it's the root window, then it's something we
-- grabbed in grabButtons. Otherwise, it's click-to-focus.
isr <- isRoot w
if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e)
if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) $ mouseBindings xmc) ($ ev_subwindow e)
else focus w
sendMessage e -- Always send button events.
@ -199,7 +212,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
, wc_y = ev_y e
, wc_width = ev_width e
, wc_height = ev_height e
, wc_border_width = fromIntegral borderWidth
, wc_border_width = fromIntegral (borderWidth xmc)
, wc_sibling = ev_above e
, wc_stack_mode = ev_detail e }
when (member w ws) (float w)
@ -216,7 +229,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
-- property notify
handle PropertyEvent { ev_event_type = t, ev_atom = a }
| t == propertyNotify && a == wM_NAME = userCode logHook
| t == propertyNotify && a == wM_NAME = userCode $ logHook xmc
handle e = broadcastMessage e -- trace (eventName e) -- ignoring
@ -243,22 +256,22 @@ scan dpy rootw = do
&& (wa_map_state wa == waIsViewable || ic)
-- | Grab the keys back
grabKeys :: M.Map (ButtonMask,KeySym) (X ()) -> X ()
grabKeys keys = do
grabKeys :: XMonadConfig l -> X ()
grabKeys xmc = do
XConf { display = dpy, theRoot = rootw } <- ask
let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
io $ ungrabKey dpy anyKey anyModifier rootw
forM_ (M.keys keys) $ \(mask,sym) -> do
forM_ (M.keys $ keys xmc) $ \(mask,sym) -> do
kc <- io $ keysymToKeycode dpy sym
-- "If the specified KeySym is not defined for any KeyCode,
-- XKeysymToKeycode() returns zero."
when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
-- | XXX comment me
grabButtons :: M.Map (ButtonMask, Button) (Window -> X ()) -> X ()
grabButtons mouseBindings = do
grabButtons :: XMonadConfig l -> X ()
grabButtons xmc = do
XConf { display = dpy, theRoot = rootw } <- ask
let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask
grabModeAsync grabModeSync none none
io $ ungrabButton dpy anyButton anyModifier rootw
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys mouseBindings)
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys $ mouseBindings xmc)

83
Main.hs
View File

@ -19,7 +19,8 @@ module Main where
--
-- Useful imports
--
import XMonad
import Control.Monad.Reader ( asks )
import XMonad hiding ( logHook, borderWidth )
import Operations
import qualified StackSet as W
import Data.Ratio
@ -27,7 +28,8 @@ import Data.Bits ((.|.))
import qualified Data.Map as M
import System.Exit
import Graphics.X11.Xlib
import EventLoop
import EventLoop hiding ( workspaces )
import qualified EventLoop ( workspaces )
-- % Extension-provided imports
@ -67,17 +69,6 @@ modMask = mod1Mask
numlockMask :: KeyMask
numlockMask = mod2Mask
-- | Width of the window border in pixels.
--
borderWidth :: Dimension
borderWidth = 1
-- | Border colors for unfocused and focused windows, respectively.
--
normalBorderColor, focusedBorderColor :: String
normalBorderColor = "#dddddd"
focusedBorderColor = "#ff0000"
-- | Default offset of drawable screen boundaries from each physical
-- screen. Anything non-zero here will leave a gap of that many pixels
-- on the given edge, on the that screen. A useful gap at top of screen
@ -90,8 +81,8 @@ focusedBorderColor = "#ff0000"
--
-- Fields are: top, bottom, left, right.
--
defaultGaps :: [(Int,Int,Int,Int)]
defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
--defaultGaps :: [(Int,Int,Int,Int)]
------------------------------------------------------------------------
-- Window rules
@ -158,42 +149,15 @@ layouts = [ Layout tiled
-- Percent of screen to increment by when resizing panes
delta = 3%100
-- | 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'
-- above, but you may program your own selection behaviour here. Layout
-- transformers, for example, would be hooked in here.
--
layoutHook :: Layout Window
layoutHook = Layout $ Select layouts
-- | Register with xmonad a list of layouts whose state we can preserve over restarts.
-- There is typically no need to modify this list, the defaults are fine.
--
serialisedLayouts :: [Layout Window]
serialisedLayouts = layoutHook : layouts
------------------------------------------------------------------------
-- Logging
-- | Perform an arbitrary action on each internal state change or X event.
-- Examples include:
-- * do nothing
-- * log the state to stdout
--
-- See the 'DynamicLog' extension for examples.
--
logHook :: X ()
logHook = return ()
serialisedLayouts = Layout (layoutHook defaultConfig) : layouts
------------------------------------------------------------------------
-- Key bindings:
-- | The preferred terminal program, which is used in a binding below and by
-- certain contrib modules.
terminal :: String
terminal = "xterm"
-- | The xmonad key bindings. Add, modify or remove key bindings here.
--
-- (The comment formatting character is used when generating the manpage)
@ -201,13 +165,13 @@ terminal = "xterm"
keys :: M.Map (KeyMask, KeySym) (X ())
keys = M.fromList $
-- launching and killing programs
[ ((modMask .|. shiftMask, xK_Return), spawn terminal) -- %! Launch terminal
[ ((modMask .|. shiftMask, xK_Return), asks terminal >>= spawn) -- %! Launch terminal
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
, ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun
, ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window
, ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
, ((modMask .|. shiftMask, xK_space ), setLayout layoutHook) -- %! Reset the layouts on the current workspace to default
, ((modMask .|. shiftMask, xK_space ), setLayout $ layoutHook defaultConfig) -- %! Reset the layouts on the current workspace to default
, ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size
@ -234,7 +198,7 @@ keys = M.fromList $
, ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
-- toggle the status bar gap
, ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
, ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps defaultConfig ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
-- quit, or restart
, ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
@ -274,9 +238,32 @@ mouseBindings = M.fromList $
-- % Extension-provided definitions
defaultConfig :: XMonadConfig Select
defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in pixels.
, EventLoop.workspaces = workspaces
, defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
-- | 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'
-- above, but you may program your own selection behaviour here. Layout
-- transformers, for example, would be hooked in here.
--
, layoutHook = Select layouts
, defaultTerminal = "xterm" -- The preferred terminal program.
, normalBorderColor = "#dddddd" -- Border color for unfocused windows.
, focusedBorderColor = "#ff0000" -- Border color for focused windows.
, EventLoop.keys = Main.keys
, EventLoop.mouseBindings = Main.mouseBindings
-- | Perform an arbitrary action on each internal state change or X event.
-- Examples include:
-- * do nothing
-- * log the state to stdout
--
-- See the 'DynamicLog' extension for examples.
, logHook = return ()
}
-- % The main function
main :: IO ()
main = makeMain normalBorderColor focusedBorderColor layoutHook workspaces
defaultGaps keys mouseBindings borderWidth logHook
main = makeMain defaultConfig

4
Main.hs-boot
View File

@ -1,11 +1,7 @@
module Main where
import Graphics.X11.Xlib.Types (Dimension)
import Graphics.X11.Xlib (KeyMask,Window)
import XMonad
borderWidth :: Dimension
numlockMask :: KeyMask
workspaces :: [WorkspaceId]
logHook :: X ()
manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)
serialisedLayouts :: [Layout Window]
terminal :: String

9
Operations.hs
View File

@ -37,7 +37,7 @@ import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo)
import Graphics.X11.Xlib.Extras
import {-# SOURCE #-} Main (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts)
import {-# SOURCE #-} Main (manageHook,numlockMask,serialisedLayouts)
-- ---------------------------------------------------------------------
-- |
@ -170,7 +170,7 @@ windows f = do
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
setTopFocus
userCode logHook
asks logHook >>= userCode
-- io performGC -- really helps, but seems to trigger GC bugs?
-- hide every window that was potentially visible before, but is not
@ -214,7 +214,8 @@ setInitialProperties :: Window -> X ()
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
setWMState w iconicState
io $ selectInput d w $ clientMask
io $ setWindowBorderWidth d w borderWidth
bw <- asks borderWidth
io $ setWindowBorderWidth d w bw
-- we must initially set the color of new windows, to maintain invariants
-- required by the border setting in 'windows'
io $ setWindowBorder d w nb
@ -543,11 +544,11 @@ floatLocation :: Window -> X (ScreenId, W.RationalRect)
floatLocation w = withDisplay $ \d -> do
ws <- gets windowset
wa <- io $ getWindowAttributes d w
bw <- fi `fmap` asks borderWidth
-- XXX horrible
let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws
sr = screenRect . W.screenDetail $ sc
bw = fi borderWidth
rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
(fi (wa_width wa + bw*2) % fi (rect_width sr))

3
XMonad.hs
View File

@ -50,7 +50,10 @@ data XState = XState
, dragging :: !(Maybe (Position -> Position -> X (), X ())) }
data XConf = XConf
{ display :: Display -- ^ the X11 display
, logHook :: !(X ()) -- ^ the loghook function
, terminal :: !String -- ^ the user's preferred terminal
, theRoot :: !Window -- ^ the root window
, borderWidth :: !Dimension -- ^ the preferred border width
, normalBorder :: !Pixel -- ^ border color of unfocused windows
, focusedBorder :: !Pixel } -- ^ border color of the focused window