mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-17 13:24:14 -07:00
Remove XMonad.Config.PlainConfig, it has been turned into the separate xmonad-light project.
This commit is contained in:
Braden Shepherdson
@@ -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."
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user