diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,12 @@ +Bluetile 0.6 (on 2011/11/26) Jan Vornberger + Now that XMonad 0.10 is out, it was possible to clean up Bluetile's code + base and reference modules from xmonad-contrib 0.10 instead. + + Furthermore, the modules XMonad.Hooks.ICCCMFocus (workaround for some + problems with Java-based applications) and XMonad.Actions.PhysicalScreens + (enumerating multiple monitors in a sensible manner) have been + incorporated into the standard configuration. + Bluetile 0.5.3 (on 2010/08/10) Jan Vornberger Bluetile's theme is now configurable, including the font that is used. I also switched back to the old, grey-ish theme. For reference, below diff --git a/bluetile.cabal b/bluetile.cabal --- a/bluetile.cabal +++ b/bluetile.cabal @@ -1,5 +1,5 @@ Name: bluetile -Version: 0.5.3 +Version: 0.6 homepage: http://www.bluetile.org/ synopsis: full-featured tiling for the GNOME desktop environment description: @@ -18,26 +18,6 @@ extra-source-files: src/Config.hs, src/ConfigParser.hs, src/BluetileDock.hs, - src/XMonad/Actions/BluetileCommands.hs, - src/XMonad/Actions/WindowMenu.hs, - src/XMonad/Hooks/CurrentWorkspaceOnTop.hs, - src/XMonad/Hooks/EwmhDesktops.hs, - src/XMonad/Hooks/Minimize.hs - src/XMonad/Hooks/PositionStoreHooks.hs, - src/XMonad/Layout/BorderResize.hs, - src/XMonad/Layout/ButtonDecoration.hs, - src/XMonad/Layout/DecorationAddons.hs, - src/XMonad/Layout/Decoration.hs, - src/XMonad/Layout/DraggingVisualizer.hs, - src/XMonad/Layout/ImageButtonDecoration.hs - src/XMonad/Layout/Minimize.hs, - src/XMonad/Layout/MouseResizableTile.hs, - src/XMonad/Layout/PositionStoreFloat.hs, - src/XMonad/Layout/WindowSwitcherDecoration.hs, - src/XMonad/Util/Font.hs, - src/XMonad/Util/Image.hs, - src/XMonad/Util/PositionStore.hs, - src/XMonad/Util/XUtils.hs, bluetiledock/Utils.hs, bluetilegreet/Utils.hs, man/bluetile.1, @@ -46,7 +26,7 @@ misc/bluetile-session.desktop, misc/gnome-bluetile-session.desktop, README, - NEWS + NEWS data-files: bluetiledock/bluetiledock.glade, bluetiledock/floating.svg, bluetiledock/tiled1.svg, @@ -58,7 +38,10 @@ etc/bluetilerc, etc/bluetilerc_user_template Build-Type: Custom -Cabal-Version: >=1.2 +Cabal-Version: >=1.6 +Source-Repository head + type: darcs + location: http://code.haskell.org/~jav/bluetile/ Executable bluetile Main-is: Main.hs @@ -66,7 +49,7 @@ Build-Depends: base>=3, base<5, containers, process, filepath, random, utf8-string, unix, regex-compat, mtl, ConfigFile, directory, X11-xft, - xmonad>=0.9.1, xmonad-contrib>=0.9.1 + xmonad>=0.10, xmonad-contrib>=0.10 if true Ghc-Options: -Wall if impl(ghc >= 6.12.1) diff --git a/etc/bluetilerc b/etc/bluetilerc --- a/etc/bluetilerc +++ b/etc/bluetilerc @@ -77,6 +77,7 @@ key_restore_minimized_window: DefaultMod+Shift+m # switching workspaces +key_toggle_workspace: DefaultMod+b key_switch_to_workspace_0: DefaultMod+0 key_switch_to_workspace_1: DefaultMod+1 key_switch_to_workspace_2: DefaultMod+2 diff --git a/man/bluetile.1 b/man/bluetile.1 --- a/man/bluetile.1 +++ b/man/bluetile.1 @@ -124,7 +124,7 @@ .\" ======================================================================== .\" .IX Title "BLUETILE 1" -.TH BLUETILE 1 "2010-07-24" "perl v5.10.1" "" +.TH BLUETILE 1 "2010-11-07" "perl v5.10.1" "" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l @@ -213,6 +213,7 @@ \& Win+Shift+m Restore next minimized window \& Win+o Show window menu for focused window \& Win+t Push dialog window back into tiling +\& Win+b Toggle to previously displayed workspace \& \& Win+1 .. Win+9, Win+0 \& Switch to workspace N diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -37,16 +37,17 @@ import XMonad.Actions.BluetileCommands import XMonad.Actions.CycleWS +import XMonad.Actions.PhysicalScreens import XMonad.Actions.WindowMenu import XMonad.Hooks.CurrentWorkspaceOnTop import XMonad.Hooks.EwmhDesktops +import XMonad.Hooks.ICCCMFocus import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers -import XMonad.Hooks.PositionStoreHooks import XMonad.Hooks.Minimize +import XMonad.Hooks.PositionStoreHooks import XMonad.Hooks.ServerMode -import XMonad.Hooks.SetWMName import XMonad.Hooks.WorkspaceByPos import XMonad.Config.Gnome @@ -126,6 +127,9 @@ , ("key_maximize_window" , withFocused (sendMessage . maximizeRestore)) , ("key_minimize_window" , withFocused minimizeWindow) , ("key_restore_minimized_window" , sendMessage RestoreNextMinimizedWin) + + -- toggle to previously displayed workspace + , ("key_toggle_workspace" , toggleWS) ] ++ -- mod-[1..9] ++ [0] %! Switch to workspace N @@ -135,10 +139,10 @@ [("key_shift_window_to_workspace_" ++ (show wkspNr), windows $ W.shift i) | (wkspNr :: Integer, i) <- zip ([1 .. 9] ++ [0]) (XMonad.workspaces conf)] ++ -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 - [("key_switch_to_screen_" ++ (show screenNr), screenWorkspace sc >>= flip whenJust (windows . W.view)) | (screenNr :: Integer, sc) <- zip [0 .. 2] [0 ..]] + [("key_switch_to_screen_" ++ (show screenNr), viewScreen sc) | (screenNr :: Integer, sc) <- zip [0 .. 2] [0 ..]] -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 ++ - [("key_shift_window_to_screen_" ++ (show screenNr), screenWorkspace sc >>= flip whenJust (windows . W.shift)) | (screenNr :: Integer, sc) <- zip [0 .. 2] [0 ..]] + [("key_shift_window_to_screen_" ++ (show screenNr), sendToScreen sc) | (screenNr :: Integer, sc) <- zip [0 .. 2] [0 ..]] bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ @@ -183,10 +187,10 @@ createXMonadConfig bluetilerc = defaultConfig { modMask = defaultModifierBRC bluetilerc, - startupHook = ewmhDesktopsStartup >> setWMName "LG3D", + startupHook = ewmhDesktopsStartup, manageHook = bluetileManageHook, layoutHook = bluetileLayoutHook bluetileTheme, - logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook, + logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook >> takeTopFocus, handleEventHook = ewmhDesktopsEventHook `mappend` fullscreenEventHook `mappend` minimizeEventHook diff --git a/src/XMonad/Actions/BluetileCommands.hs b/src/XMonad/Actions/BluetileCommands.hs deleted file mode 100644 --- a/src/XMonad/Actions/BluetileCommands.hs +++ /dev/null @@ -1,83 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : XMonad.Actions.BluetileCommands --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- This is a list of selected commands that can be made available using --- "XMonad.Hooks.ServerMode" to allow external programs to control --- the window manager. Bluetile () --- uses this to enable its dock application to do things like changing --- workspaces and layouts. --- ------------------------------------------------------------------------------ - -module XMonad.Actions.BluetileCommands ( - -- * Usage - -- $usage - bluetileCommands - ) where - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Layout.LayoutCombinators -import System.Exit - --- $usage --- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.ServerMode --- > import XMonad.Actions.BluetileCommands --- --- Then edit your @handleEventHook@: --- --- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook' bluetileCommands } --- --- See the documentation of "XMonad.Hooks.ServerMode" for details on --- how to actually invoke the commands from external programs. - -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) diff --git a/src/XMonad/Actions/WindowMenu.hs b/src/XMonad/Actions/WindowMenu.hs deleted file mode 100644 --- a/src/XMonad/Actions/WindowMenu.hs +++ /dev/null @@ -1,79 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : XMonad.Actions.WindowMenu --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- Uses "XMonad.Actions.GridSelect" to display a number of actions related to --- window management in the center of the focused window. Actions include: Closing, --- maximizing, minimizing and shifting the window to another workspace. --- --- Note: For maximizing and minimizing to actually work, you will need --- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your --- setup. See the documentation of those modules for more information. --- ------------------------------------------------------------------------------ - -module XMonad.Actions.WindowMenu ( - -- * Usage - -- $usage - windowMenu - ) where - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Actions.GridSelect -import XMonad.Layout.Maximize -import XMonad.Layout.Minimize -import XMonad.Util.XUtils (fi) - --- $usage --- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Actions.WindowMenu --- --- Then add a keybinding, e.g. --- --- > , ((modm, xK_o ), windowMenu) - -colorizer :: a -> Bool -> X (String, String) -colorizer _ isFg = do - fBC <- asks (focusedBorderColor . config) - nBC <- asks (normalBorderColor . config) - return $ if isFg - then (fBC, nBC) - else (nBC, fBC) - -windowMenu :: X () -windowMenu = withFocused $ \w -> do - tags <- asks (workspaces . config) - Rectangle x y wh ht <- getSize w - Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset - let originFractX = (fi x - fi sx + fi wh / 2) / fi swh - originFractY = (fi y - fi sy + fi ht / 2) / fi sht - gsConfig = (buildDefaultGSConfig colorizer) - { gs_originFractX = originFractX - , gs_originFractY = originFractY } - actions = [ ("Cancel menu", return ()) - , ("Close" , kill) - , ("Maximize" , sendMessage $ maximizeRestore w) - , ("Minimize" , minimizeWindow w) - ] ++ - [ ("Move to " ++ tag, windows $ W.shift tag) - | tag <- tags ] - runSelectedAction gsConfig actions - -getSize :: Window -> X (Rectangle) -getSize w = do - d <- asks display - wa <- io $ getWindowAttributes d w - let x = fi $ wa_x wa - y = fi $ wa_y wa - wh = fi $ wa_width wa - ht = fi $ wa_height wa - return (Rectangle x y wh ht) diff --git a/src/XMonad/Hooks/CurrentWorkspaceOnTop.hs b/src/XMonad/Hooks/CurrentWorkspaceOnTop.hs deleted file mode 100644 --- a/src/XMonad/Hooks/CurrentWorkspaceOnTop.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Hooks.CurrentWorkspaceOnTop --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- Ensures that the windows of the current workspace are always in front --- of windows that are located on other visible screens. This becomes important --- if you use decoration and drag windows from one screen to another. Using this --- module, the dragged window will always be in front of other windows. --- ------------------------------------------------------------------------------ - -module XMonad.Hooks.CurrentWorkspaceOnTop ( - -- * Usage - -- $usage - currentWorkspaceOnTop - ) where - -import XMonad -import qualified XMonad.StackSet as S -import Control.Monad(when) -import System.Posix.Env -import qualified Data.Map as M - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.CurrentWorkspaceOnTop --- > --- > main = xmonad $ defaultConfig { --- > ... --- > logHook = currentWorkspaceOnTop --- > ... --- > } --- - -data CWOTState = CWOTS String deriving (Read, Show, Typeable) - -currentWorkspaceOnTop :: X () -currentWorkspaceOnTop = withDisplay $ \d -> do - ws <- gets windowset - cwotsEnvM <- io $ getEnv "BLUETILE_CWOTS" - let (CWOTS lastTag) = maybe (CWOTS "") read cwotsEnvM - let curTag = S.tag . S.workspace . S.current $ ws - when (curTag /= lastTag) $ do - -- the following is more or less a reimplementation of what's happening in "XMonad.Operation" - let s = S.current ws - wsp = S.workspace s - viewrect = screenRect $ S.screenDetail s - tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws) - (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect - updateLayout curTag ml' - let this = S.view curTag ws - fltWins = filter (flip M.member (S.floating ws)) $ S.index this - wins = fltWins ++ (map fst rs) -- order: first all floating windows, then the order the layout returned - -- end of reimplementation - - when (not . null $ wins) $ do - io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top, - io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow - io $ setEnv "BLUETILE_CWOTS" (show (CWOTS curTag)) True diff --git a/src/XMonad/Hooks/EwmhDesktops.hs b/src/XMonad/Hooks/EwmhDesktops.hs deleted file mode 100644 --- a/src/XMonad/Hooks/EwmhDesktops.hs +++ /dev/null @@ -1,254 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.EwmhDesktops --- Copyright : (c) 2007, 2008 Joachim Breitner --- License : BSD --- --- Maintainer : Joachim Breitner --- Stability : unstable --- Portability : unportable --- --- Makes xmonad use the EWMH hints to tell panel applications about its --- workspaces and the windows therein. It also allows the user to interact --- with xmonad by clicking on panels and window lists. ------------------------------------------------------------------------------ -module XMonad.Hooks.EwmhDesktops ( - -- * Usage - -- $usage - ewmh, - ewmhDesktopsStartup, - ewmhDesktopsLogHook, - ewmhDesktopsLogHookCustom, - ewmhDesktopsEventHook, - fullscreenEventHook - ) where - -import Codec.Binary.UTF8.String (encode) -import Data.List -import Data.Maybe -import Data.Monoid - -import XMonad -import Control.Monad -import qualified XMonad.StackSet as W - -import XMonad.Hooks.SetWMName -import XMonad.Util.XUtils (fi) -import XMonad.Util.WorkspaceCompare -import XMonad.Util.WindowProperties (getProp32) - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad --- > import XMonad.Hooks.EwmhDesktops --- > --- > main = xmonad $ ewmh defaultConfig --- --- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks. - - --- | Add EWMH functionality to the given config. See above for an example. -ewmh :: XConfig a -> XConfig a -ewmh c = c { startupHook = startupHook c +++ ewmhDesktopsStartup - , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook - , logHook = logHook c +++ ewmhDesktopsLogHook } - where x +++ y = mappend x y - --- | --- Initializes EwmhDesktops and advertises EWMH support to the X --- server -ewmhDesktopsStartup :: X () -ewmhDesktopsStartup = setSupported - --- | --- Notifies pagers and window lists, such as those in the gnome-panel --- of the current state of workspaces and windows. -ewmhDesktopsLogHook :: X () -ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id --- | --- Generalized version of ewmhDesktopsLogHook that allows an arbitrary --- user-specified function to transform the workspace list (post-sorting) -ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X () -ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = f $ sort' $ W.workspaces s - - -- Number of Workspaces - setNumberOfDesktops (length ws) - - -- Names thereof - setDesktopNames (map W.tag ws) - - -- all windows, with focused windows last - let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws - setClientList wins - - -- Current desktop - case (elemIndex (W.currentTag s) $ map W.tag ws) of - Nothing -> return () - Just curr -> do - setCurrentDesktop curr - - -- Per window Desktop - -- To make gnome-panel accept our xinerama stuff, we display - -- all visible windows on the current desktop. - forM_ (W.current s : W.visible s) $ \x -> - forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do - setWindowDesktop win curr - - forM_ (W.hidden s) $ \w -> - case elemIndex (W.tag w) (map W.tag ws) of - Nothing -> return () - Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do - setWindowDesktop win wn - - setActiveWindow - - return () - --- | --- Intercepts messages from pagers and similar applications and reacts on them. --- Currently supports: --- --- * _NET_CURRENT_DESKTOP (switching desktops) --- --- * _NET_WM_DESKTOP (move windows to other desktops) --- --- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) --- -ewmhDesktopsEventHook :: Event -> X All -ewmhDesktopsEventHook e = handle e >> return (All True) - -handle :: Event -> X () -handle ClientMessageEvent { - ev_window = w, - ev_message_type = mt, - ev_data = d - } = withWindowSet $ \s -> do - sort' <- getSortByIndex - let ws = sort' $ W.workspaces s - - a_cd <- getAtom "_NET_CURRENT_DESKTOP" - a_d <- getAtom "_NET_WM_DESKTOP" - a_aw <- getAtom "_NET_ACTIVE_WINDOW" - a_cw <- getAtom "_NET_CLOSE_WINDOW" - a_ignore <- mapM getAtom ["XMONAD_TIMER"] - if mt == a_cd then do - let n = head d - if 0 <= n && fi n < length ws then - windows $ W.view (W.tag (ws !! fi n)) - else trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n - else if mt == a_d then do - let n = head d - if 0 <= n && fi n < length ws then - windows $ W.shiftWin (W.tag (ws !! fi n)) w - else trace $ "Bad _NET_DESKTOP with data[0]="++show n - else if mt == a_aw then do - windows $ W.focusWindow w - else if mt == a_cw then do - killWindow w - else if mt `elem` a_ignore then do - return () - else do - -- The Message is unknown to us, but that is ok, not all are meant - -- to be handled by the window manager - return () -handle _ = return () - --- | --- An event hook to handle applications that wish to fullscreen using the --- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() --- function, such as Totem, Evince and OpenOffice.org. -fullscreenEventHook :: Event -> X All -fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do - state <- getAtom "_NET_WM_STATE" - fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" - wstate <- fromMaybe [] `fmap` getProp32 state win - - let isFull = fromIntegral fullsc `elem` wstate - - -- Constants for the _NET_WM_STATE protocol: - remove = 0 - add = 1 - toggle = 2 - ptype = 4 -- The atom property type for changeProperty - chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate) - - when (typ == state && fi fullsc `elem` dats) $ do - when (action == add || (action == toggle && not isFull)) $ do - chWstate (fi fullsc:) - windows $ W.float win $ W.RationalRect 0 0 1 1 - when (action == remove || (action == toggle && isFull)) $ do - chWstate $ delete (fi fullsc) - windows $ W.sink win - - return $ All True - -fullscreenEventHook _ = return $ All True - -setNumberOfDesktops :: (Integral a) => a -> X () -setNumberOfDesktops n = withDisplay $ \dpy -> do - a <- getAtom "_NET_NUMBER_OF_DESKTOPS" - c <- getAtom "CARDINAL" - r <- asks theRoot - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] - -setCurrentDesktop :: (Integral a) => a -> X () -setCurrentDesktop i = withDisplay $ \dpy -> do - a <- getAtom "_NET_CURRENT_DESKTOP" - c <- getAtom "CARDINAL" - r <- asks theRoot - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] - -setDesktopNames :: [String] -> X () -setDesktopNames names = withDisplay $ \dpy -> do - -- Names thereof - r <- asks theRoot - a <- getAtom "_NET_DESKTOP_NAMES" - c <- getAtom "UTF8_STRING" - let names' = map fromIntegral $ concatMap ((++[0]) . encode) names - io $ changeProperty8 dpy r a c propModeReplace names' - -setClientList :: [Window] -> X () -setClientList wins = withDisplay $ \dpy -> do - -- (What order do we really need? Something about age and stacking) - r <- asks theRoot - c <- getAtom "WINDOW" - a <- getAtom "_NET_CLIENT_LIST" - io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins) - a' <- getAtom "_NET_CLIENT_LIST_STACKING" - io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins) - -setWindowDesktop :: (Integral a) => Window -> a -> X () -setWindowDesktop win i = withDisplay $ \dpy -> do - a <- getAtom "_NET_WM_DESKTOP" - c <- getAtom "CARDINAL" - io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] - -setSupported :: X () -setSupported = withDisplay $ \dpy -> do - r <- asks theRoot - a <- getAtom "_NET_SUPPORTED" - c <- getAtom "ATOM" - supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN" - ,"_NET_NUMBER_OF_DESKTOPS" - ,"_NET_CLIENT_LIST" - ,"_NET_CLIENT_LIST_STACKING" - ,"_NET_CURRENT_DESKTOP" - ,"_NET_DESKTOP_NAMES" - ,"_NET_ACTIVE_WINDOW" - ,"_NET_WM_DESKTOP" - ,"_NET_WM_STRUT" - ] - io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) - - setWMName "xmonad" - -setActiveWindow :: X () -setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do - let w = fromMaybe none (W.peek s) - r <- asks theRoot - a <- getAtom "_NET_ACTIVE_WINDOW" - c <- getAtom "WINDOW" - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w] diff --git a/src/XMonad/Hooks/Minimize.hs b/src/XMonad/Hooks/Minimize.hs deleted file mode 100644 --- a/src/XMonad/Hooks/Minimize.hs +++ /dev/null @@ -1,53 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : XMonad.Hooks.Minimize --- Copyright : (c) Justin Bogner 2010 --- License : BSD3-style (see LICENSE) --- --- Maintainer : Justin Bogner --- Stability : unstable --- Portability : not portable --- --- Handles window manager hints to minimize and restore windows. Use --- this with XMonad.Layout.Minimize. --- ------------------------------------------------------------------------------ - -module XMonad.Hooks.Minimize - ( -- * Usage - -- $usage - minimizeEventHook - ) where - -import Data.Monoid -import Control.Monad(when) - -import XMonad -import XMonad.Layout.Minimize - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.Minimize --- > import XMonad.Layout.Minimize --- > --- > myHandleEventHook = minimizeEventHook --- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayout --- > , handleEventHook = myHandleEventHook } - -minimizeEventHook :: Event -> X All -minimizeEventHook (ClientMessageEvent {ev_window = w, - ev_message_type = mt, - ev_data = dt}) = do - a_aw <- getAtom "_NET_ACTIVE_WINDOW" - a_cs <- getAtom "WM_CHANGE_STATE" - - when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w) - when (mt == a_cs) $ do - let message = fromIntegral . head $ dt - when (message == normalState) $ sendMessage (RestoreMinimizedWin w) - when (message == iconicState) $ minimizeWindow w - - return (All True) -minimizeEventHook _ = return (All True) diff --git a/src/XMonad/Hooks/PositionStoreHooks.hs b/src/XMonad/Hooks/PositionStoreHooks.hs deleted file mode 100644 --- a/src/XMonad/Hooks/PositionStoreHooks.hs +++ /dev/null @@ -1,106 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : XMonad.Hooks.PositionStoreHooks --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- This module contains two hooks for the --- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and --- an EventHook. --- --- The ManageHook can be used to fill the PositionStore with position and size --- information about new windows. The advantage of using this hook is, that the --- information is recorded independent of the currently active layout. So the --- floating shape of the window can later be restored even if it was opened in a --- tiled layout initially. --- --- For windows, that do not request a particular position, a random position will --- be assigned. This prevents windows from piling up exactly on top of each other. --- --- The EventHook makes sure that windows are deleted from the PositionStore --- when they are closed. --- ------------------------------------------------------------------------------ - -module XMonad.Hooks.PositionStoreHooks ( - -- * Usage - -- $usage - positionStoreManageHook, - positionStoreEventHook - ) where - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Util.PositionStore -import XMonad.Hooks.ManageDocks -import XMonad.Layout.Decoration - -import System.Random(randomRIO) -import Control.Applicative((<$>)) -import Control.Monad(when) -import Data.Maybe -import Data.Monoid -import qualified Data.Set as S - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.PositionStoreHooks --- --- and adding 'positionStoreManageHook' to your 'ManageHook' as well --- as 'positionStoreEventHook' to your event hooks. To be accurate --- about window sizes, the module needs to know if any decoration is in effect. --- This is specified with the first argument: Supply 'Nothing' for no decoration, --- otherwise use 'Just defaultTheme' or similar to inform the module about the --- decoration theme used. --- --- > myManageHook = positionStoreManageHook Nothing <+> manageHook defaultConfig --- > myHandleEventHook = positionStoreEventHook --- > --- > main = xmonad defaultConfig { manageHook = myManageHook --- > , handleEventHook = myHandleEventHook --- > } --- - -positionStoreManageHook :: Maybe Theme -> ManageHook -positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook - -positionStoreInit :: Maybe Theme -> Window -> X () -positionStoreInit mDecoTheme w = withDisplay $ \d -> do - let decoH = maybe 0 decoHeight mDecoTheme -- take decoration into account, which - in its current - -- form - makes windows smaller to make room for it - wa <- io $ getWindowAttributes d w - ws <- gets windowset - arbitraryOffsetX <- randomIntOffset - arbitraryOffsetY <- randomIntOffset - if (wa_x wa == 0) && (wa_y wa == 0) - then do - let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws - modifyPosStore (\ps -> posStoreInsert ps w - (Rectangle (srX + fi arbitraryOffsetX) - (srY + fi arbitraryOffsetY) - (fi $ wa_width wa) - (decoH + fi (wa_height wa))) sr ) - else do - sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) - let sr = screenRect . W.screenDetail $ sc - sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting - -- a somewhat unfortunate inter-dependency - -- with 'XMonad.Hooks.ManageDocks' - modifyPosStore (\ps -> posStoreInsert ps w - (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH) - (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' ) - where - randomIntOffset :: X (Int) - randomIntOffset = io $ randomRIO (42, 242) - -positionStoreEventHook :: Event -> X All -positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do - when (et == destroyNotify) $ do - modifyPosStore (\ps -> posStoreRemove ps w) - return (All True) -positionStoreEventHook _ = return (All True) diff --git a/src/XMonad/Layout/BorderResize.hs b/src/XMonad/Layout/BorderResize.hs deleted file mode 100644 --- a/src/XMonad/Layout/BorderResize.hs +++ /dev/null @@ -1,224 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.BorderResize --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- This layout modifier will allow to resize windows by dragging their --- borders with the mouse. However, it only works in layouts or modified --- layouts that react to the 'SetGeometry' message. --- "XMonad.Layout.WindowArranger" can be used to create such a setup, --- but it is probably must useful in a floating layout such as --- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested. --- See the documentation of PositionStoreFloat for a typical usage example. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.BorderResize - ( -- * Usage - -- $usage - borderResize - , BorderResize (..) - ) where - -import XMonad -import XMonad.Layout.Decoration -import XMonad.Layout.WindowArranger -import XMonad.Util.XUtils -import Control.Monad(when) -import qualified Data.Map as M - --- $usage --- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.BorderResize --- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...) --- > main = xmonad defaultConfig { layoutHook = myLayout } --- - -type BorderBlueprint = (Rectangle, Glyph, BorderType) - -data BorderType = RightSideBorder - | LeftSideBorder - | TopSideBorder - | BottomSideBorder - deriving (Show, Read, Eq) -data BorderInfo = BI { bWin :: Window, - bRect :: Rectangle, - bType :: BorderType - } deriving (Show, Read) - -type RectWithBorders = (Rectangle, [BorderInfo]) - -data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) - -brBorderOffset :: Position -brBorderOffset = 5 -brBorderSize :: Dimension -brBorderSize = 10 - -borderResize :: l a -> ModifiedLayout BorderResize l a -borderResize = ModifiedLayout (BR M.empty) - -instance LayoutModifier BorderResize Window where - redoLayout _ _ Nothing wrs = return (wrs, Nothing) - redoLayout (BR wrsLastTime) _ _ wrs = do - let correctOrder = map fst wrs - wrsCurrent = M.fromList wrs - wrsGone = M.difference wrsLastTime wrsCurrent - wrsAppeared = M.difference wrsCurrent wrsLastTime - wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent - handleGone wrsGone - wrsCreated <- handleAppeared wrsAppeared - let wrsChanged = handleStillThere wrsStillThere - wrsThisTime = M.union wrsChanged wrsCreated - return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime) - -- What we return is the original wrs with the new border - -- windows inserted at the correct positions - this way, the core - -- will restack the borders correctly. - -- We also return information about our borders, so that we - -- can handle events that they receive and destroy them when - -- they are no longer needed. - where - testIfUnchanged entry@(rLastTime, _) rCurrent = - if rLastTime == rCurrent - then (Nothing, entry) - else (Just rCurrent, entry) - - handleMess (BR wrsLastTime) m - | Just e <- fromMessage m :: Maybe Event = - handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing - | Just _ <- fromMessage m :: Maybe LayoutMessages = - handleGone wrsLastTime >> return (Just $ BR M.empty) - handleMess _ _ = return Nothing - -compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] -compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder - in concat $ map compileWr wrs - -compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)] -compileWr (w, (r, borderInfos)) = - let borderWrs = for borderInfos $ \bi -> (bWin bi, bRect bi) - in borderWrs ++ [(w, r)] - -handleGone :: M.Map Window RectWithBorders -> X () -handleGone wrsGone = mapM_ deleteWindow borderWins - where - borderWins = map bWin . concat . map snd . M.elems $ wrsGone - -handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders) -handleAppeared wrsAppeared = do - let wrs = M.toList wrsAppeared - wrsCreated <- mapM handleSingleAppeared wrs - return $ M.fromList wrsCreated - -handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders) -handleSingleAppeared (w, r) = do - let borderBlueprints = prepareBorders r - borderInfos <- mapM createBorder borderBlueprints - return (w, (r, borderInfos)) - -handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders -handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere - -handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders -handleSingleStillThere (Nothing, entry) = entry -handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) - where - changedBorderBlueprints = prepareBorders rCurrent - updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints - -- assuming that the four borders are always in the same order - -updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo -updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r } - -createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))] -createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime - where - processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))] - processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r)) - -prepareBorders :: Rectangle -> [BorderBlueprint] -prepareBorders (Rectangle x y wh ht) = - [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), xC_right_side , RightSideBorder), - ((Rectangle (x - brBorderOffset) y brBorderSize ht) , xC_left_side , LeftSideBorder), - ((Rectangle x (y - brBorderOffset) wh brBorderSize) , xC_top_side , TopSideBorder), - ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), xC_bottom_side, BottomSideBorder) - ] - -handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () -handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } - | et == buttonPress, Just edge <- lookup ew borders = - case edge of - (RightSideBorder, hostWin, (Rectangle hx hy _ hht)) -> - mouseDrag (\x _ -> do - let nwh = max 1 $ fi (x - hx) - rect = Rectangle hx hy nwh hht - focus hostWin - when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) - (LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> - mouseDrag (\x _ -> do - let nx = max 0 $ min (hx + fi hwh) $ x - nwh = max 1 $ hwh + fi (hx - x) - rect = Rectangle nx hy nwh hht - focus hostWin - when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) - (TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> - mouseDrag (\_ y -> do - let ny = max 0 $ min (hy + fi hht) $ y - nht = max 1 $ hht + fi (hy - y) - rect = Rectangle hx ny hwh nht - focus hostWin - when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) - (BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) -> - mouseDrag (\_ y -> do - let nht = max 1 $ fi (y - hy) - rect = Rectangle hx hy hwh nht - focus hostWin - when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) -handleResize _ _ = return () - -createBorder :: BorderBlueprint -> X (BorderInfo) -createBorder (borderRect, borderCursor, borderType) = do - borderWin <- createInputWindow borderCursor borderRect - return BI { bWin = borderWin, bRect = borderRect, bType = borderType } - -createInputWindow :: Glyph -> Rectangle -> X Window -createInputWindow cursorGlyph r = withDisplay $ \d -> do - win <- mkInputWindow d r - io $ selectInput d win (exposureMask .|. buttonPressMask) - cursor <- io $ createFontCursor d cursorGlyph - io $ defineCursor d win cursor - io $ freeCursor d cursor - showWindow win - return win - -mkInputWindow :: Display -> Rectangle -> X Window -mkInputWindow d (Rectangle x y w h) = do - rw <- asks theRoot - let screen = defaultScreenOfDisplay d - visual = defaultVisualOfScreen screen - attrmask = cWOverrideRedirect - io $ allocaSetWindowAttributes $ - \attributes -> do - set_override_redirect attributes True - createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes - -for :: [a] -> (a -> b) -> [b] -for = flip map - -reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] -reorder wrs order = - let ordered = concat $ map (pickElem wrs) order - rest = filter (\(w, _) -> not (w `elem` order)) wrs - in ordered ++ rest - where - pickElem list e = case (lookup e list) of - Just result -> [(e, result)] - Nothing -> [] diff --git a/src/XMonad/Layout/ButtonDecoration.hs b/src/XMonad/Layout/ButtonDecoration.hs deleted file mode 100644 --- a/src/XMonad/Layout/ButtonDecoration.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.ButtonDecoration --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- A decoration that includes small buttons on both ends which invoke --- various actions when clicked on: Show a window menu (see --- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window. --- --- Note: For maximizing and minimizing to actually work, you will need --- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your --- setup. See the documentation of those modules for more information. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.ButtonDecoration - ( -- * Usage: - -- $usage - buttonDeco - ) where - -import XMonad -import XMonad.Layout.Decoration -import XMonad.Layout.DecorationAddons - --- $usage --- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.DecorationAddons --- > import XMonad.Layout.ButtonDecoration --- --- Then edit your @layoutHook@ by adding the ButtonDecoration to --- your layout: --- --- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook defaultConfig) --- > main = xmonad defaultConfig { layoutHook = myL } --- - -buttonDeco :: (Eq a, Shrinker s) => s -> Theme - -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a -buttonDeco s c = decoration s c $ NFD True - -data ButtonDecoration a = NFD Bool deriving (Show, Read) - -instance Eq a => DecorationStyle ButtonDecoration a where - describeDeco _ = "ButtonDeco" - decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR - decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () diff --git a/src/XMonad/Layout/Decoration.hs b/src/XMonad/Layout/Decoration.hs deleted file mode 100644 --- a/src/XMonad/Layout/Decoration.hs +++ /dev/null @@ -1,457 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.Decoration --- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A layout modifier and a class for easily creating decorated --- layouts. ------------------------------------------------------------------------------ - -module XMonad.Layout.Decoration - ( -- * Usage: - -- $usage - decoration - , Theme (..), defaultTheme - , Decoration - , DecorationMsg (..) - , DecorationStyle (..) - , DefaultDecoration (..) - , Shrinker (..), DefaultShrinker - , shrinkText, CustomShrink ( CustomShrink ), shrinkWhile - , isInStack, isVisible, isInvisible, isWithin, fi - , findWindowByDecoration - , module XMonad.Layout.LayoutModifier - ) where - -import Control.Monad (when) -import Data.Maybe -import Data.List -import Foreign.C.Types(CInt) - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Hooks.UrgencyHook -import XMonad.Layout.LayoutModifier -import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList) -import XMonad.Util.NamedWindows (getName) -import XMonad.Util.Invisible -import XMonad.Util.XUtils -import XMonad.Util.Font -import XMonad.Util.Image - --- $usage --- This module is intended for layout developers, who want to decorate --- their layouts. End users will not find here very much for them. --- --- For examples of 'DecorationStyle' instances you can have a look at --- "XMonad.Layout.SimpleDecoration", "XMonad.Layout.Tabbed", --- "XMonad.Layout.DwmStyle", or "XMonad.Layout.TabBarDecoration". - --- | A layout modifier that, with a 'Shrinker', a 'Theme', a --- 'DecorationStyle', and a layout, will decorate this layout --- according to the decoration style provided. --- --- For some usage examples see "XMonad.Layout.DecorationMadness". -decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a - -> l a -> ModifiedLayout (Decoration ds s) l a -decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds) - --- | A 'Theme' is a record of colors, font etc., to customize a --- 'DecorationStyle'. --- --- For a collection of 'Theme's see "XMonad.Util.Themes" -data Theme = - Theme { activeColor :: String -- ^ Color of the active window - , inactiveColor :: String -- ^ Color of the inactive window - , urgentColor :: String -- ^ Color of the urgent window - , activeBorderColor :: String -- ^ Color of the border of the active window - , inactiveBorderColor :: String -- ^ Color of the border of the inactive window - , urgentBorderColor :: String -- ^ Color of the border of the urgent window - , activeTextColor :: String -- ^ Color of the text of the active window - , inactiveTextColor :: String -- ^ Color of the text of the inactive window - , urgentTextColor :: String -- ^ Color of the text of the urgent window - , fontName :: String -- ^ Font name - , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') - , decoHeight :: Dimension -- ^ Height of the decorations - , windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar - , windowTitleIcons :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar - } deriving (Show, Read) - --- | The default xmonad 'Theme'. -defaultTheme :: Theme -defaultTheme = - Theme { activeColor = "#999999" - , inactiveColor = "#666666" - , urgentColor = "#FFFF00" - , activeBorderColor = "#FFFFFF" - , inactiveBorderColor = "#BBBBBB" - , urgentBorderColor = "##00FF00" - , activeTextColor = "#FFFFFF" - , inactiveTextColor = "#BFBFBF" - , urgentTextColor = "#FF0000" - , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , decoWidth = 200 - , decoHeight = 20 - , windowTitleAddons = [] - , windowTitleIcons = [] - } - --- | A 'Decoration' layout modifier will handle 'SetTheme', a message --- to dynamically change the decoration 'Theme'. -data DecorationMsg = SetTheme Theme deriving ( Typeable ) -instance Message DecorationMsg - --- | The 'Decoration' state component, where the list of decorated --- window's is zipped with a list of decoration. A list of decoration --- is a list of tuples, a 'Maybe' 'Window' and a 'Maybe Rectangle'. --- The 'Window' will be displayed only if the rectangle is of type --- 'Just'. -data DecorationState = - DS { decos :: [(OrigWin,DecoWin)] - , font :: XMonadFont - } -type DecoWin = (Maybe Window, Maybe Rectangle) -type OrigWin = (Window,Rectangle) - --- | The 'Decoration' 'LayoutModifier'. This data type is an instance --- of the 'LayoutModifier' class. This data type will be passed, --- together with a layout, to the 'ModifiedLayout' type constructor --- to modify the layout by adding decorations according to a --- 'DecorationStyle'. -data Decoration ds s a = - Decoration (Invisible Maybe DecorationState) s Theme (ds a) - deriving (Show, Read) - --- | The 'DecorationStyle' class, defines methods used in the --- implementation of the 'Decoration' 'LayoutModifier' instance. A --- type instance of this class is passed to the 'Decoration' type in --- order to decorate a layout, by using these methods. -class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where - - -- | The description that the 'Decoration' modifier will display. - describeDeco :: ds a -> String - describeDeco ds = show ds - - -- | Shrink the window's rectangle when applying a decoration. - shrink :: ds a -> Rectangle -> Rectangle -> Rectangle - shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) - - -- | The decoration event hook - decorationEventHook :: ds a -> DecorationState -> Event -> X () - decorationEventHook ds s e = handleMouseFocusDrag ds s e - - -- | A hook that can be used to catch the cases when the user - -- clicks on the decoration. If you return True here, the click event - -- will be considered as dealt with and no further processing will take place. - decorationCatchClicksHook :: ds a - -> Window - -> Int -- ^ distance from the left where the click happened on the decoration - -> Int -- ^ distance from the right where the click happened on the decoration - -> X Bool - decorationCatchClicksHook _ _ _ _ = return False - - -- | This hook is called while a window is dragged using the decoration. - -- The hook can be overwritten if a different way of handling the dragging - -- is required. - decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () - decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y - - -- | This hoook is called after a window has been dragged using the decoration. - decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X () - decorationAfterDraggingHook _ds (mainw, _r) _decoWin = focus mainw - - -- | The pure version of the main method, 'decorate'. - pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle - -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle - pureDecoration _ _ ht _ s _ (w,Rectangle x y wh ht') = if isInStack s w && (ht < ht') - then Just $ Rectangle x y wh ht - else Nothing - - -- | Given the theme's decoration width and height, the screen - -- rectangle, the windows stack, the list of windows and - -- rectangles returned by the underlying layout and window to be - -- decorated, tupled with its rectangle, produce a 'Just' - -- 'Rectangle' or 'Nothing' if the window is not to be decorated. - decorate :: ds a -> Dimension -> Dimension -> Rectangle - -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle) - decorate ds w h r s wrs wr = return $ pureDecoration ds w h r s wrs wr - --- | The default 'DecorationStyle', with just the default methods' --- implementations. -data DefaultDecoration a = DefaultDecoration deriving ( Read, Show ) -instance Eq a => DecorationStyle DefaultDecoration a - --- | The long 'LayoutModifier' instance for the 'Decoration' type. --- --- In 'redoLayout' we check the state: if there is no state we --- initialize it. --- --- The state is 'diff'ed against the list of windows produced by the --- underlying layout: removed windows get deleted and new ones --- decorated by 'createDecos', which will call 'decorate' to decide if --- a window must be given a 'Rectangle', in which case a decoration --- window will be created. --- --- After that we resync the updated state with the windows' list and --- then we process the resynced stated (as we do with a new state). --- --- First we map the decoration windows, we update each decoration to --- reflect any decorated window's change, and we insert, in the list --- of windows and rectangles returned by the underlying layout, the --- decoration for each window. This way xmonad will restack the --- decorations and their windows accordingly. At the end we remove --- invisible\/stacked windows. --- --- Message handling is quite simple: when needed we release the state --- component of the 'Decoration' 'LayoutModifier'. Otherwise we call --- 'handleEvent', which will call the appropriate 'DecorationStyle' --- methods to perform its tasks. -instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where - redoLayout (Decoration (I (Just s)) sh t ds) _ Nothing _ = do - releaseResources s - return ([], Just $ Decoration (I Nothing) sh t ds) - redoLayout _ _ Nothing _ = return ([], Nothing) - - redoLayout (Decoration st sh t ds) sc (Just stack) wrs - | I Nothing <- st = initState t ds sc stack wrs >>= processState - | I (Just s) <- st = do let dwrs = decos s - (d,a) = curry diff (get_ws dwrs) ws - toDel = todel d dwrs - toAdd = toadd a wrs - deleteDecos (map snd toDel) - let ndwrs = zip toAdd $ repeat (Nothing,Nothing) - ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs - processState (s {decos = ndecos }) - | otherwise = return (wrs, Nothing) - - where - ws = map fst wrs - get_w = fst . fst - get_ws = map get_w - del_dwrs = listFromList get_w notElem - find_dw i = fst . snd . flip (!!) i - todel d = filter (flip elem d . get_w) - toadd a = filter (flip elem a . fst ) - - check_dwr dwr = case dwr of - (Nothing, Just dr) -> do dw <- createDecoWindow t dr - return (Just dw, Just dr) - _ -> return dwr - - resync _ [] = return [] - resync d ((w,r):xs) = case w `elemIndex` get_ws d of - Just i -> do dr <- decorate ds (decoWidth t) (decoHeight t) sc stack wrs (w,r) - dwr <- check_dwr (find_dw i d, dr) - dwrs <- resync d xs - return $ ((w,r),dwr) : dwrs - Nothing -> resync d xs - - -- We drop any windows that are *precisely* stacked underneath - -- another window: these must be intended to be tabbed! - remove_stacked rs ((w,r):xs) - | r `elem` rs = remove_stacked rs xs - | otherwise = (w,r) : remove_stacked (r:rs) xs - remove_stacked _ [] = [] - - insert_dwr ((w,r),(Just dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs - insert_dwr (x ,( _ , _ )) xs = x:xs - - dwrs_to_wrs = remove_stacked [] . foldr insert_dwr [] - - processState s = do let ndwrs = decos s - showDecos (map snd ndwrs) - updateDecos sh t (font s) ndwrs - return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) - - handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m - | Just e <- fromMessage m = do decorationEventHook ds s e - handleEvent sh t s e - return Nothing - | Just Hide <- fromMessage m = do hideDecos (map snd dwrs) - return Nothing - | Just (SetTheme nt) <- fromMessage m = do releaseResources s - return $ Just $ Decoration (I Nothing) sh nt ds - | Just ReleaseResources <- fromMessage m = do releaseResources s - return $ Just $ Decoration (I Nothing) sh t ds - handleMess _ _ = return Nothing - - modifierDescription (Decoration _ _ _ ds) = describeDeco ds - --- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent' --- only. -handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X () -handleEvent sh t (DS dwrs fs) e - | PropertyEvent {ev_window = w} <- e - , Just i <- w `elemIndex` (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i) - | ExposeEvent {ev_window = w} <- e - , Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i) -handleEvent _ _ _ _ = return () - --- | Mouse focus and mouse drag are handled by the same function, this --- way we can start dragging unfocused windows too. -handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X () -handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew - , ev_event_type = et - , ev_x_root = ex - , ev_y_root = ey } - | et == buttonPress - , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do - let Just (Rectangle dx _ dwh _) = decoRectM - distFromLeft = ex - fi dx - distFromRight = fi dwh - (ex - fi dx) - dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight) - when (not dealtWith) $ do - mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y) - (decorationAfterDraggingHook ds (mainw, r) ew) -handleMouseFocusDrag _ _ _ = return () - -handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () -handleDraggingInProgress ex ey (_, r) x y = do - let rect = Rectangle (x - (fi ex - rect_x r)) - (y - (fi ey - rect_y r)) - (rect_width r) - (rect_height r) - sendMessage $ SetGeometry rect - --- | Given a window and the state, if a matching decoration is in the --- state return it with its ('Maybe') 'Rectangle'. -lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle)) -lookFor w ((wr,(Just dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) - | otherwise = lookFor w dwrs -lookFor w ((_, (Nothing, _)):dwrs) = lookFor w dwrs -lookFor _ [] = Nothing - -findWindowByDecoration :: Window -> DecorationState -> Maybe (OrigWin,(Window,Maybe Rectangle)) -findWindowByDecoration w ds = lookFor w (decos ds) - --- | Initialize the 'DecorationState' by initializing the font --- structure and by creating the needed decorations. -initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle - -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState -initState t ds sc s wrs = do - fs <- initXMF (fontName t) - dwrs <- createDecos t ds sc s wrs wrs - return $ DS dwrs fs - --- | Delete windows stored in the state and release the font structure. -releaseResources :: DecorationState -> X () -releaseResources s = do - deleteDecos (map snd $ decos s) - releaseXMF (font s) - --- | Create the decoration windows of a list of windows and their --- rectangles, by calling the 'decorate' method of the --- 'DecorationStyle' received. -createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window - -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] -createDecos t ds sc s wrs ((w,r):xs) = do - deco <- decorate ds (decoWidth t) (decoHeight t) sc s wrs (w,r) - case deco of - Just dr -> do dw <- createDecoWindow t dr - dwrs <- createDecos t ds sc s wrs xs - return $ ((w,r), (Just dw, Just dr)) : dwrs - Nothing -> do dwrs <- createDecos t ds sc s wrs xs - return $ ((w,r), (Nothing, Nothing)) : dwrs -createDecos _ _ _ _ _ [] = return [] - -createDecoWindow :: Theme -> Rectangle -> X Window -createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in - createNewWindow r mask (inactiveColor t) True - -showDecos :: [DecoWin] -> X () -showDecos = showWindows . catMaybes . map fst . filter (isJust . snd) - -hideDecos :: [DecoWin] -> X () -hideDecos = hideWindows . catMaybes . map fst - -deleteDecos :: [DecoWin] -> X () -deleteDecos = deleteWindows . catMaybes . map fst - -updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X () -updateDecos s t f = mapM_ $ updateDeco s t f - --- | Update a decoration window given a shrinker, a theme, the font --- structure and the needed 'Rectangle's -updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X () -updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do - nw <- getName w - ur <- readUrgents - dpy <- asks display - let focusColor win ic ac uc = (maybe ic (\focusw -> case () of - _ | focusw == win -> ac - | win `elem` ur -> uc - | otherwise -> ic) . W.peek) - `fmap` gets windowset - (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t) - (activeColor t, activeBorderColor t, activeTextColor t) - (urgentColor t, urgentBorderColor t, urgentTextColor t) - let s = shrinkIt sh - name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n - return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) - let als = AlignCenter : map snd (windowTitleAddons t) - strs = name : map fst (windowTitleAddons t) - i_als = map snd (windowTitleIcons t) - icons = map fst (windowTitleIcons t) - paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons -updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w -updateDeco _ _ _ _ = return () - --- | True if the window is in the 'Stack'. The 'Window' comes second --- to facilitate list processing, even though @w \`isInStack\` s@ won't --- work...;) -isInStack :: Eq a => W.Stack a -> a -> Bool -isInStack s = flip elem (W.integrate s) - --- | Given a 'Rectangle' and a list of 'Rectangle's is True if the --- 'Rectangle' is not completely contained by any 'Rectangle' of the --- list. -isVisible :: Rectangle -> [Rectangle] -> Bool -isVisible r = and . foldr f [] - where f x xs = if r `isWithin` x then False : xs else True : xs - --- | The contrary of 'isVisible'. -isInvisible :: Rectangle -> [Rectangle] -> Bool -isInvisible r = not . isVisible r - --- | True is the first 'Rectangle' is totally within the second --- 'Rectangle'. -isWithin :: Rectangle -> Rectangle -> Bool -isWithin (Rectangle x y w h) (Rectangle rx ry rw rh) - | x >= rx, x <= rx + fi rw - , y >= ry, y <= ry + fi rh - , x + fi w <= rx + fi rw - , y + fi h <= ry + fi rh = True - | otherwise = False - -shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String -shrinkWhile sh p x = sw $ sh x - where sw [n] = return n - sw [] = return "" - sw (n:ns) = do - cond <- p n - if cond - then sw ns - else return n - -data CustomShrink = CustomShrink -instance Show CustomShrink where show _ = "" -instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] - -class (Read s, Show s) => Shrinker s where - shrinkIt :: s -> String -> [String] - -data DefaultShrinker = DefaultShrinker -instance Show DefaultShrinker where show _ = "" -instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] -instance Shrinker DefaultShrinker where - shrinkIt _ "" = [""] - shrinkIt s cs = cs : shrinkIt s (init cs) - -shrinkText :: DefaultShrinker -shrinkText = DefaultShrinker diff --git a/src/XMonad/Layout/DecorationAddons.hs b/src/XMonad/Layout/DecorationAddons.hs deleted file mode 100644 --- a/src/XMonad/Layout/DecorationAddons.hs +++ /dev/null @@ -1,123 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.DecorationAddons --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- Various stuff that can be added to the decoration. Most of it --- is intended to be used by other modules. See --- "XMonad.Layout.ButtonDecoration" for a module that makes use of this. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.DecorationAddons ( - titleBarButtonHandler - ,defaultThemeWithButtons - ,handleScreenCrossing - ) where - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Layout.Decoration -import XMonad.Actions.WindowMenu -import XMonad.Layout.Minimize -import XMonad.Layout.Maximize -import XMonad.Hooks.ManageDocks -import XMonad.Util.Font -import XMonad.Util.PositionStore - -import Control.Applicative((<$>)) -import Data.Maybe -import qualified Data.Set as S - -minimizeButtonOffset :: Int -minimizeButtonOffset = 48 - -maximizeButtonOffset :: Int -maximizeButtonOffset = 25 - -closeButtonOffset :: Int -closeButtonOffset = 10 - -buttonSize :: Int -buttonSize = 10 - --- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. --- It will intercept clicks on the buttons of the decoration and invoke the associated action. --- To actually see the buttons, you will need to use a theme that includes them. --- See 'defaultThemeWithButtons' below. -titleBarButtonHandler :: Window -> Int -> Int -> X Bool -titleBarButtonHandler mainw distFromLeft distFromRight = do - let action = if (fi distFromLeft <= 3 * buttonSize) - then focus mainw >> windowMenu >> return True - else if (fi distFromRight >= closeButtonOffset && - fi distFromRight <= closeButtonOffset + buttonSize) - then focus mainw >> kill >> return True - else if (fi distFromRight >= maximizeButtonOffset && - fi distFromRight <= maximizeButtonOffset + (2 * buttonSize)) - then focus mainw >> sendMessage (maximizeRestore mainw) >> return True - else if (fi distFromRight >= minimizeButtonOffset && - fi distFromRight <= minimizeButtonOffset + buttonSize) - then focus mainw >> minimizeWindow mainw >> return True - else return False - action - --- | Intended to be used together with 'titleBarButtonHandler'. See above. -defaultThemeWithButtons :: Theme -defaultThemeWithButtons = defaultTheme { - windowTitleAddons = [ (" (M)", AlignLeft) - , ("_" , AlignRightOffset minimizeButtonOffset) - , ("[]" , AlignRightOffset maximizeButtonOffset) - , ("X" , AlignRightOffset closeButtonOffset) - ] - } - --- | A function intended to be plugged into the 'decorationAfterDraggingHook' of a decoration. --- It will check if the window has been dragged onto another screen and shift it there. --- The PositionStore is also updated accordingly, as this is designed to be used together --- with "XMonad.Layout.PositionStoreFloat". -handleScreenCrossing :: Window -> Window -> X Bool -handleScreenCrossing w decoWin = withDisplay $ \d -> do - root <- asks theRoot - (_, _, _, px, py, _, _, _) <- io $ queryPointer d root - ws <- gets windowset - sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py) - maybeWksp <- screenWorkspace $ W.screen sc - let targetWksp = maybeWksp >>= \wksp -> - W.findTag w ws >>= \currentWksp -> - if (currentWksp /= wksp) - then Just wksp - else Nothing - case targetWksp of - Just wksp -> do - -- find out window under cursor on target workspace - -- apparently we have to switch to the workspace first - -- to make this work, which unforunately introduces some flicker - windows $ \ws' -> W.view wksp ws' - (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root - - -- adjust PositionStore - let oldScreenRect = screenRect . W.screenDetail $ W.current ws - newScreenRect = screenRect . W.screenDetail $ sc - {-- somewhat ugly hack to get proper ScreenRect, - creates unwanted inter-dependencies - TODO: get ScreenRects in a proper way --} - oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) - newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) - wa <- io $ getWindowAttributes d decoWin - modifyPosStore (\ps -> - posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa) - oldScreenRect' newScreenRect') - - -- set focus correctly so the window will be inserted - -- at the correct position on the target workspace - -- and then shift the window - windows $ \ws' -> W.shiftWin wksp w . W.focusWindow selWin $ ws' - - -- return True to signal that screen crossing has taken place - return True - Nothing -> return False diff --git a/src/XMonad/Layout/DraggingVisualizer.hs b/src/XMonad/Layout/DraggingVisualizer.hs deleted file mode 100644 --- a/src/XMonad/Layout/DraggingVisualizer.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.DraggingVisualizer --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- A helper module to visualize the process of dragging a window by --- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration" --- for a module that makes use of this. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.DraggingVisualizer - ( draggingVisualizer, - DraggingVisualizerMsg (..) - ) where - -import XMonad -import XMonad.Layout.LayoutModifier - -data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show ) -draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window -draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing - -data DraggingVisualizerMsg = DraggingWindow Window Rectangle - | DraggingStopped - deriving ( Typeable, Eq ) -instance Message DraggingVisualizerMsg - -instance LayoutModifier DraggingVisualizer Window where - modifierDescription (DraggingVisualizer _) = "DraggingVisualizer" - pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs = - if draggedWin `elem` (map fst wrs) - then (dragged : rest, Nothing) - else (wrs, Just $ DraggingVisualizer Nothing) - where - rest = filter (\(w, _) -> w /= draggedWin) wrs - pureModifier _ _ _ wrs = (wrs, Nothing) - - pureMess (DraggingVisualizer _) m = case fromMessage m of - Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect) - Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing - _ -> Nothing diff --git a/src/XMonad/Layout/ImageButtonDecoration.hs b/src/XMonad/Layout/ImageButtonDecoration.hs deleted file mode 100644 --- a/src/XMonad/Layout/ImageButtonDecoration.hs +++ /dev/null @@ -1,182 +0,0 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.ImageButtonDecoration --- Copyright : (c) Jan Vornberger 2009 --- Alejandro Serrano 2010 --- License : BSD3-style (see LICENSE) --- --- Maintainer : trupill@gmail.com --- Stability : unstable --- Portability : not portable --- --- A decoration that includes small image buttons on both ends which invoke --- various actions when clicked on: Show a window menu (see --- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window. --- --- Note: For maximizing and minimizing to actually work, you will need --- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your --- setup. See the documentation of those modules for more information. --- ------------------------------------------------------------------------------ - --- This module is mostly derived from "XMonad.Layout.DecorationAddons" --- and "XMonad.Layout.ButtonDecoration" - -module XMonad.Layout.ImageButtonDecoration - ( -- * Usage: - -- $usage - imageButtonDeco - , defaultThemeWithImageButtons - , imageTitleBarButtonHandler - ) where - -import XMonad -import XMonad.Layout.Decoration -import XMonad.Layout.DecorationAddons -import XMonad.Util.Image - -import XMonad.Actions.WindowMenu -import XMonad.Layout.Minimize -import XMonad.Layout.Maximize - --- $usage --- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.ImageButtonDecoration --- --- Then edit your @layoutHook@ by adding the ImageButtonDecoration to --- your layout: --- --- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook defaultConfig) --- > main = xmonad defaultConfig { layoutHook = myL } --- - --- The buttons' dimension and placements - -buttonSize :: Int -buttonSize = 10 - -menuButtonOffset :: Int -menuButtonOffset = 4 - -minimizeButtonOffset :: Int -minimizeButtonOffset = 32 - -maximizeButtonOffset :: Int -maximizeButtonOffset = 18 - -closeButtonOffset :: Int -closeButtonOffset = 4 - - --- The images in a 0-1 scale to make --- it easier to visualize - -convertToBool' :: [Int] -> [Bool] -convertToBool' = map (\x -> x == 1) - -convertToBool :: [[Int]] -> [[Bool]] -convertToBool = map convertToBool' - -menuButton' :: [[Int]] -menuButton' = [[1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1]] - -menuButton :: [[Bool]] -menuButton = convertToBool menuButton' - -miniButton' :: [[Int]] -miniButton' = [[0,0,0,0,0,0,0,0,0,0], - [0,0,0,0,0,0,0,0,0,0], - [0,0,0,0,0,0,0,0,0,0], - [0,0,0,0,0,0,0,0,0,0], - [0,0,0,0,0,0,0,0,0,0], - [0,0,0,0,0,0,0,0,0,0], - [0,0,0,0,0,0,0,0,0,0], - [0,0,0,0,0,0,0,0,0,0], - [1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1]] - -miniButton :: [[Bool]] -miniButton = convertToBool miniButton' - -maxiButton' :: [[Int]] -maxiButton' = [[1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,0,0,0,0,0,0,1,1], - [1,1,1,1,1,1,1,1,1,1], - [1,1,1,1,1,1,1,1,1,1]] - -maxiButton :: [[Bool]] -maxiButton = convertToBool maxiButton' - -closeButton' :: [[Int]] -closeButton' = [[1,1,0,0,0,0,0,0,1,1], - [1,1,1,0,0,0,0,1,1,1], - [0,1,1,1,0,0,1,1,1,0], - [0,0,1,1,1,1,1,1,0,0], - [0,0,0,1,1,1,1,0,0,0], - [0,0,0,1,1,1,1,0,0,0], - [0,0,1,1,1,1,1,1,0,0], - [0,1,1,1,0,0,1,1,1,0], - [1,1,1,0,0,0,0,1,1,1], - [1,1,0,0,0,0,0,0,1,1]] - - -closeButton :: [[Bool]] -closeButton = convertToBool closeButton' - --- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. --- It will intercept clicks on the buttons of the decoration and invoke the associated action. --- To actually see the buttons, you will need to use a theme that includes them. --- See 'defaultThemeWithImageButtons' below. -imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool -imageTitleBarButtonHandler mainw distFromLeft distFromRight = do - let action = if (fi distFromLeft >= menuButtonOffset && - fi distFromLeft <= menuButtonOffset + buttonSize) - then focus mainw >> windowMenu >> return True - else if (fi distFromRight >= closeButtonOffset && - fi distFromRight <= closeButtonOffset + buttonSize) - then focus mainw >> kill >> return True - else if (fi distFromRight >= maximizeButtonOffset && - fi distFromRight <= maximizeButtonOffset + buttonSize) - then focus mainw >> sendMessage (maximizeRestore mainw) >> return True - else if (fi distFromRight >= minimizeButtonOffset && - fi distFromRight <= minimizeButtonOffset + buttonSize) - then focus mainw >> minimizeWindow mainw >> return True - else return False - action - -defaultThemeWithImageButtons :: Theme -defaultThemeWithImageButtons = defaultTheme { - windowTitleIcons = [ (menuButton, CenterLeft 3), - (closeButton, CenterRight 3), - (maxiButton, CenterRight 18), - (miniButton, CenterRight 33) ] - } - -imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme - -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a -imageButtonDeco s c = decoration s c $ NFD True - -data ImageButtonDecoration a = NFD Bool deriving (Show, Read) - -instance Eq a => DecorationStyle ImageButtonDecoration a where - describeDeco _ = "ImageButtonDeco" - decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR - decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () diff --git a/src/XMonad/Layout/Minimize.hs b/src/XMonad/Layout/Minimize.hs deleted file mode 100644 --- a/src/XMonad/Layout/Minimize.hs +++ /dev/null @@ -1,143 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.Minimize --- Copyright : (c) Jan Vornberger 2009, Alejandro Serrano 2010 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- Makes it possible to minimize windows, temporarily removing them --- from the layout until they are restored. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.Minimize ( - -- * Usage - -- $usage - minimize, - minimizeWindow, - MinimizeMsg(RestoreMinimizedWin,RestoreNextMinimizedWin) - ) where - -import XMonad -import qualified XMonad.StackSet as W -import XMonad.Layout.LayoutModifier -import XMonad.Layout.BoringWindows as BW -import XMonad.Util.WindowProperties (getProp32) -import Data.List -import qualified Data.Map as M -import Data.Maybe -import Foreign.C.Types (CLong) - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.Minimize --- --- Then edit your @layoutHook@ by adding the Minimize layout modifier: --- --- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayout } --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" --- --- In the key-bindings, do something like: --- --- > , ((modm, xK_m ), withFocused minimizeWindow) --- > , ((modm .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) --- --- The first action will minimize the focused window, while the second one will restore --- the next minimized window. --- --- For detailed instruction on editing the key binding see: --- --- "XMonad.Doc.Extending#Editing_key_bindings". --- --- The module is designed to work together with "XMonad.Layout.BoringWindows" so --- that minimized windows will be skipped over when switching the focused window with --- the keyboard. Include 'BW.boringWindows' in your layout hook and see the --- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings. --- --- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize --- and restore windows from your taskbar. - -data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show ) -minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window -minimize = ModifiedLayout $ Minimize [] M.empty - -data MinimizeMsg = MinimizeWin Window - | RestoreMinimizedWin Window - | RestoreNextMinimizedWin - deriving (Typeable, Eq) -instance Message MinimizeMsg - -minimizeWindow :: Window -> X () -minimizeWindow w = sendMessage (MinimizeWin w) >> BW.focusDown - -setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X () -setMinimizedState win st f = do - setWMState win st - withDisplay $ \dpy -> do - state <- getAtom "_NET_WM_STATE" - mini <- getAtom "_NET_WM_STATE_HIDDEN" - wstate <- fromMaybe [] `fmap` getProp32 state win - let ptype = 4 -- The atom property type for changeProperty - fi_mini = fromIntegral mini - io $ changeProperty32 dpy win state ptype propModeReplace (f fi_mini wstate) - -setMinimized :: Window -> X () -setMinimized win = setMinimizedState win iconicState (:) - -setNotMinimized :: Window -> X () -setNotMinimized win = setMinimizedState win normalState delete - -instance LayoutModifier Minimize Window where - modifierDescription _ = "Minimize" - - modifyLayout (Minimize minimized _) wksp rect = do - let stack = W.stack wksp - filtStack = stack >>=W.filter (\w -> not (w `elem` minimized)) - runLayout (wksp {W.stack = filtStack}) rect - - handleMess (Minimize minimized unfloated) m - | Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do - setMinimized w - ws <- gets windowset - case M.lookup w (W.floating ws) of - Nothing -> return $ Just $ Minimize (w:minimized) unfloated - Just r -> do - modify (\s -> s { windowset = W.sink w ws}) - return $ Just $ Minimize (w:minimized) (M.insert w r unfloated) - | Just (RestoreMinimizedWin w) <- fromMessage m = do - setNotMinimized w - case M.lookup w unfloated of - Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated - Just r -> do - ws <- gets windowset - modify (\s -> s { windowset = W.float w r ws}) - return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated) - | Just RestoreNextMinimizedWin <- fromMessage m = do - ws <- gets windowset - if not (null minimized) - then case M.lookup (head minimized) unfloated of - Nothing -> do - let w = head minimized - setNotMinimized w - modify (\s -> s { windowset = W.focusWindow w ws}) - return $ Just $ Minimize (tail minimized) unfloated - Just r -> do - let w = head minimized - setNotMinimized w - modify (\s -> s { windowset = (W.focusWindow w . W.float w r) ws}) - return $ Just $ Minimize (tail minimized) (M.delete w unfloated) - else return Nothing - | Just BW.UpdateBoring <- fromMessage m = do - ws <- gets (W.workspace . W.current . windowset) - flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized - return Nothing - | otherwise = return Nothing diff --git a/src/XMonad/Layout/MouseResizableTile.hs b/src/XMonad/Layout/MouseResizableTile.hs deleted file mode 100644 --- a/src/XMonad/Layout/MouseResizableTile.hs +++ /dev/null @@ -1,320 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.MouseResizableTile --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option --- to use the mouse to adjust the layout. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.MouseResizableTile ( - -- * Usage - -- $usage - mouseResizableTile, - mouseResizableTileMirrored, - MRTMessage (ShrinkSlave, ExpandSlave), - - -- * Parameters - -- $mrtParameters - nmaster, - masterFrac, - slaveFrac, - fracIncrement, - isMirrored, - draggerType, - DraggerType (..), - ) where - -import XMonad hiding (tile, splitVertically, splitHorizontallyBy) -import qualified XMonad.StackSet as W -import XMonad.Util.XUtils -import Control.Applicative((<$>)) - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.MouseResizableTile --- --- Then edit your @layoutHook@ by adding the MouseResizableTile layout. --- Either in its normal form or the mirrored version. (The mirror layout modifier --- will not work correctly here because of the use of the mouse.) --- --- > myLayout = mouseResizableTile ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayout } --- --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" --- --- You may also want to add the following key bindings: --- --- > , ((modm, xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area --- > , ((modm, xK_i), sendMessage ExpandSlave) -- %! Expand a slave area --- --- For detailed instruction on editing the key binding see: --- --- "XMonad.Doc.Extending#Editing_key_bindings". - --- $mrtParameters --- The following functions are also labels for updating the @data@ (whose --- representation is otherwise hidden) produced by 'mouseResizableTile'. --- --- Usage: --- --- > myLayout = mouseResizableTile{ masterFrac = 0.7, --- > fracIncrement = 0.05, --- > draggerType = BordersDragger } --- > ||| etc.. - -data MRTMessage = SetMasterFraction Rational - | SetLeftSlaveFraction Int Rational - | SetRightSlaveFraction Int Rational - | ShrinkSlave - | ExpandSlave - deriving Typeable -instance Message MRTMessage - -data DraggerInfo = MasterDragger Position Rational - | LeftSlaveDragger Position Rational Int - | RightSlaveDragger Position Rational Int - deriving (Show, Read) -type DraggerWithRect = (Rectangle, Glyph, DraggerInfo) -type DraggerWithWin = (Window, DraggerInfo) - --- | Specifies the size of the clickable area between windows. -data DraggerType = FixedDragger - { gapWidth :: Dimension -- ^ width of a gap between windows - , draggerWidth :: Dimension -- ^ width of the dragger itself - -- (will overlap windows if greater than gap) - } - | BordersDragger -- ^ no gaps, draggers overlap window borders - deriving (Show, Read) -type DraggerGeometry = (Position, Dimension, Position, Dimension) - -data MouseResizableTile a = MRT { nmaster :: Int, - -- ^ Get/set the number of windows in - -- master pane (default: 1). - masterFrac :: Rational, - -- ^ Get/set the proportion of screen - -- occupied by master pane (default: 1/2). - slaveFrac :: Rational, - -- ^ Get/set the proportion of remaining - -- space in a column occupied by a slave - -- window (default: 1/2). - fracIncrement :: Rational, - -- ^ Get/set the increment used when - -- modifying masterFrac/slaveFrac by the - -- Shrink, Expand, etc. messages (default: - -- 3/100). - leftFracs :: [Rational], - rightFracs :: [Rational], - draggers :: [DraggerWithWin], - draggerType :: DraggerType, - -- ^ Get/set dragger and gap dimensions - -- (default: FixedDragger 6 6). - focusPos :: Int, - numWindows :: Int, - isMirrored :: Bool - -- ^ Get/set whether the layout is - -- mirrored (default: False). - } deriving (Show, Read) - -mouseResizableTile :: MouseResizableTile a -mouseResizableTile = MRT 1 0.5 0.5 0.03 [] [] [] (FixedDragger 6 6) 0 0 False - --- | May be removed in favor of @mouseResizableTile { isMirrored = True }@ -mouseResizableTileMirrored :: MouseResizableTile a -mouseResizableTileMirrored = mouseResizableTile { isMirrored = True } - -instance LayoutClass MouseResizableTile Window where - doLayout state sr (W.Stack w l r) = do - drg <- draggerGeometry $ draggerType state - let wins = reverse l ++ w : r - num = length wins - sr' = mirrorAdjust sr (mirrorRect sr) - (rects, preparedDraggers) = tile (nmaster state) (masterFrac state) - (leftFracs state ++ repeat (slaveFrac state)) - (rightFracs state ++ repeat (slaveFrac state)) sr' num drg - rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects - mapM_ deleteDragger $ draggers state - (draggerWrs, newDraggers) <- unzip <$> mapM - (createDragger sr . adjustForMirror (isMirrored state)) - preparedDraggers - return (draggerWrs ++ zip wins rects', Just $ state { draggers = newDraggers, - focusPos = length l, - numWindows = length wins }) - where - mirrorAdjust a b = if (isMirrored state) - then b - else a - - handleMessage state m - | Just (IncMasterN d) <- fromMessage m = - return $ Just $ state { nmaster = max 0 (nmaster state + d) } - | Just Shrink <- fromMessage m = - return $ Just $ state { masterFrac = max 0 (masterFrac state - fracIncrement state) } - | Just Expand <- fromMessage m = - return $ Just $ state { masterFrac = min 1 (masterFrac state + fracIncrement state) } - | Just ShrinkSlave <- fromMessage m = - return $ Just $ modifySlave state (- fracIncrement state) - | Just ExpandSlave <- fromMessage m = - return $ Just $ modifySlave state (fracIncrement state) - | Just (SetMasterFraction f) <- fromMessage m = - return $ Just $ state { masterFrac = max 0 (min 1 f) } - | Just (SetLeftSlaveFraction pos f) <- fromMessage m = - return $ Just $ state { leftFracs = replaceAtPos (slaveFrac state) - (leftFracs state) pos (max 0 (min 1 f)) } - | Just (SetRightSlaveFraction pos f) <- fromMessage m = - return $ Just $ state { rightFracs = replaceAtPos (slaveFrac state) - (rightFracs state) pos (max 0 (min 1 f)) } - - | Just e <- fromMessage m :: Maybe Event = handleResize (draggers state) (isMirrored state) e >> return Nothing - | Just Hide <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] }) - | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] }) - where releaseResources = mapM_ deleteDragger $ draggers state - handleMessage _ _ = return Nothing - - description state = mirror "MouseResizableTile" - where mirror = if isMirrored state then ("Mirror " ++) else id - -draggerGeometry :: DraggerType -> X DraggerGeometry -draggerGeometry (FixedDragger g d) = - return (fromIntegral $ g `div` 2, g, fromIntegral $ d `div` 2, d) -draggerGeometry BordersDragger = do - w <- asks (borderWidth . config) - return (0, 0, fromIntegral w, 2*w) - -adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect -adjustForMirror False dragger = dragger -adjustForMirror True (draggerRect, draggerCursor, draggerInfo) = - (mirrorRect draggerRect, draggerCursor', draggerInfo) - where - draggerCursor' = if (draggerCursor == xC_sb_h_double_arrow) - then xC_sb_v_double_arrow - else xC_sb_h_double_arrow - -modifySlave :: MouseResizableTile a -> Rational -> MouseResizableTile a -modifySlave state delta = - let pos = focusPos state - num = numWindows state - nmaster' = nmaster state - leftFracs' = leftFracs state - rightFracs' = rightFracs state - slFrac = slaveFrac state - draggersLeft = nmaster' - 1 - draggersRight = (num - nmaster') - 1 - in if pos < nmaster' - then if draggersLeft > 0 - then let draggerPos = min (draggersLeft - 1) pos - oldFraction = (leftFracs' ++ repeat slFrac) !! draggerPos - in state { leftFracs = replaceAtPos slFrac leftFracs' draggerPos - (max 0 (min 1 (oldFraction + delta))) } - else state - else if draggersRight > 0 - then let draggerPos = min (draggersRight - 1) (pos - nmaster') - oldFraction = (rightFracs' ++ repeat slFrac) !! draggerPos - in state { rightFracs = replaceAtPos slFrac rightFracs' draggerPos - (max 0 (min 1 (oldFraction + delta))) } - else state - -replaceAtPos :: (Num t) => Rational -> [Rational] -> t -> Rational -> [Rational] -replaceAtPos _ [] 0 x' = [x'] -replaceAtPos d [] pos x' = d : replaceAtPos d [] (pos - 1) x' -replaceAtPos _ (_:xs) 0 x' = x' : xs -replaceAtPos d (x:xs) pos x' = x : replaceAtPos d xs (pos -1 ) x' - -sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle -sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) = - (Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y) - (within 1 swh wh) (within 1 sht ht)) - -within :: (Ord a) => a -> a -> a -> a -within low high a = max low $ min high a - -tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect]) -tile nmaster' masterFrac' leftFracs' rightFracs' sr num drg - | num <= nmaster' = splitVertically (take (num - 1) leftFracs') sr True 0 drg - | nmaster' == 0 = splitVertically (take (num - 1) rightFracs') sr False 0 drg - | otherwise = (leftRects ++ rightRects, masterDragger : leftDraggers ++ rightDraggers) - where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr drg - (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0 drg - (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0 drg - -splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect]) -splitVertically [] r _ _ _ = ([r], []) -splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num drg@(drOff, drSz, drOff2, drSz2) = - let nextRect = Rectangle sx sy sw $ smallh - div drSz 2 - (otherRects, otherDragger) = splitVertically fx - (Rectangle sx (sy + fromIntegral smallh + drOff) - sw (sh - smallh - div drSz 2)) - isLeft (num + 1) drg - draggerRect = Rectangle sx (sy + fromIntegral smallh - drOff2) sw drSz2 - draggerInfo = if isLeft - then LeftSlaveDragger sy (fromIntegral sh) num - else RightSlaveDragger sy (fromIntegral sh) num - nextDragger = (draggerRect, xC_sb_v_double_arrow, draggerInfo) - in (nextRect : otherRects, nextDragger : otherDragger) - where smallh = floor $ fromIntegral sh * f - -splitHorizontallyBy :: RealFrac r => r -> Rectangle -> DraggerGeometry -> ((Rectangle, Rectangle), DraggerWithRect) -splitHorizontallyBy f (Rectangle sx sy sw sh) (drOff, drSz, drOff2, drSz2) = - ((leftHalf, rightHalf), (draggerRect, xC_sb_h_double_arrow, draggerInfo)) - where leftw = floor $ fromIntegral sw * f - leftHalf = Rectangle sx sy (leftw - drSz `div` 2) sh - rightHalf = Rectangle (sx + fromIntegral leftw + drOff) sy - (sw - fromIntegral leftw - drSz `div` 2) sh - draggerRect = Rectangle (sx + fromIntegral leftw - drOff2) sy drSz2 sh - draggerInfo = MasterDragger sx (fromIntegral sw) - -createDragger :: Rectangle -> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin) -createDragger sr (draggerRect, draggerCursor, draggerInfo) = do - let draggerRect' = sanitizeRectangle sr draggerRect - draggerWin <- createInputWindow draggerCursor draggerRect' - return ((draggerWin, draggerRect'), (draggerWin, draggerInfo)) - -deleteDragger :: DraggerWithWin -> X () -deleteDragger (draggerWin, _) = deleteWindow draggerWin - -handleResize :: [DraggerWithWin] -> Bool -> Event -> X () -handleResize draggers' isM ButtonEvent { ev_window = ew, ev_event_type = et } - | et == buttonPress, Just x <- lookup ew draggers' = case x of - MasterDragger lb r -> mouseDrag' id lb r SetMasterFraction - LeftSlaveDragger lb r num -> mouseDrag' flip lb r (SetLeftSlaveFraction num) - RightSlaveDragger lb r num -> mouseDrag' flip lb r (SetRightSlaveFraction num) - where - chooseAxis isM' axis1 axis2 = if isM' then axis2 else axis1 - mouseDrag' flp lowerBound range msg = flip mouseDrag (return ()) $ \x y -> do - let axis = flp (chooseAxis isM) x y - fraction = fromIntegral (axis - lowerBound) / range - sendMessage (msg fraction) - -handleResize _ _ _ = return () - -createInputWindow :: Glyph -> Rectangle -> X Window -createInputWindow cursorGlyph r = withDisplay $ \d -> do - win <- mkInputWindow d r - io $ selectInput d win (exposureMask .|. buttonPressMask) - cursor <- io $ createFontCursor d cursorGlyph - io $ defineCursor d win cursor - io $ freeCursor d cursor - showWindow win - return win - -mkInputWindow :: Display -> Rectangle -> X Window -mkInputWindow d (Rectangle x y w h) = do - rw <- asks theRoot - let screen = defaultScreenOfDisplay d - visual = defaultVisualOfScreen screen - attrmask = cWOverrideRedirect - io $ allocaSetWindowAttributes $ - \attributes -> do - set_override_redirect attributes True - createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes diff --git a/src/XMonad/Layout/PositionStoreFloat.hs b/src/XMonad/Layout/PositionStoreFloat.hs deleted file mode 100644 --- a/src/XMonad/Layout/PositionStoreFloat.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.PositionStoreFloat --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- A floating layout which has been designed with a dual-head setup --- in mind. It makes use of "XMonad.Util.PositionStore" as well as --- "XMonad.Hooks.PositionStoreHooks" . Since there is currently no way --- to move or resize windows with the keyboard alone in this layout, --- it is adviced to use it in combination with a decoration such as --- "XMonad.Layout.NoFrillsDecoration" (to move windows) and the --- layout modifier "XMonad.Layout.BorderResize" (to resize windows). --- ------------------------------------------------------------------------------ - -module XMonad.Layout.PositionStoreFloat - ( -- * Usage - -- $usage - positionStoreFloat - ) where - -import XMonad -import XMonad.Util.PositionStore -import qualified XMonad.StackSet as S -import XMonad.Layout.WindowArranger -import Control.Monad(when) -import Data.Maybe(isJust) -import Data.List(nub) - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.PositionStoreFloat --- > import XMonad.Layout.NoFrillsDecoration --- > import XMonad.Layout.BorderResize --- --- Then edit your @layoutHook@ by adding the PositionStoreFloat layout. --- Below is a suggestion which uses the mentioned NoFrillsDecoration and --- BorderResize: --- --- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc.. --- > where floatingDeco l = noFrillsDeco shrinkText defaultTheme l --- > main = xmonad defaultConfig { layoutHook = myLayouts } --- --- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how --- to add the support hooks. - -positionStoreFloat :: PositionStoreFloat a -positionStoreFloat = PSF (Nothing, []) - -data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read) -instance LayoutClass PositionStoreFloat Window where - description _ = "PSF" - doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do - posStore <- getPosStore - let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r) - let focused = case maybeChange of - Nothing -> (w, pSQ posStore w sr) - Just changedRect -> (w, changedRect) - let wrs' = focused : wrs - let paintOrder' = nub (w : paintOrder) - when (isJust maybeChange) $ do - updatePositionStore focused sr - return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder')) - where - pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of - Just rect -> rect - Nothing -> (Rectangle 50 50 200 200) -- should usually not happen - pureMessage (PSF (_, paintOrder)) m - | Just (SetGeometry rect) <- fromMessage m = - Just $ PSF (Just rect, paintOrder) - | otherwise = Nothing - -updatePositionStore :: (Window, Rectangle) -> Rectangle -> X () -updatePositionStore (w, rect) sr = modifyPosStore (\ps -> - posStoreInsert ps w rect sr) - -reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] -reorder wrs order = - let ordered = concat $ map (pickElem wrs) order - rest = filter (\(w, _) -> not (w `elem` order)) wrs - in ordered ++ rest - where - pickElem list e = case (lookup e list) of - Just result -> [(e, result)] - Nothing -> [] diff --git a/src/XMonad/Layout/WindowSwitcherDecoration.hs b/src/XMonad/Layout/WindowSwitcherDecoration.hs deleted file mode 100644 --- a/src/XMonad/Layout/WindowSwitcherDecoration.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Layout.WindowSwitcherDecoration --- Copyright : (c) Jan Vornberger 2009 --- Alejandro Serrano 2010 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- A decoration that allows to switch the position of windows by dragging --- them onto each other. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.WindowSwitcherDecoration - ( -- * Usage: - -- $usage - windowSwitcherDecoration, - windowSwitcherDecorationWithButtons, - windowSwitcherDecorationWithImageButtons - ) where - -import XMonad -import XMonad.Layout.Decoration -import XMonad.Layout.DecorationAddons -import XMonad.Layout.ImageButtonDecoration -import XMonad.Layout.DraggingVisualizer -import qualified XMonad.StackSet as S -import Control.Monad -import Foreign.C.Types(CInt) - --- $usage --- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.WindowSwitcherDecoration --- > import XMonad.Layout.DraggingVisualizer --- --- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to --- your layout: --- --- > myL = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer $ layoutHook defaultConfig) --- > main = xmonad defaultConfig { layoutHook = myL } --- --- There is also a version of the decoration that contains buttons like --- "XMonad.Layout.ButtonDecoration". To use that version, you will need to --- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@ --- in the following way: --- --- > import XMonad.Layout.DecorationAddons --- > --- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook defaultConfig) --- > main = xmonad defaultConfig { layoutHook = myL } --- --- Additionaly, there is a version of the decoration that contains image buttons like --- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to --- import "XMonad.Layout.ImageButtonDecoration" as well and modify your @layoutHook@ --- in the following way: --- --- > import XMonad.Layout.ImageButtonDecoration --- > --- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook defaultConfig) --- > main = xmonad defaultConfig { layoutHook = myL } --- - -windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme - -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a -windowSwitcherDecoration s c = decoration s c $ WSD False - -windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme - -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a -windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True - -data WindowSwitcherDecoration a = WSD Bool deriving (Show, Read) - -instance Eq a => DecorationStyle WindowSwitcherDecoration a where - describeDeco _ = "WindowSwitcherDeco" - - decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons - then titleBarButtonHandler mainw dFL dFR - else return False - decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y - decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw - hasCrossed <- handleScreenCrossing mainw decoWin - unless hasCrossed $ do sendMessage $ DraggingStopped - performWindowSwitching mainw - --- Note: the image button code is duplicated from the above --- because the title bar handle is different - -windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme - -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a -windowSwitcherDecorationWithImageButtons s c = decoration s c $ IWSD True - -data ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read) - -instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where - describeDeco _ = "ImageWindowSwitcherDeco" - - decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons - then imageTitleBarButtonHandler mainw dFL dFR - else return False - decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y - decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw - hasCrossed <- handleScreenCrossing mainw decoWin - unless hasCrossed $ do sendMessage $ DraggingStopped - performWindowSwitching mainw - -handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () -handleTiledDraggingInProgress ex ey (mainw, r) x y = do - let rect = Rectangle (x - (fi ex - rect_x r)) - (y - (fi ey - rect_y r)) - (rect_width r) - (rect_height r) - sendMessage $ DraggingWindow mainw rect - -performWindowSwitching :: Window -> X () -performWindowSwitching win = - withDisplay $ \d -> do - root <- asks theRoot - (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root - ws <- gets windowset - let allWindows = S.index ws - -- do a little double check to be sure - if (win `elem` allWindows) && (selWin `elem` allWindows) - then do - let allWindowsSwitched = map (switchEntries win selWin) allWindows - let (ls, t:rs) = break (win ==) allWindowsSwitched - let newStack = S.Stack t (reverse ls) rs - windows $ S.modify' $ \_ -> newStack - else return () - where - switchEntries a b x - | x == a = b - | x == b = a - | otherwise = x diff --git a/src/XMonad/Util/Font.hs b/src/XMonad/Util/Font.hs deleted file mode 100644 --- a/src/XMonad/Util/Font.hs +++ /dev/null @@ -1,187 +0,0 @@ -{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- --- | --- Module : XMonad.Util.Font --- Copyright : (c) 2007 Andrea Rossato and Spencer Janssen --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A module for abstracting a font facility over Core fonts and Xft --- ------------------------------------------------------------------------------ - -module XMonad.Util.Font - ( -- * Usage: - -- $usage - XMonadFont(..) - , initXMF - , releaseXMF - , initCoreFont - , releaseCoreFont - , initUtf8Font - , releaseUtf8Font - , Align (..) - , stringPosition - , textWidthXMF - , textExtentsXMF - , printStringXMF - , stringToPixel - , decodeInput - , encodeOutput - ) where - -import XMonad -import Foreign -import Control.Applicative -import Data.Maybe - -import Data.List -import Graphics.X11.Xft -import Graphics.X11.Xrender - -import Codec.Binary.UTF8.String (encodeString, decodeString) - - --- Hide the Core Font/Xft switching here -data XMonadFont = Core FontStruct - | Utf8 FontSet - | Xft XftFont - --- $usage --- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples - --- | Get the Pixel value for a named color: if an invalid name is --- given the black pixel will be returned. -stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel -stringToPixel d s = fromMaybe fallBack <$> io getIt - where getIt = initColor d s - fallBack = blackPixel d (defaultScreen d) - - --- | Given a fontname returns the font structure. If the font name is --- not valid the default font will be loaded and returned. -initCoreFont :: String -> X FontStruct -initCoreFont s = do - d <- asks display - io $ catch (getIt d) (fallBack d) - where getIt d = loadQueryFont d s - fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - -releaseCoreFont :: FontStruct -> X () -releaseCoreFont fs = do - d <- asks display - io $ freeFont d fs - -initUtf8Font :: String -> X FontSet -initUtf8Font s = do - d <- asks display - (_,_,fs) <- io $ catch (getIt d) (fallBack d) - return fs - where getIt d = createFontSet d s - fallBack d = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - -releaseUtf8Font :: FontSet -> X () -releaseUtf8Font fs = do - d <- asks display - io $ freeFontSet d fs - --- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend --- Example: 'xft: Sans-10' -initXMF :: String -> X XMonadFont -initXMF s = - if xftPrefix `isPrefixOf` s then - do dpy <- asks display - xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) - return (Xft xftdraw) - else - fmap Utf8 $ initUtf8Font s - where xftPrefix = "xft:" - -releaseXMF :: XMonadFont -> X () -releaseXMF (Xft xftfont) = do - dpy <- asks display - io $ xftFontClose dpy xftfont -releaseXMF (Utf8 fs) = releaseUtf8Font fs -releaseXMF (Core fs) = releaseCoreFont fs - - -textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int -textWidthXMF _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s -textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s -textWidthXMF dpy (Xft xftdraw) s = liftIO $ do - gi <- xftTextExtents dpy xftdraw s - return $ xglyphinfo_xOff gi - -textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32) -textExtentsXMF (Utf8 fs) s = do - let (_,rl) = wcTextExtents fs s - ascent = fi $ - (rect_y rl) - descent = fi $ rect_height rl + (fi $ rect_y rl) - return (ascent, descent) -textExtentsXMF (Core fs) s = do - let (_,a,d,_) = textExtents fs s - return (a,d) -textExtentsXMF (Xft xftfont) _ = io $ do - ascent <- fi `fmap` xftfont_ascent xftfont - descent <- fi `fmap` xftfont_descent xftfont - return (ascent, descent) - --- | String position -data Align = AlignCenter | AlignRight | AlignLeft | AlignRightOffset Int - deriving (Show, Read) - --- | Return the string x and y 'Position' in a 'Rectangle', given a --- 'FontStruct' and the 'Align'ment -stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position) -stringPosition dpy fs (Rectangle _ _ w h) al s = do - width <- textWidthXMF dpy fs s - (a,d) <- textExtentsXMF fs s - let y = fi $ ((h - fi (a + d)) `div` 2) + fi a; - x = case al of - AlignCenter -> fi (w `div` 2) - fi (width `div` 2) - AlignLeft -> 1 - AlignRight -> fi (w - (fi width + 1)); - AlignRightOffset offset -> fi (w - (fi width + 1)) - fi offset; - return (x,y) - -printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String - -> Position -> Position -> String -> m () -printStringXMF d p (Core fs) gc fc bc x y s = io $ do - setFont d gc $ fontFromFontStruct fs - [fc',bc'] <- mapM (stringToPixel d) [fc,bc] - setForeground d gc fc' - setBackground d gc bc' - drawImageString d p gc x y s -printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do - [fc',bc'] <- mapM (stringToPixel d) [fc,bc] - setForeground d gc fc' - setBackground d gc bc' - io $ wcDrawImageString d p fs gc x y s -printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do - let screen = defaultScreenOfDisplay dpy - colormap = defaultColormapOfScreen screen - visual = defaultVisualOfScreen screen - bcolor <- stringToPixel dpy bc - (a,d) <- textExtentsXMF fs s - gi <- io $ xftTextExtents dpy font s - io $ setForeground dpy gc bcolor - io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi)) - (y - fi a) - (fi $ xglyphinfo_xOff gi) - (fi $ a + d) - io $ withXftDraw dpy drw visual colormap $ - \draw -> withXftColorName dpy visual colormap fc $ - \color -> xftDrawString draw color font x y s - -decodeInput :: String -> String -decodeInput = decodeString - -encodeOutput :: String -> String -encodeOutput = encodeString - --- | Short-hand for 'fromIntegral' -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral diff --git a/src/XMonad/Util/Image.hs b/src/XMonad/Util/Image.hs deleted file mode 100644 --- a/src/XMonad/Util/Image.hs +++ /dev/null @@ -1,94 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : XMonad.Util.Image --- Copyright : (c) 2010 Alejandro Serrano --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : trupill@gmail.com --- Stability : unstable --- Portability : unportable --- --- Utilities for manipulating [[Bool]] as images --- ------------------------------------------------------------------------------ - -module XMonad.Util.Image - ( -- * Usage: - -- $usage - Placement(..), - iconPosition, - drawIcon, - - fi, - ) where - -import XMonad -import XMonad.Util.Font (stringToPixel) - --- | Placement of the icon in the title bar -data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the upper left corner - | OffsetRight Int Int -- ^ An exact amount of pixels from the right left corner - | CenterLeft Int -- ^ Centered in the y-axis, an amount of pixels from the left - | CenterRight Int -- ^ Centered in the y-axis, an amount of pixels from the right - deriving (Show, Read) - --- $usage --- This module uses matrices of boolean values as images. When drawing them, --- a True value tells that we want the fore color, and a False value that we --- want the background color to be painted. --- In the module we suppose that those matrices are represented as [[Bool]], --- so the lengths of the inner lists must be the same. --- --- See "Xmonad.Layout.Decoration" for usage examples - --- | Gets the ('width', 'height') of an image -imageDims :: [[Bool]] -> (Int, Int) -imageDims img = (length (head img), length img) - --- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing --- the image given its 'Placement' -iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position) -iconPosition (Rectangle _ _ _ _) (OffsetLeft x y) _ = (fi x, fi y) -iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon = - let (icon_w, _) = imageDims icon - in (fi w - fi x - fi icon_w, fi y) -iconPosition (Rectangle _ _ _ h) (CenterLeft x) icon = - let (_, icon_h) = imageDims icon - in (fi x, fi (h `div` 2) - fi (icon_h `div` 2)) -iconPosition (Rectangle _ _ w h) (CenterRight x) icon = - let (icon_w, icon_h) = imageDims icon - in (fi w - fi x - fi icon_w, fi (h `div` 2) - fi (icon_h `div` 2)) - --- | Converts an image represented as [[Bool]] to a series of points --- to be painted (the ones with True values) -iconToPoints :: [[Bool]] -> [Point] -iconToPoints icon = - let labels_inside = map (zip (iterate (1+) 0)) icon - filtered_inside = map (\l -> [x | (x, t) <- l, t]) labels_inside - labels_outside = zip (iterate (1+) 0) filtered_inside - in [Point x y | (y, l) <- labels_outside, x <- l] - --- | Displaces a point ('a', 'b') along a vector ('x', 'y') -movePoint :: Position -> Position -> Point -> Point -movePoint x y (Point a b) = Point (a + x) (b + y) - --- | Displaces a list of points along a vector 'x', 'y' -movePoints :: Position -> Position -> [Point] -> [Point] -movePoints x y points = map (movePoint x y) points - --- | Draw an image into a X surface -drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String - ->String -> Position -> Position -> [[Bool]] -> m () -drawIcon dpy drw gc fc bc x y icon = do - let (i_w, i_h) = imageDims icon - fcolor <- stringToPixel dpy fc - bcolor <- stringToPixel dpy bc - io $ setForeground dpy gc bcolor - io $ fillRectangle dpy drw gc x y (fi i_w) (fi i_h) - io $ setForeground dpy gc fcolor - io $ drawPoints dpy drw gc (movePoints x y (iconToPoints icon)) coordModeOrigin - - --- | Short-hand for 'fromIntegral' -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral diff --git a/src/XMonad/Util/PositionStore.hs b/src/XMonad/Util/PositionStore.hs deleted file mode 100644 --- a/src/XMonad/Util/PositionStore.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - ----------------------------------------------------------------------------- --- | --- Module : XMonad.Util.PositionStore --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- A utility module to store information about position and size of a window. --- See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this. --- ------------------------------------------------------------------------------ - -module XMonad.Util.PositionStore ( - getPosStore, - modifyPosStore, - - posStoreInsert, - posStoreMove, - posStoreQuery, - posStoreRemove - ) where - -import XMonad -import qualified Data.Map as M -import System.Posix.Env - --- Store window positions relative to the upper left screen edge --- and windows sizes as well as positions as fractions of the screen size. --- This way windows can be easily relocated and scaled when switching screens. - -data PositionStore = PS (M.Map Window PosStoreRectangle) - deriving (Read,Show,Typeable) -data PosStoreRectangle = PSRectangle Double Double Double Double - deriving (Read,Show,Typeable) - -getPosStore :: X (PositionStore) -getPosStore = do - posStoreEnvM <- io $ getEnv "BLUETILE_POSITION_STORE" - return $ maybe (PS M.empty) read posStoreEnvM - -modifyPosStore :: (PositionStore -> PositionStore) -> X () -modifyPosStore f = do - posStore <- getPosStore - io $ setEnv "BLUETILE_POSITION_STORE" (show (f posStore)) True - -posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore -posStoreInsert (PS posStoreMap) w (Rectangle x y wh ht) (Rectangle srX srY srWh srHt) = - let offsetX = x - srX - offsetY = y - srY - in PS $ M.insert w (PSRectangle (fromIntegral offsetX / fromIntegral srWh) - (fromIntegral offsetY / fromIntegral srHt) - (fromIntegral wh / fromIntegral srWh) - (fromIntegral ht / fromIntegral srHt)) posStoreMap - -posStoreRemove :: PositionStore -> Window -> PositionStore -posStoreRemove (PS posStoreMap) w = PS $ M.delete w posStoreMap - -posStoreQuery :: PositionStore -> Window -> Rectangle -> Maybe Rectangle -posStoreQuery (PS posStoreMap) w (Rectangle srX srY srWh srHt) = do - (PSRectangle x y wh ht) <- M.lookup w posStoreMap - let realWh = fromIntegral srWh * wh - realHt = fromIntegral srHt * ht - realOffsetX = fromIntegral srWh * x - realOffsetY = fromIntegral srHt * y - return (Rectangle (srX + round realOffsetX) (srY + round realOffsetY) - (round realWh) (round realHt)) - -posStoreMove :: PositionStore -> Window -> Position -> Position -> Rectangle -> Rectangle -> PositionStore -posStoreMove posStore w x y oldSr newSr = - case (posStoreQuery posStore w oldSr) of - Nothing -> posStore -- not in store, can't move -> do nothing - Just (Rectangle _ _ wh ht) -> posStoreInsert posStore w (Rectangle x y wh ht) newSr diff --git a/src/XMonad/Util/XUtils.hs b/src/XMonad/Util/XUtils.hs deleted file mode 100644 --- a/src/XMonad/Util/XUtils.hs +++ /dev/null @@ -1,206 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Util.XUtils --- Copyright : (c) 2007 Andrea Rossato --- 2010 Alejandro Serrano --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A module for painting on the screen --- ------------------------------------------------------------------------------ - -module XMonad.Util.XUtils - ( -- * Usage: - -- $usage - averagePixels - , createNewWindow - , showWindow - , showWindows - , hideWindow - , hideWindows - , deleteWindow - , deleteWindows - , paintWindow - , paintAndWrite - , paintTextAndIcons - , stringToPixel - , fi - ) where - -import Data.Maybe -import XMonad -import XMonad.Util.Font -import XMonad.Util.Image -import Control.Monad - --- $usage --- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or --- "XMonad.Layout.Decoration" for usage examples - --- | Compute the weighted average the colors of two given Pixel values. -averagePixels :: Pixel -> Pixel -> Double -> X Pixel -averagePixels p1 p2 f = - do d <- asks display - let cm = defaultColormap d (defaultScreen d) - [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0] - let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f)) - Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0) - return p - --- | Create a simple window given a rectangle. If Nothing is given --- only the exposureMask will be set, otherwise the Just value. --- Use 'showWindow' to map and hideWindow to unmap. -createNewWindow :: Rectangle -> Maybe EventMask -> String -> Bool -> X Window -createNewWindow (Rectangle x y w h) m col o = do - d <- asks display - rw <- asks theRoot - c <- stringToPixel d col - win <- io $ mkWindow d (defaultScreenOfDisplay d) rw x y w h c o - case m of - Just em -> io $ selectInput d win em - Nothing -> io $ selectInput d win exposureMask - return win - --- | Map a window -showWindow :: Window -> X () -showWindow w = do - d <- asks display - io $ mapWindow d w - --- | the list version -showWindows :: [Window] -> X () -showWindows = mapM_ showWindow - --- | unmap a window -hideWindow :: Window -> X () -hideWindow w = do - d <- asks display - io $ unmapWindow d w - --- | the list version -hideWindows :: [Window] -> X () -hideWindows = mapM_ hideWindow - --- | destroy a window -deleteWindow :: Window -> X () -deleteWindow w = do - d <- asks display - io $ destroyWindow d w - --- | the list version -deleteWindows :: [Window] -> X () -deleteWindows = mapM_ deleteWindow - --- | Fill a window with a rectangle and a border -paintWindow :: Window -- ^ The window where to draw - -> Dimension -- ^ Window width - -> Dimension -- ^ Window height - -> Dimension -- ^ Border width - -> String -- ^ Window background color - -> String -- ^ Border color - -> X () -paintWindow w wh ht bw c bc = - paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing Nothing - --- | Fill a window with a rectangle and a border, and write --- | a number of strings to given positions -paintAndWrite :: Window -- ^ The window where to draw - -> XMonadFont -- ^ XMonad Font for drawing - -> Dimension -- ^ Window width - -> Dimension -- ^ Window height - -> Dimension -- ^ Border width - -> String -- ^ Window background color - -> String -- ^ Border color - -> String -- ^ String color - -> String -- ^ String background color - -> [Align] -- ^ String 'Align'ments - -> [String] -- ^ Strings to be printed - -> X () -paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do - d <- asks display - strPositions <- forM (zip als strs) $ \(al, str) -> - stringPosition d fs (Rectangle 0 0 wh ht) al str - let ms = Just (fs,ffc,fbc, zip strs strPositions) - paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms Nothing - --- | Fill a window with a rectangle and a border, and write --- | a number of strings and a number of icons to given positions -paintTextAndIcons :: Window -- ^ The window where to draw - -> XMonadFont -- ^ XMonad Font for drawing - -> Dimension -- ^ Window width - -> Dimension -- ^ Window height - -> Dimension -- ^ Border width - -> String -- ^ Window background color - -> String -- ^ Border color - -> String -- ^ String color - -> String -- ^ String background color - -> [Align] -- ^ String 'Align'ments - -> [String] -- ^ Strings to be printed - -> [Placement] -- ^ Icon 'Placements' - -> [[[Bool]]] -- ^ Icons to be printed - -> X () -paintTextAndIcons w fs wh ht bw bc borc ffc fbc als strs i_als icons = do - d <- asks display - strPositions <- forM (zip als strs) $ \(al, str) -> - stringPosition d fs (Rectangle 0 0 wh ht) al str - let iconPositions = map ( \(al, icon) -> iconPosition (Rectangle 0 0 wh ht) al icon ) (zip i_als icons) - ms = Just (fs,ffc,fbc, zip strs strPositions) - is = Just (ffc, fbc, zip iconPositions icons) - paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is - --- This stuff is not exported - --- | Paints a titlebar with some strings and icons --- drawn inside it. --- Not exported. -paintWindow' :: Window -> Rectangle -> Dimension -> String -> String - -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) - -> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X () -paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff iconStuff = do - d <- asks display - p <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) - gc <- io $ createGC d p - -- draw - io $ setGraphicsExposures d gc False - [color',b_color'] <- mapM (stringToPixel d) [color,b_color] - -- we start with the border - io $ setForeground d gc b_color' - io $ fillRectangle d p gc 0 0 wh ht - -- and now again - io $ setForeground d gc color' - io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) - -- paint strings - when (isJust strStuff) $ do - let (xmf,fc,bc,strAndPos) = fromJust strStuff - forM_ strAndPos $ \(s, (x, y)) -> - printStringXMF d p xmf gc fc bc x y s - -- paint icons - when (isJust iconStuff) $ do - let (fc, bc, iconAndPos) = fromJust iconStuff - forM_ iconAndPos $ \((x, y), icon) -> - drawIcon d p gc fc bc x y icon - -- copy the pixmap over the window - io $ copyArea d p win gc 0 0 wh ht 0 0 - -- free the pixmap and GC - io $ freePixmap d p - io $ freeGC d gc - --- | Creates a window with the possibility of setting some attributes. --- Not exported. -mkWindow :: Display -> Screen -> Window -> Position - -> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window -mkWindow d s rw x y w h p o = do - let visual = defaultVisualOfScreen s - attrmask = cWOverrideRedirect .|. cWBackPixel .|. cWBorderPixel - allocaSetWindowAttributes $ - \attributes -> do - set_override_redirect attributes o - set_border_pixel attributes p - set_background_pixel attributes p - createWindow d rw x y w h 0 (defaultDepthOfScreen s) - inputOutput visual attrmask attributes -