From 3ff04ab726c7f2503630ff99d357f79f76a96829 Mon Sep 17 00:00:00 2001 From: Braden Shepherdson Date: Wed, 3 Dec 2008 17:15:34 +0100 Subject: Remove XMonad.Config.PlainConfig, it has been turned into the separate xmonad-light project. darcs-hash:20081203161534-d53a8-9deed7e404210ef94d1d4d9709ce93c479ccd0a9.gz --- XMonad/Config/PlainConfig.hs | 528 ------------------------------------------- 1 file changed, 528 deletions(-) delete mode 100644 XMonad/Config/PlainConfig.hs (limited to 'XMonad/Config/PlainConfig.hs') 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 --- License : BSD3 --- --- Maintainer : Braden Shepherdson --- --- 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 \ spawn \"\\" none@ --- --- * @kill kill M-S-c@ --- --- * @nextLayout sendMessage NextLayout M-\@ --- --- * @refresh refresh M-S-\@ --- --- * @focusDown windows W.focusDown M-\, 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-\@ --- --- * @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." - -- cgit v1.2.3