aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Actions/MouseResize.hs
blob: fd04fb065a28e9343a39899b8307505ebf596266 (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
133
134
{-# 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 XMonad
import XMonad.Layout.Decoration

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:
--
-- > myLayout = mouseResize $ windowArrange $ layoutHook def
--
-- and then:
--
-- > main = xmonad def { layoutHook = myLayout }
--
-- 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 _       _ Nothing  wrs = return (wrs, Nothing)
    redoLayout (MR st) _ (Just 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)

                  cursor <- io $ createFontCursor d xC_bottom_right_corner
                  io $ defineCursor d tw cursor
                  io $ freeCursor d cursor

                  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