aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBraden Shepherdson <Braden.Shepherdson@gmail.com>2008-12-03 17:15:34 +0100
committerBraden Shepherdson <Braden.Shepherdson@gmail.com>2008-12-03 17:15:34 +0100
commit3ff04ab726c7f2503630ff99d357f79f76a96829 (patch)
tree7c9419972fa196e7c64580cbc00419654f3a8016
parentb0fbbf55772dbe2be6d7e21ff1f2041ce06d73a8 (diff)
downloadXMonadContrib-3ff04ab726c7f2503630ff99d357f79f76a96829.tar.gz
XMonadContrib-3ff04ab726c7f2503630ff99d357f79f76a96829.tar.xz
XMonadContrib-3ff04ab726c7f2503630ff99d357f79f76a96829.zip
Remove XMonad.Config.PlainConfig, it has been turned into the separate xmonad-light project.
darcs-hash:20081203161534-d53a8-9deed7e404210ef94d1d4d9709ce93c479ccd0a9.gz
-rw-r--r--XMonad/Config/PlainConfig.hs528
-rw-r--r--xmonad-contrib.cabal1
2 files changed, 0 insertions, 529 deletions
diff --git a/XMonad/Config/PlainConfig.hs b/XMonad/Config/PlainConfig.hs
deleted file mode 100644
index f1ebf1d..0000000
--- a/XMonad/Config/PlainConfig.hs
+++ /dev/null
@@ -1,528 +0,0 @@
-{-# LANGUAGE
- FlexibleInstances,
- FlexibleContexts,
- MultiParamTypeClasses,
- ExistentialQuantification
- #-}
-
--------------------------------------------------------------------------
--- |
--- Module : XMonad.Config.PlainConfig
--- Copyright : Braden Shepherdson <Braden.Shepherdson@gmail.com>
--- License : BSD3
---
--- Maintainer : Braden Shepherdson <Braden.Shepherdson@gmail.com>
---
--- Proof-of-concept (but usable) plain-text configuration file
--- parser, for use instead of xmonad.hs. Does not require recompilation,
--- allowing xmonad to be free of the GHC dependency.
---
--------------------------------------------------------------------------
-
-
-module XMonad.Config.PlainConfig
- (
- -- * Introduction
- -- $usage
-
- -- * Supported Layouts
- -- $layouts
-
- -- * Support Key Bindings
- -- $keys
-
- -- * Other Notes
- -- $notes
-
- -- * Example Config File
- -- $example
-
- plainConfig ,readConfig, checkConfig
- )
-where
-
-
-import XMonad
-import System.Exit
-
-import qualified XMonad.StackSet as W
-import qualified Data.Map as M
-import Data.List
-import Data.Maybe (isJust,fromJust)
-import Data.Char (isSpace)
-
-
---import Control.Monad
-import Control.Monad.Error
-import Control.Monad.Identity
-
-import Control.Arrow ((&&&))
-
-import Text.ParserCombinators.ReadP
-
-import System.IO
-import Control.Exception (bracket)
-
-import XMonad.Util.EZConfig (mkKeymap)
-
-
-
--- $usage
--- The @xmonad.hs@ file is very minimal when used with PlainConfig.
--- It typically contains only the following:
---
--- > module Main where
--- > import XMonad
--- > import XMonad.Config.PlainConfig (plainConfig)
--- > main = plainConfig
---
--- The 'plainConfig' function parses @~\/.xmonad\/xmonad.conf@,
--- the format of which is described below.
-
-
--- $layouts
--- Only 'Tall', 'Wide' and 'Full' are supported at present.
-
-
-
--- $keys
---
--- Key bindings are specified as a pair of an arbitrary EZConfig and
--- one of the following:
---
--- @ Name Haskell equivalent Default binding(s)@
---
--- * @spawn \<cmd\> spawn \"\<cmd\>\" none@
---
--- * @kill kill M-S-c@
---
--- * @nextLayout sendMessage NextLayout M-\<Space\>@
---
--- * @refresh refresh M-S-\<Space\>@
---
--- * @focusDown windows W.focusDown M-\<Tab\>, M-j@
---
--- * @focusUp windows W.focusUp M-k@
---
--- * @focusMaster windows W.focusMaster M-m@
---
--- * @swapDown windows W.swapDown M-S-j@
---
--- * @swapUp windows W.swapUp M-S-k@
---
--- * @swapMaster windows W.swapMaster M-\<Return\>@
---
--- * @shrink sendMessage Shrink M-h@
---
--- * @expand sendMessage Expand M-l@
---
--- * @sink withFocused $ windows . W.sink M-t@
---
--- * @incMaster sendMessage (IncMasterN 1) M-,@
---
--- * @decMaster sendMessage (IncMasterN (-1)) M-.@
---
--- * @quit io $ exitWith ExitSuccess M-S-q@
---
--- * @restart broadcastMessageReleaseResources >> restart \"xmonad\" True M-q@
---
-
-
--- $notes
--- Submaps are allowed.
--- These settings override the defaults. Changes made here will be used over
--- the default bindings for those keys.
-
-
--- $example
--- An example @~\/.xmonad\/xmonad.conf@ file follows:
---
--- @modMask = 3@
---
--- @numlockMask = 2@
---
--- @borderWidth = 1@
---
--- @normalBorderColor = #dddddd@
---
--- @focusedBorderColor = #00ff00@
---
--- @terminal=urxvt@
---
--- @workspaces=[\"1: IRC\",\"2: Web\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\"]@
---
--- @focusFollowsMouse=True@
---
--- @layouts=[\"Tall\",\"Full\",\"Wide\"]@
---
--- @key=(\"M-x t\", \"spawn xmessage Test\")@
---
--- @manageHook=(ClassName \"MPlayer\" , \"float\" )@
---
--- @manageHook=(ClassName \"Gimp\" , \"float\" )@
---
--- @manageHook=(Resource \"desktop_window\", \"ignore\" )@
---
--- @manageHook=(Resource \"kdesktop\" , \"ignore\" )@
---
--- @manageHook=(Resource \"gnome-panel\" , \"ignore\" )@
---
-
-
-
-
-
-
-----------------------------------------------------------------
------- Several functions for parsing the key-value file. -------
-----------------------------------------------------------------
-
-parseKVBy :: Char -> ReadP (String,String)
-parseKVBy sep = do
- skipSpaces
- k <- munch1 (\x -> x /= ' ' && x /= sep)
- skipSpaces
- char kvSep
- skipSpaces
- v <- munch1 (\x -> x /= ' ') --or EOS
- return (k,v)
-
-parseKVVBy :: Char -> ReadP (String,String)
-parseKVVBy sep = do
- skipSpaces
- k <- munch1 (\x -> x /= ' ' && x /= sep)
- skipSpaces
- char kvSep
- skipSpaces
- v <- munch1 (const True) -- until EOS
- return (k,v)
-
-
-kvSep :: Char
-kvSep = '='
-
-parseKV, parseKVV :: ReadP (String,String)
-parseKV = parseKVBy kvSep
-parseKVV = parseKVVBy kvSep
-
-
-
-readKV :: String -> Integer -> RC (String,String)
-readKV s ln = case readP_to_S parseKV s of
- [((k,v),"")] -> return (k,v) --single, correct parse
- [] -> throwError [(ln,"No parse")]
- _ -> do
- case readP_to_S parseKVV s of
- [((k,v),"")] -> return (k,v) --single, correct parse
- [] -> throwError [(ln,"No parse")]
- xs -> throwError [(ln,"Ambiguous parse: "
- ++ show xs)]
-
-
-
-isComment :: String -> Bool
-isComment = not . null . readP_to_S parseComment
- where parseComment = skipSpaces >> char '#' >> return ()
- -- null means failed parse, so _not_ a comment.
-
-
-isBlank :: String -> Bool
-isBlank = null . filter (not . isSpace)
-
-
-type RC = ErrorT [(Integer,String)] Identity
-
-instance Error [(Integer,String)] where
- noMsg = [(-1, "Unknown error.")]
- strMsg s = [(-1, s)]
-
-
-parseFile :: [String] -> RC (XConfig Layout)
-parseFile ss = parseLines baseConfig theLines
- where theLines = filter (not . liftM2 (||) isComment isBlank . snd)
- $ zip [1..] ss
-
-
-
-parseLines :: XConfig Layout -> [(Integer,String)] -> RC (XConfig Layout)
-parseLines = foldM parse
-
-
-parse :: XConfig Layout -> (Integer, String) -> RC (XConfig Layout)
-parse xc (ln,s) = do
- (k,v) <- readKV s ln
- case M.lookup k commands of
- Nothing -> throwError [(ln,"Unknown command: "++k)]
- Just f -> f v ln xc
-
-
-
-
-----------------------------------------------------------------
--- Now the semantic parts, that convert from the relevant --
--- key-value entries to values in an XConfig --
-----------------------------------------------------------------
-
-
-
-type Command = String -> Integer -> XConfig Layout -> RC (XConfig Layout)
-
-commands :: M.Map String Command
-commands = M.fromList $
- [("modMask" , cmd_modMask )
- ,("numlockMask" , cmd_numlockMask )
- ,("normalBorderColor" , cmd_normalBorderColor )
- ,("focusedBorderColor" , cmd_focusedBorderColor)
- ,("terminal" , cmd_terminal )
- ,("workspaces" , cmd_workspaces )
- ,("focusFollowsMouse" , cmd_focusFollowsMouse )
- ,("layouts" , cmd_layouts )
- ,("key" , cmd_key )
- ,("manageHook" , cmd_manageHook )
- ,("borderWidth" , cmd_borderWidth )
- ]
-
-
--- | Behind-the-scenes helper for both 'cmd_modMask' and 'cmd_numlockMask'.
-genericModKey :: (KeyMask -> XConfig Layout) -> Command
-genericModKey f s ln _ = do
- x <- rcRead s ln :: RC Integer
- case lookup x (zip [1..] [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask]) of
- Just y -> return $ f y
- Nothing -> throwError [(ln,"Invalid mod key number: "++ show x)]
-
-
--- | Reads the mod key modifier number.
-cmd_modMask :: Command
-cmd_modMask s ln xc = genericModKey (\k -> xc{modMask = k}) s ln xc
-
--- | Reads the numlock key modifier number.
-cmd_numlockMask :: Command
-cmd_numlockMask s ln xc = genericModKey (\k -> xc{numlockMask = k}) s ln xc
-
-
--- | Reads the border width.
-cmd_borderWidth :: Command
-cmd_borderWidth s ln xc = do
- w <- rcRead s ln
- return $ xc { borderWidth = w }
-
-
--- | Reads the colors but just keeps them as RRGGBB Strings.
-cmd_normalBorderColor, cmd_focusedBorderColor :: Command
-cmd_normalBorderColor s _ xc = return $ xc{ normalBorderColor = s }
-cmd_focusedBorderColor s _ xc = return $ xc{ focusedBorderColor = s }
-
-
--- | Reads the terminal. It is just a String, no parsing.
-cmd_terminal :: Command
-cmd_terminal s _ xc = return $ xc{ terminal = s }
-
-
--- | Reads the workspace tag list. This is given as a Haskell [String].
-cmd_workspaces :: Command
-cmd_workspaces s ln xc = rcRead s ln >>= \x -> return xc{ workspaces = x }
-
-
--- | Reads the focusFollowsMouse, as a Haskell Bool.
-cmd_focusFollowsMouse :: Command
-cmd_focusFollowsMouse s ln xc = rcRead s ln >>=
- \x -> return xc{focusFollowsMouse = x}
-
-
--- | The list known layouts, mapped by name.
--- An easy location for improvement is to add more contrib layouts here.
-layouts :: M.Map String (Layout Window)
-layouts = M.fromList
- [("Tall", Layout (Tall 1 (3/100) (1/2)))
- ,("Wide", Layout (Mirror (Tall 1 (3/100) (1/2))))
- ,("Full", Layout Full)
- ]
-
-
--- | Expects a [String], the strings being layout names. Quotes required.
--- Draws from the `layouts' list above.
-cmd_layouts :: Command
-cmd_layouts s ln xc = do
- xs <- rcRead s ln -- read the list of strings
- let ls = map (id &&& (flip M.lookup) layouts) xs
- when (null ls) $ throwError [(ln,"Empty layout list")]
- case filter (not . isJust . snd) ls of
- [] -> return $ xc{ layoutHook = foldr1
- (\(Layout l) (Layout r) ->
- Layout (l ||| r)) (map (fromJust . snd) ls)
- }
- ys -> throwError $ map (\(x,_) -> (ln, "Unknown layout: "++ x)) ys
-
-
-
--- | A Map from names to key binding actions.
-key_actions :: M.Map String (X ())
-key_actions = M.fromList
- [("kill" , kill )
- ,("nextLayout" , sendMessage NextLayout )
- --,("prevLayout" , sendMessage PrevLayout )
- --,("resetLayout" , setLayout $ XMonad.layoutHook conf)
- ,("refresh" , refresh )
- ,("focusDown" , windows W.focusDown )
- ,("focusUp" , windows W.focusUp )
- ,("focusMaster" , windows W.focusMaster )
- ,("swapMaster" , windows W.swapMaster )
- ,("swapDown" , windows W.swapDown )
- ,("swapUp" , windows W.swapUp )
- ,("shrink" , sendMessage Shrink )
- ,("expand" , sendMessage Expand )
- ,("sink" , withFocused $ windows . W.sink)
- ,("incMaster" , sendMessage (IncMasterN 1))
- ,("decMaster" , sendMessage (IncMasterN (-1)))
- ,("quit" , io $ exitWith ExitSuccess)
- ,("restart" , broadcastMessage ReleaseResources
- >> restart "xmonad" True)
- ]
-
-
--- | Expects keys as described in the preamble, as
--- (\"EZConfig key name\", \"action name\"),
--- eg. (\"M-S-t\", \"spawn thunderbird\")
--- One key per "key=" line.
-cmd_key :: Command
-cmd_key s ln xc = do
- (k,v) <- rcRead s ln
- if "spawn " `isPrefixOf` v
- then return $ xc {
- keys = \c -> M.union (mkKeymap c
- [(k, spawn (drop 6 v))]
- ) ((keys xc) c)
- }
- else do
- case M.lookup v key_actions of
- Nothing -> throwError [(ln, "Unknown key action \"" ++ v ++ "\"")]
- Just ac -> return $
- xc { keys = \c -> M.union (mkKeymap c [(k, ac)])
- ((keys xc) c)
- }
-
-
-
--- | Map of names to actions for 'ManageHook's.
-manageHook_actions :: M.Map String ManageHook
-manageHook_actions = M.fromList
- [("float" , doFloat )
- ,("ignore" , doIgnore )
- ]
-
-
--- | Parses 'ManageHook's in the form given in the preamble.
--- eg. (ClassName \"MPlayer\", \"float\")
-cmd_manageHook :: Command
-cmd_manageHook s ln xc = do
- (k,v) <- rcRead s ln
- let q = parseQuery k
- if "toWorkspace " `isPrefixOf` v
- then return $ xc { manageHook = manageHook xc <+>
- (q --> doShift (drop 12 v))
- }
- else case M.lookup v manageHook_actions of
- Nothing -> throwError [(ln, "Unknown ManageHook action \""
- ++ v ++ "\"")]
- Just ac -> return $ xc { manageHook = manageHook xc <+> (q --> ac) }
-
-
-
--- | Core of the ManageHook expression parser.
--- Taken from Roman Cheplyaka's WindowProperties
-parseQuery :: Property -> Query Bool
-parseQuery (Title s) = title =? s
-parseQuery (ClassName s) = className =? s
-parseQuery (Resource s) = resource =? s
-parseQuery (And p q) = parseQuery p <&&> parseQuery q
-parseQuery (Or p q) = parseQuery p <&&> parseQuery q
-parseQuery (Not p) = not `fmap` parseQuery p
-parseQuery (Const b) = return b
-
-
--- | Property constructors are quite self-explaining.
--- Taken from Roman Cheplyaka's WindowProperties
-data Property = Title String
- | ClassName String
- | Resource String
- | And Property Property
- | Or Property Property
- | Not Property
- | Const Bool
- deriving (Read, Show)
-
-
-
--- | A wrapping of the read function into the RC monad.
-rcRead :: (Read a) => String -> Integer -> RC a
-rcRead s ln = case reads s of
- [(x,"")] -> return x
- _ -> throwError [(ln, "Failed to parse value")]
-
-
-
--- | The standard Config.hs 'defaultConfig', with the layout wrapped.
-baseConfig :: XConfig Layout
-baseConfig = defaultConfig{ layoutHook = Layout (layoutHook defaultConfig) }
-
-
-
--- | Core function that attempts to parse @~\/.xmonad\/xmonad.conf@
-readConfig :: IO (Maybe (XConfig Layout))
-readConfig = do
- dir <- getXMonadDir
- cs <- bracket (openFile (dir++"/xmonad.conf") ReadMode)
- (\h -> hClose h) -- vv force the lazy IO
- (\h -> (lines `fmap` hGetContents h) >>= \ss ->
- length ss `seq` return ss)
- let xce = runIdentity $ runErrorT $ parseFile cs
- case xce of
- Left es -> mapM_ (\(ln,e) ->
- putStrLn $ "readConfig error: line "++show ln++
- ": "++ e) es
- >> return Nothing
- Right xc -> return $ Just xc
-
-
--- | Attempts to run readConfig, and checks if it failed.
-checkConfig :: IO Bool
-checkConfig = isJust `fmap` readConfig
-
-
-
-{- REMOVED: It was for debugging, and causes an 'orphaned instances'
- warning to boot.
-
-
-
--- | Reads in the config, and then prints the resulting XConfig
-dumpConfig :: IO ()
-dumpConfig = readConfig >>= print
-
-
-instance Show (XConfig Layout) where
- show x = "XConfig { "
- ++ "normalBorderColor = "++ normalBorderColor x ++", "
- ++ "focusedBorderColor = "++ focusedBorderColor x++", "
- ++ "terminal = "++ terminal x ++", "
- ++ "workspaces = "++ show (workspaces x) ++", "
- ++ "numlockMask = "++ show (numlockMask x) ++", "
- ++ "modMask = "++ show (modMask x) ++", "
- ++ "borderWidth = "++ show (borderWidth x) ++", "
- ++ "focusFollowsMouse = "++ show (focusFollowsMouse x) ++", "
- ++ "layouts = "++ show (layoutHook x) ++" }"
-
--}
-
--- | Handles the unwrapping of the Layout. Intended for use as
--- @main = plainConfig@
-plainConfig :: IO ()
-plainConfig = do
- conf <- readConfig
- case conf of
- (Just xc@XConfig{layoutHook= (Layout l)}) ->
- xmonad (xc{ layoutHook = l })
- Nothing ->
- spawn $ "xmessage Failed to read xmonad.conf. See xmonad.errors."
-
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index 5012b83..f35fd8a 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -106,7 +106,6 @@ library
XMonad.Config.Droundy
XMonad.Config.Gnome
XMonad.Config.Kde
- XMonad.Config.PlainConfig
XMonad.Config.Sjanssen
XMonad.Config.Xfce
XMonad.Hooks.DynamicHooks