bluetile 0.4.3 → 0.5
raw patch · 10 files changed
+755/−150 lines, 10 filesdep +ConfigFiledep +mtldep +regex-compatsetup-changed
Dependencies added: ConfigFile, mtl, regex-compat
Files
- Setup.lhs +22/−0
- bluetile.cabal +8/−3
- bluetiledock/BluetileDock.hs +12/−4
- bluetiledock/bluetiledock.glade +69/−56
- etc/bluetilerc +106/−0
- etc/bluetilerc_user_template +13/−0
- man/bluetile.1 +4/−9
- src/Config.hs +74/−59
- src/ConfigParser.hs +420/−0
- src/Main.hs +27/−19
Setup.lhs view
@@ -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
bluetile.cabal view
@@ -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
bluetiledock/BluetileDock.hs view
@@ -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
bluetiledock/bluetiledock.glade view
@@ -1,36 +1,36 @@-<?xml version="1.0" encoding="UTF-8" standalone="no"?>-<!DOCTYPE glade-interface SYSTEM "glade-2.0.dtd">-<!--Generated with glade3 3.4.5 on Mon Jul 27 17:15:18 2009 -->+<?xml version="1.0"?> <glade-interface>+ <!-- interface-requires gtk+ 2.6 -->+ <!-- interface-naming-policy toplevel-contextual --> <widget class="GtkWindow" id="monitor0Dock"> <property name="width_request">30</property>- <property name="height_request">690</property>+ <property name="height_request">700</property> <property name="title" translatable="yes">BluetileDock - Workspace</property> <child> <widget class="GtkVBox" id="vbox2"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkVBox" id="vbox3"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkLabel" id="label2"> <property name="visible">True</property> <property name="label" translatable="yes">Wrk- spc</property> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkToggleButton" id="togglebutton1">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 1</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">1</property>@@ -38,12 +38,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton2">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 2</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">2</property>@@ -51,12 +50,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton3">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 3</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">3</property>@@ -64,12 +62,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton4">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 4</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">4</property>@@ -77,12 +74,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton5">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 5</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">5</property>@@ -90,12 +86,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton6">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 6</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">6</property>@@ -103,12 +98,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton7">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 7</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">7</property>@@ -116,12 +110,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton8">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 8</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">8</property>@@ -129,12 +122,11 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton9">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 9</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">9</property>@@ -142,51 +134,56 @@ </child> <child> <widget class="GtkToggleButton" id="togglebutton0">+ <property name="label" translatable="yes">togglebutton</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to workspace 0</property>- <property name="label" translatable="yes">togglebutton</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">10</property> </packing> </child> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkVBox" id="vbox1"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkLabel" id="label1"> <property name="visible">True</property> <property name="label" translatable="yes">Lay- out</property> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkVBox" id="vbox4"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkImage" id="imagelayouta"> <property name="visible">True</property> <property name="pixbuf">floating.svg</property> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkToggleButton" id="togglebuttonlayouta">+ <property name="label" translatable="yes">...</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to stacking window layout</property>- <property name="label" translatable="yes">...</property>- <property name="relief">GTK_RELIEF_HALF</property>- <property name="response_id">0</property>+ <property name="relief">half</property> </widget> <packing> <property name="position">1</property>@@ -201,22 +198,23 @@ <child> <widget class="GtkVBox" id="vbox5"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkImage" id="imagelayoutb"> <property name="visible">True</property> <property name="pixbuf">tiled1.svg</property> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkToggleButton" id="togglebuttonlayoutb">+ <property name="label" translatable="yes">...</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to tiled horizontal layout</property>- <property name="label" translatable="yes">...</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">1</property>@@ -231,22 +229,23 @@ <child> <widget class="GtkVBox" id="vbox6"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkImage" id="imagelayoutc"> <property name="visible">True</property> <property name="pixbuf">tiled2.svg</property> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkToggleButton" id="togglebuttonlayoutc">+ <property name="label" translatable="yes">...</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to tiled vertical layout</property>- <property name="label" translatable="yes">...</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">1</property>@@ -261,22 +260,23 @@ <child> <widget class="GtkVBox" id="vbox7"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkImage" id="imagelayoutd"> <property name="visible">True</property> <property name="pixbuf">fullscreen.svg</property> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkToggleButton" id="togglebuttonlayoutd">+ <property name="label" translatable="yes">...</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Switch to fullscreen layout</property>- <property name="label" translatable="yes">...</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">1</property>@@ -296,42 +296,55 @@ <child> <widget class="GtkVBox" id="vbox8"> <property name="visible">True</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>- <property name="orientation">GTK_ORIENTATION_VERTICAL</property>+ <property name="orientation">vertical</property> <child> <widget class="GtkButton" id="incmasterbutton">+ <property name="label" translatable="yes">+1</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Increase number of windows in the master area</property>- <property name="label" translatable="yes">+1</property>- <property name="response_id">0</property> </widget>+ <packing>+ <property name="position">0</property>+ </packing> </child> <child> <widget class="GtkButton" id="decmasterbutton">+ <property name="label" translatable="yes">-1</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property> <property name="tooltip" translatable="yes">Decrease number of windows in the master area</property>- <property name="label" translatable="yes">-1</property>- <property name="response_id">0</property> </widget> <packing> <property name="position">1</property> </packing> </child> <child>+ <widget class="GtkButton" id="configbutton">+ <property name="label" translatable="yes">C</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Configure Bluetile</property>+ </widget>+ <packing>+ <property name="position">2</property>+ </packing>+ </child>+ <child> <widget class="GtkButton" id="quitbutton">+ <property name="label" translatable="yes">Q</property> <property name="visible">True</property> <property name="can_focus">True</property> <property name="receives_default">True</property>+ <property name="has_tooltip">True</property> <property name="tooltip" translatable="yes">Quit Bluetile</property>- <property name="label" translatable="yes">Q</property>- <property name="response_id">0</property> </widget> <packing>- <property name="position">2</property>+ <property name="position">3</property> </packing> </child> </widget>
+ etc/bluetilerc view
@@ -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
+ etc/bluetilerc_user_template view
@@ -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
man/bluetile.1 view
@@ -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 <jan.vornberger@informatik.uni\-oldenburg.de>
src/Config.hs view
@@ -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 ++ "'"
+ src/ConfigParser.hs view
@@ -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)
src/Main.hs view
@@ -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" }