aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDon Stewart <dons@cse.unsw.edu.au>2007-03-07 03:48:38 +0100
committerDon Stewart <dons@cse.unsw.edu.au>2007-03-07 03:48:38 +0100
commitb9ae5cbeea8818d447d2a490615db98cd13a86cc (patch)
tree97a93ed5c44c44c9cc50f5412923abfd65a9aa43
parentfd4435303a52e7d1506b9f3c5783a2b2c4d0bf5a (diff)
downloadxmonad-b9ae5cbeea8818d447d2a490615db98cd13a86cc.tar.gz
xmonad-b9ae5cbeea8818d447d2a490615db98cd13a86cc.tar.xz
xmonad-b9ae5cbeea8818d447d2a490615db98cd13a86cc.zip
depend on the X11-extras package
darcs-hash:20070307024838-9c5c1-a1e8969b5a390b2852dda76881e8f571857b37f7.gz
-rw-r--r--XlibExtras.hsc253
-rw-r--r--include/XlibExtras.h33
-rw-r--r--thunk.cabal7
-rw-r--r--thunk.hs2
4 files changed, 2 insertions, 293 deletions
diff --git a/XlibExtras.hsc b/XlibExtras.hsc
deleted file mode 100644
index 103a149..0000000
--- a/XlibExtras.hsc
+++ /dev/null
@@ -1,253 +0,0 @@
-module XlibExtras where
-
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Types
-import Foreign
-import Foreign.C.Types
-import Control.Monad (ap)
-
-#include "XlibExtras.h"
-
-data Event
- = AnyEvent
- { event_type :: EventType
- , serial :: CULong
- , send_event :: Bool
- , event_display :: Display
- , window :: Window
- }
- | ConfigureRequestEvent
- { event_type :: EventType
- , serial :: CULong
- , send_event :: Bool
- , event_display :: Display
- , parent :: Window
- , window :: Window
- , x :: Int
- , y :: Int
- , width :: Int
- , height :: Int
- , border_width :: Int
- , above :: Window
- , detail :: Int
- , value_mask :: CULong
- }
- | MapRequestEvent
- { event_type :: EventType
- , serial :: CULong
- , send_event :: Bool
- , event_display :: Display
- , parent :: Window
- , window :: Window
- }
- | KeyEvent
- { event_type :: EventType
- , serial :: CULong
- , send_event :: Bool
- , event_display :: Display
- , window :: Window
- , root :: Window
- , subwindow :: Window
- , time :: Time
- , x :: Int
- , y :: Int
- , x_root :: Int
- , y_root :: Int
- , state :: KeyMask
- , keycode :: KeyCode
- , same_screen :: Bool
- }
- | DestroyWindowEvent
- { event_type :: EventType
- , serial :: CULong
- , send_event :: Bool
- , event_display :: Display
- , event :: Window
- , window :: Window
- }
- | UnmapEvent
- { event_type :: EventType
- , serial :: CULong
- , send_event :: Bool
- , event_display :: Display
- , event :: Window
- , window :: Window
- , fromConfigure :: Bool
- }
- deriving Show
-
-getEvent :: XEventPtr -> IO Event
-getEvent p = do
- -- All events share this layout and naming convention, there is also a
- -- common Window field, but the names for this field vary.
- type_ <- #{peek XAnyEvent, type} p
- serial_ <- #{peek XAnyEvent, serial} p
- send_event_ <- #{peek XAnyEvent, send_event} p
- display_ <- fmap Display (#{peek XAnyEvent, display} p)
- case () of
-
- -------------------------
- -- ConfigureRequestEvent:
- -------------------------
- _ | type_ == configureRequest -> do
- parent_ <- #{peek XConfigureRequestEvent, parent } p
- window_ <- #{peek XConfigureRequestEvent, window } p
- x_ <- #{peek XConfigureRequestEvent, x } p
- y_ <- #{peek XConfigureRequestEvent, y } p
- width_ <- #{peek XConfigureRequestEvent, width } p
- height_ <- #{peek XConfigureRequestEvent, height } p
- border_width_ <- #{peek XConfigureRequestEvent, border_width} p
- above_ <- #{peek XConfigureRequestEvent, above } p
- detail_ <- #{peek XConfigureRequestEvent, detail } p
- value_mask_ <- #{peek XConfigureRequestEvent, value_mask } p
- return $ ConfigureRequestEvent
- { event_type = type_
- , serial = serial_
- , send_event = send_event_
- , event_display = display_
- , parent = parent_
- , window = window_
- , x = x_
- , y = y_
- , width = width_
- , height = height_
- , border_width = border_width_
- , above = above_
- , detail = detail_
- , value_mask = value_mask_
- }
-
- -------------------
- -- MapRequestEvent:
- -------------------
- | type_ == mapRequest -> do
- parent_ <- #{peek XMapRequestEvent, parent} p
- window_ <- #{peek XMapRequestEvent, window} p
- return $ MapRequestEvent
- { event_type = type_
- , serial = serial_
- , send_event = send_event_
- , event_display = display_
- , parent = parent_
- , window = window_
- }
-
- ------------
- -- KeyEvent:
- ------------
- | type_ == keyPress || type_ == keyRelease -> do
- window_ <- #{peek XKeyEvent, window } p
- root_ <- #{peek XKeyEvent, root } p
- subwindow_ <- #{peek XKeyEvent, subwindow } p
- time_ <- #{peek XKeyEvent, time } p
- x_ <- #{peek XKeyEvent, x } p
- y_ <- #{peek XKeyEvent, y } p
- x_root_ <- #{peek XKeyEvent, x_root } p
- y_root_ <- #{peek XKeyEvent, y_root } p
- state_ <- #{peek XKeyEvent, state } p
- keycode_ <- #{peek XKeyEvent, keycode } p
- same_screen_ <- #{peek XKeyEvent, same_screen} p
- return $ KeyEvent
- { event_type = type_
- , serial = serial_
- , send_event = send_event_
- , event_display = display_
- , window = window_
- , root = root_
- , subwindow = subwindow_
- , time = time_
- , x = x_
- , y = y_
- , x_root = x_root_
- , y_root = y_root_
- , state = state_
- , keycode = keycode_
- , same_screen = same_screen_
- }
-
- ----------------------
- -- DestroyWindowEvent:
- ----------------------
- | type_ == destroyNotify -> do
- event_ <- #{peek XDestroyWindowEvent, event } p
- window_ <- #{peek XDestroyWindowEvent, window} p
- return $ DestroyWindowEvent
- { event_type = type_
- , serial = serial_
- , send_event = send_event_
- , event_display = display_
- , event = event_
- , window = window_
- }
-
-
- --------------------
- -- UnmapNotifyEvent:
- --------------------
- | type_ == unmapNotify -> do
- event_ <- #{peek XUnmapEvent, event } p
- window_ <- #{peek XUnmapEvent, window } p
- fromConfigure_ <- #{peek XUnmapEvent, from_configure} p
- return $ UnmapEvent
- { event_type = type_
- , serial = serial_
- , send_event = send_event_
- , event_display = display_
- , event = event_
- , window = window_
- , fromConfigure = fromConfigure_
- }
-
- -- We don't handle this event specifically, so return the generic
- -- AnyEvent.
- | otherwise -> do
- window_ <- #{peek XAnyEvent, window} p
- return $ AnyEvent
- { event_type = type_
- , serial = serial_
- , send_event = send_event_
- , event_display = display_
- , window = window_
- }
-
-data WindowChanges = WindowChanges
- { wcX :: Int
- , wcY :: Int
- , wcWidth :: Int
- , wcHeight:: Int
- , wcBorderWidth :: Int
- , wcSibling :: Window
- , wcStackMode :: Int
- }
-
-instance Storable WindowChanges where
- sizeOf _ = #{size XWindowChanges}
-
- -- I really hope this is right:
- alignment _ = alignment (undefined :: Int)
-
- poke p wc = do
- #{poke XWindowChanges, x } p $ wcX wc
- #{poke XWindowChanges, y } p $ wcY wc
- #{poke XWindowChanges, width } p $ wcWidth wc
- #{poke XWindowChanges, height } p $ wcHeight wc
- #{poke XWindowChanges, border_width} p $ wcBorderWidth wc
- #{poke XWindowChanges, sibling } p $ wcSibling wc
- #{poke XWindowChanges, stack_mode } p $ wcStackMode wc
-
- peek p = return WindowChanges
- `ap` (#{peek XWindowChanges, x} p)
- `ap` (#{peek XWindowChanges, y} p)
- `ap` (#{peek XWindowChanges, width} p)
- `ap` (#{peek XWindowChanges, height} p)
- `ap` (#{peek XWindowChanges, border_width} p)
- `ap` (#{peek XWindowChanges, sibling} p)
- `ap` (#{peek XWindowChanges, stack_mode} p)
-
-foreign import ccall unsafe "XlibExtras.h XConfigureWindow"
- xConfigureWindow :: Display -> Window -> CULong -> Ptr WindowChanges -> IO Int
-
-configureWindow :: Display -> Window -> CULong -> WindowChanges -> IO ()
-configureWindow d w m c = do
- with c (xConfigureWindow d w m)
- return ()
diff --git a/include/XlibExtras.h b/include/XlibExtras.h
deleted file mode 100644
index 52fbeaa..0000000
--- a/include/XlibExtras.h
+++ /dev/null
@@ -1,33 +0,0 @@
-/* This file copied from the X11 package */
-
-/* -----------------------------------------------------------------------------
- * Definitions for package `X11' which are visible in Haskell land.
- * ---------------------------------------------------------------------------*
- */
-
-#ifndef XLIBEXTRAS_H
-#define XLIBEXTRAS_H
-#include <stdlib.h>
-/* This doesn't always work, so we play safe below... */
-#define XUTIL_DEFINE_FUNCTIONS
-#include <X11/X.h>
-#include <X11/X.h>
-#include <X11/Xlib.h>
-#include <X11/Xatom.h>
-#include <X11/Xutil.h>
-/* Xutil.h overrides some functions with macros.
- * In recent versions of X this can be turned off with
- * #define XUTIL_DEFINE_FUNCTIONS
- * before the #include, but this doesn't work with older versions.
- * As a workaround, we undef the macros here. Note that this is only
- * safe for functions with return type int.
- */
-#undef XDestroyImage
-#undef XGetPixel
-#undef XPutPixel
-#undef XSubImage
-#undef XAddPixel
-#define XK_MISCELLANY
-#define XK_LATIN1
-#include <X11/keysymdef.h>
-#endif
diff --git a/thunk.cabal b/thunk.cabal
index 8d9b3b3..cee19bf 100644
--- a/thunk.cabal
+++ b/thunk.cabal
@@ -7,13 +7,8 @@ license: BSD3
license-file: LICENSE
author: Spencer Janssen
maintainer: sjanssen@cse.unl.edu
-build-depends: base >= 2.0, X11, unix, mtl
+build-depends: base >= 2.0, X11, X11-extras, unix, mtl
executable: thunk
main-is: thunk.hs
-extensions: ForeignFunctionInterface
-other-modules: XlibExtras
ghc-options: -O
-include-dirs: include
--- OpenBSD:
--- include-dirs: include /usr/X11R6/include
diff --git a/thunk.hs b/thunk.hs
index 3a8f92b..bae8b76 100644
--- a/thunk.hs
+++ b/thunk.hs
@@ -8,11 +8,11 @@ import Data.Bits
import Control.Monad.State
import System.IO
import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
import System.Process (runCommand)
import System.Exit
import Wm
-import XlibExtras
handler :: Event -> Wm ()
handler (MapRequestEvent {window = w}) = manage w