aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Actions/MouseResize.hs
blob: a0efb0d0c71a05c4635646f43fc25cd13637e5a7 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.MouseResize
-- Copyright   :  (c) 2007 Andrea Rossato
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout modifier to resize windows with the mouse by grabbing the
-- window's lower right corner.
--
-- This module must be used together with "XMonad.Layout.WindowArranger".
-----------------------------------------------------------------------------

module XMonad.Actions.MouseResize
    ( -- * Usage:
      -- $usage
      mouseResize
    , MouseResize (..)
    ) where

import Control.Monad
import Data.Maybe

import XMonad
import XMonad.Layout.Decoration
import XMonad.Layout.LayoutModifier

import XMonad.Layout.WindowArranger
import XMonad.Util.XUtils

-- $usage
-- Usually this module is used to create layouts, but you can also use
-- it to resize windows in any layout, together with the
-- "XMonad.Layout.WindowArranger". For usage example see
-- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".
--
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.MouseResize
-- > import XMonad.Layout.WindowArranger
--
-- Then edit your @layoutHook@ by modifying a given layout:
--
-- > myLayouts = mouseResize $ windowArrange $ layoutHook defaultConfig
--
-- and then:
--
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

mouseResize :: l a -> ModifiedLayout MouseResize l a
mouseResize = ModifiedLayout (MR [])

data MouseResize a = MR [((a,Rectangle),Maybe a)]
instance Show (MouseResize a) where show        _ = ""
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]

instance LayoutModifier MouseResize Window where
    redoLayout (MR st) _ s wrs
        | [] <- st  = initState    >>= \nst -> return (wrs, Just $ MR nst)
        | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)
        where
          wrs'         = wrs_to_state [] . filter (isInStack s . fst) $ wrs
          initState    = mapM createInputWindow wrs'
          processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'

          inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10

          wrs_to_state rs ((w,r):xs)
              | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs
              | otherwise         = ((w,r),Nothing) : wrs_to_state (r:   rs) xs
              where ir = inputRectangle r
          wrs_to_state _ [] = []

    handleMess (MR s) m
        | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing
        | Just Hide             <- fromMessage m = releaseResources >> return (Just $ MR [])
        | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR [])
        where releaseResources = mapM_ (deleteInputWin . snd) s
    handleMess _ _ = return Nothing

handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X ()
handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
    | et == buttonPress
    , Just (w,Rectangle wx wy _ _) <- getWin ew st = do
                                        focus w
                                        mouseDrag (\x y -> do
                                                     let rect = Rectangle wx wy
                                                                (max 1 . fi $ x - wx)
                                                                (max 1 . fi $ y - wy)
                                                     sendMessage (SetGeometry rect)) (return ())

      where
        getWin w (((win,r),tw):xs)
            | Just w' <- tw
            , w == w'   = Just (win,r)
            | otherwise = getWin w xs
        getWin _ []     = Nothing
handleResize _ _ = return ()

createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
createInputWindow ((w,r),mr) = do
  case mr of
    Just tr  -> withDisplay $ \d -> do
                  tw <- mkInputWindow d tr
                  io $ selectInput d tw (exposureMask .|. buttonPressMask)
                  showWindow tw
                  return ((w,r), Just tw)
    Nothing ->    return ((w,r), Nothing)

deleteInputWin :: Maybe Window -> X ()
deleteInputWin = maybe (return ()) deleteWindow

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