Rename XMonad to MetaTile

1 files changed, 0 insertions, 433 deletions

diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
deleted file mode 100644
index 224631c..0000000
--- a/XMonad/Main.hsc
+++ /dev/null
@@ -1,433 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
--- |
--- Module      :  XMonad.Main
--- Copyright   :  (c) Spencer Janssen 2007
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  spencerjanssen@gmail.com
--- Stability   :  unstable
--- Portability :  not portable, uses mtl, X11, posix
---
--- xmonad, a minimalist, tiling window manager for X11
---
------------------------------------------------------------------------------
-
-module XMonad.Main (xmonad) where
-
-import Control.Arrow (second)
-import Data.Bits
-import Data.List ((\\))
-import Data.Function
-import qualified Data.Map as M
-import Control.Monad.Reader
-import Control.Monad.State
-import Data.Maybe (fromMaybe)
-import Data.Monoid (getAll)
-
-import Foreign.C
-import Foreign.Ptr
-
-import System.Environment (getArgs)
-
-import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
-import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xlib.Types (Visual(..))
-
-import XMonad.Core
-import qualified XMonad.Config as Default
-import XMonad.StackSet (new, member)
-import qualified XMonad.StackSet as W
-import XMonad.Operations
-
-import System.IO
-
-------------------------------------------------------------------------
--- Locale support
-
-#include <locale.h>
-
-foreign import ccall unsafe "locale.h setlocale"
-    c_setlocale :: CInt -> Ptr CChar -> IO (Ptr CChar)
-
-------------------------------------------------------------------------
-
--- |
--- The main entry point
---
-xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
-xmonad initxmc = do
-    -- setup locale information from environment
-    withCString "" $ c_setlocale (#const LC_ALL)
-    -- ignore SIGPIPE and SIGCHLD
-    installSignalHandlers
-    -- First, wrap the layout in an existential, to keep things pretty:
-    let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc }
-    dpy   <- openDisplay ""
-    let dflt = defaultScreen dpy
-
-    rootw  <- rootWindow dpy dflt
-
-    args <- getArgs
-
-    when ("--replace" `elem` args) $ replace dpy dflt rootw
-
-    -- If another WM is running, a BadAccess error will be returned.  The
-    -- default error handler will write the exception to stderr and exit with
-    -- an error.
-    selectInput dpy rootw $ rootMask initxmc
-
-    sync dpy False -- sync to ensure all outstanding errors are delivered
-
-    -- turn off the default handler in favor of one that ignores all errors
-    -- (ugly, I know)
-    xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
-
-    xinesc <- getCleanedScreenInfo dpy
-    nbc    <- do v            <- initColor dpy $ normalBorderColor  xmc
-                 ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def
-                 return (fromMaybe nbc_ v)
-
-    fbc    <- do v <- initColor dpy $ focusedBorderColor xmc
-                 ~(Just fbc_)  <- initColor dpy $ focusedBorderColor Default.def
-                 return (fromMaybe fbc_ v)
-
-    hSetBuffering stdout NoBuffering
-
-    let layout = layoutHook xmc
-        lreads = readsLayout layout
-        initialWinset = new layout (workspaces xmc) $ map SD xinesc
-        maybeRead reads' s = case reads' s of
-                                [(x, "")] -> Just x
-                                _         -> Nothing
-
-        winset = fromMaybe initialWinset $ do
-                    ("--resume" : s : _) <- return args
-                    ws                   <- maybeRead reads s
-                    return $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
-        extState = fromMaybe M.empty $ do
-                     ("--resume" : _ : dyns : _) <- return args
-                     vals                        <- maybeRead reads dyns
-                     return . M.fromList . map (second Left) $ vals
-
-        cf = XConf
-            { display       = dpy
-            , config        = xmc
-            , theRoot       = rootw
-            , normalBorder  = nbc
-            , focusedBorder = fbc
-            , keyActions    = keys xmc xmc
-            , buttonActions = mouseBindings xmc xmc
-            , mouseFocused  = False
-            , mousePosition = Nothing
-            , currentEvent  = Nothing }
-
-        st = XState
-            { windowset       = initialWinset
-            , numberlockMask  = 0
-            , windowState     = M.empty
-            , dragging        = Nothing
-            , extensibleState = extState
-            }
-    allocaXEvent $ \e ->
-        runX cf st $ do
-
-            setNumlockMask
-            grabKeys
-            grabButtons
-
-            io $ sync dpy False
-
-            ws <- io $ scan dpy rootw
-
-            -- bootstrap the windowset, Operations.windows will identify all
-            -- the windows in winset as new and set initial properties for
-            -- those windows.  Remove all windows that are no longer top-level
-            -- children of the root, they may have disappeared since
-            -- restarting.
-            windows . const . foldr W.delete winset $ W.allWindows winset \\ ws
-
-            -- manage the as-yet-unmanaged windows
-            mapM_ (\w -> reparent w >> manage w) (ws \\ W.allWindows winset)
-
-            userCode $ startupHook initxmc
-
-            -- main loop, for all you HOF/recursion fans out there.
-            forever $ prehandle =<< io (nextEvent dpy e >> getEvent e)
-
-    return ()
-      where
-        -- if the event gives us the position of the pointer, set mousePosition
-        prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
-                                     return (fromIntegral (ev_x_root e)
-                                            ,fromIntegral (ev_y_root e))
-                      in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
-        evs = [ keyPress, keyRelease, enterNotify, leaveNotify
-              , buttonPress, buttonRelease]
-
-
--- | Runs handleEventHook from the configuration and runs the default handler
--- function if it returned True.
-handleWithHook :: Event -> X ()
-handleWithHook e = do
-  evHook <- asks (handleEventHook . config)
-  whenX (userCodeDef True $ getAll `fmap` evHook e) (handle e)
-
--- ---------------------------------------------------------------------
--- | 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
-        userCodeDef () $ 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
-      reparent w
-      manage w
-
--- window destroyed, unmanage it
--- window gone,      unmanage it
-handle (DestroyWindowEvent {ev_window = w}) = do
-    whenX (isClient w) $
-      unmanage w
-    unparent w
-    modify (\s -> s { windowState = M.delete w (windowState s)})
-
--- 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, ev_event = we} = whenX (isClient w) $ do
-    rootw <- asks theRoot
-    e <- getsWindowState wsWaitingUnmap w
-    if (synthetic || (e == 0 && we /= rootw))
-        then unmanage w >> hideParent w
-        else when (e > 0) $ modifyWindowState (\ws -> ws { wsWaitingUnmap = e - 1 }) w
-
--- set keyboard mapping
-handle e@(MappingNotifyEvent {}) = do
-    io $ refreshKeyboardMapping e
-    when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do
-        setNumlockMask
-        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.
-    dpy <- asks display
-    isr <- isRoot w
-    m <- cleanMask $ ev_state e
-    mact <- asks (M.lookup (m, b) . buttonActions)
-    case mact of
-        Just act | isr -> act $ ev_subwindow e
-        _              -> do
-            focus w
-            ctf <- asks (clickJustFocuses . config)
-            unless ctf $ io (allowEvents dpy replayPointer currentTime)
-    broadcastMessage e -- Always send button events.
-
--- entered a normal window: focus it if focusFollowsMouse is set to
--- True in the user's config.
-handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
-    | t == enterNotify && ev_mode   e == notifyNormal
-    = whenX (asks $ focusFollowsMouse . config) (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
-
-    if 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 = 0
-                    , wc_sibling      = ev_above e
-                    , wc_stack_mode   = ev_detail e }
-        else configureClientWindow w
-    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 event@(PropertyEvent { ev_event_type = t, ev_atom = a })
-    | t == propertyNotify && a == wM_NAME = asks (logHook . config) >>= userCodeDef () >>
-                                         broadcastMessage event
-
-handle e@ClientMessageEvent { ev_message_type = mt } = do
-    a <- getAtom "XMONAD_RESTART"
-    if (mt == a)
-        then restart "xmonad" True
-        else broadcastMessage e
-
-handle e = broadcastMessage e -- trace (eventName e) -- ignoring
-
-
-reparent :: Window -> X ()
-reparent w = withDisplay $ \dpy -> do
-    rootw <- asks theRoot
-    p <- asks normalBorder
-    fMask <- asks (frameMask . config)
-    noFrame <- getsWindowState ((==none) . wsFrame) w
-    when noFrame $ do
-        trace $ "reparent: " ++ show w
-        frame <- io $ allocaSetWindowAttributes $ \swa -> do
-            set_background_pixel swa p
-            set_border_pixel swa p
-            set_event_mask swa fMask
-            set_override_redirect swa True
-            createWindow dpy rootw (-1) (-1) 1 1 0 copyFromParent inputOutput (Visual nullPtr) (cWBackPixel.|.cWBorderPixel.|.cWEventMask.|.cWOverrideRedirect) swa
-        io $ do
-            unmapWindow dpy w
-            addToSaveSet dpy w
-            reparentWindow dpy w frame 0 0
-        modifyWindowState (\ws -> ws { wsFrame = frame }) w
-
-hideParent :: Window -> X ()
-hideParent w = withDisplay $ \dpy -> do
-    frame <- getsWindowState wsFrame w
-    when (frame /= none) $ io $ unmapWindow dpy frame
-
-unparent :: Window -> X ()
-unparent w = withDisplay $ \dpy -> do
-    frame <- getsWindowState wsFrame w
-    when (frame /= none) $ do
-        trace $ "unparent: " ++ show w
-        io $ destroyWindow dpy frame
-        modifyWindowState (\ws -> ws { wsFrame = none }) w
-
--- ---------------------------------------------------------------------
--- IO stuff. Doesn't require any X state
--- Most of these things run only on startup (bar grabkeys)
-
--- | scan for any new windows to manage. If they're already managed,
--- this should be idempotent.
-scan :: Display -> Window -> IO [Window]
-scan dpy rootw = do
-    (_, _, ws) <- queryTree dpy rootw
-    filterM ok ws
-  -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==
-  -- Iconic
-  where ok w = do wa <- getWindowAttributes dpy w
-                  a  <- internAtom dpy "WM_STATE" False
-                  p  <- getWindowProperty32 dpy a w
-                  let ic = case p of
-                            Just (3:_) -> True -- 3 for iconified
-                            _          -> False
-                  return $ not (wa_override_redirect wa)
-                         && (wa_map_state wa == waIsViewable || ic)
-
-setNumlockMask :: X ()
-setNumlockMask = do
-    dpy <- asks display
-    ms <- io $ getModifierMapping dpy
-    xs <- sequence [ do
-                        ks <- io $ keycodeToKeysym dpy kc 0
-                        if ks == xK_Num_Lock
-                            then return (setBit 0 (fromIntegral m))
-                            else return (0 :: KeyMask)
-                        | (m, kcs) <- ms, kc <- kcs, kc /= 0]
-    modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
-
--- | Grab the keys back
-grabKeys :: X ()
-grabKeys = do
-    XConf { display = dpy, theRoot = rootw } <- ask
-    let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
-        (minCode, maxCode) = displayKeycodes dpy
-        allCodes = [fromIntegral minCode .. fromIntegral maxCode]
-    io $ ungrabKey dpy anyKey anyModifier rootw
-    ks <- asks keyActions
-    -- build a map from keysyms to lists of keysyms (doing what
-    -- XGetKeyboardMapping would do if the X11 package bound it)
-    syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
-    let keysymMap = M.fromListWith (++) (zip syms [[code] | code <- allCodes])
-        keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
-    forM_ (M.keys ks) $ \(mask,sym) ->
-         forM_ (keysymToKeycodes sym) $ \kc ->
-              mapM_ (grab kc . (mask .|.)) =<< extraModifiers
-
--- | XXX comment me
-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
-    ba <- asks buttonActions
-    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
-
--- | @replace@ to signals compliant window managers to exit.
-replace :: Display -> ScreenNumber -> Window -> IO ()
-replace dpy dflt rootw = do
-    -- check for other WM
-    wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
-    currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
-    when (currentWmSnOwner /= 0) $ do
-        -- prepare to receive destroyNotify for old WM
-        selectInput dpy currentWmSnOwner structureNotifyMask
-
-        -- create off-screen window
-        netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
-            set_override_redirect attributes True
-            set_event_mask attributes propertyChangeMask
-            let screen = defaultScreenOfDisplay dpy
-                visual = defaultVisualOfScreen screen
-                attrmask = cWOverrideRedirect .|. cWEventMask
-            createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-
-        -- try to acquire wmSnAtom, this should signal the old WM to terminate
-        xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-
-        -- SKIPPED: check if we acquired the selection
-        -- SKIPPED: send client message indicating that we are now the WM
-
-        -- wait for old WM to go away
-        fix $ \again -> do
-            evt <- allocaXEvent $ \event -> do
-                windowEvent dpy currentWmSnOwner structureNotifyMask event
-                get_EventType event
-
-            when (evt /= destroyNotify) again