Hierarchify

darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz

1 files changed, 137 insertions, 0 deletions

diff --git a/XMonad/Layout/DragPane.hs b/XMonad/Layout/DragPane.hs
new file mode 100644
index 0000000..8428d2b
--- /dev/null
+++ b/XMonad/Layout/DragPane.hs
@@ -0,0 +1,137 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.DragPane
+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+--                    David Roundy <droundy@darcs.net>,
+--                    Andrea Rossato <andrea.rossato@unibz.it>
+-- License     :  BSD3-style (see LICENSE)
+-- 
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+--                Andrea Rossato <andrea.rossato@unibz.it>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Layouts that splits the screen either horizontally or vertically and
+-- shows two windows.  The first window is always the master window, and
+-- the other is either the currently focused window or the second window in
+-- layout order.
+
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.DragPane (
+                               -- * Usage
+                               -- $usage
+                                dragPane
+                              , DragPane, DragType (..)
+                              ) where
+
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import XMonad
+import Data.Bits
+import Data.Unique
+
+import XMonad.Layouts
+import XMonad.Operations
+import qualified XMonad.StackSet as W 
+import XMonad.Util.Invisible
+import XMonad.Util.XUtils
+
+-- $usage
+--
+-- You can use this module with the following in your Config.hs file:
+--
+-- > import XMonad.Layout.DragPane
+--
+--  and add, to the list of layouts:
+--
+-- > Layout $ dragPane Horizontal 0.1 0.5
+
+halfHandleWidth :: Integral a => a
+halfHandleWidth = 1
+
+handleColor :: String
+handleColor = "#000000"
+
+dragPane :: DragType -> Double -> Double -> DragPane a
+dragPane t x y = DragPane (I Nothing) t x y
+
+data DragPane a = 
+    DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double 
+             deriving ( Show, Read )
+
+data DragType = Horizontal | Vertical deriving ( Show, Read )
+
+instance LayoutClass DragPane a where
+    doLayout d@(DragPane _ Vertical   _ _) = doLay id d
+    doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d
+    handleMessage = handleMess
+
+data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )
+instance Message SetFrac
+
+handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))
+handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
+    | Just e <- fromMessage x :: Maybe Event = do handleEvent d e
+                                                  return Nothing
+    | Just Hide             <- fromMessage x = do hideWindow win
+                                                  return $ Just (DragPane mb ty delta split)
+    | Just ReleaseResources <- fromMessage x = do deleteWindow win
+                                                  return $ Just (DragPane (I Nothing) ty delta split)
+    -- layout specific messages
+    | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
+    | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
+    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
+                                     return $ Just (DragPane mb ty delta frac)
+handleMess _ _ = return Nothing
+
+handleEvent :: DragPane a -> Event -> X ()
+handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) 
+            (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
+    | t == buttonPress && thisw == win || thisbw == win  = do
+  mouseDrag (\ex ey -> do
+             let frac = case ty of
+                        Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)
+                        Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
+             sendMessage (SetFrac ident frac))
+            (return ())
+handleEvent _ _  = return ()
+
+doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
+doLay mirror (DragPane mw ty delta split) r s = do
+  let r' = mirror r
+      (left', right') = splitHorizontallyBy split r'
+      left = case left' of Rectangle x y w h ->
+                               mirror $ Rectangle x y (w-halfHandleWidth) h
+      right = case right' of
+                Rectangle x y w h ->
+		    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
+      handr = case left' of
+                Rectangle x y w h ->
+                    mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
+      wrs = case reverse (W.up s) of
+              (master:_) -> [(master,left),(W.focus s,right)]
+              [] -> case W.down s of
+                      (next:_) -> [(W.focus s,left),(next,right)]
+                      [] -> [(W.focus s, r)]
+  if length wrs > 1 
+     then case mw of
+            I (Just (w,_,ident)) -> do 
+                    w' <- deleteWindow w >> newDragWin handr
+                    return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)
+            I Nothing -> do 
+                    w <- newDragWin handr
+                    i <- io $ newUnique
+                    return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)
+     else return (wrs, Nothing)
+
+
+newDragWin :: Rectangle -> X Window
+newDragWin r = do
+  let mask = Just $ exposureMask .|. buttonPressMask
+  w <- createNewWindow r mask handleColor
+  showWindow  w
+  return      w