diff --git a/BluetileDock.hs b/BluetileDock.hs deleted file mode 100644 --- a/BluetileDock.hs +++ /dev/null @@ -1,219 +0,0 @@ -{-# 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 Data.Char -import Paths_bluetileutils -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 - gladeFile <- getDataFileName "bluetiledock.glade" - Just xml <- xmlNew gladeFile - 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 diff --git a/BluetileGreet.hs b/BluetileGreet.hs deleted file mode 100644 --- a/BluetileGreet.hs +++ /dev/null @@ -1,56 +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 --- ------------------------------------------------------------------------------ - -module Main where - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.Glade -import Paths_bluetileutils -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 - gladeFile <- getDataFileName "bluetilegreet.glade" - Just xml <- xmlNew gladeFile - - 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 diff --git a/BluetileMockWin.hs b/BluetileMockWin.hs deleted file mode 100644 --- a/BluetileMockWin.hs +++ /dev/null @@ -1,36 +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 --- ------------------------------------------------------------------------------ - -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/THIS_PACKAGE_IS_OBSOLETE b/THIS_PACKAGE_IS_OBSOLETE new file mode 100644 --- /dev/null +++ b/THIS_PACKAGE_IS_OBSOLETE @@ -0,0 +1,1 @@ +The contents of this package has been merged in with the package 'bluetile'. diff --git a/Utils.hs b/Utils.hs deleted file mode 100644 --- a/Utils.hs +++ /dev/null @@ -1,35 +0,0 @@ ----------------------------------------------------------------------------- --- | --- 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.glade b/bluetiledock.glade deleted file mode 100644 --- a/bluetiledock.glade +++ /dev/null @@ -1,345 +0,0 @@ - - - - - - 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/bluetilegreet.glade b/bluetilegreet.glade deleted file mode 100644 --- a/bluetilegreet.glade +++ /dev/null @@ -1,178 +0,0 @@ - - - - - - 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/bluetileutils.cabal b/bluetileutils.cabal --- a/bluetileutils.cabal +++ b/bluetileutils.cabal @@ -1,31 +1,20 @@ Name: bluetileutils -Version: 0.1 +Version: 0.2 synopsis: Utilities for Bluetile +description: + This package is OBSOLETE. + The contents of this package has been merged in with the package 'bluetile'. category: Utils License: BSD3 License-file: LICENSE Author: Jan Vornberger Maintainer: jan.vornberger@informatik.uni-oldenburg.de -extra-source-files: Utils.hs -data-files: bluetiledock.glade, bluetilegreet.glade, - floating.svg, tiled1.svg, tiled2.svg, fullscreen.svg +extra-source-files: THIS_PACKAGE_IS_OBSOLETE Build-Type: Simple Cabal-Version: >=1.2 -Executable bluetiledock - Main-is: BluetileDock.hs - Build-Depends: base>=3, base<4, unix, - glade>=0.9, gtk>=0.9, X11>=1.4 - C-sources: gdk_property_change_wrapper.c - Ghc-options: -Wall - -Executable bluetilemockwin +Executable bluetilemockwin-obsolete + Hs-Source-Dirs: bluetilemockwin Main-is: BluetileMockWin.hs - Build-Depends: base>=3, base<4, gtk>=0.9 - Ghc-options: -Wall - -Executable bluetilegreet - Main-is: BluetileGreet.hs - Build-Depends: base>=3, base<4, directory, filepath, - glade>=0.9, gtk>=0.9 + Build-Depends: base>=3, base<4, gtk Ghc-options: -Wall diff --git a/floating.svg b/floating.svg deleted file mode 100644 --- a/floating.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - diff --git a/fullscreen.svg b/fullscreen.svg deleted file mode 100644 --- a/fullscreen.svg +++ /dev/null @@ -1,77 +0,0 @@ - - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/gdk_property_change_wrapper.c b/gdk_property_change_wrapper.c deleted file mode 100644 --- a/gdk_property_change_wrapper.c +++ /dev/null @@ -1,28 +0,0 @@ -//////////////////////////////////////////////////////////////////////////// -// 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/tiled1.svg b/tiled1.svg deleted file mode 100644 --- a/tiled1.svg +++ /dev/null @@ -1,99 +0,0 @@ - - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - diff --git a/tiled2.svg b/tiled2.svg deleted file mode 100644 --- a/tiled2.svg +++ /dev/null @@ -1,99 +0,0 @@ - - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - -