{-# 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.-------------------------------------------------------------------------------moduleXMonad.Layout.BorderResize(-- * Usage-- $usageborderResize,BorderResize(..),RectWithBorders,BorderInfo,)whereimportXMonadimportXMonad.Layout.DecorationimportXMonad.Layout.WindowArrangerimportXMonad.Util.XUtilsimportControl.Monad(when)importqualifiedData.MapasM-- $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 }--typeBorderBlueprint=(Rectangle,Glyph,BorderType)dataBorderType=RightSideBorder|LeftSideBorder|TopSideBorder|BottomSideBorderderiving(Show,Read,Eq)dataBorderInfo=BI{bWin::Window,bRect::Rectangle,bType::BorderType}deriving(Show,Read)typeRectWithBorders=(Rectangle,[BorderInfo])dataBorderResizea=BR(M.MapWindowRectWithBorders)deriving(Show,Read)brBorderSize::DimensionbrBorderSize=2borderResize::la->ModifiedLayoutBorderResizelaborderResize=ModifiedLayout(BRM.empty)instanceLayoutModifierBorderResizeWindowwhereredoLayout__Nothingwrs=return(wrs,Nothing)redoLayout(BRwrsLastTime)__wrs=doletcorrectOrder=mapfstwrswrsCurrent=M.fromListwrswrsGone=M.differencewrsLastTimewrsCurrentwrsAppeared=M.differencewrsCurrentwrsLastTimewrsStillThere=M.intersectionWithtestIfUnchangedwrsLastTimewrsCurrenthandleGonewrsGonewrsCreated<-handleAppearedwrsAppearedletwrsChanged=handleStillTherewrsStillTherewrsThisTime=M.unionwrsChangedwrsCreatedreturn(compileWrswrsThisTimecorrectOrder,Just$BRwrsThisTime)-- 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.wheretestIfUnchangedentry@(rLastTime,_)rCurrent=ifrLastTime==rCurrentthen(Nothing,entry)else(JustrCurrent,entry)handleMess(BRwrsLastTime)m|Juste<-fromMessagem::MaybeEvent=handleResize(createBorderLookupTablewrsLastTime)e>>returnNothing|Just_<-fromMessagem::MaybeLayoutMessages=handleGonewrsLastTime>>return(Just$BRM.empty)handleMess__=returnNothingcompileWrs::M.MapWindowRectWithBorders->[Window]->[(Window,Rectangle)]compileWrswrsThisTimecorrectOrder=letwrs=reorder(M.toListwrsThisTime)correctOrderinconcat$mapcompileWrwrscompileWr::(Window,RectWithBorders)->[(Window,Rectangle)]compileWr(w,(r,borderInfos))=letborderWrs=forborderInfos$\bi->(bWinbi,bRectbi)inborderWrs++[(w,r)]handleGone::M.MapWindowRectWithBorders->X()handleGonewrsGone=mapM_deleteWindowborderWinswhereborderWins=mapbWin.concat.mapsnd.M.elems$wrsGonehandleAppeared::M.MapWindowRectangle->X(M.MapWindowRectWithBorders)handleAppearedwrsAppeared=doletwrs=M.toListwrsAppearedwrsCreated<-mapMhandleSingleAppearedwrsreturn$M.fromListwrsCreatedhandleSingleAppeared::(Window,Rectangle)->X(Window,RectWithBorders)handleSingleAppeared(w,r)=doletborderBlueprints=prepareBordersrborderInfos<-mapMcreateBorderborderBlueprintsreturn(w,(r,borderInfos))handleStillThere::M.MapWindow(MaybeRectangle,RectWithBorders)->M.MapWindowRectWithBordershandleStillTherewrsStillThere=M.maphandleSingleStillTherewrsStillTherehandleSingleStillThere::(MaybeRectangle,RectWithBorders)->RectWithBordershandleSingleStillThere(Nothing,entry)=entryhandleSingleStillThere(JustrCurrent,(_,borderInfos))=(rCurrent,updatedBorderInfos)wherechangedBorderBlueprints=prepareBordersrCurrentupdatedBorderInfos=mapupdateBorderInfo.zipborderInfos$changedBorderBlueprints-- assuming that the four borders are always in the same orderupdateBorderInfo::(BorderInfo,BorderBlueprint)->BorderInfoupdateBorderInfo(borderInfo,(r,_,_))=borderInfo{bRect=r}createBorderLookupTable::M.MapWindowRectWithBorders->[(Window,(BorderType,Window,Rectangle))]createBorderLookupTablewrsLastTime=concat$mapprocessSingleEntry$M.toListwrsLastTimewhereprocessSingleEntry::(Window,RectWithBorders)->[(Window,(BorderType,Window,Rectangle))]processSingleEntry(w,(r,borderInfos))=forborderInfos$\bi->(bWinbi,(bTypebi,w,r))prepareBorders::Rectangle->[BorderBlueprint]prepareBorders(Rectanglexywhht)=[((Rectangle(x+fiwh-fibrBorderSize)ybrBorderSizeht),xC_right_side,RightSideBorder),((RectanglexybrBorderSizeht),xC_left_side,LeftSideBorder),((RectanglexywhbrBorderSize),xC_top_side,TopSideBorder),((Rectanglex(y+fiht-fibrBorderSize)whbrBorderSize),xC_bottom_side,BottomSideBorder)]handleResize::[(Window,(BorderType,Window,Rectangle))]->Event->X()handleResizebordersButtonEvent{ev_window=ew,ev_event_type=et}|et==buttonPress,Justedge<-lookupewborders=caseedgeof(RightSideBorder,hostWin,(Rectanglehxhy_hht))->mouseDrag(\x_->doletnwh=max1$fi(x-hx)rect=RectanglehxhynwhhhtfocushostWinwhen(x-hx>0)$sendMessage(SetGeometryrect))(focushostWin)(LeftSideBorder,hostWin,(Rectanglehxhyhwhhht))->mouseDrag(\x_->doletnx=max0$min(hx+fihwh)$xnwh=max1$hwh+fi(hx-x)rect=RectanglenxhynwhhhtfocushostWinwhen(x<hx+fihwh)$sendMessage(SetGeometryrect))(focushostWin)(TopSideBorder,hostWin,(Rectanglehxhyhwhhht))->mouseDrag(\_y->doletny=max0$min(hy+fihht)$ynht=max1$hht+fi(hy-y)rect=RectanglehxnyhwhnhtfocushostWinwhen(y<hy+fihht)$sendMessage(SetGeometryrect))(focushostWin)(BottomSideBorder,hostWin,(Rectanglehxhyhwh_))->mouseDrag(\_y->doletnht=max1$fi(y-hy)rect=RectanglehxhyhwhnhtfocushostWinwhen(y-hy>0)$sendMessage(SetGeometryrect))(focushostWin)handleResize__=return()createBorder::BorderBlueprint->X(BorderInfo)createBorder(borderRect,borderCursor,borderType)=doborderWin<-createInputWindowborderCursorborderRectreturnBI{bWin=borderWin,bRect=borderRect,bType=borderType}createInputWindow::Glyph->Rectangle->XWindowcreateInputWindowcursorGlyphr=withDisplay$\d->dowin<-mkInputWindowdrio$selectInputdwin(exposureMask.|.buttonPressMask)cursor<-io$createFontCursordcursorGlyphio$defineCursordwincursorio$freeCursordcursorshowWindowwinreturnwinmkInputWindow::Display->Rectangle->XWindowmkInputWindowd(Rectanglexywh)=dorw<-askstheRootletscreen=defaultScreenOfDisplaydvisual=defaultVisualOfScreenscreenattrmask=cWOverrideRedirectio$allocaSetWindowAttributes$\attributes->doset_override_redirectattributesTruecreateWindowdrwxywh00inputOnlyvisualattrmaskattributesfor::[a]->(a->b)->[b]for=flipmapreorder::(Eqa)=>[(a,b)]->[a]->[(a,b)]reorderwrsorder=letordered=concat$map(pickElemwrs)orderrest=filter(\(w,_)->not(w`elem`order))wrsinordered++restwherepickElemliste=case(lookupelist)ofJustresult->[(e,result)]Nothing->[]