twin/xmonad
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad.git synced 2025-07-26 17:51:51 -07:00
Code Issues Packages Projects Releases Wiki Activity

Float handler out of makeMain, make keys and mouseBindings dependent on XConfig for easy modMask switching

Browse Source
This commit is contained in:
Spencer Janssen
2007-11-02 02:59:24 +00:00
parent 4996b1bc47
commit 131e060533
3 changed files with 135 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
XMonad.hs
View File

@@ -51,7 +51,12 @@ data XConf = XConf
, config :: !XConfig -- ^ initial user configuration
, theRoot :: !Window -- ^ the root window
, normalBorder :: !Pixel -- ^ border color of unfocused windows
, focusedBorder :: !Pixel } -- ^ border color of the focused window
, focusedBorder :: !Pixel -- ^ border color of the focused window
, keyActions :: !(M.Map (KeyMask, KeySym) (X ()))
-- ^ a mapping of key presses to actions
, buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
-- ^ a mapping of button presses to actions
}
-- todo, better name
data XConfig = XConfig { normalBorderColor :: !String
@@ -61,9 +66,10 @@ data XConfig = XConfig { normalBorderColor :: !String
, manageHook :: !(Window -> String -> String -> String -> X (WindowSet -> WindowSet))
, workspaces :: ![String]
, defaultGaps :: ![(Int,Int,Int,Int)]
, numlockMask :: KeyMask
, keys :: !(M.Map (ButtonMask,KeySym) (X ()))
, mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
, numlockMask :: !KeyMask
, modMask :: !KeyMask
, keys :: !(XConfig -> M.Map (ButtonMask,KeySym) (X ()))
, mouseBindings :: !(XConfig -> M.Map (ButtonMask, Button) (Window -> X ()))
, borderWidth :: !Dimension
, logHook :: !(X ()) }

18
XMonad/DefaultConfig.hs
View File

@@ -50,8 +50,8 @@ workspaces = map show [1 .. 9 :: Int]
-- ("right alt"), which does not conflict with emacs keybindings. The
-- "windows key" is usually mod4Mask.
--
modMask :: KeyMask
modMask = mod1Mask
defaultModMask :: KeyMask
defaultModMask = mod1Mask
-- | The mask for the numlock key. Numlock status is "masked" from the
-- current modifier status, so the keybindings will work with numlock on or
@@ -153,10 +153,10 @@ layout = tiled ||| Mirror tiled ||| Full
--
-- (The comment formatting character is used when generating the manpage)
--
keys :: M.Map (KeyMask, KeySym) (X ())
keys = M.fromList $
keys :: XConfig -> M.Map (KeyMask, KeySym) (X ())
keys conf@(XConfig {modMask = modMask}) = M.fromList $
-- launching and killing programs
[ ((modMask .|. shiftMask, xK_Return), asks (terminal . config) >>= spawn) -- %! Launch terminal
[ ((modMask .|. shiftMask, xK_Return), spawn $ terminal conf) -- %! 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
@@ -189,8 +189,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 ), do gs <- asks (defaultGaps . config)
modifyGap (\i n -> let x = (gs ++ 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 conf ++ 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
@@ -215,8 +214,8 @@ keys = M.fromList $
-- | Mouse bindings: default actions bound to mouse events
--
mouseBindings :: M.Map (KeyMask, Button) (Window -> X ())
mouseBindings = M.fromList $
mouseBindings :: XConfig -> M.Map (KeyMask, Button) (Window -> X ())
mouseBindings (XConfig {modMask = modMask}) = M.fromList $
-- mod-button1 %! Set the window to floating mode and move by dragging
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
-- mod-button2 %! Raise the window to the top of the stack
@@ -245,6 +244,7 @@ defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixel
, normalBorderColor = "#dddddd" -- Border color for unfocused windows.
, focusedBorderColor = "#ff0000" -- Border color for focused windows.
, XMonad.numlockMask = numlockMask
, modMask = defaultModMask
, XMonad.keys = XMonad.DefaultConfig.keys
, XMonad.mouseBindings = XMonad.DefaultConfig.mouseBindings
-- | Perform an arbitrary action on each internal state change or X event.

117
XMonad/EventLoop.hs
View File

@@ -71,7 +71,9 @@ makeMain xmc = do
, config = xmc
, theRoot = rootw
, normalBorder = nbc
, focusedBorder = fbc }
, focusedBorder = fbc
, keyActions = keys xmc xmc
, buttonActions = mouseBindings xmc xmc }
st = XState
{ windowset = initialWinset
, mapped = S.empty
@@ -88,8 +90,8 @@ makeMain xmc = do
allocaXEvent $ \e ->
runX cf st $ do
grabKeys xmc
grabButtons xmc
grabKeys
grabButtons
io $ sync dpy False
@@ -109,51 +111,53 @@ makeMain xmc = do
return ()
where forever_ a = a >> forever_ a
-- ---------------------------------------------------------------------
-- | Event handler. Map X events onto calls into Operations.hs, which
-- modify our internal model of the window manager state.
--
-- Events dwm handles that we don't:
--
-- [ButtonPress] = buttonpress,
-- [Expose] = expose,
-- [PropertyNotify] = propertynotify,
--
handle :: Event -> X ()
-- run window manager command
handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
-- ---------------------------------------------------------------------
-- | Event handler. Map X events onto calls into Operations.hs, which
-- modify our internal model of the window manager state.
--
-- Events dwm handles that we don't:
--
-- [ButtonPress] = buttonpress,
-- [Expose] = expose,
-- [PropertyNotify] = propertynotify,
--
handle :: Event -> X ()
-- run window manager command
handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
| t == keyPress = withDisplay $ \dpy -> do
s <- io $ keycodeToKeysym dpy code 0
mClean <- cleanMask m
userCode $ whenJust (M.lookup (mClean, s) (keys xmc)) id
ks <- asks keyActions
userCode $ whenJust (M.lookup (mClean, s) ks) id
-- manage a new window
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
-- manage a new window
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
wa <- io $ getWindowAttributes dpy w -- ignore override windows
-- need to ignore mapping requests by managed windows not on the current workspace
managed <- isClient w
when (not (wa_override_redirect wa) && not managed) $ do manage w
-- window destroyed, unmanage it
-- window gone, unmanage it
handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w
-- window destroyed, unmanage it
-- window gone, unmanage it
handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w
-- We track expected unmap events in waitingUnmap. We ignore this event unless
-- it is synthetic or we are not expecting an unmap notification from a window.
handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
-- We track expected unmap events in waitingUnmap. We ignore this event unless
-- it is synthetic or we are not expecting an unmap notification from a window.
handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
if (synthetic || e == 0)
then unmanage w
else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) })
-- set keyboard mapping
handle e@(MappingNotifyEvent {}) = do
-- set keyboard mapping
handle e@(MappingNotifyEvent {}) = do
io $ refreshKeyboardMapping e
when (ev_request e == mappingKeyboard) (grabKeys xmc)
when (ev_request e == mappingKeyboard) grabKeys
-- handle button release, which may finish dragging.
handle e@(ButtonEvent {ev_event_type = t})
-- handle button release, which may finish dragging.
handle e@(ButtonEvent {ev_event_type = t})
| t == buttonRelease = do
drag <- gets dragging
case drag of
@@ -161,40 +165,43 @@ makeMain xmc = do
Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f
Nothing -> broadcastMessage e
-- handle motionNotify event, which may mean we are dragging.
handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do
-- handle motionNotify event, which may mean we are dragging.
handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do
drag <- gets dragging
case drag of
Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging
Nothing -> broadcastMessage e
-- click on an unfocused window, makes it focused on this workspace
handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
-- click on an unfocused window, makes it focused on this workspace
handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
| t == buttonPress = do
-- If it's the root window, then it's something we
-- grabbed in grabButtons. Otherwise, it's click-to-focus.
isr <- isRoot w
m <- cleanMask $ ev_state e
if isr then userCode $ whenJust (M.lookup (m, b) $ mouseBindings xmc) ($ ev_subwindow e)
ba <- asks buttonActions
if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e)
else focus w
sendMessage e -- Always send button events.
-- entered a normal window, makes this focused.
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
-- entered a normal window, makes this focused.
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
| t == enterNotify && ev_mode e == notifyNormal
&& ev_detail e /= notifyInferior = focus w
-- left a window, check if we need to focus root
handle e@(CrossingEvent {ev_event_type = t})
-- left a window, check if we need to focus root
handle e@(CrossingEvent {ev_event_type = t})
| t == leaveNotify
= do rootw <- asks theRoot
when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw
-- configure a window
handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
-- configure a window
handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
ws <- gets windowset
wa <- io $ getWindowAttributes dpy w
bw <- asks (borderWidth . config)
if M.member w (floating ws)
|| not (member w ws)
then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
@@ -202,7 +209,7 @@ makeMain xmc = do
, wc_y = ev_y e
, wc_width = ev_width e
, wc_height = ev_height e
, wc_border_width = fromIntegral (borderWidth xmc)
, wc_border_width = fromIntegral bw
, wc_sibling = ev_above e
, wc_stack_mode = ev_detail e }
when (member w ws) (float w)
@@ -214,14 +221,14 @@ makeMain xmc = do
sendEvent dpy w False 0 ev
io $ sync dpy False
-- configuration changes in the root may mean display settings have changed
handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
-- configuration changes in the root may mean display settings have changed
handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
-- property notify
handle PropertyEvent { ev_event_type = t, ev_atom = a }
| t == propertyNotify && a == wM_NAME = userCode $ logHook xmc
-- property notify
handle PropertyEvent { ev_event_type = t, ev_atom = a }
| t == propertyNotify && a == wM_NAME = userCode =<< asks (logHook . config)
handle e = broadcastMessage e -- trace (eventName e) -- ignoring
handle e = broadcastMessage e -- trace (eventName e) -- ignoring
-- ---------------------------------------------------------------------
@@ -246,23 +253,25 @@ scan dpy rootw = do
&& (wa_map_state wa == waIsViewable || ic)
-- | Grab the keys back
grabKeys :: XConfig -> X ()
grabKeys xmc = do
grabKeys :: X ()
grabKeys = 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 xmc) $ \(mask,sym) -> do
ks <- asks keyActions
forM_ (M.keys ks) $ \(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 :: XConfig -> X ()
grabButtons xmc = do
grabButtons :: X ()
grabButtons = 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
ems <- extraModifiers
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ mouseBindings xmc)
ba <- asks buttonActions
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)