addfile ./Config.hs hunk ./Config.hs 1 +---------------------------------------------------------------------------- +-- | +-- 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.Hooks.ManageDocks +import XMonad.Hooks.DynamicLog +import XMonad.Hooks.EwmhDesktops +--import XMonad.Hooks.ActiveCorners +import XMonad.Hooks.EventHook +import XMonad.Util.Run (spawnPipe) +import XMonad.Util.Scratchpad + +import XMonad.Layout hiding ( (|||) ) +import XMonad.Layout.Spiral +import XMonad.Layout.ResizableTile +import XMonad.Layout.Maximize +import XMonad.Layout.Accordion +import XMonad.Layout.NoBorders +import XMonad.Layout.Grid +import XMonad.Layout.Boxes +import XMonad.Layout.DragPane +import XMonad.Layout.WindowArranger +import XMonad.Layout.ActiveCorners +import XMonad.Layout.LayoutCombinators +import XMonad.Layout.SimpleFloat +import XMonad.Layout.LayoutStorage +import XMonad.Layout.Named + +import XMonad.Actions.MouseResize +import XMonad.Actions.CycleWS + +import XMonad.Config.Gnome + +import qualified XMonad.StackSet as W +import qualified Data.Map as M + +import System.IO +import System.Exit +import Data.Monoid + +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 .|. shiftMask, xK_Return), scratchpadSpawnActionTerminal "x-terminal-emulator") -- %! Show scratchpad + , ((modMask, xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog + , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window + + , ((modMask, xK_F10 ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms + , ((modMask .|. shiftMask, xK_F10 ), setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default + + , ((modMask, xK_F5 ), refresh) -- %! Resize viewed windows to the correct size + + -- move focus up or down the window stack + , ((modMask, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window + , ((modMask .|. shiftMask, xK_Tab ), windows W.focusUp ) -- %! Move focus to the previous window + , ((modMask, xK_j ), windows W.focusDown) -- %! Move focus to the next window + , ((modMask, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window + , ((modMask, xK_m ), windows W.focusMaster ) -- %! Move focus to the master 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 MirrorShrink) + , ((modMask, xK_i ), sendMessage MirrorExpand) + + -- floating layer support + , ((modMask, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + + -- 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) + + -- 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 .|. shiftMask, xK_m), withFocused (sendMessage . maximizeRestore)) + + -- additional keys + , ((modMask , xK_minus), spawn "amixer set PCM 1-") -- lower volume + , ((modMask , xK_plus), spawn "amixer set PCM 1+") -- raise volume + , ((modMask .|. shiftMask, xK_minus), spawn "amixer set PCM mute") -- mute + , ((modMask .|. shiftMask, xK_plus), spawn "amixer set PCM unmute") -- unmute + ] + ++ + -- 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)]] + +blueTileManageHook :: ManageHook +blueTileManageHook = composeAll + [ -- shift + className =? "Firefox" --> doF(W.shift "5") + , className =? "Iceweasel" --> doF(W.shift "5") + , className =? "Gnucash" --> doF(W.shift "6") + , className =? "Pidgin" --> doF(W.shift "7") + , className =? "Gtk-gnutella" --> doF(W.shift "8") + , resource =? "amarokapp" --> doF(W.shift "9") + , className =? "stalonetray" --> doF(W.shift "0") + , className =? "Conky" --> doF(W.shift "0") + -- float + , className =? "MPlayer" --> doFloat + --, className =? "Totem" --> doIgnore + --, className =? "Gimp" --> doFloat + --, className =? "Gimp-2.4" --> doFloat + , className =? "Inkscape" --> doFloat + , className =? "Scribus" --> doFloat + , className =? "Conky" --> doFloat + , className =? "VLC media player" --> doFloat + -- ignore + , title =? "Do" --> doIgnore + , resource =? "desktop_window" --> doIgnore + , resource =? "kdesktop" --> doIgnore + , manageDocks + , scratchpadManageHookDefault] + +data EventHookButton = EventHookButton deriving ( Show, Read ) +instance EventHook EventHookButton where + handleEvent _ (ButtonEvent {ev_window = w}) = do + io $ hPutStrLn stderr + $ "This is a button event on window " ++ (show w) + handleEvent _ _ = return () + +blueTileLayoutHook = activeCorners $ avoidStruts $ layoutStorage $ maximize $ (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| dragPane Horizontal 0.1 0.5 ) + where + tiled = ResizableTall nmaster delta ratio [] + nmaster = 1 + delta = 3/100 + ratio = 1/2 + +blueTileConfig = defaultConfig + { modMask = mod4Mask, -- logo key + manageHook = blueTileManageHook, + layoutHook = blueTileLayoutHook, + logHook = ewmhDesktopsLogHook, + --handleEventHook = activeCornersEventHook `mappend` ewmhDesktopsEventHook, + handleEventHook = ewmhDesktopsEventHook, + workspaces = blueTileWorkspaces, + keys = blueTileKeys, + focusFollowsMouse = False, + focusedBorderColor = "#ff5500", + terminal = "gnome-terminal" + } addfile ./Main.hs hunk ./Main.hs 1 +---------------------------------------------------------------------------- +-- | +-- 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 gradual learning curve +-- +----------------------------------------------------------------------------- + +module Main (main) where + +import XMonad + +import Config + +import System.IO +import System.Info +import System.Environment + +-- | The entry point into bluetile. Just launch with the default +-- configuration. Compiling a custom configuration is not supported for now. +main :: IO () +main = do + installSignalHandlers -- important to ignore SIGCHLD to avoid zombies + args <- getArgs + let launch = xmonad blueTileConfig + 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_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 addfile ./LICENSE hunk ./LICENSE 1 +Copyright (c) 2009 Jan Vornberger + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. addfile ./Setup.lhs hunk ./Setup.lhs 1 +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain addfile ./bluetile.cabal hunk ./bluetile.cabal 1 +Name: bluetile +Version: 0.1 +synopsis: A modern tiling window manager with a gradual learning curve +category: System +License: BSD3 +License-file: LICENSE +Author: Jan Vornberger +Maintainer: jan.vornberger@informatik.uni-oldenburg.de +extra-source-files: Config.hs +Build-Type: Simple +Cabal-Version: >=1.2 + +Executable bluetile + Main-is: Main.hs + Build-Depends: base, containers, xmonad>=0.8, xmonad<0.9, xmonad-contrib>=0.8, xmonad-contrib<0.9 + hunk ./Config.hs 45 +import XMonad.Hooks.CustomRestart + hunk ./Config.hs 180 - handleEventHook = ewmhDesktopsEventHook, + handleEventHook = ewmhDesktopsEventHook `mappend` customRestartEventHook "bluetile", hunk ./Main.hs 55 - xmonad_restart <- internAtom dpy "XMONAD_RESTART" False + xmonad_restart <- internAtom dpy "XMONAD_CUSTOM_RESTART" False hunk ./Config.hs 105 + -- more Metacity keys + , ((mod1Mask , xK_F2), gnomeRun) + , ((mod1Mask , xK_F4), kill) + hunk ./Config.hs 21 ---import XMonad.Hooks.ActiveCorners hunk ./Config.hs 29 -import XMonad.Layout.Accordion hunk ./Config.hs 31 -import XMonad.Layout.Boxes hunk ./Config.hs 33 -import XMonad.Layout.ActiveCorners hunk ./Config.hs 35 -import XMonad.Layout.LayoutStorage hunk ./Config.hs 166 -blueTileLayoutHook = activeCorners $ avoidStruts $ layoutStorage $ maximize $ (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| dragPane Horizontal 0.1 0.5 ) +blueTileLayoutHook = avoidStruts $ maximize $ (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| dragPane Horizontal 0.1 0.5 ) hunk ./Config.hs 178 - --handleEventHook = activeCornersEventHook `mappend` ewmhDesktopsEventHook, hunk ./Config.hs 36 +import XMonad.Layout.TwoPane +import XMonad.Layout.BoringWindows hunk ./Config.hs 69 - , ((modMask, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window - , ((modMask .|. shiftMask, xK_Tab ), windows W.focusUp ) -- %! Move focus to the previous window - , ((modMask, xK_j ), windows W.focusDown) -- %! Move focus to the next window - , ((modMask, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window - , ((modMask, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window + , ((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 hunk ./Config.hs 167 -blueTileLayoutHook = avoidStruts $ maximize $ (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| dragPane Horizontal 0.1 0.5 ) +blueTileLayoutHook = avoidStruts $ boringWindows $ maximize $ (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) hunk ./Config.hs 29 +import XMonad.Layout.Minimize hunk ./Config.hs 113 - , ((modMask .|. shiftMask, xK_m), withFocused (sendMessage . maximizeRestore)) + , ((modMask , xK_z), withFocused (sendMessage . maximizeRestore)) + + -- Minimizing + , ((modMask, xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) + , ((modMask .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) hunk ./Config.hs 172 -blueTileLayoutHook = avoidStruts $ boringWindows $ maximize $ (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) +blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ maximize (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) hunk ./Config.hs 44 +import XMonad.Hooks.RestoreMinimized hunk ./Config.hs 185 - handleEventHook = ewmhDesktopsEventHook `mappend` customRestartEventHook "bluetile", + handleEventHook = ewmhDesktopsEventHook + `mappend` customRestartEventHook "bluetile" + `mappend` restoreMinimizedEventHook, hunk ./Config.hs 39 +import XMonad.Layout.SimpleDecoration +import XMonad.Layout.WindowSwitcherDecoration +import XMonad.Layout.DraggingVisualizer hunk ./Config.hs 176 -blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ maximize (named "Floating" simpleFloat ||| named "Tiled1" (Mirror tiled) ||| named "Tiled2" tiled ||| named "Fullscreen" (smartBorders Full) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) +blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ maximize (named "Floating" simpleFloat ||| named "Tiled1" (tilingDeco (Mirror tiled)) ||| named "Tiled2" (tilingDeco tiled) ||| named "Fullscreen" (tilingDeco (smartBorders Full)) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) hunk ./Config.hs 178 + tilingDeco l = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer l) hunk ./Config.hs 155 - --, className =? "Totem" --> doIgnore - --, className =? "Gimp" --> doFloat - --, className =? "Gimp-2.4" --> doFloat - , className =? "Inkscape" --> doFloat - , className =? "Scribus" --> doFloat - , className =? "Conky" --> doFloat - , className =? "VLC media player" --> doFloat hunk ./Config.hs 42 +import XMonad.Layout.PositionStoreFloat hunk ./Config.hs 170 -blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ maximize (named "Floating" simpleFloat ||| named "Tiled1" (tilingDeco (Mirror tiled)) ||| named "Tiled2" (tilingDeco tiled) ||| named "Fullscreen" (tilingDeco (smartBorders Full)) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) +blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ maximize (named "Floating" positionStoreFloat ||| named "Tiled1" (tilingDeco (Mirror tiled)) ||| named "Tiled2" (tilingDeco tiled) ||| named "Fullscreen" (tilingDeco (smartBorders Full)) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) hunk ./Config.hs 49 +import XMonad.Hooks.WorkspaceByPos hunk ./Config.hs 146 - [ -- shift - className =? "Firefox" --> doF(W.shift "5") + [ workspaceByPos + -- shift + , className =? "Firefox" --> doF(W.shift "5") hunk ./Config.hs 39 +import XMonad.Layout.Decoration hunk ./Config.hs 173 -blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ maximize (named "Floating" positionStoreFloat ||| named "Tiled1" (tilingDeco (Mirror tiled)) ||| named "Tiled2" (tilingDeco tiled) ||| named "Fullscreen" (tilingDeco (smartBorders Full)) ||| spiral (6/7) ||| Grid ||| TwoPane (3/100) (1/2) ) +blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( + named "Floating" floating ||| + named "Tiled1" tiled1 ||| + named "Tiled2" tiled2 ||| + named "Fullscreen" fullscreen + ) hunk ./Config.hs 180 + floating = mouseResize $ floatingDeco $ maximize $ positionStoreFloat + tiled1 = tilingDeco $ maximize $ Mirror tiled + tiled2 = tilingDeco $ maximize $ tiled + fullscreen = tilingDeco $ maximize $ smartBorders Full + hunk ./Config.hs 186 + floatingDeco l = simpleDeco shrinkText defaultTheme l hunk ./bluetile.cabal 15 - Build-Depends: base, containers, xmonad>=0.8, xmonad<0.9, xmonad-contrib>=0.8, xmonad-contrib<0.9 + Build-Depends: base, containers, xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, + xmonad-contrib-bluetilebranch>=0.8, xmonad-contrib-bluetilebranch<0.9 hunk ./Main.hs 24 +import System.Cmd +import System.Exit hunk ./Main.hs 31 + blueTileConfig' <- checkTerminal blueTileConfig hunk ./Main.hs 34 - let launch = xmonad blueTileConfig + let launch = xmonad blueTileConfig' hunk ./Main.hs 64 + +checkTerminal :: XConfig l -> IO (XConfig l) +checkTerminal conf = do + let terminal = XMonad.terminal conf + status <- system $ "which " ++ terminal + if status == ExitSuccess + then return conf + else return conf { terminal = "xterm" } hunk ./bluetile.cabal 15 - Build-Depends: base, containers, xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, - xmonad-contrib-bluetilebranch>=0.8, xmonad-contrib-bluetilebranch<0.9 + Build-Depends: base, containers, xmonad>=0.8, xmonad<0.9, xmonad-contrib>=0.8, xmonad-contrib<0.9 hunk ./bluetile.cabal 15 - Build-Depends: base, containers, xmonad>=0.8, xmonad<0.9, xmonad-contrib>=0.8, xmonad-contrib<0.9 - + Build-Depends: base, containers, process, xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, + xmonad-contrib-bluetilebranch>=0.8, xmonad-contrib-bluetilebranch<0.9 hunk ./Main.hs 31 + uninstallSignalHandlers -- make sure we can receive SIGCHLD to check terminal hunk ./Main.hs 33 - installSignalHandlers -- important to ignore SIGCHLD to avoid zombies + installSignalHandlers -- important to ignore SIGCHLD from now on to avoid zombies hunk ./Main.hs 69 - status <- system $ "which " ++ terminal + status <- system $ "which " ++ terminal ++ " > /dev/null" hunk ./Config.hs 44 +import XMonad.Layout.MouseResizableTile hunk ./Config.hs 90 - , ((modMask, xK_u ), sendMessage MirrorShrink) - , ((modMask, xK_i ), sendMessage MirrorExpand) + , ((modMask, xK_u ), sendMessage MirrorShrink >> sendMessage ShrinkSlave) + , ((modMask, xK_i ), sendMessage MirrorExpand >> sendMessage ExpandSlave) hunk ./Config.hs 183 - tiled2 = tilingDeco $ maximize $ tiled + tiled2 = tilingDeco $ maximize $ mouseResizableTile hunk ./Config.hs 44 -import XMonad.Layout.MouseResizableTile hunk ./Config.hs 180 - floating = mouseResize $ floatingDeco $ maximize $ positionStoreFloat + floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat hunk ./Config.hs 44 +import XMonad.Layout.BorderResize +import XMonad.Layout.MouseResizableTile hunk ./Config.hs 27 -import XMonad.Layout.ResizableTile hunk ./Config.hs 90 - , ((modMask, xK_u ), sendMessage MirrorShrink >> sendMessage ShrinkSlave) - , ((modMask, xK_i ), sendMessage MirrorExpand >> sendMessage ExpandSlave) + , ((modMask, xK_u ), sendMessage ShrinkSlave) -- %! Shrink a slave area + , ((modMask, xK_i ), sendMessage ExpandSlave) -- %! Expand a slave area hunk ./Config.hs 182 - tiled1 = tilingDeco $ maximize $ Mirror tiled + tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored hunk ./Config.hs 188 - tiled = ResizableTall nmaster delta ratio [] - nmaster = 1 - delta = 3/100 - ratio = 1/2 hunk ./Config.hs 52 +import XMonad.Hooks.BluetileDock hunk ./Config.hs 190 -blueTileConfig = defaultConfig - { modMask = mod4Mask, -- logo key - manageHook = blueTileManageHook, - layoutHook = blueTileLayoutHook, - logHook = ewmhDesktopsLogHook, - handleEventHook = ewmhDesktopsEventHook - `mappend` customRestartEventHook "bluetile" - `mappend` restoreMinimizedEventHook, - workspaces = blueTileWorkspaces, - keys = blueTileKeys, - focusFollowsMouse = False, - focusedBorderColor = "#ff5500", - terminal = "gnome-terminal" - } +blueTileConfig dockHandle = + defaultConfig + { modMask = mod4Mask, -- logo key + manageHook = blueTileManageHook, + layoutHook = blueTileLayoutHook, + logHook = ewmhDesktopsLogHook >> bluetileDock dockHandle, + handleEventHook = ewmhDesktopsEventHook + `mappend` customRestartEventHook "bluetile" + `mappend` restoreMinimizedEventHook, + workspaces = blueTileWorkspaces, + keys = blueTileKeys, + focusFollowsMouse = False, + focusedBorderColor = "#ff5500", + terminal = "gnome-terminal" + } hunk ./Main.hs 18 +import XMonad.Util.Run (spawnPipe) hunk ./Main.hs 32 + -- start docks + dockHandle <- spawnPipe "bluetiledock" + + -- check terminal hunk ./Main.hs 37 - blueTileConfig' <- checkTerminal blueTileConfig + blueTileConfig' <- checkTerminal $ blueTileConfig dockHandle hunk ./Main.hs 39 - args <- getArgs + + -- process arguments hunk ./Main.hs 42 + args <- getArgs hunk ./Config.hs 48 +import XMonad.Actions.BluetileCommands hunk ./Config.hs 54 +import XMonad.Hooks.ServerMode hunk ./Config.hs 58 -import qualified XMonad.StackSet as W +import qualified XMonad.StackSet as W hunk ./Config.hs 200 - `mappend` restoreMinimizedEventHook, + `mappend` restoreMinimizedEventHook + `mappend` serverModeEventHookCustom bluetileCommands, hunk ./Config.hs 45 +import XMonad.Layout.NoFrillsDecoration hunk ./Config.hs 191 - floatingDeco l = simpleDeco shrinkText defaultTheme l + floatingDeco l = noFrillsDeco shrinkText defaultTheme l hunk ./Config.hs 50 +import XMonad.Actions.WindowMenu hunk ./Config.hs 82 + , ((modMask, xK_o ), windowMenu) + hunk ./Config.hs 66 +import Control.Monad(when) hunk ./Config.hs 103 + , ((modMask .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window hunk ./Config.hs 155 +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) + hunk ./Config.hs 228 + mouseBindings = blueTileMouseBindings, hunk ./Config.hs 18 -import XMonad.Hooks.ManageDocks -import XMonad.Hooks.DynamicLog -import XMonad.Hooks.EwmhDesktops -import XMonad.Hooks.EventHook -import XMonad.Util.Run (spawnPipe) -import XMonad.Util.Scratchpad hunk ./Config.hs 20 -import XMonad.Layout.Spiral hunk ./Config.hs 23 -import XMonad.Layout.Grid -import XMonad.Layout.DragPane -import XMonad.Layout.WindowArranger hunk ./Config.hs 24 -import XMonad.Layout.SimpleFloat hunk ./Config.hs 25 -import XMonad.Layout.TwoPane hunk ./Config.hs 27 -import XMonad.Layout.SimpleDecoration hunk ./Config.hs 34 -import XMonad.Actions.MouseResize hunk ./Config.hs 38 +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.EwmhDesktops hunk ./Config.hs 51 -import System.IO hunk ./Config.hs 61 - , ((modMask .|. shiftMask, xK_Return), scratchpadSpawnActionTerminal "x-terminal-emulator") -- %! Show scratchpad hunk ./Config.hs 64 - , ((modMask, xK_F10 ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms - , ((modMask .|. shiftMask, xK_F10 ), setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default - - , ((modMask, xK_F5 ), refresh) -- %! Resize viewed windows to the correct size + , ((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 hunk ./Config.hs 119 - - -- additional keys - , ((modMask , xK_minus), spawn "amixer set PCM 1-") -- lower volume - , ((modMask , xK_plus), spawn "amixer set PCM 1+") -- raise volume - , ((modMask .|. shiftMask, xK_minus), spawn "amixer set PCM mute") -- mute - , ((modMask .|. shiftMask, xK_plus), spawn "amixer set PCM unmute") -- unmute hunk ./Config.hs 151 -blueTileManageHook :: ManageHook +blueTileManageHook :: ManageHook hunk ./Config.hs 154 - -- shift - , className =? "Firefox" --> doF(W.shift "5") - , className =? "Iceweasel" --> doF(W.shift "5") - , className =? "Gnucash" --> doF(W.shift "6") - , className =? "Pidgin" --> doF(W.shift "7") - , className =? "Gtk-gnutella" --> doF(W.shift "8") - , resource =? "amarokapp" --> doF(W.shift "9") - , className =? "stalonetray" --> doF(W.shift "0") - , className =? "Conky" --> doF(W.shift "0") - -- float hunk ./Config.hs 155 - -- ignore - , title =? "Do" --> doIgnore - , resource =? "desktop_window" --> doIgnore - , resource =? "kdesktop" --> doIgnore - , manageDocks - , scratchpadManageHookDefault] - -data EventHookButton = EventHookButton deriving ( Show, Read ) -instance EventHook EventHookButton where - handleEvent _ (ButtonEvent {ev_window = w}) = do - io $ hPutStrLn stderr - $ "This is a button event on window " ++ (show w) - handleEvent _ _ = return () + , manageDocks] hunk ./Config.hs 1 +{-# OPTIONS -fno-warn-missing-signatures #-} hunk ./Config.hs 56 -blueTileWorkspaces = ["1","2","3","4","5","6","7","8","9", "0"] +blueTileWorkspaces :: [String] +blueTileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"] hunk ./Config.hs 60 -blueTileKeys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $ +blueTileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ hunk ./Config.hs 62 - [ ((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_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 hunk ./Config.hs 66 - , ((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_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 hunk ./Config.hs 69 - , ((modMask, xK_o ), windowMenu) + , ((modMask', xK_o ), windowMenu) hunk ./Config.hs 72 - , ((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_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 hunk ./Config.hs 78 - , ((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 + , ((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 hunk ./Config.hs 82 - , ((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 + , ((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 hunk ./Config.hs 88 - , ((modMask, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling - , ((modMask .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window + , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + , ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window hunk ./Config.hs 92 - , ((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 + , ((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 hunk ./Config.hs 96 - , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit bluetile - , ((modMask , xK_q ), spawn "bluetile --restart") -- %! Restart bluetile + , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit bluetile + , ((modMask' , xK_q ), spawn "bluetile --restart") -- %! Restart bluetile hunk ./Config.hs 110 - , ((modMask , xK_a), sendMessage $ JumpToLayout "Floating") - , ((modMask , xK_s), sendMessage $ JumpToLayout "Tiled1") - , ((modMask , xK_d), sendMessage $ JumpToLayout "Tiled2") - , ((modMask , xK_f), sendMessage $ JumpToLayout "Fullscreen") + , ((modMask' , xK_a), sendMessage $ JumpToLayout "Floating") + , ((modMask' , xK_s), sendMessage $ JumpToLayout "Tiled1") + , ((modMask' , xK_d), sendMessage $ JumpToLayout "Tiled2") + , ((modMask' , xK_f), sendMessage $ JumpToLayout "Fullscreen") hunk ./Config.hs 116 - , ((modMask , xK_z), withFocused (sendMessage . maximizeRestore)) + , ((modMask' , xK_z), withFocused (sendMessage . maximizeRestore)) hunk ./Config.hs 119 - , ((modMask, xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) - , ((modMask .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) + , ((modMask', xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) + , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) hunk ./Config.hs 125 - [((m .|. modMask, k), windows $ f i) + [((m .|. modMask', k), windows $ f i) hunk ./Config.hs 131 - [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f)) + [((m .|. modMask', key), screenWorkspace sc >>= flip whenJust (windows . f)) hunk ./Config.hs 136 -blueTileMouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $ +blueTileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ hunk ./Config.hs 138 - [ ((modMask, button1), (\w -> isFloating w >>= \isF -> when (isF) $ + [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $ hunk ./Config.hs 141 - , ((modMask, button2), (\_ -> sendMessage NextLayout)) - , ((modMask .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating")) + , ((modMask', button2), (\_ -> sendMessage NextLayout)) + , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating")) hunk ./Config.hs 144 - , ((modMask, button3), (\w -> isFloating w >>= \isF -> when (isF) $ + , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $ hunk ./Main.hs 23 -import System.Info hunk ./Main.hs 74 - let terminal = XMonad.terminal conf - status <- system $ "which " ++ terminal ++ " > /dev/null" + let term = XMonad.terminal conf + status <- system $ "which " ++ term ++ " > /dev/null" hunk ./bluetile.cabal 17 + Ghc-Options: -Wall hunk ./Main.hs 11 --- bluetile - a modern tiling window manager with a gradual learning curve +-- bluetile - a modern tiling window manager with a gentle learning curve hunk ./bluetile.cabal 3 -synopsis: A modern tiling window manager with a gradual learning curve +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 + automatically to tile the screen without gaps or overlap, maximising + screen use. Bluetile's focus lies on making the tiling paradigm easily + accessible for users coming from traditional window managers by drawing + on known conventions and making all features available using the mouse. + It also tries to be usable 'out of the box', making configuration unnecessary. hunk ./Main.hs 31 - -- start docks + -- start docks and greeting screen hunk ./Main.hs 33 + spawnPipe "bluetilegreet" hunk ./bluetile.cabal 22 - Build-Depends: base, containers, process, xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, + Build-Depends: base>=3, base<4, containers, process, + xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, adddir ./src move ./Config.hs ./src/Config.hs move ./Main.hs ./src/Main.hs hunk ./bluetile.cabal 16 -extra-source-files: Config.hs +extra-source-files: src/Config.hs hunk ./bluetile.cabal 22 + Hs-Source-Dirs: src hunk ./src/Main.hs 31 + 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 "" + hunk ./bluetile.cabal 17 + 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 hunk ./bluetile.cabal 35 + +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 adddir ./bluetiledock addfile ./bluetiledock/BluetileDock.hs hunk ./bluetiledock/BluetileDock.hs 1 +{-# 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 + hndl <- spawnPipe "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 addfile ./bluetiledock/Utils.hs hunk ./bluetiledock/Utils.hs 1 +---------------------------------------------------------------------------- +-- | +-- 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 () addfile ./bluetiledock/bluetiledock.glade hunk ./bluetiledock/bluetiledock.glade 1 + + + + + + 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 + + + + + + addfile ./bluetiledock/floating.svg hunk ./bluetiledock/floating.svg 1 + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + addfile ./bluetiledock/fullscreen.svg hunk ./bluetiledock/fullscreen.svg 1 + + + + + + + + + + + + + image/svg+xml + + + + + + + + + addfile ./bluetiledock/gdk_property_change_wrapper.c hunk ./bluetiledock/gdk_property_change_wrapper.c 1 +//////////////////////////////////////////////////////////////////////////// +// 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); +} addfile ./bluetiledock/tiled1.svg hunk ./bluetiledock/tiled1.svg 1 + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + addfile ./bluetiledock/tiled2.svg hunk ./bluetiledock/tiled2.svg 1 + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + adddir ./bluetilegreet addfile ./bluetilegreet/BluetileGreet.hs hunk ./bluetilegreet/BluetileGreet.hs 1 +---------------------------------------------------------------------------- +-- | +-- 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 + spawnPipe "bluetilemockwin 0 0 65535" + spawnPipe "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 addfile ./bluetilegreet/Utils.hs hunk ./bluetilegreet/Utils.hs 1 +---------------------------------------------------------------------------- +-- | +-- 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 () addfile ./bluetilegreet/bluetilegreet.glade hunk ./bluetilegreet/bluetilegreet.glade 1 + + + + + + 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 + + + + + + + + adddir ./bluetilemockwin addfile ./bluetilemockwin/BluetileMockWin.hs hunk ./bluetilemockwin/BluetileMockWin.hs 1 +---------------------------------------------------------------------------- +-- | +-- 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 hunk ./bluetiledock/BluetileDock.hs 188 - hndl <- spawnPipe "bluetiledock --otherscreen" + binDir <- getBinDir + hndl <- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetiledock --otherscreen" hunk ./bluetilegreet/BluetileGreet.hs 43 - spawnPipe "bluetilemockwin 0 0 65535" - spawnPipe "bluetilemockwin 65535 0 0" + binDir <- getBinDir + spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilemockwin 0 0 65535" + spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilemockwin 65535 0 0" hunk ./src/Main.hs 26 +import System.FilePath(pathSeparator) + +import Paths_bluetile hunk ./src/Main.hs 43 - dockHandle <- spawnPipe "bluetiledock" - spawnPipe "bluetilegreet" + binDir <- getBinDir + dockHandle <- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetiledock" + spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilegreet" hunk ./bluetile.cabal 2 -Version: 0.1 +Version: 0.2 hunk ./bluetile.cabal 8 - accessible for users coming from traditional window managers by drawing - on known conventions and making all features available using the mouse. + accessible to users coming from traditional window managers by drawing + on known conventions and provide both mouse and keyboard access for all features. hunk ./src/Config.hs 76 + , ((modMask', xK_space ), focusMaster) -- %! Move focus to the master window hunk ./src/Config.hs 79 + , ((modMask' .|. shiftMask, xK_space ), windows W.swapMaster) -- %! Swap the focused window and the master window hunk ./bluetile.cabal 2 -Version: 0.2 +Version: 0.3 hunk ./bluetile.cabal 32 - xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, - xmonad-contrib-bluetilebranch>=0.8, xmonad-contrib-bluetilebranch<0.9 + xmonad-bluetilebranch>=0.8.1.3, xmonad-contrib-bluetilebranch>=0.8.1.3 hunk ./bluetile.cabal 9 - on known conventions and provide both mouse and keyboard access for all features. + on known conventions and providing both mouse and keyboard access for all features. hunk ./src/Main.hs 29 +import Data.Version(showVersion) hunk ./src/Main.hs 35 + -- process arguments + args <- getArgs + case args of + [] -> launch + ["--resume", _] -> launch + ["--help"] -> usage + ["--restart"] -> sendRestart >> return () + ["--version"] -> putStrLn ("bluetile " ++ showVersion version) + _ -> fail "unrecognized flags" + +launch :: IO () +launch = do hunk ./src/Main.hs 65 - -- 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" + xmonad blueTileConfig' hunk ./bluetile.cabal 2 -Version: 0.3 +Version: 0.4 hunk ./bluetile.cabal 16 -extra-source-files: src/Config.hs +extra-source-files: src/Config.hs, + src/BluetileCommands.hs, + src/BluetileDock.hs, hunk ./bluetile.cabal 25 - bluetiledock/fullscreen.svg + bluetiledock/fullscreen.svg, hunk ./bluetile.cabal 34 - xmonad-bluetilebranch>=0.8.1.3, xmonad-contrib-bluetilebranch>=0.8.1.3 + xmonad>=0.9, xmonad-contrib>=0.9 hunk ./bluetiledock/BluetileDock.hs 66 -incMasterCmd = 15 +incMasterCmd = 16 hunk ./bluetiledock/BluetileDock.hs 68 -decMasterCmd = 16 +decMasterCmd = 17 hunk ./bluetiledock/BluetileDock.hs 70 -quitBluetileCmd = 17 +quitBluetileCmd = 18 hunk ./bluetiledock/BluetileDock.hs 72 -quitBluetileStartMetacityCmd = 18 +quitBluetileStartMetacityCmd = 19 hunk ./bluetiledock/BluetileDock.hs 76 -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) addfile ./src/BluetileCommands.hs hunk ./src/BluetileCommands.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : BluetileCommands +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +----------------------------------------------------------------------------- + +module BluetileCommands (bluetileCommands) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutCombinators +import System.Exit + +-- | Generate a list of commands to switch to workspaces (on the given screen). +workspaceCommands :: Int -> X [(String, X ())] +workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return + [(("greedyView" ++ show i), + activateScreen sid >> windows (W.greedyView i)) + | i <- spaces ] + +layoutCommands :: Int -> [(String, X ())] +layoutCommands sid = [ ("layout floating" , activateScreen sid >> + sendMessage (JumpToLayout "Floating")) + , ("layout tiled1" , activateScreen sid >> + sendMessage (JumpToLayout "Tiled1")) + , ("layout tiled2" , activateScreen sid >> + sendMessage (JumpToLayout "Tiled2")) + , ("layout fullscreen" , activateScreen sid >> + sendMessage (JumpToLayout "Fullscreen")) + ] + +masterAreaCommands :: Int -> [(String, X ())] +masterAreaCommands sid = [ ("increase master n", activateScreen sid >> + sendMessage (IncMasterN 1)) + , ("decrease master n", activateScreen sid >> + sendMessage (IncMasterN (-1))) + ] + +quitCommands :: [(String, X ())] +quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess)) + , ("quit bluetile and start metacity", restart "metacity" False) + ] + +bluetileCommands :: X [(String, X ())] +bluetileCommands = do + let restartCommand = [ ("restart bluetile", restart "bluetile" True) ] + wscmds0 <- workspaceCommands 0 + wscmds1 <- workspaceCommands 1 + return $ restartCommand + ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands + ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands + +activateScreen :: Int -> X () +activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view) addfile ./src/BluetileDock.hs hunk ./src/BluetileDock.hs 1 +---------------------------------------------------------------------------- +-- | +-- 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 hunk ./src/Config.hs 18 +import BluetileCommands +import BluetileDock + hunk ./src/Config.hs 31 +import XMonad.Layout.DecorationAddons hunk ./src/Config.hs 37 -import XMonad.Layout.NoFrillsDecoration +import XMonad.Layout.ButtonDecoration hunk ./src/Config.hs 40 -import XMonad.Actions.BluetileCommands hunk ./src/Config.hs 44 -import XMonad.Hooks.CustomRestart hunk ./src/Config.hs 46 -import XMonad.Hooks.BluetileDock hunk ./src/Config.hs 47 +import XMonad.Hooks.PositionStoreHooks +import XMonad.Hooks.CurrentWorkspaceOnTop hunk ./src/Config.hs 160 - [ workspaceByPos + [ workspaceByPos, positionStoreManageHook hunk ./src/Config.hs 176 - 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 hunk ./src/Config.hs 184 - logHook = ewmhDesktopsLogHook >> bluetileDock dockHandle, + logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook >> bluetileDock dockHandle, hunk ./src/Config.hs 186 - `mappend` customRestartEventHook "bluetile" hunk ./src/Config.hs 187 - `mappend` serverModeEventHookCustom bluetileCommands, + `mappend` serverModeEventHook' bluetileCommands + `mappend` positionStoreEventHook, hunk ./src/Main.hs 19 +import XMonad.Util.Replace hunk ./src/Main.hs 40 - ["--resume", _] -> launch + ("--resume":_) -> launch hunk ./src/Main.hs 66 + replace hunk ./src/Main.hs 84 - xmonad_restart <- internAtom dpy "XMONAD_CUSTOM_RESTART" False + a <- internAtom dpy "XMONAD_COMMAND" False hunk ./src/Main.hs 87 - setClientMessageEvent e rw xmonad_restart 32 0 currentTime + setClientMessageEvent e rw a 32 1 currentTime hunk ./bluetile.cabal 17 - src/BluetileCommands.hs, hunk ./src/BluetileCommands.hs 1 ----------------------------------------------------------------------------- --- | --- Module : BluetileCommands --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- ------------------------------------------------------------------------------ - -module BluetileCommands (bluetileCommands) where - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Layout.LayoutCombinators -import System.Exit - --- | Generate a list of commands to switch to workspaces (on the given screen). -workspaceCommands :: Int -> X [(String, X ())] -workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return - [(("greedyView" ++ show i), - activateScreen sid >> windows (W.greedyView i)) - | i <- spaces ] - -layoutCommands :: Int -> [(String, X ())] -layoutCommands sid = [ ("layout floating" , activateScreen sid >> - sendMessage (JumpToLayout "Floating")) - , ("layout tiled1" , activateScreen sid >> - sendMessage (JumpToLayout "Tiled1")) - , ("layout tiled2" , activateScreen sid >> - sendMessage (JumpToLayout "Tiled2")) - , ("layout fullscreen" , activateScreen sid >> - sendMessage (JumpToLayout "Fullscreen")) - ] - -masterAreaCommands :: Int -> [(String, X ())] -masterAreaCommands sid = [ ("increase master n", activateScreen sid >> - sendMessage (IncMasterN 1)) - , ("decrease master n", activateScreen sid >> - sendMessage (IncMasterN (-1))) - ] - -quitCommands :: [(String, X ())] -quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess)) - , ("quit bluetile and start metacity", restart "metacity" False) - ] - -bluetileCommands :: X [(String, X ())] -bluetileCommands = do - let restartCommand = [ ("restart bluetile", restart "bluetile" True) ] - wscmds0 <- workspaceCommands 0 - wscmds1 <- workspaceCommands 1 - return $ restartCommand - ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands - ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands - -activateScreen :: Int -> X () -activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view) rmfile ./src/BluetileCommands.hs hunk ./src/Config.hs 18 -import BluetileCommands hunk ./src/Config.hs 40 +import XMonad.Actions.BluetileCommands hunk ./src/Config.hs 12 --- The default configuration of bluetile +-- This is the default configuration of Bluetile hunk ./src/Config.hs 16 -module Config where - -import BluetileDock +module Config ( + bluetileConfig + ) where hunk ./src/Config.hs 23 -import XMonad.Layout.Maximize -import XMonad.Layout.Minimize -import XMonad.Layout.NoBorders -import XMonad.Layout.LayoutCombinators -import XMonad.Layout.Named +import XMonad.Layout.BorderResize hunk ./src/Config.hs 25 +import XMonad.Layout.ButtonDecoration hunk ./src/Config.hs 28 -import XMonad.Layout.WindowSwitcherDecoration hunk ./src/Config.hs 29 -import XMonad.Layout.PositionStoreFloat -import XMonad.Layout.BorderResize +import XMonad.Layout.LayoutCombinators +import XMonad.Layout.Maximize +import XMonad.Layout.Minimize hunk ./src/Config.hs 33 -import XMonad.Layout.ButtonDecoration +import XMonad.Layout.Named +import XMonad.Layout.NoBorders +import XMonad.Layout.PositionStoreFloat +import XMonad.Layout.WindowSwitcherDecoration hunk ./src/Config.hs 38 +import XMonad.Actions.BluetileCommands hunk ./src/Config.hs 41 -import XMonad.Actions.BluetileCommands hunk ./src/Config.hs 42 -import XMonad.Hooks.ManageDocks +import XMonad.Hooks.CurrentWorkspaceOnTop hunk ./src/Config.hs 44 +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.PositionStoreHooks hunk ./src/Config.hs 47 -import XMonad.Hooks.WorkspaceByPos hunk ./src/Config.hs 48 -import XMonad.Hooks.PositionStoreHooks -import XMonad.Hooks.CurrentWorkspaceOnTop +import XMonad.Hooks.WorkspaceByPos hunk ./src/Config.hs 59 -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"] hunk ./src/Config.hs 62 -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 $ hunk ./src/Config.hs 140 -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 $ hunk ./src/Config.hs 158 -blueTileManageHook :: ManageHook -blueTileManageHook = composeAll +bluetileManageHook :: ManageHook +bluetileManageHook = composeAll hunk ./src/Config.hs 164 -blueTileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( +bluetileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( hunk ./src/Config.hs 179 -blueTileConfig dockHandle = +bluetileConfig = hunk ./src/Config.hs 182 - manageHook = blueTileManageHook, - layoutHook = blueTileLayoutHook, - logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook >> bluetileDock dockHandle, + manageHook = bluetileManageHook, + layoutHook = bluetileLayoutHook, + logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook, hunk ./src/Config.hs 189 - workspaces = blueTileWorkspaces, - keys = blueTileKeys, - mouseBindings = blueTileMouseBindings, + workspaces = bluetileWorkspaces, + keys = bluetileKeys, + mouseBindings = bluetileMouseBindings, hunk ./src/Main.hs 11 --- bluetile - a modern tiling window manager with a gentle learning curve +-- Bluetile - a modern tiling window manager with a gentle learning curve hunk ./src/Main.hs 21 +import BluetileDock hunk ./src/Main.hs 64 - blueTileConfig' <- checkTerminal $ blueTileConfig dockHandle + bluetileConfig' <- checkTerminal $ bluetileConfig { logHook = logHook bluetileConfig >> bluetileDock dockHandle } hunk ./src/Main.hs 68 - xmonad blueTileConfig' + xmonad bluetileConfig' hunk ./src/Config.hs 164 -bluetileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( +bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( hunk ./src/Config.hs 45 +import XMonad.Hooks.ManageHelpers hunk ./src/Config.hs 163 + , isFullscreen --> doFullFloat hunk ./src/Config.hs 188 + `mappend` fullscreenEventHook hunk ./src/Config.hs 196 - focusedBorderColor = "#ff5500", + borderWidth = 0, hunk ./src/Config.hs 195 - focusFollowsMouse = False, + focusFollowsMouse = False, hunk ./src/Config.hs 196 - borderWidth = 0, + focusedBorderColor = "#000000", hunk ./bluetile.cabal 10 - It also tries to be usable 'out of the box', making configuration unnecessary. + It also tries to be usable 'out of the box', requiring minimal to + no configuration in most cases. hunk ./bluetile.cabal 38 + Buildable: True hunk ./bluetile.cabal 46 + Buildable: True hunk ./bluetile.cabal 53 + Buildable: True hunk ./bluetile.cabal 34 - xmonad>=0.9, xmonad-contrib>=0.9 + xmonad-bluetilebranch>=0.9, xmonad-contrib-bluetilebranch>=0.9