summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2013-09-11 19:14:25 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2013-09-11 19:14:25 +0200
commiteb5addb90f58ed0aa7e6f504fa2c960dd8228b1e (patch)
tree26ff1cc8b287979cd6a3c2deee315ef993bf4eab
parentccbc4c12236407083f3a3ebcd2d53be762f35eb5 (diff)
downloadmetatile-eb5addb90f58ed0aa7e6f504fa2c960dd8228b1e.tar
metatile-eb5addb90f58ed0aa7e6f504fa2c960dd8228b1e.zip
Rename XMonad to MetaTile
-rw-r--r--Main.hs32
-rw-r--r--MetaTile.hs (renamed from XMonad.hs)30
-rw-r--r--MetaTile/Config.hs (renamed from XMonad/Config.hs)74
-rw-r--r--MetaTile/Core.hs (renamed from XMonad/Core.hs)42
-rw-r--r--MetaTile/Layout.hs (renamed from XMonad/Layout.hs)8
-rw-r--r--MetaTile/Main.hsc (renamed from XMonad/Main.hsc)22
-rw-r--r--MetaTile/ManageHook.hs (renamed from XMonad/ManageHook.hs)10
-rw-r--r--MetaTile/Operations.hs (renamed from XMonad/Operations.hs)10
-rw-r--r--MetaTile/StackSet.hs (renamed from XMonad/StackSet.hs)6
-rw-r--r--metatile.cabal (renamed from xmonad.cabal)49
10 files changed, 137 insertions, 146 deletions
diff --git a/Main.hs b/Main.hs
index 1e634d1..6aba89f 100644
--- a/Main.hs
+++ b/Main.hs
@@ -8,13 +8,13 @@
-- Stability : unstable
-- Portability : not portable, uses mtl, X11, posix
--
--- xmonad, a minimalist, tiling window manager for X11
+-- metatile, a minimalist, tiling window manager for X11
--
-----------------------------------------------------------------------------
module Main (main) where
-import XMonad
+import MetaTile
import Control.Monad (unless)
import System.Info
@@ -22,7 +22,7 @@ import System.Environment
import System.Posix.Process (executeFile)
import System.Exit (exitFailure)
-import Paths_xmonad (version)
+import Paths_metatile (version)
import Data.Version (showVersion)
import Graphics.X11.Xinerama (compiledWithXinerama)
@@ -31,13 +31,13 @@ import Graphics.X11.Xinerama (compiledWithXinerama)
import qualified Properties
#endif
--- | The entry point into xmonad. Attempts to compile any custom main
--- for xmonad, and if it doesn't find one, just launches the default.
+-- | The entry point into metatile. Attempts to compile any custom main
+-- for metatile, and if it doesn't find one, just launches the default.
main :: IO ()
main = do
installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
args <- getArgs
- let launch = xmonad def
+ let launch = metatile def
case args of
[] -> launch
("--resume":_) -> launch
@@ -52,7 +52,7 @@ main = do
#endif
_ -> fail "unrecognized flags"
where
- shortVersion = ["xmonad", showVersion version]
+ shortVersion = ["metatile", showVersion version]
longVersion = [ "compiled by", compilerName, showVersion compilerVersion
, "for", arch ++ "-" ++ os
, "\nXinerama:", show compiledWithXinerama ]
@@ -65,36 +65,36 @@ usage = do
"Options:" :
" --help Print this message" :
" --version Print the version number" :
- " --recompile Recompile your ~/.xmonad/xmonad.hs" :
- " --replace Replace the running window manager with xmonad" :
- " --restart Request a running xmonad process to restart" :
+ " --recompile Recompile your ~/.metatile/metatile.hs" :
+ " --replace Replace the running window manager with metatile" :
+ " --restart Request a running metatile process to restart" :
#ifdef TESTING
" --run-tests Run the test suite" :
#endif
[]
--- | Build "~\/.xmonad\/xmonad.hs" with ghc, then execute it. If there are no
+-- | Build "~\/.metatile\/metatile.hs" with ghc, then execute it. If there are no
-- errors, this function does not return. An exception is raised in any of
-- these cases:
--
-- * ghc missing
--
--- * both "~\/.xmonad\/xmonad.hs" and "~\/.xmonad\/xmonad-$arch-$os" missing
+-- * both "~\/.metatile\/metatile.hs" and "~\/.metatile\/metatile-$arch-$os" missing
--
--- * xmonad.hs fails to compile
+-- * metatile.hs fails to compile
--
-- ** wrong ghc in path (fails to compile)
--
-- ** type error, syntax error, ..
--
--- * Missing XMonad\/XMonadContrib modules due to ghc upgrade
+-- * Missing MetaTile\/MetaTileContrib modules due to ghc upgrade
--
buildLaunch :: IO ()
buildLaunch = do
recompile False
- dir <- getXMonadDir
+ dir <- getMetaTileDir
args <- getArgs
- executeFile (dir ++ "/xmonad-"++arch++"-"++os) False args Nothing
+ executeFile (dir ++ "/metatile-"++arch++"-"++os) False args Nothing
return ()
sendRestart :: IO ()
diff --git a/XMonad.hs b/MetaTile.hs
index c1fc5dc..9da613e 100644
--- a/XMonad.hs
+++ b/MetaTile.hs
@@ -1,6 +1,6 @@
--------------------------------------------------------------------
-- |
--- Module : XMonad
+-- Module : MetaTile
-- Copyright : (c) Don Stewart
-- License : BSD3
--
@@ -12,14 +12,14 @@
--
-- Useful exports for configuration files.
-module XMonad (
+module MetaTile (
- module XMonad.Main,
- module XMonad.Core,
- module XMonad.Config,
- module XMonad.Layout,
- module XMonad.ManageHook,
- module XMonad.Operations,
+ module MetaTile.Main,
+ module MetaTile.Core,
+ module MetaTile.Config,
+ module MetaTile.Layout,
+ module MetaTile.ManageHook,
+ module MetaTile.Operations,
module Graphics.X11,
module Graphics.X11.Xlib.Extras,
(.|.),
@@ -30,13 +30,13 @@ module XMonad (
) where
-- core modules
-import XMonad.Main
-import XMonad.Core
-import XMonad.Config
-import XMonad.Layout
-import XMonad.ManageHook
-import XMonad.Operations
--- import XMonad.StackSet -- conflicts with 'workspaces' defined in XMonad.hs
+import MetaTile.Main
+import MetaTile.Core
+import MetaTile.Config
+import MetaTile.Layout
+import MetaTile.ManageHook
+import MetaTile.Operations
+-- import MetaTile.StackSet -- conflicts with 'workspaces' defined in MetaTile.hs
-- modules needed to get basic configuration working
import Data.Bits
diff --git a/XMonad/Config.hs b/MetaTile/Config.hs
index 1405fd1..71706d8 100644
--- a/XMonad/Config.hs
+++ b/MetaTile/Config.hs
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
--- Module : XMonad.Config
+-- Module : MetaTile.Config
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
@@ -13,30 +13,30 @@
-- This module specifies the default configuration values for xmonad.
--
-- DO NOT MODIFY THIS FILE! It won't work. You may configure xmonad
--- by providing your own @~\/.xmonad\/xmonad.hs@ that overrides
+-- by providing your own @~\/.metatile\/metatile.hs@ that overrides
-- specific fields in the default config, 'def'. For a starting point, you can
--- copy the @xmonad.hs@ found in the @man@ directory, or look at
+-- copy the @metatile.hs@ found in the @man@ directory, or look at
-- examples on the xmonad wiki.
--
------------------------------------------------------------------------
-module XMonad.Config (defaultConfig, Default(..)) where
+module MetaTile.Config (defaultConfig, Default(..)) where
--
-- Useful imports
--
-import XMonad.Core as XMonad hiding
+import MetaTile.Core as MetaTile hiding
(workspaces,manageHook,keys,logHook,startupHook,mouseBindings
,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
,handleEventHook,clickJustFocuses,rootMask,frameMask,clientMask)
-import qualified XMonad.Core as XMonad
+import qualified MetaTile.Core as MetaTile
(workspaces,manageHook,keys,logHook,startupHook,mouseBindings
,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
,handleEventHook,clickJustFocuses,rootMask,frameMask,clientMask)
-import XMonad.Layout
-import XMonad.Operations
-import qualified XMonad.StackSet as W
+import MetaTile.Layout
+import MetaTile.Operations
+import qualified MetaTile.StackSet as W
import Data.Bits ((.|.))
import Data.Default
import Data.Monoid
@@ -181,15 +181,15 @@ clickJustFocuses = True
-- (The comment formatting character is used when generating the manpage)
--
keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
-keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
+keys conf@(XConfig {MetaTile.modMask = modMask}) = M.fromList $
-- launching and killing programs
- [ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
+ [ ((modMask .|. shiftMask, xK_Return), spawn $ MetaTile.terminal conf) -- %! Launch terminal
, ((modMask, xK_p ), spawn "dmenu_run") -- %! 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 $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default
+ , ((modMask .|. shiftMask, xK_space ), setLayout $ MetaTile.layoutHook conf) -- %! Reset the layouts on the current workspace to default
, ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size
@@ -214,8 +214,8 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
, ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
-- quit, or restart
- , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
- , ((modMask , xK_q ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi") -- %! Restart xmonad
+ , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit metatile
+ , ((modMask , xK_q ), spawn "if type metatile; then metatile --recompile && metatile --restart; else xmessage metatile not in \\$PATH: \"$PATH\"; fi") -- %! Restart metatile
, ((modMask .|. shiftMask, xK_slash ), spawn ("echo \"" ++ help ++ "\" | xmessage -file -")) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
-- repeat the binding for non-American layout keyboards
@@ -225,7 +225,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
-- mod-[1..9] %! Switch to workspace N
-- mod-shift-[1..9] %! Move client to workspace N
[((m .|. modMask, k), windows $ f i)
- | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
+ | (i, k) <- zip (MetaTile.workspaces conf) [xK_1 .. xK_9]
, (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
++
-- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
@@ -236,7 +236,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
-- | Mouse bindings: default actions bound to mouse events
mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
-mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList
+mouseBindings (XConfig {MetaTile.modMask = modMask}) = M.fromList
-- mod-button2 %! Raise the window to the top of the stack
[ ((modMask, button2), windows . (W.shiftMaster .) . W.focusWindow)
-- you may also bind events to the mouse scroll wheel (button4 and button5)
@@ -244,28 +244,28 @@ mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList
instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) where
def = XConfig
- { XMonad.workspaces = workspaces
- , XMonad.layoutHook = layout
- , XMonad.terminal = terminal
- , XMonad.normalBorderColor = normalBorderColor
- , XMonad.focusedBorderColor = focusedBorderColor
- , XMonad.defaultBorderWidth = defaultBorderWidth
- , XMonad.modMask = defaultModMask
- , XMonad.keys = keys
- , XMonad.logHook = logHook
- , XMonad.startupHook = startupHook
- , XMonad.mouseBindings = mouseBindings
- , XMonad.manageHook = manageHook
- , XMonad.handleEventHook = handleEventHook
- , XMonad.focusFollowsMouse = focusFollowsMouse
- , XMonad.clickJustFocuses = clickJustFocuses
- , XMonad.clientMask = clientMask
- , XMonad.frameMask = frameMask
- , XMonad.rootMask = rootMask
+ { MetaTile.workspaces = workspaces
+ , MetaTile.layoutHook = layout
+ , MetaTile.terminal = terminal
+ , MetaTile.normalBorderColor = normalBorderColor
+ , MetaTile.focusedBorderColor = focusedBorderColor
+ , MetaTile.defaultBorderWidth = defaultBorderWidth
+ , MetaTile.modMask = defaultModMask
+ , MetaTile.keys = keys
+ , MetaTile.logHook = logHook
+ , MetaTile.startupHook = startupHook
+ , MetaTile.mouseBindings = mouseBindings
+ , MetaTile.manageHook = manageHook
+ , MetaTile.handleEventHook = handleEventHook
+ , MetaTile.focusFollowsMouse = focusFollowsMouse
+ , MetaTile.clickJustFocuses = clickJustFocuses
+ , MetaTile.clientMask = clientMask
+ , MetaTile.frameMask = frameMask
+ , MetaTile.rootMask = rootMask
}
-- | The default set of configuration values itself
-{-# DEPRECATED defaultConfig "Use def (from Data.Default, and re-exported by XMonad and XMonad.Config) instead." #-}
+{-# DEPRECATED defaultConfig "Use def (from Data.Default, and re-exported by MetaTile and MetaTile.Config) instead." #-}
defaultConfig :: XConfig (Choose Tall (Choose (Mirror Tall) Full))
defaultConfig = def
@@ -306,8 +306,8 @@ help = unlines ["The default modifier key is 'alt'. Default keybindings:",
"mod-period (mod-.) Deincrement the number of windows in the master area",
"",
"-- quit, or restart",
- "mod-Shift-q Quit xmonad",
- "mod-q Restart xmonad",
+ "mod-Shift-q Quit metatile",
+ "mod-q Restart metatile",
"mod-[1..9] Switch to workSpace N",
"",
"-- Workspaces & screens",
diff --git a/XMonad/Core.hs b/MetaTile/Core.hs
index 18ca213..14c4211 100644
--- a/XMonad/Core.hs
+++ b/MetaTile/Core.hs
@@ -3,7 +3,7 @@
-----------------------------------------------------------------------------
-- |
--- Module : XMonad.Core
+-- Module : MetaTile.Core
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
@@ -16,7 +16,7 @@
--
-----------------------------------------------------------------------------
-module XMonad.Core (
+module MetaTile.Core (
X, WindowSet, WindowSpace, WorkspaceId, BorderWidth(..), WindowState(..),
ScreenId(..), ScreenDetail(..), XState(..),
XConf(..), XConfig(..), LayoutClass(..),
@@ -25,11 +25,11 @@ module XMonad.Core (
StateExtension(..), ExtensionClass(..),
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces, getWindowState, getsWindowState, setWindowState, modifyWindowState,
- getAtom, spawn, spawnPID, xfork, getXMonadDir, recompile, trace, whenJust, whenX,
+ getAtom, spawn, spawnPID, xfork, getMetaTileDir, recompile, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery
) where
-import XMonad.StackSet hiding (modify)
+import MetaTile.StackSet hiding (modify)
import Prelude hiding ( catch )
import Codec.Binary.UTF8.String (encodeString)
@@ -87,7 +87,7 @@ data XState = XState
, extensibleState :: !(M.Map String (Either String StateExtension))
-- ^ stores custom state information.
--
- -- The module "XMonad.Utils.ExtensibleState" in xmonad-contrib
+ -- The module "MetaTile.Utils.ExtensibleState" in xmonad-contrib
-- provides additional information and a simple interface for using this.
}
@@ -301,7 +301,7 @@ class Show (layout a) => LayoutClass layout a where
-- instances of 'LayoutClass' probably do not need to implement
-- 'runLayout'; it is only useful for layouts which wish to make
-- use of more of the 'Workspace' information (for example,
- -- "XMonad.Layout.PerWorkspace").
+ -- "MetaTile.Layout.PerWorkspace").
runLayout :: Workspace WorkspaceId (layout a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (layout a))
@@ -474,24 +474,24 @@ runOnWorkspaces job = do
w':ws' <- mapM job (w:ws)
return scr { screenWorkspace = w', screenHidden = ws' }
--- | Return the path to @~\/.xmonad@.
-getXMonadDir :: MonadIO m => m String
-getXMonadDir = io $ getAppUserDataDirectory "xmonad"
+-- | Return the path to @~\/.metatile@.
+getMetaTileDir :: MonadIO m => m String
+getMetaTileDir = io $ getAppUserDataDirectory "metatile"
--- | 'recompile force', recompile @~\/.xmonad\/xmonad.hs@ when any of the
+-- | 'recompile force', recompile @~\/.metatile\/metatile.hs@ when any of the
-- following apply:
--
-- * force is 'True'
--
--- * the xmonad executable does not exist
+-- * the metatile executable does not exist
--
--- * the xmonad executable is older than xmonad.hs or any file in
--- ~\/.xmonad\/lib
+-- * the metatile executable is older than metatile.hs or any file in
+-- ~\/.metatile\/lib
--
--- The -i flag is used to restrict recompilation to the xmonad.hs file only,
--- and any files in the ~\/.xmonad\/lib directory.
+-- The -i flag is used to restrict recompilation to the metatile.hs file only,
+-- and any files in the ~\/.metatile\/lib directory.
--
--- Compilation errors (if any) are logged to ~\/.xmonad\/xmonad.errors. If
+-- Compilation errors (if any) are logged to ~\/.metatile\/metatile.errors. If
-- GHC indicates failure with a non-zero exit code, an xmessage displaying
-- that file is spawned.
--
@@ -499,10 +499,10 @@ getXMonadDir = io $ getAppUserDataDirectory "xmonad"
--
recompile :: MonadIO m => Bool -> m Bool
recompile force = io $ do
- dir <- getXMonadDir
- let binn = "xmonad-"++arch++"-"++os
+ dir <- getMetaTileDir
+ let binn = "metatile-"++arch++"-"++os
bin = dir </> binn
- base = dir </> "xmonad"
+ base = dir </> "metatile"
err = base ++ ".errors"
src = base ++ ".hs"
lib = dir </> "lib"
@@ -514,7 +514,7 @@ recompile force = io $ do
-- temporarily disable SIGCHLD ignoring:
uninstallSignalHandlers
status <- bracket (openFile err WriteMode) hClose $ \h ->
- waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-main-is", "main", "-v0", "-o",binn] (Just dir)
+ waitForProcess =<< runProcess "ghc" ["--make", "metatile.hs", "-i", "-ilib", "-fforce-recomp", "-main-is", "main", "-v0", "-o",binn] (Just dir)
Nothing Nothing Nothing (Just h)
-- re-enable SIGCHLD:
@@ -524,7 +524,7 @@ recompile force = io $ do
when (status /= ExitSuccess) $ do
ghcErr <- readFile err
let msg = unlines $
- ["Error detected while loading xmonad configuration file: " ++ src]
+ ["Error detected while loading metatile configuration file: " ++ src]
++ lines (if null ghcErr then show status else ghcErr)
++ ["","Please check the file for errors."]
-- nb, the ordering of printing, then forking, is crucial due to
diff --git a/XMonad/Layout.hs b/MetaTile/Layout.hs
index 8eff488..47fd4f9 100644
--- a/XMonad/Layout.hs
+++ b/MetaTile/Layout.hs
@@ -2,7 +2,7 @@
-- --------------------------------------------------------------------------
-- |
--- Module : XMonad.Layout
+-- Module : MetaTile.Layout
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
@@ -14,7 +14,7 @@
--
-----------------------------------------------------------------------------
-module XMonad.Layout (
+module MetaTile.Layout (
Full(..), Tall(..), Mirror(..),
Resize(..), IncMasterN(..), Choose, (|||), ChangeLayout(..),
mirrorRect, splitVertically,
@@ -24,10 +24,10 @@ module XMonad.Layout (
) where
-import XMonad.Core
+import MetaTile.Core
import Graphics.X11 (Rectangle(..))
-import qualified XMonad.StackSet as W
+import qualified MetaTile.StackSet as W
import Control.Arrow ((***), second)
import Control.Monad
import Data.Maybe (fromMaybe)
diff --git a/XMonad/Main.hsc b/MetaTile/Main.hsc
index 224631c..abdb75c 100644
--- a/XMonad/Main.hsc
+++ b/MetaTile/Main.hsc
@@ -1,7 +1,7 @@
{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ForeignFunctionInterface #-}
----------------------------------------------------------------------------
-- |
--- Module : XMonad.Main
+-- Module : MetaTile.Main
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
@@ -9,11 +9,11 @@
-- Stability : unstable
-- Portability : not portable, uses mtl, X11, posix
--
--- xmonad, a minimalist, tiling window manager for X11
+-- metatile, a minimalist, tiling window manager for X11
--
-----------------------------------------------------------------------------
-module XMonad.Main (xmonad) where
+module MetaTile.Main (metatile) where
import Control.Arrow (second)
import Data.Bits
@@ -34,11 +34,11 @@ 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 MetaTile.Core
+import qualified MetaTile.Config as Default
+import MetaTile.StackSet (new, member)
+import qualified MetaTile.StackSet as W
+import MetaTile.Operations
import System.IO
@@ -55,8 +55,8 @@ foreign import ccall unsafe "locale.h setlocale"
-- |
-- The main entry point
--
-xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
-xmonad initxmc = do
+metatile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
+metatile initxmc = do
-- setup locale information from environment
withCString "" $ c_setlocale (#const LC_ALL)
-- ignore SIGPIPE and SIGCHLD
@@ -298,7 +298,7 @@ handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
handle e@ClientMessageEvent { ev_message_type = mt } = do
a <- getAtom "XMONAD_RESTART"
if (mt == a)
- then restart "xmonad" True
+ then restart "metatile" True
else broadcastMessage e
handle e = broadcastMessage e -- trace (eventName e) -- ignoring
diff --git a/XMonad/ManageHook.hs b/MetaTile/ManageHook.hs
index 64f9fe6..f2daf9c 100644
--- a/XMonad/ManageHook.hs
+++ b/MetaTile/ManageHook.hs
@@ -2,7 +2,7 @@
-----------------------------------------------------------------------------
-- |
--- Module : XMonad.ManageHook
+-- Module : MetaTile.ManageHook
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
@@ -16,18 +16,18 @@
-- XXX examples required
-module XMonad.ManageHook where
+module MetaTile.ManageHook where
import Prelude hiding (catch)
-import XMonad.Core
+import MetaTile.Core
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
import Control.Exception.Extensible (bracket, catch, SomeException(..))
import Control.Monad.Reader
import Data.Maybe
import Data.Monoid
-import qualified XMonad.StackSet as W
-import XMonad.Operations (reveal)
+import qualified MetaTile.StackSet as W
+import MetaTile.Operations (reveal)
-- | Lift an 'X' action to a 'Query'.
liftX :: X a -> Query a
diff --git a/XMonad/Operations.hs b/MetaTile/Operations.hs
index 294d4a8..1a2fd11 100644
--- a/XMonad/Operations.hs
+++ b/MetaTile/Operations.hs
@@ -3,7 +3,7 @@
-- --------------------------------------------------------------------------
-- |
--- Module : XMonad.Operations
+-- Module : MetaTile.Operations
-- Copyright : (c) Spencer Janssen 2007
-- License : BSD3-style (see LICENSE)
--
@@ -15,11 +15,11 @@
--
-----------------------------------------------------------------------------
-module XMonad.Operations where
+module MetaTile.Operations where
-import XMonad.Core
-import XMonad.Layout (Full(..))
-import qualified XMonad.StackSet as W
+import MetaTile.Core
+import MetaTile.Layout (Full(..))
+import qualified MetaTile.StackSet as W
import Data.Maybe
import Data.Monoid (Endo(..))
diff --git a/XMonad/StackSet.hs b/MetaTile/StackSet.hs
index 958b94b..907840c 100644
--- a/XMonad/StackSet.hs
+++ b/MetaTile/StackSet.hs
@@ -2,7 +2,7 @@
-----------------------------------------------------------------------------
-- |
--- Module : XMonad.StackSet
+-- Module : MetaTile.StackSet
-- Copyright : (c) Don Stewart 2007
-- License : BSD3-style (see LICENSE)
--
@@ -11,7 +11,7 @@
-- Portability : portable, Haskell 98
--
-module XMonad.StackSet (
+module MetaTile.StackSet (
-- * Introduction
-- $intro
@@ -178,7 +178,7 @@ data Stack a = Stack { focus :: !a -- focused thing in this set
-- | this function indicates to catch that an error is expected
abort :: String -> a
-abort x = error $ "xmonad: StackSet: " ++ x
+abort x = error $ "metatile: StackSet: " ++ x
-- ---------------------------------------------------------------------
-- $construction
diff --git a/xmonad.cabal b/metatile.cabal
index 627361c..d5327da 100644
--- a/xmonad.cabal
+++ b/metatile.cabal
@@ -1,9 +1,8 @@
-name: xmonad
+name: metatile
version: 0.12
-homepage: http://xmonad.org
synopsis: A tiling window manager
description:
- xmonad is a tiling window manager for X. Windows are arranged
+ metatile is a tiling window manager for X. Windows are arranged
automatically to tile the screen without gaps or overlap, maximising
screen use. All features of the window manager are accessible from
the keyboard: a mouse is strictly optional. xmonad is written and
@@ -24,18 +23,10 @@ cabal-version: >= 1.6
bug-reports: http://code.google.com/p/xmonad/issues/list
build-type: Simple
-tested-with: GHC==7.6.1,
- GHC==7.4.1,
- GHC==7.2.1,
- GHC==6.12.3,
- GHC==6.10.4
+tested-with: GHC==7.6.3
data-files: man/xmonad.hs, man/xmonad.1, man/xmonad.1.html
-source-repository head
- type: darcs
- location: http://code.haskell.org/xmonad
-
flag small_base
description: Choose the new smaller, split-up base package.
@@ -44,14 +35,14 @@ flag testing
default: False
library
- exposed-modules: XMonad
- XMonad.Main
- XMonad.Core
- XMonad.Config
- XMonad.Layout
- XMonad.ManageHook
- XMonad.Operations
- XMonad.StackSet
+ exposed-modules: MetaTile
+ MetaTile.Main
+ MetaTile.Core
+ MetaTile.Config
+ MetaTile.Layout
+ MetaTile.ManageHook
+ MetaTile.Operations
+ MetaTile.StackSet
if flag(small_base)
build-depends: base < 5 && >=3, containers, directory, process, filepath, extensible-exceptions
@@ -73,16 +64,16 @@ library
if flag(testing)
buildable: False
-executable xmonad
+executable metatile
main-is: Main.hs
- other-modules: XMonad
- XMonad.Main
- XMonad.Core
- XMonad.Config
- XMonad.Layout
- XMonad.ManageHook
- XMonad.Operations
- XMonad.StackSet
+ other-modules: MetaTile
+ MetaTile.Main
+ MetaTile.Core
+ MetaTile.Config
+ MetaTile.Layout
+ MetaTile.ManageHook
+ MetaTile.Operations
+ MetaTile.StackSet
if true
ghc-options: -funbox-strict-fields -Wall