xtest 0.1 → 0.2

raw patch · 3 files changed

+106/−23 lines, 3 files

Files

• Graphics/X11/XTest.hs +81/−2
• test.hs +20/−0
• xtest.cabal +5/−21

@@ -1,11 +1,16 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Graphics.X11.XTest-  (fakeMotion,+  (queryXTestSupport,+   fakeMotion,    fakeButtonPress,-   movePointer)+   movePointer,+   withGrabbedControl,+   sendKey)   where +import Control.Monad import Graphics.X11.Xlib+import Foreign import Foreign.C.Types  -- FFI imports@@ -16,6 +21,80 @@  foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeMotionEvent"     xFakeMotionEvent :: Display -> CInt -> CInt -> CInt -> Time -> IO Status++foreign import ccall unsafe "X11/extensions/XTest.h XTestGrabControl"+    xGrabControl :: Display -> Bool -> IO Status++foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeKeyEvent"+    xFakeKeyEvent :: Display -> KeyCode -> Bool -> CULong -> IO Status++foreign import ccall unsafe "X11/extensions/XTest.h XTestQueryExtension"+    xQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO Bool++-- | Ask the X server if XTest extension is supported.+-- Returns Nothing, if extension is not supported.+-- Otherwise, it returns:+--+--  * Event number for the first event for this extension (undefined for current version of XTest).+--+--  * Error number for the first error for this extension (undefined for current version of XTest).+--+--  * Major and+--+--  * minor versions of the extension.+--+queryXTestSupport :: Display -> IO (Maybe (Int, Int, Int, Int))+queryXTestSupport dpy = do+  alloca $ \pevent ->+    alloca $ \perror ->+      alloca $ \pmajor ->+        alloca $ \pminor -> do+          b <- xQueryExtension dpy pevent perror pmajor pminor+          if b+            then do+                 event <- peek pevent+                 error <- peek perror+                 major <- peek pmajor+                 minor <- peek pminor+                 return $ Just (fromIntegral event, fromIntegral error,+                                fromIntegral major, fromIntegral minor)+            else return Nothing++-- | Perform some IO actions while control grabbed by XTest+withGrabbedControl :: Display -> IO a -> IO a+withGrabbedControl dpy action = do+    st <- xGrabControl dpy True+    if st /= 0 -- Grabbed successfully+      then do+           result <- action+           xGrabControl dpy False+           return result+      else fail $ "XTest cannot grab control"++-- | Send fake key press+sendKey :: Display+        -> [KeySym] -- ^ Modifier keys (say, xK_Control_L). Set to [] if modifier is not needed.+        -> KeySym   -- ^ Key to press (say, xK_n).+        -> IO ()+sendKey dpy mods keysym = do+  keycode <- keysymToKeycode dpy keysym+  when (keycode /= 0) $ withGrabbedControl dpy $ do+      -- Press mods+      forM_ mods $ \modsym -> do+          code <- keysymToKeycode dpy modsym+          xFakeKeyEvent dpy code True 0++      -- Press and release key+      xFakeKeyEvent dpy keycode True  0+      xFakeKeyEvent dpy keycode False 0++      -- Release mods+      forM_ (reverse mods) $ \modsym -> do+          code <- keysymToKeycode dpy modsym+          xFakeKeyEvent dpy code False 0++      sync dpy False+      return ()  -- | Create fake pointer motion event. fakeMotion :: Display      -- 

@@ -0,0 +1,20 @@++import Control.Concurrent+import Graphics.X11+import Graphics.X11.XTest++withDisplay :: String -> (Display -> IO a) -> IO ()+withDisplay str action = do+  dpy <- openDisplay str+  action dpy+  closeDisplay dpy++main = do+  withDisplay ":0" $ \dpy -> do+      Just (a,b,c,d) <- queryXTestSupport dpy+      print (a,b,c,d)+      sendKey dpy [] xK_m+      threadDelay 1000000+      sendKey dpy [xK_Shift_L] xK_n++

@@ -1,32 +1,19 @@--- xtest.cabal auto-generated by cabal init. For additional options,--- see--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.--- The name of the package. Name:                xtest --- The package version. See the Haskell package versioning policy--- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for--- standards guiding when and how versions should be incremented.-Version:             0.1+Version:             0.2 --- A short (one-line) description of the package. Synopsis:            Thin FFI bindings to X11 XTest library --- A longer description of the package.-Description:         This package provides bindings to some functions from X11 XTest-                     extension client library (-lXtst).+Description:         This package provides thin bindings for X11 XTest library.+                     For more info, see XTest documentation. --- The license under which the package is released. License:             BSD3 --- The file containing the license text. License-file:        LICENSE  -- The package author(s). Author:              Ilya Portnov --- An email address to which users can send suggestions, bug reports,--- and patches. Maintainer:          portnov84@rambler.ru  -- A copyright notice.@@ -36,12 +23,9 @@  Build-type:          Simple --- Extra files to be distributed with the package, such as examples or--- a README.--- Extra-source-files:  +Extra-source-files:  test.hs --- Constraint on the version of Cabal needed to build this package.-Cabal-version:       >=1.2+Cabal-version:       >=1.6   Library