mirror of
https://github.com/xmonad/xmonad.git
synced 2025-05-19 00:20:22 -07:00
depend on the X11-extras package
This commit is contained in:
Don Stewart
parent
07ee2a19cd
commit
d3eb6a4971
253
XlibExtras.hsc
253
XlibExtras.hsc
@ -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 ()
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
2
thunk.hs
2
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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user