bluetile 0.5.3 → 0.6
raw patch · 25 files changed
+29/−3020 lines, 25 filesdep ~xmonaddep ~xmonad-contrib
Dependency ranges changed: xmonad, xmonad-contrib
Files
- NEWS +9/−0
- bluetile.cabal +7/−24
- etc/bluetilerc +1/−0
- man/bluetile.1 +2/−1
- src/Config.hs +10/−6
- src/XMonad/Actions/BluetileCommands.hs +0/−83
- src/XMonad/Actions/WindowMenu.hs +0/−79
- src/XMonad/Hooks/CurrentWorkspaceOnTop.hs +0/−67
- src/XMonad/Hooks/EwmhDesktops.hs +0/−254
- src/XMonad/Hooks/Minimize.hs +0/−53
- src/XMonad/Hooks/PositionStoreHooks.hs +0/−106
- src/XMonad/Layout/BorderResize.hs +0/−224
- src/XMonad/Layout/ButtonDecoration.hs +0/−55
- src/XMonad/Layout/Decoration.hs +0/−457
- src/XMonad/Layout/DecorationAddons.hs +0/−123
- src/XMonad/Layout/DraggingVisualizer.hs +0/−48
- src/XMonad/Layout/ImageButtonDecoration.hs +0/−182
- src/XMonad/Layout/Minimize.hs +0/−143
- src/XMonad/Layout/MouseResizableTile.hs +0/−320
- src/XMonad/Layout/PositionStoreFloat.hs +0/−92
- src/XMonad/Layout/WindowSwitcherDecoration.hs +0/−139
- src/XMonad/Util/Font.hs +0/−187
- src/XMonad/Util/Image.hs +0/−94
- src/XMonad/Util/PositionStore.hs +0/−77
- src/XMonad/Util/XUtils.hs +0/−206
NEWS view
@@ -1,3 +1,12 @@+Bluetile 0.6 (on 2011/11/26) Jan Vornberger <jan.vornberger@informatik.uni-oldenburg.de>+ 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 <jan.vornberger@informatik.uni-oldenburg.de> 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
bluetile.cabal view
@@ -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)
etc/bluetilerc view
@@ -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
man/bluetile.1 view
@@ -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
src/Config.hs view
@@ -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
− src/XMonad/Actions/BluetileCommands.hs
@@ -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 (<http://projects.haskell.org/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)
− src/XMonad/Actions/WindowMenu.hs
@@ -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)
− src/XMonad/Hooks/CurrentWorkspaceOnTop.hs
@@ -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
− src/XMonad/Hooks/EwmhDesktops.hs
@@ -1,254 +0,0 @@--------------------------------------------------------------------------------- |--- Module : XMonad.Hooks.EwmhDesktops--- Copyright : (c) 2007, 2008 Joachim Breitner <mail@joachim-breitner.de>--- License : BSD------ Maintainer : Joachim Breitner <mail@joachim-breitner.de>--- 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]
− src/XMonad/Hooks/Minimize.hs
@@ -1,53 +0,0 @@-------------------------------------------------------------------------------- |--- Module : XMonad.Hooks.Minimize--- Copyright : (c) Justin Bogner 2010--- License : BSD3-style (see LICENSE)------ Maintainer : Justin Bogner <mail@justinbogner.com>--- 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)
− src/XMonad/Hooks/PositionStoreHooks.hs
@@ -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)
− src/XMonad/Layout/BorderResize.hs
@@ -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 -> []
− src/XMonad/Layout/ButtonDecoration.hs
@@ -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 ()
− src/XMonad/Layout/Decoration.hs
@@ -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
− src/XMonad/Layout/DecorationAddons.hs
@@ -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
− src/XMonad/Layout/DraggingVisualizer.hs
@@ -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
− src/XMonad/Layout/ImageButtonDecoration.hs
@@ -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 ()
− src/XMonad/Layout/Minimize.hs
@@ -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
− src/XMonad/Layout/MouseResizableTile.hs
@@ -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
− src/XMonad/Layout/PositionStoreFloat.hs
@@ -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 -> []
− src/XMonad/Layout/WindowSwitcherDecoration.hs
@@ -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
− src/XMonad/Util/Font.hs
@@ -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
− src/XMonad/Util/Image.hs
@@ -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
− src/XMonad/Util/PositionStore.hs
@@ -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
− src/XMonad/Util/XUtils.hs
@@ -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-