bluetile 0.4 → 0.4.1
raw patch · 28 files changed
+3386/−35 lines, 28 filesdep +randomdep +utf8-stringdep +xmonaddep −xmonad-bluetilebranchdep −xmonad-contrib-bluetilebranchdep ~basebuild-type:Customsetup-changedbinary-added
Dependencies added: random, utf8-string, xmonad, xmonad-contrib
Dependencies removed: xmonad-bluetilebranch, xmonad-contrib-bluetilebranch
Dependency ranges changed: base
Files
- Setup.lhs +16/−1
- bluetile.cabal +55/−20
- bluetiledock/BluetileDock.hs +2/−3
- bluetilegreet/BluetileGreet.hs +3/−3
- logo/bluetile-icon-48x48.png binary
- logo/bluetile-icon.svg +138/−0
- man/bluetile.1 +224/−0
- src/Config.hs +2/−3
- src/Main.hs +4/−5
- src/XMonad/Actions/BluetileCommands.hs +83/−0
- src/XMonad/Actions/WindowMenu.hs +79/−0
- src/XMonad/Hooks/CurrentWorkspaceOnTop.hs +60/−0
- src/XMonad/Hooks/EwmhDesktops.hs +254/−0
- src/XMonad/Hooks/PositionStoreHooks.hs +106/−0
- src/XMonad/Layout/BorderResize.hs +224/−0
- src/XMonad/Layout/ButtonDecoration.hs +55/−0
- src/XMonad/Layout/Decoration.hs +457/−0
- src/XMonad/Layout/DecorationAddons.hs +123/−0
- src/XMonad/Layout/DraggingVisualizer.hs +48/−0
- src/XMonad/Layout/ImageButtonDecoration.hs +182/−0
- src/XMonad/Layout/Minimize.hs +140/−0
- src/XMonad/Layout/MouseResizableTile.hs +320/−0
- src/XMonad/Layout/PositionStoreFloat.hs +92/−0
- src/XMonad/Layout/WindowSwitcherDecoration.hs +139/−0
- src/XMonad/Util/Font.hs +203/−0
- src/XMonad/Util/Image.hs +94/−0
- src/XMonad/Util/PositionStore.hs +77/−0
- src/XMonad/Util/XUtils.hs +206/−0
Setup.lhs view
@@ -1,3 +1,18 @@ #!/usr/bin/env runhaskell+> import Distribution.PackageDescription > import Distribution.Simple-> main = defaultMain+> import Distribution.Simple.LocalBuildInfo+> import Distribution.Simple.Setup+> import System.FilePath+> import System.Directory+> import Control.Monad+> main = defaultMainWithHooks (simpleUserHooks { postInst = myPostInst } )+>+> -- postInst hook to move helper binaries to the libexec directory+> myPostInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()+> myPostInst _ _ pkgdesc lbi = do+> let dirs = absoluteInstallDirs pkgdesc lbi NoCopyDest+> let lexecdir = libexecdir dirs+> createDirectoryIfMissing True lexecdir+> forM_ ["bluetiledock", "bluetilemockwin", "bluetilegreet"] $ \binary ->+> renameFile (bindir dirs </> binary) (lexecdir </> binary)
bluetile.cabal view
@@ -1,14 +1,14 @@ Name: bluetile-Version: 0.4+Version: 0.4.1+homepage: http://www.bluetile.org/ synopsis: A modern tiling window manager with a gentle learning curve description:- Bluetile is a tiling window manager for X based on xmonad. Windows are arranged- automatically to tile the screen without gaps or overlap, maximising- screen use. Bluetile's focus lies on making the tiling paradigm easily- accessible to users coming from traditional window managers by drawing- on known conventions and providing both mouse and keyboard access for all features.- It also tries to be usable 'out of the box', requiring minimal to- no configuration in most cases.+ Bluetile is a tiling window manager for X based on xmonad. Windows are+ arranged to use the entire screen without overlapping. Bluetile's focus lies+ on making the tiling paradigm easily accessible to users coming from+ traditional window managers by drawing on known conventions and providing+ both mouse and keyboard access for all features. It also tries to be usable+ 'out of the box', requiring minimal to no configuration in most cases. category: System License: BSD3 License-file: LICENSE@@ -16,42 +16,77 @@ Maintainer: jan.vornberger@informatik.uni-oldenburg.de extra-source-files: src/Config.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/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+ bluetilegreet/Utils.hs,+ man/bluetile.1 data-files: bluetiledock/bluetiledock.glade, bluetiledock/floating.svg, bluetiledock/tiled1.svg, bluetiledock/tiled2.svg, bluetiledock/fullscreen.svg,- bluetilegreet/bluetilegreet.glade-Build-Type: Simple+ bluetilegreet/bluetilegreet.glade,+ logo/bluetile-icon-48x48.png,+ logo/bluetile-icon.svg+Build-Type: Custom Cabal-Version: >=1.2 Executable bluetile Main-is: Main.hs Hs-Source-Dirs: src- Build-Depends: base>=3, base<4, containers, process,- xmonad-bluetilebranch>=0.9, xmonad-contrib-bluetilebranch>=0.9- Ghc-Options: -Wall+ Build-Depends: base>=3, base<5, containers, process, filepath,+ random, utf8-string,+ xmonad>=0.9.1, xmonad-contrib>=0.9.1+ if true+ Ghc-Options: -Wall+ if impl(ghc >= 6.12.1)+ Ghc-Options: -fno-warn-unused-do-bind Executable bluetiledock Buildable: True Hs-Source-Dirs: bluetiledock Main-is: BluetileDock.hs- Build-Depends: base>=3, base<4, unix, glade, gtk, X11>=1.4+ Build-Depends: base>=3, base<5, unix, glade, gtk, X11>=1.4 C-sources: bluetiledock/gdk_property_change_wrapper.c- Ghc-options: -Wall+ if true+ Ghc-Options: -Wall+ if impl(ghc >= 6.12.1)+ Ghc-Options: -fno-warn-unused-do-bind Executable bluetilemockwin Buildable: True Hs-Source-Dirs: bluetilemockwin Main-is: BluetileMockWin.hs- Build-Depends: base>=3, base<4, gtk- Ghc-options: -Wall+ Build-Depends: base>=3, base<5, gtk+ if true+ Ghc-Options: -Wall+ if impl(ghc >= 6.12.1)+ Ghc-Options: -fno-warn-unused-do-bind Executable bluetilegreet Buildable: True Hs-Source-Dirs: bluetilegreet Main-is: BluetileGreet.hs- Build-Depends: base>=3, base<4, directory, filepath, glade, gtk- Ghc-options: -Wall+ Build-Depends: base>=3, base<5, directory, filepath, glade, gtk+ if true+ Ghc-Options: -Wall+ if impl(ghc >= 6.12.1)+ Ghc-Options: -fno-warn-unused-do-bind
bluetiledock/BluetileDock.hs view
@@ -22,7 +22,6 @@ import System.Environment import System.IO import System.FilePath(pathSeparator)-import Data.Char import Paths_bluetile import Utils import Data.IORef@@ -185,8 +184,8 @@ activateToggleButtons xml layoutDesc "layout" writeIORef lockSendCommand False when (sid /= myScreenId && isNothing hndlM) $ do- binDir <- getBinDir- hndl <- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetiledock --otherscreen"+ libexecDir <- getLibexecDir+ hndl <- spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetiledock --otherscreen" writeIORef otherDockProcess (Just hndl) hPutStrLn hndl $ show update when (sid /= myScreenId && isJust hndlM) $ do
bluetilegreet/BluetileGreet.hs view
@@ -40,9 +40,9 @@ openWindowsBtn <- xmlGetWidget xml castToButton "openwindowsbutton" onClicked openWindowsBtn $ do- binDir <- getBinDir- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilemockwin 0 0 65535"- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilemockwin 65535 0 0"+ libexecDir <- getLibexecDir+ spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetilemockwin 0 0 65535"+ spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetilemockwin 65535 0 0" return () startBtn <- xmlGetWidget xml castToButton "startbutton"
+ logo/bluetile-icon-48x48.png view
binary file changed (absent → 295 bytes)
+ logo/bluetile-icon.svg view
@@ -0,0 +1,138 @@+<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!-- Created with Inkscape (http://www.inkscape.org/) -->+<svg+ xmlns:dc="http://purl.org/dc/elements/1.1/"+ xmlns:cc="http://creativecommons.org/ns#"+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"+ xmlns:svg="http://www.w3.org/2000/svg"+ xmlns="http://www.w3.org/2000/svg"+ xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"+ width="744.09448819"+ height="1052.3622047"+ id="svg5208"+ sodipodi:version="0.32"+ inkscape:version="0.46"+ sodipodi:docname="bluetile_logo_v2.svg"+ inkscape:output_extension="org.inkscape.output.svg.inkscape">+ <defs+ id="defs5210">+ <inkscape:perspective+ sodipodi:type="inkscape:persp3d"+ inkscape:vp_x="0 : 526.18109 : 1"+ inkscape:vp_y="0 : 1000 : 0"+ inkscape:vp_z="744.09448 : 526.18109 : 1"+ inkscape:persp3d-origin="372.04724 : 350.78739 : 1"+ id="perspective5216" />+ </defs>+ <sodipodi:namedview+ id="base"+ pagecolor="#ffffff"+ bordercolor="#ffffff"+ borderopacity="0.0"+ inkscape:pageopacity="0.0"+ inkscape:pageshadow="0"+ inkscape:zoom="0.24748737"+ inkscape:cx="167.01076"+ inkscape:cy="1235.0688"+ inkscape:document-units="px"+ inkscape:current-layer="layer1"+ showgrid="false"+ inkscape:window-width="878"+ inkscape:window-height="719"+ inkscape:window-x="50"+ inkscape:window-y="25" />+ <metadata+ id="metadata5213">+ <rdf:RDF>+ <cc:Work+ rdf:about="">+ <dc:format>image/svg+xml</dc:format>+ <dc:type+ rdf:resource="http://purl.org/dc/dcmitype/StillImage" />+ </cc:Work>+ </rdf:RDF>+ </metadata>+ <g+ inkscape:label="Layer 1"+ inkscape:groupmode="layer"+ id="layer1">+ <g+ id="g5793"+ inkscape:export-filename="/tmp/bluetile-icon-48x48.png"+ inkscape:export-xdpi="10.799996"+ inkscape:export-ydpi="10.799996">+ <rect+ y="-448.65707"+ x="-26.733566"+ height="384.89572"+ width="384.89569"+ id="rect4673"+ style="fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:15.10428523999999939;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-256.20932"+ x="-365.71429"+ height="100"+ width="100"+ id="rect4651"+ style="fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-256.20932"+ x="-165.71431"+ height="100"+ width="100"+ id="rect4653"+ style="fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-156.2093"+ x="-65.71431"+ height="100"+ width="100"+ id="rect4655"+ style="fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-356.20932"+ x="-65.71431"+ height="100"+ width="100"+ id="rect4659"+ style="fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-456.20932"+ x="-165.71431"+ height="100"+ width="100"+ id="rect4661"+ style="fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-156.2093"+ x="-265.71429"+ height="100"+ width="100"+ id="rect4663"+ style="fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-456.20932"+ x="-365.71429"+ height="100"+ width="100"+ id="rect4665"+ style="fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ <rect+ transform="scale(-1,1)"+ y="-356.20932"+ x="-265.71429"+ height="100"+ width="100"+ id="rect4667"+ style="fill:#0000ff;fill-opacity:1;stroke:none;stroke-width:3.52976799;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />+ </g>+ </g>+</svg>
+ man/bluetile.1 view
@@ -0,0 +1,224 @@+.\" Automatically generated by Pod::Man 2.22 (Pod::Simple 3.07)+.\"+.\" Standard preamble:+.\" ========================================================================+.de Sp \" Vertical space (when we can't use .PP)+.if t .sp .5v+.if n .sp+..+.de Vb \" Begin verbatim text+.ft CW+.nf+.ne \\$1+..+.de Ve \" End verbatim text+.ft R+.fi+..+.\" Set up some character translations and predefined strings. \*(-- will+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left+.\" double quote, and \*(R" will give a right double quote. \*(C+ will+.\" give a nicer C++. Capital omega is used to do unbreakable dashes and+.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,+.\" nothing in troff, for use with C<>.+.tr \(*W-+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'+.ie n \{\+. ds -- \(*W-+. ds PI pi+. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch+. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch+. ds L" ""+. ds R" ""+. ds C` ""+. ds C' ""+'br\}+.el\{\+. ds -- \|\(em\|+. ds PI \(*p+. ds L" ``+. ds R" ''+'br\}+.\"+.\" Escape single quotes in literal strings from groff's Unicode transform.+.ie \n(.g .ds Aq \(aq+.el .ds Aq '+.\"+.\" If the F register is turned on, we'll generate index entries on stderr for+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index+.\" entries marked with X<> in POD. Of course, you'll have to process the+.\" output yourself in some meaningful fashion.+.ie \nF \{\+. de IX+. tm Index:\\$1\t\\n%\t"\\$2"+..+. nr % 0+. rr F+.\}+.el \{\+. de IX+..+.\}+.\"+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).+.\" Fear. Run. Save yourself. No user-serviceable parts.+. \" fudge factors for nroff and troff+.if n \{\+. ds #H 0+. ds #V .8m+. ds #F .3m+. ds #[ \f1+. ds #] \fP+.\}+.if t \{\+. ds #H ((1u-(\\\\n(.fu%2u))*.13m)+. ds #V .6m+. ds #F 0+. ds #[ \&+. ds #] \&+.\}+. \" simple accents for nroff and troff+.if n \{\+. ds ' \&+. ds ` \&+. ds ^ \&+. ds , \&+. ds ~ ~+. ds /+.\}+.if t \{\+. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"+. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'+. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'+. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'+. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'+. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'+.\}+. \" troff and (daisy-wheel) nroff accents+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]+.ds ae a\h'-(\w'a'u*4/10)'e+.ds Ae A\h'-(\w'A'u*4/10)'E+. \" corrections for vroff+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'+. \" for low resolution devices (crt and lpr)+.if \n(.H>23 .if \n(.V>19 \+\{\+. ds : e+. ds 8 ss+. ds o a+. ds d- d\h'-1'\(ga+. ds D- D\h'-1'\(hy+. ds th \o'bp'+. ds Th \o'LP'+. ds ae ae+. ds Ae AE+.\}+.rm #[ #] #H #V #F C+.\" ========================================================================+.\"+.IX Title "BLUETILE 1"+.TH BLUETILE 1 "2010-06-06" "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+.nh+.SH "NAME"+bluetile \- a modern tiling window manager with a gentle learning curve+.SH "SYNOPSIS"+.IX Header "SYNOPSIS"+bluetile [\-\-help] [\-\-version] [\-\-restart]+.SH "DESCRIPTION"+.IX Header "DESCRIPTION"+\&\fBBluetile\fR is a tiling window manager for X based on xmonad. Windows are+arranged to use the entire screen without overlapping. \fBBluetile\fR's focus+lies on making the tiling paradigm easily accessible to users coming+from traditional window managers by drawing on known conventions and+providing both mouse and keyboard access for all features. It also tries+to be usable 'out of the box', requiring minimal to no configuration in+most cases.+.IP "\(bu" 4+Hybrid approach: Stacking window layout & tiling layouts available+.IP "\(bu" 4+Maximizing & minimizing windows in all layouts+.IP "\(bu" 4+All features accessible from mouse, as well as keyboard+.IP "\(bu" 4+Good multihead support+.IP "\(bu" 4+Proper handling of fullscreen applications+.IP "\(bu" 4+Designed to integrate with the \s-1GNOME\s0 desktop environment+.SH "OPTIONS"+.IX Header "OPTIONS"+\&\fB\-\-help\fR print help message+.PP+\&\fB\-\-version\fR print the version number+.PP+\&\fB\-\-restart\fR request a running \fBBluetile\fR process to restart+.SH "KEYBOARD SHORTCUTS"+.IX Header "KEYBOARD SHORTCUTS"+This is a list of most keyboard shortcuts for \fBBluetile\fR:+.PP+.Vb 2+\& Win+Return Launch terminal+\& Win+p Launch GNOME "Run application" dialog+\&+\& Win+a Switch to stacking window layout+\& Win+s Switch to tiled horizontal layout+\& Win+d Switch to tiled vertical layout+\& Win+f Switch to fullscreen layout+\&+\& Win+j Move focus to the next window+\& Win+k Move focus to the previous window+\& Win+Space Move focus to the master window+\& Win+Shift+j Swap the focused window with the next window+\& Win+Shift+k Swap the focused window with the previous window+\& Win+Shift+Space Swap the focused window with the master window+\&+\& Win+h Shrink the master area+\& Win+l Expand the master area+\& Win+u Shrink a slave area+\& Win+i Expand a slave area+\& Win+, Increment the number of windows in the master area+\& Win+. Decrement the number of windows in the master area+\&+\& Win+Shift+c Close the focused window+\& Win+z Maximize/zoom focused window+\& Win+m Minimize focused window+\& Win+Shift+m Restore next minimized window+\& Win+o Show window menu for focused window+\& Win+t Push dialog window back into tiling+\&+\& Win+1 .. Win+9, Win+0+\& Switch to workspace N+\&+\& Win+Shift+1 .. Win+Shift+9, Win+Shift+0+\& Move client to workspace N+\&+\& Win+w, Win+e, Win+r+\& Switch to physical/Xinerama screens 1, 2 or 3+\&+\& Win+Shift+w, Win+Shift+e, Win+Shift+r+\& Move client to physical/Xinerama screen 1, 2 or 3+\&+\& Win+F5 Refresh layout+\& Win+Shift+q Quit Bluetile+.Ve+.SH "CAVEATS"+.IX Header "CAVEATS"+The full list of keyboard shortcuts is currently only documented in the+source code. Also, there is currently no way to change the keyboard+shortcuts expect by modifying the source code. A user-friendly+configuration system that is more in line with \fBBluetile\fR's goals is+planned. You can also have a look at the wiki on+\&\fBhttp://www.bluetile.org\fR for a possible workaround.+.SH "AUTHOR"+.IX Header "AUTHOR"+Jan Vornberger <jan.vornberger@informatik.uni\-oldenburg.de>
src/Config.hs view
@@ -19,7 +19,6 @@ import XMonad hiding ( (|||) ) -import XMonad.Layout hiding ( (|||) ) import XMonad.Layout.BorderResize import XMonad.Layout.BoringWindows import XMonad.Layout.ButtonDecoration@@ -158,7 +157,7 @@ bluetileManageHook :: ManageHook bluetileManageHook = composeAll- [ workspaceByPos, positionStoreManageHook+ [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons) , className =? "MPlayer" --> doFloat , isFullscreen --> doFullFloat , manageDocks]@@ -171,7 +170,7 @@ ) where floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat- tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored+ tiled1 = tilingDeco $ maximize $ mouseResizableTile { isMirrored = True } tiled2 = tilingDeco $ maximize $ mouseResizableTile fullscreen = tilingDeco $ maximize $ smartBorders Full
src/Main.hs view
@@ -21,7 +21,6 @@ import BluetileDock import Config -import System.IO import System.Environment import System.Cmd import System.Exit@@ -55,9 +54,9 @@ putStrLn "" -- start docks and greeting screen- binDir <- getBinDir- dockHandle <- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetiledock"- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetilegreet"+ libexecDir <- getLibexecDir+ dockHandle <- spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetiledock"+ spawnPipe $ libexecDir ++ [pathSeparator] ++ "bluetilegreet" -- check terminal uninstallSignalHandlers -- make sure we can receive SIGCHLD to check terminal@@ -75,7 +74,7 @@ "Options:" : " --help Print this message" : " --version Print the version number" :- " --restart Request a running xmonad process to restart" :+ " --restart Request a running Bluetile process to restart" : [] sendRestart :: IO ()
+ src/XMonad/Actions/BluetileCommands.hs view
@@ -0,0 +1,83 @@+----------------------------------------------------------------------------+-- |+-- 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 view
@@ -0,0 +1,79 @@+----------------------------------------------------------------------------+-- |+-- 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" , sendMessage $ MinimizeWin 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 view
@@ -0,0 +1,60 @@+{-# 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++-- $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+ let s = S.current ws+ wsp = S.workspace s+ viewrect = screenRect $ S.screenDetail s+ tmpStack = S.stack . S.workspace $ s+ (rs, _) <- runLayout wsp { S.stack = tmpStack } viewrect+ let wins = map fst rs+ 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 view
@@ -0,0 +1,254 @@+-----------------------------------------------------------------------------+-- |+-- 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/PositionStoreHooks.hs view
@@ -0,0 +1,106 @@+----------------------------------------------------------------------------+-- |+-- 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 view
@@ -0,0 +1,224 @@+{-# 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 view
@@ -0,0 +1,55 @@+{-# 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 view
@@ -0,0 +1,457 @@+{-# 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 view
@@ -0,0 +1,123 @@+----------------------------------------------------------------------------+-- |+-- 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 >> sendMessage (MinimizeWin 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 view
@@ -0,0 +1,48 @@+{-# 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 view
@@ -0,0 +1,182 @@+{-# 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 >> sendMessage (MinimizeWin 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 view
@@ -0,0 +1,140 @@+{-# 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,+ MinimizeMsg(..)+ ) 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 (\f -> sendMessage (MinimizeWin f)))+-- > , ((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.RestoreMinimized" if you want to be able to restore+-- minimized 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+++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+ BW.focusDown+ setMinimized w+ ws <- gets windowset+ case M.lookup w (W.floating ws) of+ Nothing -> return $ Just $ Minimize (w:minimized) unfloated+ Just r -> do+ (windows . W.sink) w+ 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+ (windows . (W.float w)) r+ return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated)+ | Just RestoreNextMinimizedWin <- fromMessage m =+ if not (null minimized)+ then case M.lookup (head minimized) unfloated of+ Nothing -> do+ let w = head minimized+ setNotMinimized w+ focus w+ return $ Just $ Minimize (tail minimized) unfloated+ Just r -> do+ let w = head minimized+ setNotMinimized w+ (windows . (W.float w)) r+ focus w+ 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 view
@@ -0,0 +1,320 @@+{-# 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 view
@@ -0,0 +1,92 @@+{-# 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 view
@@ -0,0 +1,139 @@+{-# 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 view
@@ -0,0 +1,203 @@+{-# 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++#ifdef XFT+import Data.List+import Graphics.X11.Xft+import Graphics.X11.Xrender+#endif++import Codec.Binary.UTF8.String (encodeString, decodeString)+++-- Hide the Core Font/Xft switching here+data XMonadFont = Core FontStruct+ | Utf8 FontSet+#ifdef XFT+ | Xft XftFont+#endif++-- $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 =+#ifdef XFT+ if xftPrefix `isPrefixOf` s then+ do dpy <- asks display+ xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)+ return (Xft xftdraw)+ else+#endif+ fmap Utf8 $ initUtf8Font s+#ifdef XFT+ where xftPrefix = "xft:"+#endif++releaseXMF :: XMonadFont -> X ()+#ifdef XFT+releaseXMF (Xft xftfont) = do+ dpy <- asks display+ io $ xftFontClose dpy xftfont+#endif+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+#ifdef XFT+textWidthXMF dpy (Xft xftdraw) s = liftIO $ do+ gi <- xftTextExtents dpy xftdraw s+ return $ xglyphinfo_xOff gi+#endif++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)+#ifdef XFT+textExtentsXMF (Xft xftfont) _ = io $ do+ ascent <- fi `fmap` xftfont_ascent xftfont+ descent <- fi `fmap` xftfont_descent xftfont+ return (ascent, descent)+#endif++-- | 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+#ifdef XFT+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+#endif++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 view
@@ -0,0 +1,94 @@+----------------------------------------------------------------------------+-- |+-- 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 view
@@ -0,0 +1,77 @@+{-# 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 view
@@ -0,0 +1,206 @@+-----------------------------------------------------------------------------+-- |+-- 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+