diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -5,18 +5,23 @@ > import Distribution.Simple.Setup > import System.FilePath > import System.Directory +> import System.IO > import Control.Monad +> import Text.Regex +> > main = defaultMainWithHooks (simpleUserHooks { postCopy = myPostCopy, postInst = myPostInst } ) > > myPostCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO () > myPostCopy _ copyflags pkgdesc lbi = do > let dirs = absoluteInstallDirs pkgdesc lbi (fromFlag $ copyDest copyflags) > libExecHook dirs +> insertPath dirs > > myPostInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO () > myPostInst _ _ pkgdesc lbi = do > let dirs = absoluteInstallDirs pkgdesc lbi NoCopyDest > libExecHook dirs +> insertPath dirs > > -- hook to move helper binaries to the libexec directory > libExecHook :: InstallDirs String -> IO () @@ -26,3 +31,20 @@ > createDirectoryIfMissing True lexecdir > forM_ ["bluetiledock", "bluetilemockwin", "bluetilegreet"] $ \binary -> > renameFile (bdir binary) (lexecdir binary) +> +> -- hook to insert path to system wide configuration +> insertPath :: InstallDirs String -> IO () +> insertPath dirs = do +> let ddir = datadir dirs +> let userConfigTemplate = ddir "etc" "bluetilerc_user_template" +> let pathToSystemConfig = ddir "etc" "bluetilerc" +> contents <- readFileStrict userConfigTemplate +> let contentsPatched = subRegex (mkRegex "__PATH_TO_BLUETILERC__") contents pathToSystemConfig +> writeFile userConfigTemplate contentsPatched +> +> -- taken from System.IO.Strict on Hackage +> readFileStrict :: FilePath -> IO String +> readFileStrict name = openFile name ReadMode >>= hGetContentsStrict +> +> hGetContentsStrict :: Handle -> IO String +> hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s diff --git a/bluetile.cabal b/bluetile.cabal --- a/bluetile.cabal +++ b/bluetile.cabal @@ -1,5 +1,5 @@ Name: bluetile -Version: 0.4.3 +Version: 0.5 homepage: http://www.bluetile.org/ synopsis: full-featured tiling for the GNOME desktop environment description: @@ -16,6 +16,7 @@ Author: Jan Vornberger Maintainer: jan.vornberger@informatik.uni-oldenburg.de extra-source-files: src/Config.hs, + src/ConfigParser.hs, src/BluetileDock.hs, src/XMonad/Actions/BluetileCommands.hs, src/XMonad/Actions/WindowMenu.hs, @@ -51,7 +52,9 @@ bluetiledock/fullscreen.svg, bluetilegreet/bluetilegreet.glade, logo/bluetile-icon-48x48.png, - logo/bluetile-icon.svg + logo/bluetile-icon.svg, + etc/bluetilerc, + etc/bluetilerc_user_template Build-Type: Custom Cabal-Version: >=1.2 @@ -59,7 +62,8 @@ Main-is: Main.hs Hs-Source-Dirs: src Build-Depends: base>=3, base<5, containers, process, filepath, - random, utf8-string, + random, utf8-string, unix, regex-compat, mtl, + ConfigFile, directory, xmonad>=0.9.1, xmonad-contrib>=0.9.1 if true Ghc-Options: -Wall @@ -67,6 +71,7 @@ Ghc-Options: -fno-warn-unused-do-bind Executable gnome-bluetile-session + Buildable: False Hs-Source-Dirs: gnome-bluetile-session Main-is: GnomeBluetileSession.hs Build-Depends: base>=3, base<5, filepath, unix diff --git a/bluetiledock/BluetileDock.hs b/bluetiledock/BluetileDock.hs --- a/bluetiledock/BluetileDock.hs +++ b/bluetiledock/BluetileDock.hs @@ -21,7 +21,7 @@ import qualified Graphics.X11.Xlib.Extras as XE import System.Environment import System.IO -import System.FilePath(pathSeparator) +import System.FilePath import Paths_bluetile import Utils import Data.IORef @@ -100,7 +100,7 @@ -- prepare GUI initGUI dataDir <- getDataDir - Just xml <- xmlNew $ dataDir ++ [pathSeparator] ++ "bluetiledock" ++ [pathSeparator] ++ "bluetiledock.glade" + Just xml <- xmlNew $ dataDir "bluetiledock" "bluetiledock.glade" Just dfltScreen <- screenGetDefault dfltWh <- screenGetWidth dfltScreen @@ -109,8 +109,9 @@ windowSetTypeHint monitor0Dock WindowTypeHintDock onDestroy monitor0Dock mainQuit (m0DockWh, m0DockHt) <- windowGetSize monitor0Dock + configBtn <- xmlGetWidget xml castToButton "configbutton" quitBtn <- xmlGetWidget xml castToButton "quitbutton" - let m0DockY = 50 + let m0DockY = 35 if myScreenId == 0 then do windowMove monitor0Dock 0 m0DockY @@ -142,6 +143,13 @@ onClicked incMasterBtn $ sendCommand incMasterCmd myScreenId onClicked decMasterBtn $ sendCommand decMasterCmd myScreenId + -- config button + onClicked configBtn $ do + home <- getEnv "HOME" + let userConfig = home ".bluetilerc" + spawnPipe $ "gedit " ++ userConfig + return () + -- quit button onClicked quitBtn $ do dialog <- messageDialogNew (Just monitor0Dock) [DialogModal] MessageQuestion ButtonsNone "Really quit Bluetile?" @@ -185,7 +193,7 @@ writeIORef lockSendCommand False when (sid /= myScreenId && isNothing hndlM) $ do libexecDir <- getLibexecDir - hndl <- spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetiledock --otherscreen" + hndl <- spawnPipe $ libexecDir "bluetiledock --otherscreen" writeIORef otherDockProcess (Just hndl) hPutStrLn hndl $ show update when (sid /= myScreenId && isJust hndlM) $ do diff --git a/bluetiledock/bluetiledock.glade b/bluetiledock/bluetiledock.glade --- a/bluetiledock/bluetiledock.glade +++ b/bluetiledock/bluetiledock.glade @@ -1,36 +1,36 @@ - - - + + + 30 - 690 + 700 BluetileDock - Workspace True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical True Wrk- spc + + 0 + + togglebutton True True True Switch to workspace 1 - togglebutton - 0 1 @@ -38,12 +38,11 @@ + togglebutton True True True Switch to workspace 2 - togglebutton - 0 2 @@ -51,12 +50,11 @@ + togglebutton True True True Switch to workspace 3 - togglebutton - 0 3 @@ -64,12 +62,11 @@ + togglebutton True True True Switch to workspace 4 - togglebutton - 0 4 @@ -77,12 +74,11 @@ + togglebutton True True True Switch to workspace 5 - togglebutton - 0 5 @@ -90,12 +86,11 @@ + togglebutton True True True Switch to workspace 6 - togglebutton - 0 6 @@ -103,12 +98,11 @@ + togglebutton True True True Switch to workspace 7 - togglebutton - 0 7 @@ -116,12 +110,11 @@ + togglebutton True True True Switch to workspace 8 - togglebutton - 0 8 @@ -129,12 +122,11 @@ + togglebutton True True True Switch to workspace 9 - togglebutton - 0 9 @@ -142,51 +134,56 @@ + togglebutton True True True Switch to workspace 0 - togglebutton - 0 10 + + 0 + True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical True Lay- out + + 0 + True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical True floating.svg + + 0 + + ... True True True Switch to stacking window layout - ... - GTK_RELIEF_HALF - 0 + half 1 @@ -201,22 +198,23 @@ True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical True tiled1.svg + + 0 + + ... True True True Switch to tiled horizontal layout - ... - 0 1 @@ -231,22 +229,23 @@ True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical True tiled2.svg + + 0 + + ... True True True Switch to tiled vertical layout - ... - 0 1 @@ -261,22 +260,23 @@ True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical True fullscreen.svg + + 0 + + ... True True True Switch to fullscreen layout - ... - 0 1 @@ -296,42 +296,55 @@ True - GTK_ORIENTATION_VERTICAL - GTK_ORIENTATION_VERTICAL + vertical + +1 True True True Increase number of windows in the master area - +1 - 0 + + 0 + + -1 True True True Decrease number of windows in the master area - -1 - 0 1 + + C + True + True + True + True + Configure Bluetile + + + 2 + + + + Q True True True + True Quit Bluetile - Q - 0 - 2 + 3 diff --git a/etc/bluetilerc b/etc/bluetilerc new file mode 100644 --- /dev/null +++ b/etc/bluetilerc @@ -0,0 +1,106 @@ +# This is the default configuration of Bluetile. +# It is recommended to not change this file and instead +# make your changes in ~/.bluetilerc +# +# Note: You can ignore the key bindings that end +# in '_alternative'. These only exist because a few +# actions can be invoked in two different ways. + +# global options (Mod4 is usually the logo key) +default_modifier: Mod4 +terminal: gnome-terminal +start_dock: true + +# launching and killing programs +key_launch_terminal: DefaultMod+Return +key_gnome_run: DefaultMod+p +key_close_window: DefaultMod+Shift+c +key_refresh: DefaultMod+F5 +key_window_menu: DefaultMod+o + +# move focus +key_focus_next_window: DefaultMod+j +key_focus_prev_window: DefaultMod+k +key_focus_master_window: DefaultMod+Space +key_focus_next_window_alternative: DefaultMod+Tab +key_focus_prev_window_alternative: DefaultMod+Shift+Tab + +# modifying the window order +key_swap_with_master_window: DefaultMod+Shift+Space +key_swap_with_next_window: DefaultMod+Shift+j +key_swap_with_prev_window: DefaultMod+Shift+k + +# resizing the master/slave ratio +key_shrink_master_area: DefaultMod+h +key_expand_master_area: DefaultMod+l +key_shrink_slave_area: DefaultMod+u +key_expand_slave_area: DefaultMod+i + +# dialog windows +key_treat_as_regular_window: DefaultMod+t +key_treat_as_dialog_window: DefaultMod+Shift+t + +# increase or decrease number of windows in the master area +key_inc_windows_in_master_area: DefaultMod+comma +key_dec_windows_in_master_area: DefaultMod+period + +# Metacity-like workspace switching +key_prev_workspace: Mod1+Ctrl+Left +key_next_workspace: Mod1+Ctrl+Right +key_shift_window_to_prev_workspace: Mod1+Ctrl+Shift+Left +key_shift_window_to_next_workspace: Mod1+Ctrl+Shift+Right + +# more Metacity keys +key_gnome_run_alternative: Mod1+F2 +key_close_window_alternative: Mod1+F4 + +# switching to layouts +key_switch_to_layout_stacked: DefaultMod+a +key_switch_to_layout_tiled1: DefaultMod+s +key_switch_to_layout_tiled2: DefaultMod+d +key_switch_to_layout_fullscreen: DefaultMod+f + +# maximizing and minimizing +key_maximize_window: DefaultMod+z +key_minimize_window: DefaultMod+m +key_restore_minimized_window: DefaultMod+Shift+m + +# switching workspaces +key_switch_to_workspace_0: DefaultMod+0 +key_switch_to_workspace_1: DefaultMod+1 +key_switch_to_workspace_2: DefaultMod+2 +key_switch_to_workspace_3: DefaultMod+3 +key_switch_to_workspace_4: DefaultMod+4 +key_switch_to_workspace_5: DefaultMod+5 +key_switch_to_workspace_6: DefaultMod+6 +key_switch_to_workspace_7: DefaultMod+7 +key_switch_to_workspace_8: DefaultMod+8 +key_switch_to_workspace_9: DefaultMod+9 + +# moving clients to workspaces +key_shift_window_to_workspace_0: DefaultMod+Shift+0 +key_shift_window_to_workspace_1: DefaultMod+Shift+1 +key_shift_window_to_workspace_2: DefaultMod+Shift+2 +key_shift_window_to_workspace_3: DefaultMod+Shift+3 +key_shift_window_to_workspace_4: DefaultMod+Shift+4 +key_shift_window_to_workspace_5: DefaultMod+Shift+5 +key_shift_window_to_workspace_6: DefaultMod+Shift+6 +key_shift_window_to_workspace_7: DefaultMod+Shift+7 +key_shift_window_to_workspace_8: DefaultMod+Shift+8 +key_shift_window_to_workspace_9: DefaultMod+Shift+9 + +# multi head: switching and moving clients +key_switch_to_screen_0: DefaultMod+w +key_switch_to_screen_1: DefaultMod+e +key_switch_to_screen_2: DefaultMod+r +key_shift_window_to_screen_0: DefaultMod+Shift+w +key_shift_window_to_screen_1: DefaultMod+Shift+e +key_shift_window_to_screen_2: DefaultMod+Shift+r + +# misc keybindings - note: these are only listed +# for the sake of completeness, some might not work +# correctly and are only used during development +focus_follows_mouse: false +key_quit_bluetile: DefaultMod+Shift+q +key_restart_bluetile: DefaultMod+q +key_reset_layouts: DefaultMod+Shift+F5 diff --git a/etc/bluetilerc_user_template b/etc/bluetilerc_user_template new file mode 100644 --- /dev/null +++ b/etc/bluetilerc_user_template @@ -0,0 +1,13 @@ +# This is your Bluetile configuration file. +# Use this file to make changes to the default configuration. +# You can see all the defaults in the file +# __PATH_TO_BLUETILERC__ +# +# Below are a few examples - note: Mod1 is usually the Alt key. +# Run 'bluetile --list-identifiers' to see a complete list of all +# possibile modifier and key names. + +#start_dock: false +#terminal: xterm +#default_modifier: Mod1 +#key_launch_terminal: DefaultMod+Shift+Return diff --git a/man/bluetile.1 b/man/bluetile.1 --- a/man/bluetile.1 +++ b/man/bluetile.1 @@ -124,7 +124,7 @@ .\" ======================================================================== .\" .IX Title "BLUETILE 1" -.TH BLUETILE 1 "2010-06-27" "perl v5.10.1" "" +.TH BLUETILE 1 "2010-07-24" "perl v5.10.1" "" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l @@ -229,14 +229,9 @@ \& Win+F5 Refresh layout \& Win+Shift+q Quit Bluetile .Ve -.SH "CAVEATS" -.IX Header "CAVEATS" -The full list of keyboard shortcuts is currently only documented in the -source code. Also, there is currently no way to change the keyboard -shortcuts expect by modifying the source code. A user-friendly -configuration system that is more in line with \fBBluetile\fR's goals is -planned. You can also have a look at the wiki on -\&\fBhttp://www.bluetile.org\fR for a possible workaround. +.SH "CONFIGURATION" +.IX Header "CONFIGURATION" +Edit the file ~/.bluetilerc to configure \fBBluetile\fR. .SH "AUTHOR" .IX Header "AUTHOR" Jan Vornberger diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS -fno-warn-missing-signatures #-} ---------------------------------------------------------------------------- -- | @@ -9,12 +10,12 @@ -- Stability : unstable -- Portability : not portable -- --- This is the default configuration of Bluetile +-- This module builds an XMonad configuration from Bluetile's configuration -- ----------------------------------------------------------------------------- module Config ( - bluetileConfig + createXMonadConfig ) where import XMonad hiding ( (|||) ) @@ -56,86 +57,87 @@ import Data.Monoid import Control.Monad(when) +import ConfigParser + bluetileWorkspaces :: [String] bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"] -bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ +bluetileKeys :: BluetileRC -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +bluetileKeys bluetilerc conf = M.fromList $ + map (\(desc, action) -> (getKeyBinding desc bluetilerc, action)) $ -- launching and killing programs - [ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal - , ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog - , ((modMask' .|. shiftMask, xK_c ), kill) -- %! Close the focused window + [ ("key_launch_terminal" , spawn $ XMonad.terminal conf) -- %! Launch terminal + , ("key_gnome_run" , gnomeRun) -- %! Launch Gnome "Run application" dialog + , ("key_close_window" , kill) -- %! Close the focused window - , ((modMask', xK_F5 ), refresh) -- %! Resize viewed windows to the correct size - , ((modMask' .|. shiftMask, xK_F5 ), setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default + , ("key_refresh" , refresh) -- %! Resize viewed windows to the correct size + , ("key_reset_layouts" , setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default - , ((modMask', xK_o ), windowMenu) + , ("key_window_menu" , windowMenu) -- move focus up or down the window stack - , ((modMask', xK_Tab ), focusDown) -- %! Move focus to the next window - , ((modMask' .|. shiftMask, xK_Tab ), focusUp) -- %! Move focus to the previous window - , ((modMask', xK_j ), focusDown) -- %! Move focus to the next window - , ((modMask', xK_k ), focusUp) -- %! Move focus to the previous window - , ((modMask', xK_space ), focusMaster) -- %! Move focus to the master window + , ("key_focus_next_window" , focusDown) -- %! Move focus to the next window + , ("key_focus_prev_window" , focusUp) -- %! Move focus to the previous window + , ("key_focus_next_window_alternative" , focusDown) -- %! Move focus to the next window + , ("key_focus_prev_window_alternative" , focusUp) -- %! Move focus to the previous window + , ("key_focus_master_window" , focusMaster) -- %! Move focus to the master window -- modifying the window order - , ((modMask' .|. shiftMask, xK_space ), windows W.swapMaster) -- %! Swap the focused window and the master window - , ((modMask' .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window - , ((modMask' .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window + , ("key_swap_with_master_window" , windows W.swapMaster) -- %! Swap the focused window and the master window + , ("key_swap_with_next_window" , windows W.swapDown ) -- %! Swap the focused window with the next window + , ("key_swap_with_prev_window" , windows W.swapUp ) -- %! Swap the focused window with the previous window -- resizing the master/slave ratio - , ((modMask', xK_h ), sendMessage Shrink) -- %! Shrink the master area - , ((modMask', xK_l ), sendMessage Expand) -- %! Expand the master area - , ((modMask', xK_u ), sendMessage ShrinkSlave) -- %! Shrink a slave area - , ((modMask', xK_i ), sendMessage ExpandSlave) -- %! Expand a slave area + , ("key_shrink_master_area" , sendMessage Shrink) -- %! Shrink the master area + , ("key_expand_master_area" , sendMessage Expand) -- %! Expand the master area + , ("key_shrink_slave_area" , sendMessage ShrinkSlave) -- %! Shrink a slave area + , ("key_expand_slave_area" , sendMessage ExpandSlave) -- %! Expand a slave area -- floating layer support - , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling - , ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window + , ("key_treat_as_regular_window" , withFocused $ windows . W.sink) -- %! Push window back into tiling + , ("key_treat_as_dialog_window" , withFocused $ float ) -- %! Float window -- increase or decrease number of windows in the master area - , ((modMask' , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area - , ((modMask' , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area + , ("key_inc_windows_in_master_area" , sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area + , ("key_dec_windows_in_master_area" , sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area -- quit, or restart - , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit bluetile - , ((modMask' , xK_q ), spawn "bluetile --restart") -- %! Restart bluetile + , ("key_quit_bluetile" , io (exitWith ExitSuccess)) -- %! Quit bluetile + , ("key_restart_bluetile" , spawn "bluetile --restart") -- %! Restart bluetile -- Metacity-like workspace switching - , ((mod1Mask .|. controlMask, xK_Left), prevWS) - , ((mod1Mask .|. controlMask, xK_Right), nextWS) - , ((mod1Mask .|. controlMask .|. shiftMask, xK_Left), shiftToPrev >> prevWS) - , ((mod1Mask .|. controlMask .|. shiftMask, xK_Right), shiftToNext >> nextWS) + , ("key_prev_workspace" , prevWS) + , ("key_next_workspace" , nextWS) + , ("key_shift_window_to_prev_workspace" , shiftToPrev >> prevWS) + , ("key_shift_window_to_next_workspace" , shiftToNext >> nextWS) -- more Metacity keys - , ((mod1Mask , xK_F2), gnomeRun) - , ((mod1Mask , xK_F4), kill) - - -- Switching to layouts - , ((modMask' , xK_a), sendMessage $ JumpToLayout "Floating") - , ((modMask' , xK_s), sendMessage $ JumpToLayout "Tiled1") - , ((modMask' , xK_d), sendMessage $ JumpToLayout "Tiled2") - , ((modMask' , xK_f), sendMessage $ JumpToLayout "Fullscreen") + , ("key_gnome_run_alternative" , gnomeRun) + , ("key_close_window_alternative" , kill) - -- Maximizing - , ((modMask' , xK_z), withFocused (sendMessage . maximizeRestore)) + -- switching to layouts + , ("key_switch_to_layout_stacked" , sendMessage $ JumpToLayout "Floating") + , ("key_switch_to_layout_tiled1" , sendMessage $ JumpToLayout "Tiled1") + , ("key_switch_to_layout_tiled2" , sendMessage $ JumpToLayout "Tiled2") + , ("key_switch_to_layout_fullscreen" , sendMessage $ JumpToLayout "Fullscreen") - -- Minimizing - , ((modMask', xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) - , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) + -- maximizing and minimizing + , ("key_maximize_window" , withFocused (sendMessage . maximizeRestore)) + , ("key_minimize_window" , withFocused (\f -> sendMessage (MinimizeWin f))) + , ("key_restore_minimized_window" , sendMessage RestoreNextMinimizedWin) ] ++ -- mod-[1..9] ++ [0] %! Switch to workspace N + [("key_switch_to_workspace_" ++ (show wkspNr), windows $ W.greedyView i) | (wkspNr :: Integer, i) <- zip ([1 .. 9] ++ [0]) (XMonad.workspaces conf)] + ++ -- mod-shift-[1..9] ++ [0] %! Move client to workspace N - [((m .|. modMask', k), windows $ f i) - | (i, k) <- zip (XMonad.workspaces conf) ([xK_1 .. xK_9] ++ [xK_0]) - , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] + [("key_shift_window_to_workspace_" ++ (show wkspNr), windows $ W.shift i) | (wkspNr :: Integer, i) <- zip ([1 .. 9] ++ [0]) (XMonad.workspaces conf)] ++ -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 + [("key_switch_to_screen_" ++ (show screenNr), screenWorkspace sc >>= flip whenJust (windows . W.view)) | (screenNr :: Integer, sc) <- zip [0 .. 2] [0 ..]] -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 - [((m .|. modMask', key), screenWorkspace sc >>= flip whenJust (windows . f)) - | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] - , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] + ++ + [("key_shift_window_to_screen_" ++ (show screenNr), screenWorkspace sc >>= flip whenJust (windows . W.shift)) | (screenNr :: Integer, sc) <- zip [0 .. 2] [0 ..]] bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ @@ -174,12 +176,19 @@ tiled2 = tilingDeco $ maximize $ mouseResizableTile fullscreen = tilingDeco $ maximize $ smartBorders Full - tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l) - floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l + tilingDeco l = windowSwitcherDecorationWithButtons shrinkText bluetileTheme (draggingVisualizer l) + floatingDeco l = buttonDeco shrinkText bluetileTheme l + bluetileTheme = defaultThemeWithButtons { activeColor = "#7ca3d3" + , activeTextColor = "white" + , activeBorderColor = "white" + , inactiveColor = "#e3e2e1" + , inactiveTextColor = "black" + , inactiveBorderColor = "black" + } -bluetileConfig = +createXMonadConfig bluetilerc = defaultConfig - { modMask = mod4Mask, -- logo key + { modMask = defaultModifierBRC bluetilerc, startupHook = ewmhDesktopsStartup, manageHook = bluetileManageHook, layoutHook = bluetileLayoutHook, @@ -190,9 +199,15 @@ `mappend` serverModeEventHook' bluetileCommands `mappend` positionStoreEventHook, workspaces = bluetileWorkspaces, - keys = bluetileKeys, + keys = bluetileKeys bluetilerc, mouseBindings = bluetileMouseBindings, - focusFollowsMouse = False, - focusedBorderColor = "#000000", - terminal = "gnome-terminal" + focusFollowsMouse = focusFollowsMouseBRC bluetilerc, + normalBorderColor = "gray", + focusedBorderColor = "black", + terminal = terminalBRC bluetilerc } + +getKeyBinding :: String -> BluetileRC -> (KeyMask, KeySym) +getKeyBinding desc bluetilerc = case (lookup desc (keysBRC bluetilerc)) of + (Just keybinding) -> keybinding + (Nothing) -> error $ "Configuration does not include key binding for key '" ++ desc ++ "'" diff --git a/src/ConfigParser.hs b/src/ConfigParser.hs new file mode 100644 --- /dev/null +++ b/src/ConfigParser.hs @@ -0,0 +1,420 @@ +{-# LANGUAGE FlexibleContexts #-} +---------------------------------------------------------------------------- +-- | +-- Module : ConfigParser +-- Copyright : (c) Jan Vornberger 2010 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- This module helps to parse Bluetile's configuration file +-- +----------------------------------------------------------------------------- + +module ConfigParser ( + parseConfigFile, + BluetileRC(..), + displayIdentifiers + ) where + +import XMonad +import qualified Data.ConfigFile as CF +import Control.Monad.Error +import Data.Char +import Data.List +import Text.Regex +import System.Exit + +data BluetileRC = BluetileRC { defaultModifierBRC :: KeyMask + , focusFollowsMouseBRC :: Bool + , terminalBRC :: String + , startDockBRC :: Bool + , keysBRC :: [(String, (KeyMask, KeySym))] + } deriving (Show) + +maskKeywordsBRC :: [(String, KeyMask)] +maskKeywordsBRC = [ ("Shift", shiftMask) + , ("Lock", lockMask) + , ("Ctrl", controlMask) + , ("Mod1", mod1Mask) + , ("Mod2", mod2Mask) + , ("Mod3", mod3Mask) + , ("Mod4", mod4Mask) + , ("Mod5", mod5Mask) + ] + +keysKeywordsBRC :: [(String, KeySym)] +keysKeywordsBRC = [ ("BackSpace", xK_BackSpace) + , ("Tab", xK_Tab) + , ("Linefeed", xK_Linefeed) + , ("Clear", xK_Clear) + , ("Return", xK_Return) + , ("Pause", xK_Pause) + , ("Scroll_Lock", xK_Scroll_Lock) + , ("Sys_Req", xK_Sys_Req) + , ("Escape", xK_Escape) + , ("Delete", xK_Delete) + , ("Home", xK_Home) + , ("Left", xK_Left) + , ("Up", xK_Up) + , ("Right", xK_Right) + , ("Down", xK_Down) + , ("Prior", xK_Prior) + , ("Page_Up", xK_Page_Up) + , ("Next", xK_Next) + , ("Page_Down", xK_Page_Down) + , ("End", xK_End) + , ("Begin", xK_Begin) + , ("Select", xK_Select) + , ("Print", xK_Print) + , ("Execute", xK_Execute) + , ("Insert", xK_Insert) + , ("Undo", xK_Undo) + , ("Redo", xK_Redo) + , ("Menu", xK_Menu) + , ("Find", xK_Find) + , ("Cancel", xK_Cancel) + , ("Help", xK_Help) + , ("Break", xK_Break) + , ("Num_Lock", xK_Num_Lock) + , ("KP_Space", xK_KP_Space) + , ("KP_Tab", xK_KP_Tab) + , ("KP_Enter", xK_KP_Enter) + , ("KP_F1", xK_KP_F1) + , ("KP_F2", xK_KP_F2) + , ("KP_F3", xK_KP_F3) + , ("KP_F4", xK_KP_F4) + , ("KP_Home", xK_KP_Home) + , ("KP_Left", xK_KP_Left) + , ("KP_Up", xK_KP_Up) + , ("KP_Right", xK_KP_Right) + , ("KP_Down", xK_KP_Down) + , ("KP_Prior", xK_KP_Prior) + , ("KP_Page_Up", xK_KP_Page_Up) + , ("KP_Next", xK_KP_Next) + , ("KP_Page_Down", xK_KP_Page_Down) + , ("KP_End", xK_KP_End) + , ("KP_Begin", xK_KP_Begin) + , ("KP_Insert", xK_KP_Insert) + , ("KP_Delete", xK_KP_Delete) + , ("KP_Equal", xK_KP_Equal) + , ("KP_Multiply", xK_KP_Multiply) + , ("KP_Add", xK_KP_Add) + , ("KP_Separator", xK_KP_Separator) + , ("KP_Subtract", xK_KP_Subtract) + , ("KP_Decimal", xK_KP_Decimal) + , ("KP_Divide", xK_KP_Divide) + , ("KP_0", xK_KP_0) + , ("KP_1", xK_KP_1) + , ("KP_2", xK_KP_2) + , ("KP_3", xK_KP_3) + , ("KP_4", xK_KP_4) + , ("KP_5", xK_KP_5) + , ("KP_6", xK_KP_6) + , ("KP_7", xK_KP_7) + , ("KP_8", xK_KP_8) + , ("KP_9", xK_KP_9) + , ("F1", xK_F1) + , ("F2", xK_F2) + , ("F3", xK_F3) + , ("F4", xK_F4) + , ("F5", xK_F5) + , ("F6", xK_F6) + , ("F7", xK_F7) + , ("F8", xK_F8) + , ("F9", xK_F9) + , ("F10", xK_F10) + , ("F11", xK_F11) + , ("L1", xK_L1) + , ("F12", xK_F12) + , ("L2", xK_L2) + , ("F13", xK_F13) + , ("L3", xK_L3) + , ("F14", xK_F14) + , ("L4", xK_L4) + , ("F15", xK_F15) + , ("L5", xK_L5) + , ("F16", xK_F16) + , ("L6", xK_L6) + , ("F17", xK_F17) + , ("L7", xK_L7) + , ("F18", xK_F18) + , ("L8", xK_L8) + , ("F19", xK_F19) + , ("L9", xK_L9) + , ("F20", xK_F20) + , ("L10", xK_L10) + , ("F21", xK_F21) + , ("R1", xK_R1) + , ("F22", xK_F22) + , ("R2", xK_R2) + , ("F23", xK_F23) + , ("R3", xK_R3) + , ("F24", xK_F24) + , ("R4", xK_R4) + , ("F25", xK_F25) + , ("R5", xK_R5) + , ("F26", xK_F26) + , ("R6", xK_R6) + , ("F27", xK_F27) + , ("R7", xK_R7) + , ("F28", xK_F28) + , ("R8", xK_R8) + , ("F29", xK_F29) + , ("R9", xK_R9) + , ("F30", xK_F30) + , ("R10", xK_R10) + , ("F31", xK_F31) + , ("R11", xK_R11) + , ("F32", xK_F32) + , ("R12", xK_R12) + , ("F33", xK_F33) + , ("R13", xK_R13) + , ("F34", xK_F34) + , ("R14", xK_R14) + , ("F35", xK_F35) + , ("R15", xK_R15) + , ("space", xK_space) + , ("exclam", xK_exclam) + , ("quotedbl", xK_quotedbl) + , ("numbersign", xK_numbersign) + , ("dollar", xK_dollar) + , ("percent", xK_percent) + , ("ampersand", xK_ampersand) + , ("apostrophe", xK_apostrophe) + , ("quoteright", xK_quoteright) + , ("parenleft", xK_parenleft) + , ("parenright", xK_parenright) + , ("asterisk", xK_asterisk) + , ("plus", xK_plus) + , ("comma", xK_comma) + , ("minus", xK_minus) + , ("period", xK_period) + , ("slash", xK_slash) + , ("0", xK_0) + , ("1", xK_1) + , ("2", xK_2) + , ("3", xK_3) + , ("4", xK_4) + , ("5", xK_5) + , ("6", xK_6) + , ("7", xK_7) + , ("8", xK_8) + , ("9", xK_9) + , ("colon", xK_colon) + , ("semicolon", xK_semicolon) + , ("less", xK_less) + , ("equal", xK_equal) + , ("greater", xK_greater) + , ("question", xK_question) + , ("at", xK_at) + , ("bracketleft", xK_bracketleft) + , ("backslash", xK_backslash) + , ("bracketright", xK_bracketright) + , ("asciicircum", xK_asciicircum) + , ("underscore", xK_underscore) + , ("grave", xK_grave) + , ("quoteleft", xK_quoteleft) + , ("a", xK_a) + , ("b", xK_b) + , ("c", xK_c) + , ("d", xK_d) + , ("e", xK_e) + , ("f", xK_f) + , ("g", xK_g) + , ("h", xK_h) + , ("i", xK_i) + , ("j", xK_j) + , ("k", xK_k) + , ("l", xK_l) + , ("m", xK_m) + , ("n", xK_n) + , ("o", xK_o) + , ("p", xK_p) + , ("q", xK_q) + , ("r", xK_r) + , ("s", xK_s) + , ("t", xK_t) + , ("u", xK_u) + , ("v", xK_v) + , ("w", xK_w) + , ("x", xK_x) + , ("y", xK_y) + , ("z", xK_z) + , ("braceleft", xK_braceleft) + , ("bar", xK_bar) + , ("braceright", xK_braceright) + , ("asciitilde", xK_asciitilde) + , ("nobreakspace", xK_nobreakspace) + , ("exclamdown", xK_exclamdown) + , ("cent", xK_cent) + , ("sterling", xK_sterling) + , ("currency", xK_currency) + , ("yen", xK_yen) + , ("brokenbar", xK_brokenbar) + , ("section", xK_section) + , ("diaeresis", xK_diaeresis) + , ("copyright", xK_copyright) + , ("ordfeminine", xK_ordfeminine) + , ("guillemotleft", xK_guillemotleft) + , ("notsign", xK_notsign) + , ("hyphen", xK_hyphen) + , ("registered", xK_registered) + , ("macron", xK_macron) + , ("degree", xK_degree) + , ("plusminus", xK_plusminus) + , ("twosuperior", xK_twosuperior) + , ("threesuperior", xK_threesuperior) + , ("acute", xK_acute) + , ("mu", xK_mu) + , ("paragraph", xK_paragraph) + , ("periodcentered", xK_periodcentered) + , ("cedilla", xK_cedilla) + , ("onesuperior", xK_onesuperior) + , ("masculine", xK_masculine) + , ("guillemotright", xK_guillemotright) + , ("onequarter", xK_onequarter) + , ("onehalf", xK_onehalf) + , ("threequarters", xK_threequarters) + , ("questiondown", xK_questiondown) + , ("Agrave", xK_Agrave) + , ("Aacute", xK_Aacute) + , ("Acircumflex", xK_Acircumflex) + , ("Atilde", xK_Atilde) + , ("Adiaeresis", xK_Adiaeresis) + , ("Aring", xK_Aring) + , ("AE", xK_AE) + , ("Ccedilla", xK_Ccedilla) + , ("Egrave", xK_Egrave) + , ("Eacute", xK_Eacute) + , ("Ecircumflex", xK_Ecircumflex) + , ("Ediaeresis", xK_Ediaeresis) + , ("Igrave", xK_Igrave) + , ("Iacute", xK_Iacute) + , ("Icircumflex", xK_Icircumflex) + , ("Idiaeresis", xK_Idiaeresis) + , ("ETH", xK_ETH) + , ("Eth", xK_Eth) + , ("Ntilde", xK_Ntilde) + , ("Ograve", xK_Ograve) + , ("Oacute", xK_Oacute) + , ("Ocircumflex", xK_Ocircumflex) + , ("Otilde", xK_Otilde) + , ("Odiaeresis", xK_Odiaeresis) + , ("multiply", xK_multiply) + , ("Ooblique", xK_Ooblique) + , ("Ugrave", xK_Ugrave) + , ("Uacute", xK_Uacute) + , ("Ucircumflex", xK_Ucircumflex) + , ("Udiaeresis", xK_Udiaeresis) + , ("Yacute", xK_Yacute) + , ("THORN", xK_THORN) + , ("Thorn", xK_Thorn) + , ("ssharp", xK_ssharp) + , ("agrave", xK_agrave) + , ("aacute", xK_aacute) + , ("acircumflex", xK_acircumflex) + , ("atilde", xK_atilde) + , ("adiaeresis", xK_adiaeresis) + , ("aring", xK_aring) + , ("ae", xK_ae) + , ("ccedilla", xK_ccedilla) + , ("egrave", xK_egrave) + , ("eacute", xK_eacute) + , ("ecircumflex", xK_ecircumflex) + , ("ediaeresis", xK_ediaeresis) + , ("igrave", xK_igrave) + , ("iacute", xK_iacute) + , ("icircumflex", xK_icircumflex) + , ("idiaeresis", xK_idiaeresis) + , ("eth", xK_eth) + , ("ntilde", xK_ntilde) + , ("ograve", xK_ograve) + , ("oacute", xK_oacute) + , ("ocircumflex", xK_ocircumflex) + , ("otilde", xK_otilde) + , ("odiaeresis", xK_odiaeresis) + , ("division", xK_division) + , ("oslash", xK_oslash) + , ("ugrave", xK_ugrave) + , ("uacute", xK_uacute) + , ("ucircumflex", xK_ucircumflex) + , ("udiaeresis", xK_udiaeresis) + , ("yacute", xK_yacute) + , ("thorn", xK_thorn) + , ("ydiaeresis", xK_ydiaeresis) + ] + +maskKeywordsBRC' :: [(String, KeyMask)] +maskKeywordsBRC' = map (\(k, v) -> (map toLower k, v)) maskKeywordsBRC + +keysKeywordsBRC' :: [(String, KeySym)] +keysKeywordsBRC' = map (\(k, v) -> (map toLower k, v)) keysKeywordsBRC + +lookupMask :: MonadError CF.CPError m => [(String, KeyMask)] -> String -> m KeyMask +lookupMask t k = case (lookup (map toLower k) t) of + (Just v) -> return v + (Nothing) -> throwError (CF.OtherProblem ("Unknown modifier '" ++ k ++ "'"), "other_problem") + +lookupKey :: MonadError CF.CPError m => String -> m KeySym +lookupKey k = case (lookup (map toLower k) keysKeywordsBRC') of + (Just v) -> return v + (Nothing) -> throwError (CF.OtherProblem ("Unknown key '" ++ k ++ "'"), "other_problem") + +parseKeyCombo :: MonadError CF.CPError m => [(String, KeyMask)] -> String -> m (KeyMask, KeySym) +parseKeyCombo maskKBRC combo = do + let parts = splitRegex (mkRegex "\\+") combo + if (length parts > 0) + then do + masks <- mapM (lookupMask maskKBRC) (init parts) + key <- lookupKey (last parts) + return (foldl (.|.) 0 masks, key) + else throwError (CF.OtherProblem ("Empty key binding"), "other_problem") + +parseKeyBinding :: MonadError CF.CPError m => [(String, KeyMask)] -> (String, String) -> m (String, (KeyMask, KeySym)) +parseKeyBinding maskKBRC (desc, keyCombo) = do + keyBinding <- parseKeyCombo maskKBRC keyCombo + return (desc, keyBinding) + +parseConfigFile :: FilePath -> FilePath -> IO BluetileRC +parseConfigFile systemConfig userConfig = do + rv <- runErrorT $ do + -- read files + cpDefault <- join $ liftIO $ CF.readfile CF.emptyCP systemConfig + cp <- join $ liftIO $ CF.readfile cpDefault userConfig + + -- global options + defaultModifierCF <- lookupMask maskKeywordsBRC' =<< CF.get cp "DEFAULT" "default_modifier" + terminalCF <- CF.get cp "DEFAULT" "terminal" + focusFollowsMouseCF <- CF.get cp "DEFAULT" "focus_follows_mouse" + startDockCF <- CF.get cp "DEFAULT" "start_dock" + let maskKeywordsBRCwithDefault = maskKeywordsBRC' ++ [("defaultmod", defaultModifierCF)] + + -- keys + itemsCF <- CF.items cp "DEFAULT" + let keyBindingsCFstr = filter (\(k, _) -> isPrefixOf "key_" k) itemsCF + keyBindingsCF <- mapM (parseKeyBinding maskKeywordsBRCwithDefault) keyBindingsCFstr + + let bluetilerc = BluetileRC { defaultModifierBRC = defaultModifierCF + , focusFollowsMouseBRC = focusFollowsMouseCF + , terminalBRC = terminalCF + , startDockBRC = startDockCF + , keysBRC = keyBindingsCF } + return bluetilerc + case rv of + (Left err) -> do + putStrLn "There was a problem reading the configuration. This is what the parser told me:" + putStrLn (show err) + exitFailure + (Right bluetilerc) -> do + return bluetilerc + +displayIdentifiers :: IO () +displayIdentifiers = do + putStrLn "The following modifiers can be used in Bluetile's configuration:" + putStrLn $ concat $ intersperse ", " ("DefaultMod" : (map fst maskKeywordsBRC)) + putStrLn "" + putStrLn "The following keys can be used in Bluetile's configuration:" + putStrLn $ concat $ intersperse ", " (map fst keysKeywordsBRC) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -20,11 +20,12 @@ import BluetileDock import Config +import ConfigParser import System.Environment -import System.Cmd -import System.Exit -import System.FilePath(pathSeparator) +import System.FilePath +import System.Directory +import Control.Monad import Paths_bluetile import Data.Version(showVersion) @@ -39,6 +40,7 @@ [] -> launch ("--resume":_) -> launch ["--help"] -> usage + ["--list-identifiers"] -> displayIdentifiers ["--restart"] -> sendRestart >> return () ["--version"] -> putStrLn ("bluetile " ++ showVersion version) _ -> fail "unrecognized flags" @@ -53,18 +55,31 @@ putStrLn "that Bluetile started successfully. Happy tiling!" putStrLn "" + -- check if configuration present + home <- getEnv "HOME" + let userConfig = home ".bluetilerc" + dataDir <- getDataDir + let systemConfig = dataDir "etc" "bluetilerc" + let userConfigTemplate = dataDir "etc" "bluetilerc_user_template" + + userConfigPresent <- doesFileExist userConfig + unless (userConfigPresent) $ copyFile userConfigTemplate userConfig + + -- read configuration + bluetilerc <- parseConfigFile systemConfig userConfig + let xmonadConfig = createXMonadConfig bluetilerc + -- start docks and greeting screen libexecDir <- getLibexecDir - dockHandle <- spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetiledock" - spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetilegreet" - - -- check terminal - uninstallSignalHandlers -- make sure we can receive SIGCHLD to check terminal - bluetileConfig' <- checkTerminal $ bluetileConfig { logHook = logHook bluetileConfig >> bluetileDock dockHandle } - installSignalHandlers -- important to ignore SIGCHLD from now on to avoid zombies + xmonadConfig' <- case (startDockBRC bluetilerc) of + True -> do + dockHandle <- spawnPipe $ libexecDir "bluetiledock" + return xmonadConfig { logHook = logHook xmonadConfig >> bluetileDock dockHandle } + False -> return xmonadConfig + spawnPipe $ libexecDir "bluetilegreet" replace - xmonad bluetileConfig' + xmonad xmonadConfig' usage :: IO () usage = do @@ -74,6 +89,7 @@ "Options:" : " --help Print this message" : " --version Print the version number" : + " --list-identifiers Print modifiers and keys that can be used in the configuration" : " --restart Request a running Bluetile process to restart" : [] @@ -87,11 +103,3 @@ setClientMessageEvent e rw a 32 1 currentTime sendEvent dpy rw False structureNotifyMask e sync dpy False - -checkTerminal :: XConfig l -> IO (XConfig l) -checkTerminal conf = do - let term = XMonad.terminal conf - status <- system $ "which " ++ term ++ " > /dev/null" - if status == ExitSuccess - then return conf - else return conf { terminal = "xterm" }