From 160a33532745ead1aa485cff0f13e7e055ebb482 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Fri, 2 Nov 2007 03:59:24 +0100 Subject: Float handler out of makeMain, make keys and mouseBindings dependent on XConfig for easy modMask switching darcs-hash:20071102025924-a5988-bbddb07ed8c00cb4279db059f2513eba4ce3ecb5 --- XMonad/DefaultConfig.hs | 18 ++-- XMonad/EventLoop.hs | 253 +++++++++++++++++++++++++----------------------- 2 files changed, 140 insertions(+), 131 deletions(-) (limited to 'XMonad') diff --git a/XMonad/DefaultConfig.hs b/XMonad/DefaultConfig.hs index 3f96f74..bd41696 100644 --- a/XMonad/DefaultConfig.hs +++ b/XMonad/DefaultConfig.hs @@ -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. diff --git a/XMonad/EventLoop.hs b/XMonad/EventLoop.hs index 9bfb588..eba8e9d 100644 --- a/XMonad/EventLoop.hs +++ b/XMonad/EventLoop.hs @@ -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,119 +111,124 @@ 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}) - | t == keyPress = withDisplay $ \dpy -> do - s <- io $ keycodeToKeysym dpy code 0 - mClean <- cleanMask m - userCode $ whenJust (M.lookup (mClean, s) (keys xmc)) id - - -- 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 - - -- 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 - io $ refreshKeyboardMapping e - when (ev_request e == mappingKeyboard) (grabKeys xmc) - - -- handle button release, which may finish dragging. - handle e@(ButtonEvent {ev_event_type = t}) - | t == buttonRelease = do - drag <- gets dragging - case drag of - -- we're done dragging and have released the mouse: - 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 - 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 }) - | 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) - 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}) - | 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}) - | 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 - ws <- gets windowset - wa <- io $ getWindowAttributes dpy w - - if M.member w (floating ws) - || not (member w ws) - then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges - { wc_x = ev_x e - , wc_y = ev_y e - , wc_width = ev_width e - , wc_height = ev_height e - , wc_border_width = fromIntegral (borderWidth xmc) - , wc_sibling = ev_above e - , wc_stack_mode = ev_detail e } - when (member w ws) (float w) - else io $ allocaXEvent $ \ev -> do - setEventType ev configureNotify - setConfigureEvent ev w w - (wa_x wa) (wa_y wa) (wa_width wa) - (wa_height wa) (ev_border_width e) none (wa_override_redirect wa) - 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 - - -- property notify - handle PropertyEvent { ev_event_type = t, ev_atom = a } - | t == propertyNotify && a == wM_NAME = userCode $ logHook xmc - - handle e = broadcastMessage e -- trace (eventName e) -- ignoring + +-- --------------------------------------------------------------------- +-- | 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 + ks <- asks keyActions + userCode $ whenJust (M.lookup (mClean, s) ks) id + +-- 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 + +-- 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 + io $ refreshKeyboardMapping e + when (ev_request e == mappingKeyboard) grabKeys + +-- handle button release, which may finish dragging. +handle e@(ButtonEvent {ev_event_type = t}) + | t == buttonRelease = do + drag <- gets dragging + case drag of + -- we're done dragging and have released the mouse: + 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 + 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 }) + | 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 + 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}) + | 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}) + | 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 + 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 + { wc_x = ev_x e + , wc_y = ev_y e + , wc_width = ev_width e + , wc_height = ev_height e + , wc_border_width = fromIntegral bw + , wc_sibling = ev_above e + , wc_stack_mode = ev_detail e } + when (member w ws) (float w) + else io $ allocaXEvent $ \ev -> do + setEventType ev configureNotify + setConfigureEvent ev w w + (wa_x wa) (wa_y wa) (wa_width wa) + (wa_height wa) (ev_border_width e) none (wa_override_redirect wa) + 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 + +-- 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 -- --------------------------------------------------------------------- @@ -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) -- cgit v1.2.3