diff --git a/Config.hs b/Config.hs deleted file mode 100644 --- a/Config.hs +++ /dev/null @@ -1,190 +0,0 @@ -{-# OPTIONS -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- --- | --- Module : Config --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- The default configuration of bluetile --- ------------------------------------------------------------------------------ - -module Config 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.BoringWindows -import XMonad.Layout.Decoration -import XMonad.Layout.WindowSwitcherDecoration -import XMonad.Layout.DraggingVisualizer -import XMonad.Layout.PositionStoreFloat -import XMonad.Layout.BorderResize -import XMonad.Layout.MouseResizableTile -import XMonad.Layout.NoFrillsDecoration - -import XMonad.Actions.CycleWS -import XMonad.Actions.BluetileCommands -import XMonad.Actions.WindowMenu - -import XMonad.Hooks.ManageDocks -import XMonad.Hooks.EwmhDesktops -import XMonad.Hooks.CustomRestart -import XMonad.Hooks.RestoreMinimized -import XMonad.Hooks.WorkspaceByPos -import XMonad.Hooks.BluetileDock -import XMonad.Hooks.ServerMode - -import XMonad.Config.Gnome - -import qualified XMonad.StackSet as W -import qualified Data.Map as M - -import System.Exit -import Data.Monoid -import Control.Monad(when) - -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 $ - -- 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 - - , ((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 - - , ((modMask', xK_o ), 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 - - -- modifying the window order - , ((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 - - -- 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 - - -- floating layer support - , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling - , ((modMask' .|. shiftMask, xK_t ), 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 - - -- quit, or restart - , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit bluetile - , ((modMask' , xK_q ), 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) - - -- 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") - - -- Maximizing - , ((modMask' , xK_z), withFocused (sendMessage . maximizeRestore)) - - -- Minimizing - , ((modMask', xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) - , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) - ] - ++ - -- mod-[1..9] ++ [0] %! Switch to workspace N - -- 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)]] - ++ - -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 - -- 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)]] - -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)) - -- mod-button2 %! Switch to next and first layout - , ((modMask', button2), (\_ -> sendMessage NextLayout)) - , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating")) - -- mod-button3 %! Resize a floated window by dragging - , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $ - focus w >> mouseResizeWindow w >> windows W.shiftMaster)) - ] - -isFloating :: Window -> X (Bool) -isFloating w = do - ws <- gets windowset - return $ M.member w (W.floating ws) - -blueTileManageHook :: ManageHook -blueTileManageHook = composeAll - [ workspaceByPos - , className =? "MPlayer" --> doFloat - , manageDocks] - -blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( - named "Floating" floating ||| - named "Tiled1" tiled1 ||| - named "Tiled2" tiled2 ||| - named "Fullscreen" fullscreen - ) - where - floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat - tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored - tiled2 = tilingDeco $ maximize $ mouseResizableTile - fullscreen = tilingDeco $ maximize $ smartBorders Full - - tilingDeco l = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer l) - floatingDeco l = noFrillsDeco shrinkText defaultTheme l - -blueTileConfig dockHandle = - defaultConfig - { modMask = mod4Mask, -- logo key - manageHook = blueTileManageHook, - layoutHook = blueTileLayoutHook, - logHook = ewmhDesktopsLogHook >> bluetileDock dockHandle, - handleEventHook = ewmhDesktopsEventHook - `mappend` customRestartEventHook "bluetile" - `mappend` restoreMinimizedEventHook - `mappend` serverModeEventHookCustom bluetileCommands, - workspaces = blueTileWorkspaces, - keys = blueTileKeys, - mouseBindings = blueTileMouseBindings, - focusFollowsMouse = False, - focusedBorderColor = "#ff5500", - terminal = "gnome-terminal" - } diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -1,79 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : Main --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- bluetile - a modern tiling window manager with a gentle learning curve --- ------------------------------------------------------------------------------ - -module Main (main) where - -import XMonad -import XMonad.Util.Run (spawnPipe) - -import Config - -import System.IO -import System.Environment -import System.Cmd -import System.Exit - --- | The entry point into bluetile. Just launch with the default --- configuration. Compiling a custom configuration is not supported for now. -main :: IO () -main = do - -- start docks and greeting screen - dockHandle <- spawnPipe "bluetiledock" - spawnPipe "bluetilegreet" - - -- check terminal - uninstallSignalHandlers -- make sure we can receive SIGCHLD to check terminal - blueTileConfig' <- checkTerminal $ blueTileConfig dockHandle - installSignalHandlers -- important to ignore SIGCHLD from now on to avoid zombies - - -- process arguments - let launch = xmonad blueTileConfig' - args <- getArgs - case args of - [] -> launch - ["--resume", _] -> launch - ["--help"] -> usage - ["--restart"] -> sendRestart >> return () - ["--version"] -> putStrLn ("bluetile 0.1") - _ -> fail "unrecognized flags" - -usage :: IO () -usage = do - self <- getProgName - putStr . unlines $ - concat ["Usage: ", self, " [OPTION]"] : - "Options:" : - " --help Print this message" : - " --version Print the version number" : - " --restart Request a running xmonad process to restart" : - [] - -sendRestart :: IO () -sendRestart = do - dpy <- openDisplay "" - rw <- rootWindow dpy $ defaultScreen dpy - xmonad_restart <- internAtom dpy "XMONAD_CUSTOM_RESTART" False - allocaXEvent $ \e -> do - setEventType e clientMessage - setClientMessageEvent e rw xmonad_restart 32 0 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" } diff --git a/bluetile.cabal b/bluetile.cabal --- a/bluetile.cabal +++ b/bluetile.cabal @@ -1,5 +1,5 @@ Name: bluetile -Version: 0.1 +Version: 0.2 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 @@ -13,13 +13,41 @@ License-file: LICENSE Author: Jan Vornberger Maintainer: jan.vornberger@informatik.uni-oldenburg.de -extra-source-files: Config.hs +extra-source-files: src/Config.hs + bluetiledock/Utils.hs, + bluetilegreet/Utils.hs +data-files: bluetiledock/bluetiledock.glade, + bluetiledock/floating.svg, + bluetiledock/tiled1.svg, + bluetiledock/tiled2.svg, + bluetiledock/fullscreen.svg + bluetilegreet/bluetilegreet.glade Build-Type: Simple Cabal-Version: >=1.2 Executable bluetile Main-is: Main.hs + Hs-Source-Dirs: src Build-Depends: base>=3, base<4, containers, process, xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, xmonad-contrib-bluetilebranch>=0.8, xmonad-contrib-bluetilebranch<0.9 Ghc-Options: -Wall + +Executable bluetiledock + Hs-Source-Dirs: bluetiledock + Main-is: BluetileDock.hs + Build-Depends: base>=3, base<4, unix, glade, gtk, X11>=1.4 + C-sources: bluetiledock/gdk_property_change_wrapper.c + Ghc-options: -Wall + +Executable bluetilemockwin + Hs-Source-Dirs: bluetilemockwin + Main-is: BluetileMockWin.hs + Build-Depends: base>=3, base<4, gtk + Ghc-options: -Wall + +Executable bluetilegreet + Hs-Source-Dirs: bluetilegreet + Main-is: BluetileGreet.hs + Build-Depends: base>=3, base<4, directory, filepath, glade, gtk + Ghc-options: -Wall diff --git a/bluetiledock/BluetileDock.hs b/bluetiledock/BluetileDock.hs new file mode 100644 --- /dev/null +++ b/bluetiledock/BluetileDock.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +---------------------------------------------------------------------------- +-- | +-- Module : Main +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +----------------------------------------------------------------------------- + +module Main where + +import Graphics.UI.Gtk +import Graphics.UI.Gtk.Glade +import Control.Concurrent +import Control.Monad(when, forM_) +import qualified Graphics.X11.Xlib as X +import qualified Graphics.X11.Xlib.Extras as XE +import System.Environment +import System.IO +import System.FilePath(pathSeparator) +import Data.Char +import Paths_bluetile +import Utils +import Data.IORef +import Data.Maybe + +import Foreign +import Foreign.C.Types +import Unsafe.Coerce(unsafeCoerce) + +foreign import ccall "set_strut_properties" + c_set_strut_properties :: Ptr Window -> CLong -> CLong -> CLong -> CLong + -> CLong -> CLong + -> CLong -> CLong + -> CLong -> CLong + -> CLong -> CLong + -> () + +setStrutProperties :: Window -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> IO () +setStrutProperties gtkWindow (left, right, top, bottom, + left_start_y, left_end_y, + right_start_y, right_end_y, + top_start_x, top_end_x, + bottom_start_x, bottom_end_x) = do + let ptrWin = unsafeCoerce gtkWindow :: ForeignPtr Window + let fi = fromIntegral + withForeignPtr ptrWin $ \realPointer -> do + return $ c_set_strut_properties realPointer (fi left) (fi right) (fi top) (fi bottom) + (fi left_start_y) (fi left_end_y) + (fi right_start_y) (fi right_end_y) + (fi top_start_x) (fi top_end_x) + (fi bottom_start_x) (fi bottom_end_x) + +data DockOutput = DO Int String String + | InternalQuitCmd + deriving (Show, Read) + +nextScreenCmdOffset :: Int +nextScreenCmdOffset = 18 + +incMasterCmd :: Int +incMasterCmd = 15 +decMasterCmd :: Int +decMasterCmd = 16 +quitBluetileCmd :: Int +quitBluetileCmd = 17 +quitBluetileStartMetacityCmd :: Int +quitBluetileStartMetacityCmd = 18 + +-- 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) + ] + +main :: IO () +main = do + args <- getArgs + let myScreenId = if (length args > 0 && head args == "--otherscreen") + then 1 + else 0 + lockSendCommand <- newIORef False + otherDockProcess <- newIORef Nothing + + -- prepare GUI + initGUI + dataDir <- getDataDir + Just xml <- xmlNew $ dataDir ++ [pathSeparator] ++ "bluetiledock" ++ [pathSeparator] ++ "bluetiledock.glade" + Just dfltScreen <- screenGetDefault + dfltWh <- screenGetWidth dfltScreen + + -- monitor0 dock + monitor0Dock <- xmlGetWidget xml castToWindow "monitor0Dock" + windowSetTypeHint monitor0Dock WindowTypeHintDock + onDestroy monitor0Dock mainQuit + (m0DockWh, m0DockHt) <- windowGetSize monitor0Dock + quitBtn <- xmlGetWidget xml castToButton "quitbutton" + let m0DockY = 50 + if myScreenId == 0 + then do + windowMove monitor0Dock 0 m0DockY + onRealize monitor0Dock $ + setStrutProperties monitor0Dock (m0DockWh + 1, 0, 0, 0, + m0DockY, m0DockY + m0DockHt, + 0, 0, 0, 0, 0, 0) + return () + else do + windowMove monitor0Dock (dfltWh - m0DockWh) m0DockY + onRealize monitor0Dock $ + setStrutProperties monitor0Dock (0, m0DockWh + 1, 0, 0, + 0, 0, + m0DockY, m0DockY + m0DockHt, + 0, 0, 0, 0) + widgetSetSensitivity quitBtn False + return () + widgetShowAll monitor0Dock + + -- toggle buttons + forM_ tbData $ \(tbName, tbCaption, _, _, f) -> do + widget <- getTogglebutton xml tbName + buttonSetLabel widget tbCaption + onToggled widget (f widget myScreenId lockSendCommand) + + -- master area buttons + incMasterBtn <- xmlGetWidget xml castToButton "incmasterbutton" + decMasterBtn <- xmlGetWidget xml castToButton "decmasterbutton" + onClicked incMasterBtn $ sendCommand incMasterCmd myScreenId + onClicked decMasterBtn $ sendCommand decMasterCmd myScreenId + + -- quit button + onClicked quitBtn $ do + dialog <- messageDialogNew (Just monitor0Dock) [DialogModal] MessageQuestion ButtonsNone "Really quit Bluetile?" + dialogAddButton dialog "Quit" (ResponseUser quitBluetileCmd) + dialogAddButton dialog "Quit and start Metacity" (ResponseUser quitBluetileStartMetacityCmd) + dialogAddButton dialog "Cancel" ResponseCancel + resp <- dialogRun dialog + widgetDestroy dialog + case resp of + ResponseUser cmd -> do + sendCommand cmd myScreenId + hndlM <- readIORef otherDockProcess + when (isJust hndlM) $ do + hPutStrLn (fromJust hndlM) $ show InternalQuitCmd + mainQuit + _ -> return () + + -- prepare stdin reader + updates <- getContents + forkIO $ processUpdate (lines updates) xml myScreenId lockSendCommand otherDockProcess + + -- enter main GUI loop + timeoutAddFull (yield >> return True) priorityDefaultIdle 50 + mainGUI + +getTogglebutton :: GladeXML -> String -> IO (ToggleButton) +getTogglebutton xml tbName = xmlGetWidget xml castToToggleButton tbName + +processUpdate :: [String] -> GladeXML -> Int -> IORef Bool -> IORef (Maybe Handle) -> IO () +processUpdate updates xml myScreenId lockSendCommand otherDockProcess = + mapM_ (pU . read) updates + where + pU :: DockOutput -> IO () + pU update@(DO sid longLayoutDesc cws) = do + let layoutDesc = last $ words longLayoutDesc + hndlM <- readIORef otherDockProcess + when (sid == myScreenId) $ do + writeIORef lockSendCommand True + activateToggleButtons xml cws "workspace" + activateToggleButtons xml layoutDesc "layout" + writeIORef lockSendCommand False + when (sid /= myScreenId && isNothing hndlM) $ do + binDir <- getBinDir + hndl <- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetiledock --otherscreen" + writeIORef otherDockProcess (Just hndl) + hPutStrLn hndl $ show update + when (sid /= myScreenId && isJust hndlM) $ do + hPutStrLn (fromJust hndlM) $ show update + pU InternalQuitCmd = mainQuit + +activateToggleButtons :: GladeXML -> String -> String -> IO () +activateToggleButtons xml cws group = do + let relevantTbData = filter (\(_, _, _, group', _) -> group' == group) tbData + forM_ relevantTbData $ \(tbName, _, tag, _, _) -> do + widget <- getTogglebutton xml tbName + toggleButtonSetActive widget (tag == cws) + +sendCommandIfToggled :: (ToggleButtonClass self) => Int -> self -> Int -> IORef Bool -> IO () +sendCommandIfToggled cmd widget myScreenId lockSendCommand = do + isToggled <- toggleButtonGetActive widget + isLocked <- readIORef lockSendCommand + when (isToggled && not isLocked) $ sendCommand cmd myScreenId + +sendCommand :: Int -> Int -> IO () +sendCommand cmd myScreenId = sendCommandX (cmd + myScreenId * nextScreenCmdOffset) + +sendCommandX :: Int -> IO () +sendCommandX com = do + d <- X.openDisplay "" + rw <- X.rootWindow d $ X.defaultScreen d + a <- X.internAtom d "XMONAD_COMMAND" False + X.allocaXEvent $ \e -> do + XE.setEventType e X.clientMessage + XE.setClientMessageEvent e rw a 32 (fromIntegral com) XE.currentTime + X.sendEvent d rw False X.structureNotifyMask e + X.sync d False diff --git a/bluetiledock/Utils.hs b/bluetiledock/Utils.hs new file mode 100644 --- /dev/null +++ b/bluetiledock/Utils.hs @@ -0,0 +1,35 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Utils +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +----------------------------------------------------------------------------- + +module Utils where + +import System.Posix +import System.IO + +-- | Launch an external application through the system shell and return a @Handle@ to its standard input. +spawnPipe :: String -> IO Handle +spawnPipe x = do + (rd, wr) <- createPipe + setFdOption wr CloseOnExec True + h <- fdToHandle wr + hSetBuffering h LineBuffering + forkProcess $ do + createSession + uninstallSignalHandlers + dupTo rd stdInput + executeFile "/bin/sh" False ["-c", x] Nothing + return h + +uninstallSignalHandlers :: IO () +uninstallSignalHandlers = do + installHandler sigCHLD Default Nothing + return () diff --git a/bluetiledock/bluetiledock.glade b/bluetiledock/bluetiledock.glade new file mode 100644 --- /dev/null +++ b/bluetiledock/bluetiledock.glade @@ -0,0 +1,345 @@ + + + + + + 30 + 690 + BluetileDock - Workspace + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + Wrk- +spc + + + + + True + True + True + Switch to workspace 1 + togglebutton + 0 + + + 1 + + + + + True + True + True + Switch to workspace 2 + togglebutton + 0 + + + 2 + + + + + True + True + True + Switch to workspace 3 + togglebutton + 0 + + + 3 + + + + + True + True + True + Switch to workspace 4 + togglebutton + 0 + + + 4 + + + + + True + True + True + Switch to workspace 5 + togglebutton + 0 + + + 5 + + + + + True + True + True + Switch to workspace 6 + togglebutton + 0 + + + 6 + + + + + True + True + True + Switch to workspace 7 + togglebutton + 0 + + + 7 + + + + + True + True + True + Switch to workspace 8 + togglebutton + 0 + + + 8 + + + + + True + True + True + Switch to workspace 9 + togglebutton + 0 + + + 9 + + + + + True + True + True + Switch to workspace 0 + togglebutton + 0 + + + 10 + + + + + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + Lay- +out + + + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + floating.svg + + + + + True + True + True + Switch to stacking window layout + ... + GTK_RELIEF_HALF + 0 + + + 1 + + + + + 2 + 1 + + + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + tiled1.svg + + + + + True + True + True + Switch to tiled horizontal layout + ... + 0 + + + 1 + + + + + 2 + 2 + + + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + tiled2.svg + + + + + True + True + True + Switch to tiled vertical layout + ... + 0 + + + 1 + + + + + 2 + 3 + + + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + fullscreen.svg + + + + + True + True + True + Switch to fullscreen layout + ... + 0 + + + 1 + + + + + 2 + 4 + + + + + 1 + + + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + True + True + Increase number of windows in the master area + +1 + 0 + + + + + True + True + True + Decrease number of windows in the master area + -1 + 0 + + + 1 + + + + + True + True + True + Quit Bluetile + Q + 0 + + + 2 + + + + + 2 + + + + + + diff --git a/bluetiledock/floating.svg b/bluetiledock/floating.svg new file mode 100644 --- /dev/null +++ b/bluetiledock/floating.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/bluetiledock/fullscreen.svg b/bluetiledock/fullscreen.svg new file mode 100644 --- /dev/null +++ b/bluetiledock/fullscreen.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/bluetiledock/gdk_property_change_wrapper.c b/bluetiledock/gdk_property_change_wrapper.c new file mode 100644 --- /dev/null +++ b/bluetiledock/gdk_property_change_wrapper.c @@ -0,0 +1,28 @@ +//////////////////////////////////////////////////////////////////////////// +// Copyright : (c) Jan Vornberger 2009 +// License : BSD3-style (see LICENSE) +// +// Maintainer : jan.vornberger@informatik.uni-oldenburg.de +////////////////////////////////////////////////////////////////////////////- + +#include +#include + +void set_strut_properties(GtkWindow *window, + long left, long right, long top, long bottom, + long left_start_y, long left_end_y, + long right_start_y, long right_end_y, + long top_start_x, long top_end_x, + long bottom_start_x, long bottom_end_x) { + gulong data[12] = {0}; + data[0] = left; data[1] = right; data[2] = top; data[3] = bottom; + data[4] = left_start_y; data[5] = left_end_y; + data[6] = right_start_y; data[7] = right_end_y; + data[8] = top_start_x; data[9] = top_end_x; + data[10] = bottom_start_x; data[11] = bottom_end_x; + + gdk_property_change(GTK_WIDGET(window)->window, + gdk_atom_intern("_NET_WM_STRUT_PARTIAL", FALSE), + gdk_atom_intern ("CARDINAL", FALSE), + 32, GDK_PROP_MODE_REPLACE, (unsigned char *)data, 12); +} diff --git a/bluetiledock/tiled1.svg b/bluetiledock/tiled1.svg new file mode 100644 --- /dev/null +++ b/bluetiledock/tiled1.svg @@ -0,0 +1,99 @@ + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + diff --git a/bluetiledock/tiled2.svg b/bluetiledock/tiled2.svg new file mode 100644 --- /dev/null +++ b/bluetiledock/tiled2.svg @@ -0,0 +1,99 @@ + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + diff --git a/bluetilegreet/BluetileGreet.hs b/bluetilegreet/BluetileGreet.hs new file mode 100644 --- /dev/null +++ b/bluetilegreet/BluetileGreet.hs @@ -0,0 +1,57 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Main +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +----------------------------------------------------------------------------- + +module Main where + +import Graphics.UI.Gtk +import Graphics.UI.Gtk.Glade +import Paths_bluetile +import Utils +import Control.Monad(when) +import System.Environment(getEnv) +import System.FilePath(pathSeparator) +import System.Directory(doesFileExist) + +main :: IO () +main = do + home <- getEnv "HOME" + let configFile = home ++ [pathSeparator] ++ ".bluetilegreet" + exists <- doesFileExist configFile + when (not exists) $ greetingScreen configFile + +greetingScreen :: String -> IO () +greetingScreen configFile = do + initGUI + dataDir <- getDataDir + Just xml <- xmlNew $ dataDir ++ [pathSeparator] ++ "bluetilegreet" ++ [pathSeparator] ++ "bluetilegreet.glade" + + window <- xmlGetWidget xml castToWindow "bluetilegreetwindow" + onDestroy window mainQuit + windowSetPosition window WinPosCenter + + openWindowsBtn <- xmlGetWidget xml castToButton "openwindowsbutton" + onClicked openWindowsBtn $ do + binDir <- getBinDir + spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilemockwin 0 0 65535" + spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilemockwin 65535 0 0" + return () + + startBtn <- xmlGetWidget xml castToButton "startbutton" + startupAgainChkBtn <- xmlGetWidget xml castToCheckButton "startupagaincheckbutton" + onClicked startBtn $ do + noFutureStartups <- toggleButtonGetActive startupAgainChkBtn + when noFutureStartups $ do + writeFile configFile "Delete this file to show the Bluetile greeting screen again.\n" + mainQuit + + widgetShowAll window + mainGUI diff --git a/bluetilegreet/Utils.hs b/bluetilegreet/Utils.hs new file mode 100644 --- /dev/null +++ b/bluetilegreet/Utils.hs @@ -0,0 +1,35 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Utils +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +----------------------------------------------------------------------------- + +module Utils where + +import System.Posix +import System.IO + +-- | Launch an external application through the system shell and return a @Handle@ to its standard input. +spawnPipe :: String -> IO Handle +spawnPipe x = do + (rd, wr) <- createPipe + setFdOption wr CloseOnExec True + h <- fdToHandle wr + hSetBuffering h LineBuffering + forkProcess $ do + createSession + uninstallSignalHandlers + dupTo rd stdInput + executeFile "/bin/sh" False ["-c", x] Nothing + return h + +uninstallSignalHandlers :: IO () +uninstallSignalHandlers = do + installHandler sigCHLD Default Nothing + return () diff --git a/bluetilegreet/bluetilegreet.glade b/bluetilegreet/bluetilegreet.glade new file mode 100644 --- /dev/null +++ b/bluetilegreet/bluetilegreet.glade @@ -0,0 +1,178 @@ + + + + + + 450 + 450 + Welcome to Bluetile! + + + True + 10 + 10 + 10 + 10 + + + True + GTK_ORIENTATION_VERTICAL + 5 + GTK_ORIENTATION_VERTICAL + + + True + <span size="large" font_weight="bold">Welcome to Bluetile!</span> +A modern tiling window manager +with a gentle learning curve. + True + GTK_JUSTIFY_CENTER + + + + + True + 3 + 2 + 3 + 3 + + + + + + + + + True + Quickstart: Open a few windows and notice that you are currently in the traditional layout mode, known from most other window managers. To start tiling, switch to another layout in one of these ways: + True + + + + + True + * Using the dock on the left (buttons A, S, D or F), +* pressing the middle mouse button while + holding down the Windows key or +* using the keyboard shortcuts Win+A, Win+S, + Win+D or Win+F . + + + 1 + 2 + + + + + True + You should be fine exploring the tiling paradigm with your mouse alone, but to get the most out of it you might want to look at the keyboard shortcuts at some point. They are documented on Bluetile's website. + True + + + 2 + 3 + + + + + True + 3 + 3 + 3 + 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + True + True + True + 0 + + + True + <span size="x-small">Open +a few +windows</span> + True + + + + + 1 + 2 + 1 + 2 + + + + + 1 + 2 + + + + + 1 + + + + + True + GTK_ORIENTATION_VERTICAL + GTK_ORIENTATION_VERTICAL + + + True + True + Do not show this window on future startups. + 0 + True + + + + + True + True + True + Let's start tiling! + 0 + + + 1 + + + + + 2 + + + + + + + + diff --git a/bluetilemockwin/BluetileMockWin.hs b/bluetilemockwin/BluetileMockWin.hs new file mode 100644 --- /dev/null +++ b/bluetilemockwin/BluetileMockWin.hs @@ -0,0 +1,36 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Main +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +----------------------------------------------------------------------------- + +module Main where + +import Graphics.UI.Gtk +import System.Environment(getArgs,getProgName) + +main :: IO () +main = do + args <- getArgs + progName <- getProgName + if length args /= 3 + then putStrLn $ "Usage: " ++ progName ++ " 0 0 65535" + else let r = read $ args !! 0 + g = read $ args !! 1 + b = read $ args !! 2 + in showMockWin (Color r g b) + +showMockWin :: Color -> IO () +showMockWin c = do + initGUI + window <- windowNew + onDestroy window mainQuit + widgetModifyBg window StateNormal c + widgetShowAll window + mainGUI diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,190 @@ +{-# OPTIONS -fno-warn-missing-signatures #-} +---------------------------------------------------------------------------- +-- | +-- Module : Config +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- The default configuration of bluetile +-- +----------------------------------------------------------------------------- + +module Config 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.BoringWindows +import XMonad.Layout.Decoration +import XMonad.Layout.WindowSwitcherDecoration +import XMonad.Layout.DraggingVisualizer +import XMonad.Layout.PositionStoreFloat +import XMonad.Layout.BorderResize +import XMonad.Layout.MouseResizableTile +import XMonad.Layout.NoFrillsDecoration + +import XMonad.Actions.CycleWS +import XMonad.Actions.BluetileCommands +import XMonad.Actions.WindowMenu + +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.EwmhDesktops +import XMonad.Hooks.CustomRestart +import XMonad.Hooks.RestoreMinimized +import XMonad.Hooks.WorkspaceByPos +import XMonad.Hooks.BluetileDock +import XMonad.Hooks.ServerMode + +import XMonad.Config.Gnome + +import qualified XMonad.StackSet as W +import qualified Data.Map as M + +import System.Exit +import Data.Monoid +import Control.Monad(when) + +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 $ + -- 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 + + , ((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 + + , ((modMask', xK_o ), 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 + + -- modifying the window order + , ((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 + + -- 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 + + -- floating layer support + , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + , ((modMask' .|. shiftMask, xK_t ), 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 + + -- quit, or restart + , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit bluetile + , ((modMask' , xK_q ), 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) + + -- 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") + + -- Maximizing + , ((modMask' , xK_z), withFocused (sendMessage . maximizeRestore)) + + -- Minimizing + , ((modMask', xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) + , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) + ] + ++ + -- mod-[1..9] ++ [0] %! Switch to workspace N + -- 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)]] + ++ + -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 + -- 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)]] + +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)) + -- mod-button2 %! Switch to next and first layout + , ((modMask', button2), (\_ -> sendMessage NextLayout)) + , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating")) + -- mod-button3 %! Resize a floated window by dragging + , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $ + focus w >> mouseResizeWindow w >> windows W.shiftMaster)) + ] + +isFloating :: Window -> X (Bool) +isFloating w = do + ws <- gets windowset + return $ M.member w (W.floating ws) + +blueTileManageHook :: ManageHook +blueTileManageHook = composeAll + [ workspaceByPos + , className =? "MPlayer" --> doFloat + , manageDocks] + +blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( + named "Floating" floating ||| + named "Tiled1" tiled1 ||| + named "Tiled2" tiled2 ||| + named "Fullscreen" fullscreen + ) + where + floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat + tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored + tiled2 = tilingDeco $ maximize $ mouseResizableTile + fullscreen = tilingDeco $ maximize $ smartBorders Full + + tilingDeco l = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer l) + floatingDeco l = noFrillsDeco shrinkText defaultTheme l + +blueTileConfig dockHandle = + defaultConfig + { modMask = mod4Mask, -- logo key + manageHook = blueTileManageHook, + layoutHook = blueTileLayoutHook, + logHook = ewmhDesktopsLogHook >> bluetileDock dockHandle, + handleEventHook = ewmhDesktopsEventHook + `mappend` customRestartEventHook "bluetile" + `mappend` restoreMinimizedEventHook + `mappend` serverModeEventHookCustom bluetileCommands, + workspaces = blueTileWorkspaces, + keys = blueTileKeys, + mouseBindings = blueTileMouseBindings, + focusFollowsMouse = False, + focusedBorderColor = "#ff5500", + terminal = "gnome-terminal" + } diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,91 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Main +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- bluetile - a modern tiling window manager with a gentle learning curve +-- +----------------------------------------------------------------------------- + +module Main (main) where + +import XMonad +import XMonad.Util.Run (spawnPipe) + +import Config + +import System.IO +import System.Environment +import System.Cmd +import System.Exit +import System.FilePath(pathSeparator) + +import Paths_bluetile + +-- | The entry point into bluetile. Just launch with the default +-- configuration. Compiling a custom configuration is not supported for now. +main :: IO () +main = do + putStrLn "Welcome to Bluetile! The window manager is now attempting to start up." + putStrLn "Information: Two helper applications should appear (Bluetile's dock and" + putStrLn "a greeting screen). However, even if you see these applications, the actual" + putStrLn "window manager might still have failed to start. Make sure to check the output" + putStrLn "below for any errors and have a look at the window decorations, to be sure," + putStrLn "that Bluetile started successfully. Happy tiling!" + putStrLn "" + + -- start docks and greeting screen + binDir <- getBinDir + dockHandle <- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetiledock" + spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilegreet" + + -- check terminal + uninstallSignalHandlers -- make sure we can receive SIGCHLD to check terminal + blueTileConfig' <- checkTerminal $ blueTileConfig dockHandle + installSignalHandlers -- important to ignore SIGCHLD from now on to avoid zombies + + -- process arguments + let launch = xmonad blueTileConfig' + args <- getArgs + case args of + [] -> launch + ["--resume", _] -> launch + ["--help"] -> usage + ["--restart"] -> sendRestart >> return () + ["--version"] -> putStrLn ("bluetile 0.1") + _ -> fail "unrecognized flags" + +usage :: IO () +usage = do + self <- getProgName + putStr . unlines $ + concat ["Usage: ", self, " [OPTION]"] : + "Options:" : + " --help Print this message" : + " --version Print the version number" : + " --restart Request a running xmonad process to restart" : + [] + +sendRestart :: IO () +sendRestart = do + dpy <- openDisplay "" + rw <- rootWindow dpy $ defaultScreen dpy + xmonad_restart <- internAtom dpy "XMONAD_CUSTOM_RESTART" False + allocaXEvent $ \e -> do + setEventType e clientMessage + setClientMessageEvent e rw xmonad_restart 32 0 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" }