Menu
▾
▴
[Gtk2hs-commit] gtk2hs/gtk/entry Editable.chs.cpp,NONE,1.1 Entry.chs.cpp,NONE,1.1 EntryCompletion.chs.cpp,NONE,1.1 Editable.chspp,1.1,NONE Entry.chspp,1.1,NONE EntryCompletion.chspp,1.1,NONE
|
From: Axel S. <as...@us...> - 2004-10-27 13:21:52
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/entry In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24829/gtk/entry Added Files: Editable.chs.cpp Entry.chs.cpp EntryCompletion.chs.cpp Removed Files: Editable.chspp Entry.chspp EntryCompletion.chspp Log Message: Enhance makefile so that it builds the library. Changed .chspp to .chs.cpp in all pre-processed chs files. Build with ghc --make the first time and with ghc -c on incremental changes. --- NEW FILE: EntryCompletion.chs.cpp --- -- -*-haskell-*- -- GIMP Toolkit (GTK) entry Widget EntryCompletion -- -- Author : Duncan Coutts -- Created: 24 April 2004 -- -- Copyright (c) 2004 Duncan Coutts -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Library General Public -- License as published by the Free Software Foundation; either -- version 2 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 -- Library General Public License for more details. -- -- | -- -- Completion functionality for the Entry widget. -- -- * Added in GTK+ 2.4 -- module EntryCompletion ( #if GTK_CHECK_VERSION(2,4,0) EntryCompletion, EntryCompletionClass, entryCompletionNew, entryCompletionGetEntry, entryCompletionSetModel, entryCompletionGetModel, entryCompletionSetMatchFunc, entryCompletionSetMinimumKeyLength, entryCompletionGetMinimumKeyLength, entryCompletionComplete, entryCompletionInsertActionText, entryCompletionInsertActionMarkup, entryCompletionDeleteAction, entryCompletionSetTextColumn #endif ) where #if GTK_CHECK_VERSION(2,4,0) import Monad (liftM) import FFI import LocalData (newIORef, readIORef, writeIORef) import GObject (makeNewGObject) import Object (makeNewObject) {#import Hierarchy#} {#import Signal#} {#import TreeModel#} (TreeIter, createTreeIter) {# context lib="gtk" prefix="gtk" #} entryCompletionNew :: IO EntryCompletion entryCompletionNew = makeNewGObject mkEntryCompletion $ liftM castPtr $ {# call gtk_entry_completion_new #} entryCompletionGetEntry :: EntryCompletion -> IO (Maybe Entry) entryCompletionGetEntry ec = do entryPtr <- {# call gtk_entry_completion_get_entry #} ec if entryPtr == nullPtr then return Nothing else liftM Just $ makeNewObject mkEntry $ return (castPtr entryPtr) entryCompletionSetModel :: EntryCompletion -> TreeModel -> IO () entryCompletionSetModel ec tm = {# call gtk_entry_completion_set_model #} ec tm entryCompletionGetModel :: EntryCompletion -> IO TreeModel entryCompletionGetModel ec = makeNewGObject mkTreeModel $ {# call gtk_entry_completion_get_model #} ec entryCompletionSetMatchFunc :: EntryCompletion -> (String -> TreeIter -> IO ()) -> IO () entryCompletionSetMatchFunc ec handler = connect_GtkEntryCompletionMatchFunc ec handler entryCompletionSetMinimumKeyLength :: EntryCompletion -> Int -> IO () entryCompletionSetMinimumKeyLength ec minLength = {# call gtk_entry_completion_set_minimum_key_length #} ec (fromIntegral minLength) entryCompletionGetMinimumKeyLength :: EntryCompletion -> IO Int entryCompletionGetMinimumKeyLength ec = liftM fromIntegral $ {# call gtk_entry_completion_get_minimum_key_length #} ec entryCompletionComplete :: EntryCompletion -> IO () entryCompletionComplete ec = {# call gtk_entry_completion_complete #} ec entryCompletionInsertActionText :: EntryCompletion -> Int -> String -> IO () entryCompletionInsertActionText ec index text = withUTFString text $ \strPtr -> {# call gtk_entry_completion_insert_action_text #} ec (fromIntegral index) strPtr entryCompletionInsertActionMarkup :: EntryCompletion -> Int -> String -> IO () entryCompletionInsertActionMarkup ec index markup = withUTFString markup $ \strPtr -> {# call gtk_entry_completion_insert_action_markup #} ec (fromIntegral index) strPtr entryCompletionDeleteAction :: EntryCompletion -> Int -> IO () entryCompletionDeleteAction ec index = {# call gtk_entry_completion_delete_action #} ec (fromIntegral index) entryCompletionSetTextColumn :: EntryCompletion -> Int -> IO () entryCompletionSetTextColumn ec column = {# call gtk_entry_completion_set_text_column #} ec (fromIntegral column) ------------------------------------------------- -- Callback stuff for entryCompletionSetMatchFunc -- {#pointer GDestroyNotify#} foreign import ccall "wrapper" mkDestructor :: IO () -> IO GDestroyNotify type GtkEntryCompletionMatchFunc = Ptr EntryCompletion -> --GtkEntryCompletion *completion Ptr CChar -> --const gchar *key Ptr TreeIter -> --GtkTreeIter *iter Ptr () -> --gpointer user_data IO () foreign import ccall "wrapper" mkHandler_GtkEntryCompletionMatchFunc :: GtkEntryCompletionMatchFunc -> IO (FunPtr GtkEntryCompletionMatchFunc) connect_GtkEntryCompletionMatchFunc :: EntryCompletion -> (String -> TreeIter -> IO ()) -> IO () connect_GtkEntryCompletionMatchFunc ec user = do hPtr <- mkHandler_GtkEntryCompletionMatchFunc (\_ keyPtr iterPtr _ -> do key <- peekUTFString keyPtr iter <- createTreeIter iterPtr user key iter) dRef <- newIORef nullFunPtr dPtr <- mkDestructor $ do freeHaskellFunPtr hPtr dPtr <- readIORef dRef freeHaskellFunPtr dPtr writeIORef dRef dPtr {# call gtk_entry_completion_set_match_func #} ec (castFunPtr hPtr) nullPtr dPtr #endif --- Entry.chspp DELETED --- --- Editable.chspp DELETED --- --- EntryCompletion.chspp DELETED --- --- NEW FILE: Entry.chs.cpp --- -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget Entry -- -- Author : Axel Simon -- -- Created: 23 May 2001 -- -- Version $Revision: 1.1 $ from $Date: 2004/10/27 13:21:39 $ -- -- Copyright (c) 1999..2002 Axel Simon -- -- This file is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This file 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 General Public License for more details. -- -- | -- -- * This widget lets the user enter a single line of text. -- -- * TODO -- -- * A couple of signals are not bound because I could not figure out what -- they mean. Some of them do not seem to be emitted at all. -- module Entry( Entry, EntryClass, castToEntry, entryNew, entrySetText, entryGetText, #ifndef DISABLE_DEPRECATED entryAppendText, entryPrependText, #endif entrySetVisibility, entryGetVisibility, entrySetInvisibleChar, entryGetInvisibleChar, entrySetMaxLength, entryGetActivatesDefault, entrySetActivatesDefault, entryGetHasFrame, entrySetHasFrame, entryGetWidthChars, entrySetWidthChars, #if GTK_CHECK_VERSION(2,4,0) entrySetAlignment, entryGetAlignment, entrySetCompletion, entryGetCompletion, #endif onEntryActivate, afterEntryActivate, onCopyClipboard, afterCopyClipboard, onCutClipboard, afterCutClipboard, onPasteClipboard, afterPasteClipboard, onInsertAtCursor, afterInsertAtCursor, onToggleOverwrite, afterToggleOverwrite ) where import Monad (liftM) import FFI import Object (makeNewObject) import GObject (makeNewGObject) {#import Hierarchy#} {#import Signal#} import Char (ord, chr) {# context lib="gtk" prefix="gtk" #} -- GtkEntry implements the GtkEditable interface instance EditableClass Entry -- methods -- | Create a new 'Entry' widget. -- entryNew :: IO Entry entryNew = makeNewObject mkEntry $ liftM castPtr $ {#call unsafe entry_new#} -- | Set the text of the 'Entry' widget. -- entrySetText :: EntryClass ec => ec -> String -> IO () entrySetText ec str = withUTFString str $ {#call entry_set_text#} (toEntry ec) -- | Get the text of the 'Entry' widget. -- entryGetText :: EntryClass ec => ec -> IO String entryGetText ec = {#call entry_get_text#} (toEntry ec) >>= peekUTFString #ifndef DISABLE_DEPRECATED -- | Append to the text of the 'Entry' widget. -- entryAppendText :: EntryClass ec => ec -> String -> IO () entryAppendText ec str = withUTFString str $ {#call entry_append_text#} (toEntry ec) -- | Prepend the text of the 'Entry' widget. -- entryPrependText :: EntryClass ec => ec -> String -> IO () entryPrependText ec str = withUTFString str $ {#call entry_prepend_text#} (toEntry ec) #endif -- | Set whether to use password mode (display stars instead of the text). -- -- * The replacement character can be changed with 'entrySetInvisibleChar'. -- entrySetVisibility :: EntryClass ec => ec -> Bool -> IO () entrySetVisibility ec visible = {#call entry_set_visibility#} (toEntry ec) (fromBool visible) -- | Get whether widget is in password mode. -- entryGetVisibility :: EntryClass ec => ec -> IO Bool entryGetVisibility ec = liftM toBool $ {#call entry_get_visibility#} (toEntry ec) -- | Set the replacement character for invisible text. -- entrySetInvisibleChar :: EntryClass ec => ec -> Char -> IO () entrySetInvisibleChar ec ch = {#call unsafe entry_set_invisible_char#} (toEntry ec) ((fromIntegral.ord) ch) -- | Get the current replacement character for invisible text, -- or 0 if not in password mode. -- entryGetInvisibleChar :: EntryClass ec => ec -> IO Char entryGetInvisibleChar ec = liftM (chr.fromIntegral) $ {#call unsafe entry_get_invisible_char#} (toEntry ec) -- | Sets a maximum length the text may grow to. -- -- * A negative number resets the restriction. -- entrySetMaxLength :: EntryClass ec => ec -> Int -> IO () entrySetMaxLength ec max = {#call entry_set_max_length#} (toEntry ec) (fromIntegral max) -- | Gets a maximum length the text is allowed to grow to. -- entryGetMaxLength :: EntryClass ec => ec -> IO Int entryGetMaxLength ec = liftM fromIntegral $ {#call unsafe entry_get_max_length#} (toEntry ec) -- | Query whether pressing return will activate the default widget. -- entryGetActivatesDefault :: EntryClass ec => ec -> IO Bool entryGetActivatesDefault ec = liftM toBool $ {#call unsafe entry_get_activates_default#} (toEntry ec) -- | Specify if pressing return will activate -- the default widget. -- -- * This setting is useful in 'Dialog' boxes where enter should press -- the default button. -- entrySetActivatesDefault :: EntryClass ec => ec -> Bool -> IO () entrySetActivatesDefault ec setting = {#call entry_set_activates_default#} (toEntry ec) (fromBool setting) -- | Query if the text 'Entry' is displayed with a frame around it. -- entryGetHasFrame :: EntryClass ec => ec -> IO Bool entryGetHasFrame ec = liftM toBool $ {#call unsafe entry_get_has_frame#} (toEntry ec) -- | Specifies whehter the 'Entry' should be in an etched-in frame. -- entrySetHasFrame :: EntryClass ec => ec -> Bool -> IO () entrySetHasFrame ec setting = {#call entry_set_has_frame#} (toEntry ec) (fromBool setting) -- | Retrieve the number of characters the widget should ask for. -- entryGetWidthChars :: EntryClass ec => ec -> IO Int entryGetWidthChars ec = liftM fromIntegral $ {#call unsafe entry_get_width_chars#} (toEntry ec) -- | Specifies how large the 'Entry' should be in characters. -- -- * This setting is only considered when the widget formulates its size -- request. Make sure that it is not mapped (shown) before you change this -- value. -- entrySetWidthChars :: EntryClass ec => ec -> Int -> IO () entrySetWidthChars ec setting = {#call entry_set_width_chars#} (toEntry ec) (fromIntegral setting) #if GTK_CHECK_VERSION(2,4,0) -- | Sets the alignment for the contents of the entry. This controls the -- horizontal positioning of the contents when the displayed text is shorter -- than the width of the entry. -- -- * Since gtk 2.4 -- entrySetAlignment :: EntryClass ec => ec -> Float -> IO () entrySetAlignment ec xalign = {#call entry_set_alignment#} (toEntry ec) (realToFrac xalign) -- | Gets the value set by 'entrySetAlignment'. -- -- * Since gtk 2.4 -- entryGetAlignment :: EntryClass ec => ec -> IO Float entryGetAlignment ec = liftM realToFrac $ {#call unsafe entry_get_alignment#} (toEntry ec) -- | Sets the auxiliary completion object to use with the entry. All further -- configuration of the completion mechanism is done on completion using the -- "EntryCompletion" API. -- -- * Since gtk 2.4 -- entrySetCompletion :: EntryClass ec => ec -> EntryCompletion -> IO () entrySetCompletion ec completion = {#call gtk_entry_set_completion#} (toEntry ec) completion -- | Returns the auxiliary completion object currently in use by the entry. -- -- * Since gtk 2.4 -- entryGetCompletion :: EntryClass ec => ec -> IO EntryCompletion entryGetCompletion ec = makeNewGObject mkEntryCompletion $ {#call gtk_entry_get_completion#} (toEntry ec) #endif -- signals -- | Emitted when the user presses return within -- the 'Entry' field. -- onEntryActivate, afterEntryActivate :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onEntryActivate = connect_NONE__NONE "activate" False afterEntryActivate = connect_NONE__NONE "activate" True -- | Emitted when the settings of the -- 'Entry' widget changes. -- onEntryChanged, afterEntryChanged :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onEntryChanged = connect_NONE__NONE "changed" False afterEntryChanged = connect_NONE__NONE "changed" True -- | Emitted when the current selection has been -- copied to the clipboard. -- onCopyClipboard, afterCopyClipboard :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onCopyClipboard = connect_NONE__NONE "copy_clipboard" False afterCopyClipboard = connect_NONE__NONE "copy_clipboard" True -- | Emitted when the current selection has been -- cut to the clipboard. -- onCutClipboard, afterCutClipboard :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onCutClipboard = connect_NONE__NONE "cut_clipboard" False afterCutClipboard = connect_NONE__NONE "cut_clipboard" True -- | Emitted when the current selection has -- been pasted from the clipboard. -- onPasteClipboard, afterPasteClipboard :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onPasteClipboard = connect_NONE__NONE "paste_clipboard" False afterPasteClipboard = connect_NONE__NONE "paste_clipboard" True -- | Emitted when a piece of text is deleted from -- the 'Entry'. -- onDeleteText, afterDeleteText :: EntryClass ec => ec -> (Int -> Int -> IO ()) -> IO (ConnectId ec) onDeleteText = connect_INT_INT__NONE "delete_text" False afterDeleteText = connect_INT_INT__NONE "delete_text" True -- | Emitted when a piece of text is inserted -- at the cursor position. -- onInsertAtCursor, afterInsertAtCursor :: EntryClass ec => ec -> (String -> IO ()) -> IO (ConnectId ec) onInsertAtCursor = connect_STRING__NONE "insert_at_cursor" False afterInsertAtCursor = connect_STRING__NONE "insert_at_cursor" True -- | Emitted when the user changes from -- overwriting to inserting. -- onToggleOverwrite, afterToggleOverwrite :: EntryClass ec => ec -> IO () -> IO (ConnectId ec) onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True --- NEW FILE: Editable.chs.cpp --- -- -*-haskell-*- -- GIMP Toolkit (GTK) Interface Editable -- -- Author : Axel Simon, Duncan Coutts -- -- Created: 30 July 2004 -- split off from Entry.chs -- -- Copyright (c) 1999..2002 Axel Simon -- modified 2004 Duncan Coutts -- -- This file is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This file 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 General Public License for more details. -- -- | -- -- * This is an interface for simple single-line text editing widgets. It is -- implemented by "Entry" and "SpinButton". -- -- * TODO -- -- * Find out if \"insert-text\" signal is useful and how to bind it. It is -- tricky because it has an in-out parameter. -- module Editable( -- * Data types Editable, EditableClass, castToEditable, -- * Methods editableSelectRegion, editableGetSelectionBounds, editableInsertText, editableDeleteText, editableGetChars, editableCutClipboard, editableCopyClipboard, editablePasteClipboard, editableDeleteSelection, editableSetEditable, editableGetEditable, editableSetPosition, editableGetPosition, -- * Signals onEditableChanged, afterEditableChanged, onDeleteText, afterDeleteText, ) where import Monad (liftM) import FFI import Object (makeNewObject) import GObject (makeNewGObject) {#import Hierarchy#} {#import Signal#} {# context lib="gtk" prefix="gtk" #} -- | Select a span of text. -- -- * A negative @end@ position will make the selection extend to the -- end of the buffer. -- -- * Calling this function with @start@=1 and @end@=4 it will -- mark \"ask\" in the string \"Haskell\". (FIXME: verify) -- editableSelectRegion :: EditableClass ed => ed -> Int -> Int -> IO () editableSelectRegion ed start end = {#call editable_select_region#} (toEditable ed) (fromIntegral start) (fromIntegral end) -- | Get the span of the current selection. -- -- * The returned tuple is not ordered. The second index represents the -- position of the cursor. The first index is the other end of the -- selection. If both numbers are equal there is in fact no selection. -- editableGetSelectionBounds :: EditableClass ed => ed -> IO (Int,Int) editableGetSelectionBounds ed = alloca $ \startPtr -> alloca $ \endPtr -> do {#call unsafe editable_get_selection_bounds#} (toEditable ed) startPtr endPtr start <- liftM fromIntegral $ peek startPtr end <- liftM fromIntegral $ peek endPtr return (start,end) -- | Insert new text at the specified position. -- -- * If the position is invalid the text will be inserted at the end of the -- buffer. The returned value reflects the actual insertion point. -- editableInsertText :: EditableClass ed => ed -> String -> Int -> IO Int editableInsertText ed str pos = withObject (fromIntegral pos) $ \posPtr -> withUTFStringLen str $ \(strPtr,len) -> do {#call editable_insert_text#} (toEditable ed) strPtr (fromIntegral len) posPtr liftM fromIntegral $ peek posPtr -- | Delete a given range of text. -- -- * If the @end@ position is invalid, it is set to the lenght of the -- buffer. -- -- * @start@ is restricted to 0..@end@. -- editableDeleteText :: EditableClass ed => ed -> Int -> Int -> IO () editableDeleteText ed start end = {#call editable_delete_text#} (toEditable ed) (fromIntegral start) (fromIntegral end) -- | Retrieve a range of characters. -- -- * Set @end@ to a negative value to reach the end of the buffer. -- editableGetChars :: EditableClass ed => ed -> Int -> Int -> IO String editableGetChars ed start end = do strPtr <- {#call unsafe editable_get_chars#} (toEditable ed) (fromIntegral start) (fromIntegral end) str <- peekUTFString strPtr {#call unsafe g_free#} (castPtr strPtr) return str -- | Cut the selected characters to the Clipboard. -- editableCutClipboard :: EditableClass ed => ed -> IO () editableCutClipboard = {#call editable_cut_clipboard#}.toEditable -- | Copy the selected characters to the Clipboard. -- editableCopyClipboard :: EditableClass ed => ed -> IO () editableCopyClipboard = {#call editable_copy_clipboard#}.toEditable -- | Paste the selected characters to the -- Clipboard. -- editablePasteClipboard :: EditableClass ed => ed -> IO () editablePasteClipboard = {#call editable_paste_clipboard#}.toEditable -- | Delete the current selection. -- editableDeleteSelection :: EditableClass ed => ed -> IO () editableDeleteSelection = {#call editable_delete_selection#}.toEditable -- | Set the cursor to a specific position. -- editableSetPosition :: EditableClass ed => ed -> Int -> IO () editableSetPosition ed pos = {#call editable_set_position#} (toEditable ed) (fromIntegral pos) -- | Get the current cursor position. -- editableGetPosition :: EditableClass ed => ed -> IO Int editableGetPosition ed = liftM fromIntegral $ {#call unsafe editable_get_position#} (toEditable ed) -- | Make the widget insensitive. -- -- * Called with False will make the text uneditable. -- editableSetEditable :: EditableClass ed => ed -> Bool -> IO () editableSetEditable ed isEditable = {#call editable_set_editable#} (toEditable ed) (fromBool isEditable) -- | Retrieves whether the text is editable. -- editableGetEditable :: EditableClass ed => ed -> IO Bool editableGetEditable ed = liftM toBool $ {#call editable_get_editable#} (toEditable ed) -- signals -- | Emitted when the settings of the 'Editable' widget changes. -- onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () -> IO (ConnectId ec) onEditableChanged = connect_NONE__NONE "changed" False afterEditableChanged = connect_NONE__NONE "changed" True -- | Emitted when a piece of text is deleted from the 'Editable' widget. -- onDeleteText, afterDeleteText :: EditableClass ec => ec -> (Int -> Int -> IO ()) -> IO (ConnectId ec) onDeleteText = connect_INT_INT__NONE "delete_text" False afterDeleteText = connect_INT_INT__NONE "delete_text" True |
