diff --git a/bluetile.cabal b/bluetile.cabal --- a/bluetile.cabal +++ b/bluetile.cabal @@ -1,5 +1,5 @@ Name: bluetile -Version: 0.3.1 +Version: 0.4 synopsis: A modern tiling window manager with a gentle learning curve description: Bluetile is a tiling window manager for X based on xmonad. Windows are arranged @@ -14,14 +14,15 @@ License-file: LICENSE Author: Jan Vornberger Maintainer: jan.vornberger@informatik.uni-oldenburg.de -extra-source-files: src/Config.hs +extra-source-files: src/Config.hs, + src/BluetileDock.hs, bluetiledock/Utils.hs, bluetilegreet/Utils.hs data-files: bluetiledock/bluetiledock.glade, bluetiledock/floating.svg, bluetiledock/tiled1.svg, bluetiledock/tiled2.svg, - bluetiledock/fullscreen.svg + bluetiledock/fullscreen.svg, bluetilegreet/bluetilegreet.glade Build-Type: Simple Cabal-Version: >=1.2 @@ -30,11 +31,11 @@ Main-is: Main.hs Hs-Source-Dirs: src Build-Depends: base>=3, base<4, containers, process, - xmonad-bluetilebranch>=0.8.1.3, xmonad-contrib-bluetilebranch>=0.8.1.3, - X11<1.5.0.0 + xmonad-bluetilebranch>=0.9, xmonad-contrib-bluetilebranch>=0.9 Ghc-Options: -Wall Executable bluetiledock + Buildable: True Hs-Source-Dirs: bluetiledock Main-is: BluetileDock.hs Build-Depends: base>=3, base<4, unix, glade, gtk, X11>=1.4 @@ -42,12 +43,14 @@ Ghc-options: -Wall Executable bluetilemockwin + Buildable: True Hs-Source-Dirs: bluetilemockwin Main-is: BluetileMockWin.hs Build-Depends: base>=3, base<4, gtk Ghc-options: -Wall Executable bluetilegreet + Buildable: True Hs-Source-Dirs: bluetilegreet Main-is: BluetileGreet.hs Build-Depends: base>=3, base<4, directory, filepath, glade, gtk diff --git a/bluetiledock/BluetileDock.hs b/bluetiledock/BluetileDock.hs --- a/bluetiledock/BluetileDock.hs +++ b/bluetiledock/BluetileDock.hs @@ -63,30 +63,30 @@ nextScreenCmdOffset = 18 incMasterCmd :: Int -incMasterCmd = 15 +incMasterCmd = 16 decMasterCmd :: Int -decMasterCmd = 16 +decMasterCmd = 17 quitBluetileCmd :: Int -quitBluetileCmd = 17 +quitBluetileCmd = 18 quitBluetileStartMetacityCmd :: Int -quitBluetileStartMetacityCmd = 18 +quitBluetileStartMetacityCmd = 19 -- name of widget caption identifier group command to execute tbData :: [(String, String, String, String, ToggleButton -> Int -> IORef Bool -> IO ())] -tbData = [ ("togglebutton1" , "1", "1" , "workspace", sendCommandIfToggled 1) - , ("togglebutton2" , "2", "2" , "workspace", sendCommandIfToggled 2) - , ("togglebutton3" , "3", "3" , "workspace", sendCommandIfToggled 3) - , ("togglebutton4" , "4", "4" , "workspace", sendCommandIfToggled 4) - , ("togglebutton5" , "5", "5" , "workspace", sendCommandIfToggled 5) - , ("togglebutton6" , "6", "6" , "workspace", sendCommandIfToggled 6) - , ("togglebutton7" , "7", "7" , "workspace", sendCommandIfToggled 7) - , ("togglebutton8" , "8", "8" , "workspace", sendCommandIfToggled 8) - , ("togglebutton9" , "9", "9" , "workspace", sendCommandIfToggled 9) - , ("togglebutton0" , "0", "0" , "workspace", sendCommandIfToggled 10) - , ("togglebuttonlayouta", "A", "Floating" , "layout" , sendCommandIfToggled 11) - , ("togglebuttonlayoutb", "S", "Tiled1" , "layout" , sendCommandIfToggled 12) - , ("togglebuttonlayoutc", "D", "Tiled2" , "layout" , sendCommandIfToggled 13) - , ("togglebuttonlayoutd", "F", "Fullscreen", "layout" , sendCommandIfToggled 14) +tbData = [ ("togglebutton1" , "1", "1" , "workspace", sendCommandIfToggled 2) + , ("togglebutton2" , "2", "2" , "workspace", sendCommandIfToggled 3) + , ("togglebutton3" , "3", "3" , "workspace", sendCommandIfToggled 4) + , ("togglebutton4" , "4", "4" , "workspace", sendCommandIfToggled 5) + , ("togglebutton5" , "5", "5" , "workspace", sendCommandIfToggled 6) + , ("togglebutton6" , "6", "6" , "workspace", sendCommandIfToggled 7) + , ("togglebutton7" , "7", "7" , "workspace", sendCommandIfToggled 8) + , ("togglebutton8" , "8", "8" , "workspace", sendCommandIfToggled 9) + , ("togglebutton9" , "9", "9" , "workspace", sendCommandIfToggled 10) + , ("togglebutton0" , "0", "0" , "workspace", sendCommandIfToggled 11) + , ("togglebuttonlayouta", "A", "Floating" , "layout" , sendCommandIfToggled 12) + , ("togglebuttonlayoutb", "S", "Tiled1" , "layout" , sendCommandIfToggled 13) + , ("togglebuttonlayoutc", "D", "Tiled2" , "layout" , sendCommandIfToggled 14) + , ("togglebuttonlayoutd", "F", "Fullscreen", "layout" , sendCommandIfToggled 15) ] main :: IO () diff --git a/src/BluetileDock.hs b/src/BluetileDock.hs new file mode 100644 --- /dev/null +++ b/src/BluetileDock.hs @@ -0,0 +1,41 @@ +---------------------------------------------------------------------------- +-- | +-- Module : BluetileDock +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +----------------------------------------------------------------------------- + +module BluetileDock (bluetileDock) where + +import XMonad +import qualified XMonad.StackSet as S +import System.IO +import Control.Monad(forM_) + +data DockOutput = DO Int String String deriving (Show, Read) + +bluetileDock :: Handle -> X () +bluetileDock outputHandle = do + ws <- gets windowset + let allscreens = S.screens ws + let outputs = for allscreens $ \s -> DO (getScreenId (S.screen s)) + (getLayoutDesc s) + (getCurrentWorkspace s) + forM_ outputs $ \o -> io $ hPutStrLn outputHandle $ show o + +getScreenId :: ScreenId -> Int +getScreenId (S sid) = sid + +getLayoutDesc :: S.Screen i (Layout Window) a sid sd -> String +getLayoutDesc = description . S.layout . S.workspace + +getCurrentWorkspace :: S.Screen i l a sid sd -> i +getCurrentWorkspace = S.tag . S.workspace + +for :: [a] -> (a -> b) -> [b] +for = flip map diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -9,40 +9,44 @@ -- Stability : unstable -- Portability : not portable -- --- The default configuration of bluetile +-- This is the default configuration of Bluetile -- ----------------------------------------------------------------------------- -module Config where +module Config ( + bluetileConfig + ) where import XMonad hiding ( (|||) ) import XMonad.Layout hiding ( (|||) ) -import XMonad.Layout.Maximize -import XMonad.Layout.Minimize -import XMonad.Layout.NoBorders -import XMonad.Layout.LayoutCombinators -import XMonad.Layout.Named +import XMonad.Layout.BorderResize import XMonad.Layout.BoringWindows +import XMonad.Layout.ButtonDecoration import XMonad.Layout.Decoration -import XMonad.Layout.WindowSwitcherDecoration +import XMonad.Layout.DecorationAddons import XMonad.Layout.DraggingVisualizer -import XMonad.Layout.PositionStoreFloat -import XMonad.Layout.BorderResize +import XMonad.Layout.LayoutCombinators +import XMonad.Layout.Maximize +import XMonad.Layout.Minimize import XMonad.Layout.MouseResizableTile -import XMonad.Layout.NoFrillsDecoration +import XMonad.Layout.Named +import XMonad.Layout.NoBorders +import XMonad.Layout.PositionStoreFloat +import XMonad.Layout.WindowSwitcherDecoration -import XMonad.Actions.CycleWS import XMonad.Actions.BluetileCommands +import XMonad.Actions.CycleWS import XMonad.Actions.WindowMenu -import XMonad.Hooks.ManageDocks +import XMonad.Hooks.CurrentWorkspaceOnTop import XMonad.Hooks.EwmhDesktops -import XMonad.Hooks.CustomRestart +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.ManageHelpers +import XMonad.Hooks.PositionStoreHooks import XMonad.Hooks.RestoreMinimized -import XMonad.Hooks.WorkspaceByPos -import XMonad.Hooks.BluetileDock import XMonad.Hooks.ServerMode +import XMonad.Hooks.WorkspaceByPos import XMonad.Config.Gnome @@ -53,11 +57,11 @@ import Data.Monoid import Control.Monad(when) -blueTileWorkspaces :: [String] -blueTileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"] +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 :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ -- launching and killing programs [ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal , ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog @@ -134,8 +138,8 @@ | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] -blueTileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -blueTileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ +bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) +bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ -- mod-button1 %! Move a floated window by dragging [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $ focus w >> mouseMoveWindow w >> windows W.shiftMaster)) @@ -152,13 +156,14 @@ ws <- gets windowset return $ M.member w (W.floating ws) -blueTileManageHook :: ManageHook -blueTileManageHook = composeAll - [ workspaceByPos +bluetileManageHook :: ManageHook +bluetileManageHook = composeAll + [ workspaceByPos, positionStoreManageHook , className =? "MPlayer" --> doFloat + , isFullscreen --> doFullFloat , manageDocks] -blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( +bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( named "Floating" floating ||| named "Tiled1" tiled1 ||| named "Tiled2" tiled2 ||| @@ -170,23 +175,24 @@ tiled2 = tilingDeco $ maximize $ mouseResizableTile fullscreen = tilingDeco $ maximize $ smartBorders Full - tilingDeco l = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer l) - floatingDeco l = noFrillsDeco shrinkText defaultTheme l + tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l) + floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l -blueTileConfig dockHandle = +bluetileConfig = defaultConfig { modMask = mod4Mask, -- logo key - manageHook = blueTileManageHook, - layoutHook = blueTileLayoutHook, - logHook = ewmhDesktopsLogHook >> bluetileDock dockHandle, + manageHook = bluetileManageHook, + layoutHook = bluetileLayoutHook, + logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook, handleEventHook = ewmhDesktopsEventHook - `mappend` customRestartEventHook "bluetile" + `mappend` fullscreenEventHook `mappend` restoreMinimizedEventHook - `mappend` serverModeEventHookCustom bluetileCommands, - workspaces = blueTileWorkspaces, - keys = blueTileKeys, - mouseBindings = blueTileMouseBindings, - focusFollowsMouse = False, - focusedBorderColor = "#ff5500", + `mappend` serverModeEventHook' bluetileCommands + `mappend` positionStoreEventHook, + workspaces = bluetileWorkspaces, + keys = bluetileKeys, + mouseBindings = bluetileMouseBindings, + focusFollowsMouse = False, + focusedBorderColor = "#000000", terminal = "gnome-terminal" } diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -8,7 +8,7 @@ -- Stability : unstable -- Portability : not portable -- --- bluetile - a modern tiling window manager with a gentle learning curve +-- Bluetile - a modern tiling window manager with a gentle learning curve -- ----------------------------------------------------------------------------- @@ -16,7 +16,9 @@ import XMonad import XMonad.Util.Run (spawnPipe) +import XMonad.Util.Replace +import BluetileDock import Config import System.IO @@ -36,7 +38,7 @@ args <- getArgs case args of [] -> launch - ["--resume", _] -> launch + ("--resume":_) -> launch ["--help"] -> usage ["--restart"] -> sendRestart >> return () ["--version"] -> putStrLn ("bluetile " ++ showVersion version) @@ -59,10 +61,11 @@ -- check terminal uninstallSignalHandlers -- make sure we can receive SIGCHLD to check terminal - blueTileConfig' <- checkTerminal $ blueTileConfig dockHandle + bluetileConfig' <- checkTerminal $ bluetileConfig { logHook = logHook bluetileConfig >> bluetileDock dockHandle } installSignalHandlers -- important to ignore SIGCHLD from now on to avoid zombies - xmonad blueTileConfig' + replace + xmonad bluetileConfig' usage :: IO () usage = do @@ -79,10 +82,10 @@ sendRestart = do dpy <- openDisplay "" rw <- rootWindow dpy $ defaultScreen dpy - xmonad_restart <- internAtom dpy "XMONAD_CUSTOM_RESTART" False + a <- internAtom dpy "XMONAD_COMMAND" False allocaXEvent $ \e -> do setEventType e clientMessage - setClientMessageEvent e rw xmonad_restart 32 0 currentTime + setClientMessageEvent e rw a 32 1 currentTime sendEvent dpy rw False structureNotifyMask e sync dpy False