packages feed

x11-xim (empty) → 0.0.1

raw patch · 6 files changed

+363/−0 lines, 6 filesdep +X11dep +basedep +utf8-stringsetup-changed

Dependencies added: X11, base, utf8-string

Files

+ Graphics/X11/Xim.hsc view
@@ -0,0 +1,133 @@+#include <X11/Xlib.h>+#include <X11/keysym.h>++module Graphics.X11.Xim (++  XIM(..)+, XIC(..)+, XNInputStyle(..)+, XrmDatabase(..)++, openIM+, closeIM+, createIC+, destroyIC+, getICValue+, filterEvent+, utf8LookupString+, utf8DrawString++) where++import Graphics.X11.XimTypes+import Codec.Binary.UTF8.String ( decodeString, encodeString )++import Graphics.X11	( Window, XEventPtr, GC, KeySym )+import Graphics.X11.Xlib.Extras	( FontSet(..) )+import Graphics.X11.Xlib.Types	( Display(..) )+import Foreign		( Int32, nullPtr, Ptr, Word32, alloca, peek,+				allocaBytes, throwIfNull )+import Foreign.C.Types	( CInt, CChar )+import Foreign.C.String	( CString, peekCStringLen, withCString )++-- DATA TYPE++data XIM = XIM { ximPtr :: Ptr XIM }+data XIC = XIC { xicPtr :: Ptr XIC }++data XrmDatabase = XrmDatabase ( Ptr XrmDatabase )++-- FUNCTIONS++foreign import ccall "X11/Xlib.h XOpenIM"	c_XOpenIM	::+	Ptr Display -> Ptr XrmDatabase -> CString -> CString -> IO ( Ptr XIM )+openIM :: Display -> Maybe XrmDatabase -> Maybe String -> Maybe String+							-> IO XIM+openIM ( Display pdpy ) mxd rn rc =+	let pxd = case mxd of+			Nothing                -> nullPtr+			Just ( XrmDatabase p ) -> p+	 in fmap XIM $ withMaybeCString rn $ \crn ->+					withMaybeCString rc $ \crc -> do+		throwIfNull "openIM" $ c_XOpenIM pdpy pxd crn crc++foreign import ccall "X11/Xlib.h XCloseIM"	c_XCloseIM	::+	Ptr XIM -> IO ()+closeIM :: XIM -> IO ()+closeIM = c_XCloseIM . ximPtr++foreign import ccall "X11/Xlib.h XCreateIC"	c_XCreateIC2	::+	Ptr XIM -> CString -> #{ type long } -> CString+		-> Window -> Ptr () -> IO ( Ptr XIC )+createIC :: XIM -> [ XNInputStyle ] -> Window -> IO XIC+createIC ( XIM pim ) xniss win = do+	fmap XIC $ throwIfNull "createIC" $ withCString "inputStyle" $ \is ->+		withCString "clientWindow" $ \cw ->+			c_XCreateIC2 pim is ( getCXNInputStyle xniss )+				cw win nullPtr++foreign import ccall "X11/Xlib.h XDestroyIC"	c_XDestroyIC	::+	Ptr XIC -> IO ()+destroyIC :: XIC -> IO ()+destroyIC = c_XDestroyIC . xicPtr++foreign import ccall "X11/Xlib.h XGetICValues"	c_XGetICValues1	::+	Ptr XIC -> CString -> Ptr #{ type unsigned long }+                -> Ptr () -> IO CString+getICValue :: XIC -> String -> IO Word32+getICValue ( XIC pic ) fn = withCString fn $ \cfn ->+	alloca $ \p -> do+		r <- c_XGetICValues1 pic cfn p nullPtr+		if r == nullPtr+			then peek p+			else error "bad"++foreign import ccall "X11/Xlib.h XFilterEvent" c_XFilterEvent ::+	XEventPtr -> Window -> IO #{ type Bool }+filterEvent :: XEventPtr -> Window -> IO Bool+filterEvent e w = do+  ret <- c_XFilterEvent e w+  return $ ret == #{ const True }++foreign import ccall "X11/Xlib.h Xutf8LookupString"	c_Xutf8LookupString+	:: Ptr XIC -> XEventPtr -> Ptr CChar -> CInt -> Ptr #{ type KeySym }+		-> Ptr #{ type Status } -> IO CInt+utf8LookupString :: XIC -> XEventPtr -> IO ( Maybe String, Maybe KeySym )+utf8LookupString xic pev = utf8LookupStringGen xic pev 1+utf8LookupStringGen :: XIC -> XEventPtr -> Int -> IO ( Maybe String, Maybe KeySym )+utf8LookupStringGen ( XIC pic ) pev bs = allocaBytes bs $ \buf ->+	alloca $ \ks -> alloca $ \stat -> do+		cnt <- fmap fromIntegral $ c_Xutf8LookupString pic pev buf+						( fromIntegral bs ) ks stat+		cStat <- peek stat+		case fromCXLookupStatus cStat of+			XLookupBoth   -> do+				str <- peekCStringLen ( buf, cnt )+				cks <- peek ks+				return ( Just $ decodeString str, Just cks )+			XLookupChars   -> do+				str <- peekCStringLen ( buf, cnt )+				return ( Just $ decodeString str, Nothing )+			XLookupKeySym   -> do+				cks <- peek ks+				return ( Nothing, Just cks )+			XLookupNone     -> return ( Nothing, Nothing )+			XBufferOverflow -> utf8LookupStringGen+						( XIC pic ) pev ( 2 * bs )+++foreign import ccall "X11/Xlib.h Xutf8DrawString"		c_Xutf8DrawString	::+	Ptr Display -> Window -> Ptr FontSet -> GC -> CInt -> CInt+		-> CString -> CInt -> IO ()+utf8DrawString :: Display -> Window -> FontSet -> GC -> Int -> Int -> String ->+	IO ()+utf8DrawString ( Display pdpy ) win ( FontSet pfs ) gc x y str =+	let	utf8Str = encodeString str+	 in withCString utf8Str $ \cstr ->+		c_Xutf8DrawString pdpy win pfs gc ( fromIntegral x )+			( fromIntegral y ) cstr+			( fromIntegral $ length utf8Str )++withMaybeCString :: Maybe String -> ( CString -> IO a ) -> IO a+withMaybeCString Nothing      f = f nullPtr+withMaybeCString ( Just str ) f = withCString str f
+ Graphics/X11/XimTypes.hsc view
@@ -0,0 +1,61 @@++++#include <X11/Xlib.h>+#include <X11/keysym.h>++module Graphics.X11.XimTypes (++  XNInputStyle(..)+, getCXNInputStyle++, XLookupStatus(..)+, fromCXLookupStatus++) where++import Data.Bits	( (.|.)	)+import Foreign		( Int32	)++data XNInputStyle =+	XIMPreeditArea	|+	XIMPreeditCallbacks	|+	XIMPreeditPosition	|+	XIMPreeditNothing	|+	XIMPreeditNone	|+	XIMStatusArea	|+	XIMStatusCallbacks	|+	XIMStatusNothing	|+	XIMStatusNone++getCXNInputStyle1 :: XNInputStyle -> #type long++getCXNInputStyle1 XIMPreeditArea	= #const XIMPreeditArea+getCXNInputStyle1 XIMPreeditCallbacks	= #const XIMPreeditCallbacks+getCXNInputStyle1 XIMPreeditPosition	= #const XIMPreeditPosition+getCXNInputStyle1 XIMPreeditNothing	= #const XIMPreeditNothing+getCXNInputStyle1 XIMPreeditNone	= #const XIMPreeditNone+getCXNInputStyle1 XIMStatusArea	= #const XIMStatusArea+getCXNInputStyle1 XIMStatusCallbacks	= #const XIMStatusCallbacks+getCXNInputStyle1 XIMStatusNothing	= #const XIMStatusNothing+getCXNInputStyle1 XIMStatusNone	= #const XIMStatusNone+++getCXNInputStyle :: [ XNInputStyle ] -> #{ type long }+getCXNInputStyle = foldl1 (.|.) . map getCXNInputStyle1++data XLookupStatus =+	XBufferOverflow	|+	XLookupNone	|+	XLookupChars	|+	XLookupKeySym	|+	XLookupBoth+fromCXLookupStatus :: #{ type Status } -> XLookupStatus++fromCXLookupStatus ( #const XBufferOverflow	) = XBufferOverflow+fromCXLookupStatus ( #const XLookupNone	) = XLookupNone+fromCXLookupStatus ( #const XLookupChars	) = XLookupChars+fromCXLookupStatus ( #const XLookupKeySym	) = XLookupKeySym+fromCXLookupStatus ( #const XLookupBoth	) = XLookupBoth++fromCXLookupStatus _  = error "bad Status"
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2010, Yoshikuni Jujo+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++  * Redistributions of source code must retain the above copyright notice,+    this list of conditions and the following disclaimer.++  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in the+    documentation and/or other materials provided with the distribution.++  * Neither the name of the Yoshikuni Jujo nor the names of its+    contributors may be used to endorse or promote products derived from+    this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVEN SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ tests/useXim.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleContexts #-}++import Graphics.X11		(+	Display, openDisplay, closeDisplay, defaultScreen, rootWindow,+	whitePixel, blackPixel,+	Window, createSimpleWindow, destroyWindow, mapWindow,+	GC, createGC, freeGC, supportsLocale, setLocaleModifiers,+	selectInput, exposureMask, keyPressMask, focusChangeMask,+	Atom, internAtom, setWMProtocols, XEventPtr, nextEvent, allocaXEvent	)+import Graphics.X11.Xlib.Extras	(+	Event(ClientMessageEvent, KeyEvent), getEvent, ev_data,+	FontSet, createFontSet+									)+import Graphics.X11.Types	( xK_Return				)+import Graphics.X11.Xim		(+	XIM, openIM, closeIM, XIC, createIC, destroyIC, getICValue,+	filterEvent, XNInputStyle(..),+	utf8LookupString, utf8DrawString				)+import Data.IORef		( IORef, newIORef, readIORef, writeIORef,+					modifyIORef			)+import Data.Maybe		( fromMaybe				)+import Data.Bits		( (.|.)					)+import Data.Convertible		( Convertible, convert			)+import Control.Monad		( unless, when				)+import Control.Monad.Tools	( doUntil_ 				)+import System.Exit		( exitFailure				)+import System.Locale.SetLocale	( setLocale, Category(..)		)+import Foreign.C.Types		( CInt					)++setLocaleAndCheck :: IO ()+setLocaleAndCheck = do+	ret <- setLocale LC_CTYPE Nothing+	case ret of+		Nothing -> putStrLn "Can't set locale." >> exitFailure+		_	-> return ()++supportsLocaleAndCheck :: IO ()+supportsLocaleAndCheck = do+	sl <- supportsLocale+	unless sl $ putStrLn "Current locale is not supported" >> exitFailure++keyEventAction :: Display -> Window -> FontSet -> GC -> XIC -> IORef Int ->+			IORef Int -> XEventPtr -> IO Bool+keyEventAction dpy win fs gc ic posx posy e = do+	( mstr, mks ) <- utf8LookupString ic e+	x <- readIORef posx+	y <- readIORef posy+	if ( mks == Just xK_Return )+		then do+			putStrLn ""+			writeIORef posx 5+			modifyIORef posy (+ 13)+		else case ( mstr, mks ) of+			( Just str, _ ) -> do+				modifyIORef posx (+ length str * 13)+				putStr str+				utf8DrawString dpy win fs gc x y str+			_ -> return ()+	return False++runWithXIM ::+	( Display -> Window -> GC -> XIM -> XIC -> Atom -> FontSet -> XEventPtr+			-> IO () )+			-> IO ()+runWithXIM act = do+	setLocaleAndCheck+	supportsLocaleAndCheck+	_ <- setLocaleModifiers ""+	dpy	<-openDisplay ""+	let	scr	=  defaultScreen dpy+		black	=  blackPixel dpy scr+		white	=  whitePixel dpy scr+	rootWin		<- rootWindow dpy scr+	win		<- createSimpleWindow dpy rootWin 0 0 100 100 1+				black white+	gc		<- createGC dpy win+	im		<- openIM dpy Nothing Nothing Nothing+	ic		<- createIC im [ XIMPreeditNothing, XIMStatusNothing ] win+	fevent		<- getICValue ic "filterEvents"+	selectInput dpy win $ exposureMask .|. keyPressMask .|.+			focusChangeMask .|. fevent+	delWin		<- internAtom dpy "WM_DELETE_WINDOW" True+	setWMProtocols dpy win [ delWin ]+	mapWindow dpy win+	( _, _, fs )	<- createFontSet dpy+				"-*-fixed-medium-r-normal--14-*-*-*"+	allocaXEvent $ \e -> act dpy win gc im ic delWin fs e+	destroyIC ic+	closeIM im+	freeGC dpy gc+	destroyWindow dpy win+	closeDisplay dpy++nextNotFilteredEvent :: Display -> XEventPtr -> IO ()+nextNotFilteredEvent dpy e = do+	nextEvent dpy e+	filtOut <- filterEvent e 0+	if filtOut+		then nextNotFilteredEvent dpy e+		else return ()++main :: IO ()+main = runWithXIM $ \dpy win gc im ic delWin fs e -> do+	posx	<- newIORef 5+	posy	<- newIORef 20+	doUntil_ $ do+		nextNotFilteredEvent dpy e+		ev <- getEvent e+		case ev of+			KeyEvent {} -> keyEventAction dpy win fs gc ic posx posy e+			ClientMessageEvent {} ->+				return $ getClientMessageAtom ev == delWin+			_                     -> return False++getClientMessageAtom :: Convertible CInt a => Event -> a+getClientMessageAtom = convert . head . ev_data
+ x11-xim.cabal view
@@ -0,0 +1,23 @@+build-type:	Simple+cabal-version:	>= 1.2++name:		x11-xim+version:	0.0.1+author:		Yoshikuni Jujo+maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>+license:	BSD3+license-file:	LICENSE+copyright:	(c) 2010-2010 Yoshikuni Jujo+category:	Graphics+synopsis:	A binding to the xim of X11 graphics library+description:	A binding to the xim of X11 graphics library++extra-source-files:	tests/useXim.hs+	++library+  exposed-modules:	Graphics.X11.Xim+  other-modules:	Graphics.X11.XimTypes+  extensions:		ForeignFunctionInterface+  build-depends:	base > 4 && < 5, X11, utf8-string+  ghc-options:		-Wall