Menu
▾
▴
[Gtk2hs-commit] (main branch): Input method bindings
|
From: Axel S. <si...@co...> - 2009-05-09 18:46:50
|
Mon May 4 15:13:02 EDT 2009 m....@gm...
* Input method bindings
Ignore-this: e8cbd55f0519ab413b24cae7b99d7b3d
hunk ./Makefile.am 626
+ gtk/Graphics/UI/Gtk/Abstract/IMContext.chs \
hunk ./Makefile.am 702
+ gtk/Graphics/UI/Gtk/Misc/IMMulticontext.chs.pp \
adddir ./demo/inputmethod
addfile ./demo/inputmethod/Layout.hs
hunk ./demo/inputmethod/Layout.hs 1
+-- Example of using a PangoLayout
+
+import Data.IORef
+
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Gdk.EventM
+import Graphics.Rendering.Cairo
+
+loremIpsum = "Lorem ipsum dolor sit amet, consectetur adipisicing elit,\
+ \ sed do eiusmod tempor incididunt ut labore et dolore magna\
+ \ aliqua. Ut enim ad minim veniam, quis nostrud exercitation\
+ \ ullamco laboris nisi ut aliquip ex ea commodo consequat.\
+ \ Duis aute irure dolor in reprehenderit in voluptate\
+ \ velit esse cillum dolore eu fugiat nulla pariatur.\
+ \ Excepteur sint occaecat cupidatat non proident, sunt in culpa\
+ \ qui officia deserunt mollit anim id est laborum."
+
+data Buffer = Buffer String Int
+
+defaultBuffer = Buffer loremIpsum (length loremIpsum)
+
+displayBuffer (Buffer str pos) =
+ before ++ "<CURSOR>" ++ after
+ where (before,after) = splitAt pos str
+
+displayBufferPreedit (Buffer str pos) preeditStr preeditPos =
+ before ++ "[" ++ prebefore ++ "<CURSOR>" ++ preafter ++ "]" ++ after
+ where (before,after) = splitAt pos str
+ (prebefore, preafter) = splitAt preeditPos preeditStr
+
+insertStr new (Buffer str pos) = Buffer (before++new++after) (pos+length new)
+ where (before,after) = splitAt pos str
+
+deleteChar b@(Buffer str 0) = b
+deleteChar (Buffer str pos) = Buffer (init before ++ after) (pos-1)
+ where (before,after) = splitAt pos str
+
+moveLeft b@(Buffer str pos) | pos==0 = b
+ | otherwise = Buffer str (pos-1)
+
+moveRight b@(Buffer str pos) | pos==length str = b
+ | otherwise = Buffer str (pos+1)
+
+main = do
+ initGUI
+ [_$_]
+ -- Create the main window.
+ win <- windowNew
+ on win objectDestroy mainQuit
+ -- Create a drawing area in which we can render text.
+ area <- drawingAreaNew
+ containerAdd win area
+ on area sizeRequest $ return (Requisition 100 100)
+ [_$_]
+ -- Our widget's data
+ buffer <- newIORef defaultBuffer
+
+ preeditRef <- newIORef Nothing
+ [_$_]
+ -- Create a Cairo Context that contains information about the current font,
+ -- etc.
+ ctxt <- cairoCreateContext Nothing
+ lay <- layoutEmpty ctxt
+ layoutSetWrap lay WrapWholeWords
+ [_$_]
+ let relayout = do
+ buffer@(Buffer _ cursor) <- readIORef buffer
+ preedit <- readIORef preeditRef
+ case preedit of
+ Nothing -> do
+ layoutSetText lay (displayBuffer buffer)
+ layoutSetAttributes lay []
+ Just (str,attrs,pos) -> do
+ layoutSetText lay (displayBufferPreedit buffer str pos)
+ layoutSetAttributes lay (map (shiftAttribute (cursor + 1))
+ (concat attrs))
+ widgetQueueDraw area
+ [_$_]
+ relayout
+ [_$_]
+ -- Wrap the layout to a different width each time the window is resized.
+ on area sizeAllocate $ \(Rectangle _ _ w _) ->
+ layoutSetWidth lay (Just (fromIntegral w))
+ [_$_]
+ -- Setup the handler to draw the layout.
+ on area exposeEvent $ updateArea area lay
+ [_$_]
+ -- Set up input method
+ im <- imMulticontextNew
+ [_$_]
+ on im imContextPreeditStart $ do
+ writeIORef preeditRef (Just ("",[],0))
+ relayout
+ on im imContextPreeditEnd $ do
+ writeIORef preeditRef Nothing
+ relayout
+ on im imContextPreeditChanged $ do
+ writeIORef preeditRef . Just =<< imContextGetPreeditString im
+ relayout
+ on im imContextCommit $ \str -> do
+ modifyIORef buffer (insertStr str)
+ relayout
+ on im imContextRetrieveSurrounding $ do
+ Buffer text pos <- readIORef buffer
+ imContextSetSurrounding im text pos
+ return True
+ on im imContextDeleteSurrounding' $ \off nchars -> do
+ putStrLn $ "delete-surrounding("++show off++","++show nchars++")"
+ return False
+ [_$_]
+ on win realize $ do
+ imContextSetClientWindow im . Just =<< widgetGetDrawWindow win
+ on win focusInEvent $ liftIO (imContextFocusIn im) >> return False
+ on win focusOutEvent $ liftIO (imContextFocusOut im) >> return False
+ on win keyReleaseEvent $ imContextFilterKeypress im
+ on win keyPressEvent $ do
+ imHandled <- imContextFilterKeypress im
+ if imHandled then return True else do
+ mod <- interpretKeyPress
+ case mod of
+ Just f -> liftIO $ modifyIORef buffer f >> relayout >> return True
+ Nothing -> return False
+ [_$_]
+ widgetShowAll win
+ mainGUI
+
+updateArea :: DrawingArea -> PangoLayout -> EventM EExpose Bool
+updateArea area lay = do
+ win <- eventWindow
+ liftIO $ do
+ renderWithDrawable win $ do
+ moveTo 0 0
+ showLayout lay
+
+ return True
+
+interpretKeyPress :: EventM EKey (Maybe (Buffer -> Buffer))
+interpretKeyPress = do
+ modifiers <- eventModifier
+ if modifiers /= [] then return Nothing else do
+ keyName <- eventKeyName
+ keyChar <- fmap keyToChar eventKeyVal
+ case keyChar of
+ Just ch -> do
+ -- This does not appear to get called; the IM handles
+ -- unmodified keypresses.
+ liftIO $ putStrLn "Literal character not handled by IM"
+ returnJust (insertStr [ch])
+ Nothing -> do
+ case keyName of
+ "Left" -> returnJust moveLeft
+ "Right" -> returnJust moveRight
+ "BackSpace" -> returnJust deleteChar
+ _ -> return Nothing
+ where returnJust = return . Just
+
+shiftAttribute :: Int -> PangoAttribute -> PangoAttribute
+shiftAttribute x attr = attr { paStart = x + paStart attr,
+ paEnd = x + paEnd attr }
addfile ./demo/inputmethod/Makefile
hunk ./demo/inputmethod/Makefile 1
+
+PROG = layout [_$_]
+SOURCES = Layout.hs
+
+$(PROG) : $(SOURCES)
+ $(HC) --make $< -o $@ $(HCFLAGS)
+
+clean:
+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG)
+
+HC=ghc
hunk ./gtk/Graphics/UI/Gtk.hs.pp 192
--- module IMContext,
--- module IMMulticontext,
+ module Graphics.UI.Gtk.Misc.IMMulticontext,
hunk ./gtk/Graphics/UI/Gtk.hs.pp 202
+ module Graphics.UI.Gtk.Abstract.IMContext,
hunk ./gtk/Graphics/UI/Gtk.hs.pp 385
---import IMContext
---import IMContextSimple
---import IMMulitcontext
+import Graphics.UI.Gtk.Misc.IMMulticontext
hunk ./gtk/Graphics/UI/Gtk.hs.pp 396
+import Graphics.UI.Gtk.Abstract.IMContext
addfile ./gtk/Graphics/UI/Gtk/Abstract/IMContext.chs.pp
hunk ./gtk/Graphics/UI/Gtk/Abstract/IMContext.chs.pp 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) Widget IMContext
+--
+-- Author : Colin McQuillan
+--
+-- Created: 30 April 2009
+--
+-- Copyright (C) 2009 Colin McQuillan
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- |
+-- Maintainer : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- Base class for input method contexts
+--
+module Graphics.UI.Gtk.Abstract.IMContext (
+
+-- * Class Hierarchy
+--
+-- |
+-- @
+-- | 'GObject'
+-- | +----IMContext
+-- | +----'IMContextSimple'
+-- | +----'IMMulticontext'
+-- @
+
+-- * Types
+ IMContext,
+ IMContextClass,
+ castToIMContext,
+ toIMContext,
+
+-- * Methods
+ imContextSetClientWindow,
+ imContextGetPreeditString,
+ imContextFilterKeypress,
+ imContextFocusIn,
+ imContextFocusOut,
+ imContextReset,
+ imContextSetCursorLocation,
+ imContextSetUsePreedit,
+ imContextSetSurrounding,
+ imContextGetSurrounding,
+ imContextDeleteSurrounding,
+
+-- * Signals
+ imContextPreeditStart,
+ imContextPreeditEnd,
+ imContextPreeditChanged,
+ imContextCommit,
+ imContextRetrieveSurrounding,
+ imContextDeleteSurrounding',
+ ) where
+
+import Control.Monad (liftM)
+import Control.Monad.Reader.Class (ask)
+import Control.Monad.Trans (liftIO)
+import Data.Maybe (fromMaybe)
+
+import System.Glib.FFI
+import System.Glib.UTFString (readUTFString, withUTFString, genUTFOfs,
+ ofsToUTF, ofsFromUTF)
+{#import Graphics.UI.Gtk.Types#}
+{#import Graphics.UI.Gtk.Signals#}
+import Graphics.UI.Gtk.Gdk.EventM (EventM, EKey)
+import Graphics.UI.Gtk.General.Structs (Rectangle)
+import Graphics.UI.Gtk.Pango.Types (PangoAttribute)
+import Graphics.UI.Gtk.Pango.Attributes (readAttrList)
+
+{# context lib="gtk" prefix="gtk" #}
+
+--------------------
+-- Methods
+
+-- | Set the client window for the input context; this is the 'DrawWindow' in
+-- which the input appears. This window is used in order to correctly position
+-- status windows, and may also be used for purposes internal to the input
+-- method.
+--
+imContextSetClientWindow :: IMContextClass self => self
+ -> Maybe DrawWindow -- ^ @window@ - the client window. 'Nothing' indicates
+ -- that the previous client window no longer exists.
+ -> IO ()
+imContextSetClientWindow self window =
+ {# call im_context_set_client_window #}
+ (toIMContext self)
+ (fromMaybe (mkDrawWindow nullForeignPtr) window)
+
+-- | Retrieve the current preedit string for the input context, and a list of
+-- attributes to apply to the string. This string should be displayed inserted
+-- at the insertion point.
+--
+imContextGetPreeditString :: IMContextClass self => self
+ -> IO (String, [[PangoAttribute]], Int)
+ -- ^ @(str, attrs, cursorPos)@ Retrieved string,
+ -- attributes to apply to the string, position of cursor.
+imContextGetPreeditString self =
+ alloca $ \strPtr ->
+ alloca $ \attrListPtr ->
+ alloca $ \cursorPosPtr ->
+ {# call im_context_get_preedit_string #}
+ (toIMContext self)
+ strPtr
+ attrListPtr
+ cursorPosPtr
+ >>
+ peek strPtr >>= readUTFString >>= \str ->
+ peek attrListPtr >>= readAttrList (genUTFOfs str) >>= \attrs ->
+ peek cursorPosPtr >>= \cursorPos ->
+ return (str, attrs, fromIntegral cursorPos)
+
+-- | Allow an input method to internally handle key press and release events.
+-- If this function returns @True@, then no further processing should be done
+-- for this key event.
+--
+imContextFilterKeypress :: IMContextClass self => self
+ -> EventM EKey Bool -- ^ returns @True@ if the input method handled the key
+ -- event.
+imContextFilterKeypress self =
+ liftM toBool $
+ ask >>= \eventPtr ->
+ liftIO $
+ {# call im_context_filter_keypress #}
+ (toIMContext self)
+ (castPtr eventPtr)
+
+-- | Notify the input method that the widget to which this input context
+-- corresponds has gained focus. The input method may, for example, change the
+-- displayed feedback to reflect this change.
+--
+imContextFocusIn :: IMContextClass self => self -> IO ()
+imContextFocusIn self =
+ {# call im_context_focus_in #}
+ (toIMContext self)
+
+-- | Notify the input method that the widget to which this input context
+-- corresponds has lost focus. The input method may, for example, change the
+-- displayed feedback or reset the contexts state to reflect this change.
+--
+imContextFocusOut :: IMContextClass self => self -> IO ()
+imContextFocusOut self =
+ {# call im_context_focus_out #}
+ (toIMContext self)
+
+-- | Notify the input method that a change such as a change in cursor position
+-- has been made. This will typically cause the input method to clear the
+-- preedit state.
+--
+imContextReset :: IMContextClass self => self -> IO ()
+imContextReset self =
+ {# call im_context_reset #}
+ (toIMContext self)
+
+-- | Notify the input method that a change in cursor position has been made.
+-- The location is relative to the client window.
+--
+imContextSetCursorLocation :: IMContextClass self => self
+ -> Rectangle -- ^ @area@ - new location
+ -> IO ()
+imContextSetCursorLocation self area =
+ with area $ \areaPtr ->
+ {# call im_context_set_cursor_location #}
+ (toIMContext self)
+ (castPtr areaPtr)
+
+-- | Sets whether the IM context should use the preedit string to display
+-- feedback. If @usePreedit@ is @False@ (default is @True@), then the IM
+-- context may use some other method to display feedback, such as displaying it
+-- in a child of the root window.
+--
+imContextSetUsePreedit :: IMContextClass self => self
+ -> Bool -- ^ @usePreedit@ - whether the IM context should use the preedit
+ -- string.
+ -> IO ()
+imContextSetUsePreedit self usePreedit =
+ {# call im_context_set_use_preedit #}
+ (toIMContext self)
+ (fromBool usePreedit)
+
+-- | Sets surrounding context around the insertion point and preedit string.
+-- This function is expected to be called in response to the
+-- 'IMContext'::retrieve_surrounding signal, and will likely have no effect if
+-- called at other times.
+--
+imContextSetSurrounding :: IMContextClass self => self
+ -> String -- ^ @text@ - text surrounding the insertion point, as UTF-8. the
+ -- preedit string should not be included within @text@.
+ -> Int -- ^ @cursorIndex@ - the index of the insertion cursor within
+ -- @text@.
+ -> IO ()
+imContextSetSurrounding self text cursorIndex =
+ withUTFString text $ \textPtr ->
+ {# call im_context_set_surrounding #}
+ (toIMContext self)
+ textPtr
+ (-1)
+ (fromIntegral (ofsToUTF cursorIndex (genUTFOfs text)))
+
+-- | Retrieves context around the insertion point. Input methods typically
+-- want context in order to constrain input text based on existing text; this
+-- is important for languages such as Thai where only some sequences of
+-- characters are allowed.
+--
+-- This function is implemented by emitting the
+-- 'imContextRetrieveSurrounding' signal on the input method; in response to
+-- this signal, a widget should provide as much context as is available, up to
+-- an entire paragraph, by calling 'imContextSetSurrounding'. Note that there
+-- is no obligation for a widget to respond to the 'imContextRetrieveSurrounding'
+-- signal, so input methods must be prepared to function without context.
+--
+imContextGetSurrounding :: IMContextClass self => self
+ -> IO (Maybe (String, Int)) -- ^ @Maybe (text,cursorIndex)@ Text holding
+ -- context around the insertion point and the
+ -- index of the insertion cursor within @text@.
+ -- 'Nothing' if no surrounding text was
+ -- provided.
+imContextGetSurrounding self =
+ alloca $ \textPtr ->
+ alloca $ \cursorIndexPtr ->
+ {# call im_context_get_surrounding #}
+ (toIMContext self)
+ textPtr
+ cursorIndexPtr >>= \provided ->
+ if toBool provided then
+ peek textPtr >>= readUTFString >>= \text ->
+ peek cursorIndexPtr >>= \cursorIndex ->
+ return (Just (text, ofsFromUTF (fromIntegral cursorIndex)
+ (genUTFOfs text)))
+ else
+ return Nothing
+
+-- | Asks the widget that the input context is attached to to delete
+-- characters around the cursor position by emitting the
+-- 'imContextDeleteSurrounding' signal.
+--
+-- In order to use this function, you should first call
+-- 'imContextGetSurrounding' to get the current context, and call this function
+-- immediately afterwards to make sure that you know what you are deleting. You
+-- should also account for the fact that even if the signal was handled, the
+-- input context might not have deleted all the characters that were requested
+-- to be deleted.
+--
+-- This function is used by an input method that wants to make substitutions
+-- in the existing text in response to new input. It is not useful for
+-- applications.
+--
+imContextDeleteSurrounding :: IMContextClass self => self
+ -> Int -- ^ @offset@ - offset from cursor position in chars; a negative
+ -- value means start before the cursor.
+ -> Int -- ^ @nChars@ - number of characters to delete.
+ -> IO Bool -- ^ returns @True@ if the signal was handled.
+imContextDeleteSurrounding self offset nChars =
+ liftM toBool $
+ {# call im_context_delete_surrounding #}
+ (toIMContext self)
+ (fromIntegral offset)
+ (fromIntegral nChars)
+
+--------------------
+-- Signals
+
+-- | This signal is emitted when a new preediting sequence starts.
+--
+imContextPreeditStart :: IMContextClass self => Signal self (IO ())
+imContextPreeditStart = Signal (connect_NONE__NONE "preedit_start")
+
+-- | This signal is emitted when a preediting sequence has been completed or
+-- canceled.
+--
+imContextPreeditEnd :: IMContextClass self => Signal self (IO ())
+imContextPreeditEnd = Signal (connect_NONE__NONE "preedit_end")
+
+-- | This signal is emitted whenever the preedit sequence currently being
+-- entered has changed. It is also emitted at the end of a preedit sequence,
+-- in which case 'imContextGetPreeditString' returns the empty string.
+--
+imContextPreeditChanged :: IMContextClass self => Signal self (IO ())
+imContextPreeditChanged = Signal (connect_NONE__NONE "preedit_changed")
+
+-- | This signal is emitted when a complete input sequence has been
+-- entered by the user. This can be a single character immediately after a
+-- key press or the final result of preediting. Parameters:
+--
+-- @str@ - the completed character(s) entered by the user
+imContextCommit :: IMContextClass self => Signal self (String -> IO ())
+imContextCommit = Signal (connect_STRING__NONE "commit")
+
+-- | This signal is emitted when the input method requires the context
+-- surrounding the cursor. The callback should set the input method
+-- surrounding context by calling 'imContextSetSurrounding'.
+--
+-- Returns True if the signal was handled.
+imContextRetrieveSurrounding :: IMContextClass self => Signal self (IO Bool)
+imContextRetrieveSurrounding = Signal (connect_NONE__BOOL "retrieve_surrounding")
+
+-- | This signal is emitted when the input method needs to delete all or part
+-- of the context surrounding the cursor. Parameters:
+--
+-- @offset@ - the character offset from the cursor position of the text to be
+-- deleted. A negative value indicates a position before the cursor.
+--
+-- @n_chars@ - the number of characters to be deleted.
+--
+-- Returns True if the signal was handled.
+imContextDeleteSurrounding' :: IMContextClass self => Signal self (Int -> Int -> IO Bool)
+imContextDeleteSurrounding' = Signal (connect_INT_INT__BOOL "delete_surrounding")
addfile ./gtk/Graphics/UI/Gtk/Misc/IMMulticontext.chs.pp
hunk ./gtk/Graphics/UI/Gtk/Misc/IMMulticontext.chs.pp 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) Widget IMMulticontext
+--
+-- Author : Colin McQuillan
+--
+-- Created: 30 April 2009
+--
+-- Copyright (C) 2009 Colin McQuillan
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- |
+-- Maintainer : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- An input method context supporting multiple, loadable input methods
+--
+module Graphics.UI.Gtk.Misc.IMMulticontext (
+
+-- * Class Hierarchy
+--
+-- |
+-- @
+-- | 'GObject'
+-- | +----'IMContext'
+-- | +----IMMulticontext
+-- @
+
+-- * Types
+ IMMulticontext,
+ IMMulticontextClass,
+ castToIMMulticontext,
+ toIMMulticontext,
+
+-- * Constructors
+ imMulticontextNew,
+
+-- * Methods
+ imMulticontextAppendMenuitems,
+ ) where
+
+import Control.Monad (liftM)
+
+import System.Glib.FFI
+{#import Graphics.UI.Gtk.Types#}
+
+{# context lib="gtk" prefix="gtk" #}
+
+--------------------
+-- Constructors
+
+-- | Creates a new 'IMMulticontext'.
+--
+imMulticontextNew :: IO IMContext
+imMulticontextNew =
+ constructNewGObject mkIMContext $
+ {# call im_multicontext_new #}
+
+--------------------
+-- Methods
+
+-- | Add menuitems for various available input methods to a menu; the
+-- menuitems, when selected, will switch the input method for the context and
+-- the global default input method.
+--
+imMulticontextAppendMenuitems :: (IMMulticontextClass self, MenuShellClass menushell) => self
+ -> menushell -- ^ @menushell@ - a 'MenuShell'
+ -> IO ()
+imMulticontextAppendMenuitems self menushell =
+ {# call im_multicontext_append_menuitems #}
+ (toIMMulticontext self)
+ (toMenuShell menushell)
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 33
- fromAttrList
+ fromAttrList,
+ readAttrList
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 50
+foreign import ccall unsafe "pango_attr_list_unref"
+ pango_attr_list_unref :: PangoAttrList -> IO ()
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 65
- {#call unsafe attr_list_unref#} alPtr
+ pango_attr_list_unref alPtr
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 212
+
+readAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
+readAttrList correct attrListPtr = do
+ elems <- fromAttrList correct attrListPtr
+ pango_attr_list_unref attrListPtr
+ return elems
|